------------------------------------------------------------------------------
|
------------------------------------------------------------------------------
|
-- --
|
-- --
|
-- GNAT COMPILER COMPONENTS --
|
-- GNAT COMPILER COMPONENTS --
|
-- --
|
-- --
|
-- S Y M B O L S --
|
-- S Y M B O L S --
|
-- --
|
-- --
|
-- 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 version of this package
|
-- This is the VMS version of this package
|
|
|
with Ada.Exceptions; use Ada.Exceptions;
|
with Ada.Exceptions; use Ada.Exceptions;
|
with Ada.Sequential_IO;
|
with Ada.Sequential_IO;
|
with Ada.Text_IO; use Ada.Text_IO;
|
with Ada.Text_IO; use Ada.Text_IO;
|
|
|
package body Symbols is
|
package body Symbols is
|
|
|
Case_Sensitive : constant String := "case_sensitive=";
|
Case_Sensitive : constant String := "case_sensitive=";
|
Symbol_Vector : constant String := "SYMBOL_VECTOR=(";
|
Symbol_Vector : constant String := "SYMBOL_VECTOR=(";
|
Equal_Data : constant String := "=DATA)";
|
Equal_Data : constant String := "=DATA)";
|
Equal_Procedure : constant String := "=PROCEDURE)";
|
Equal_Procedure : constant String := "=PROCEDURE)";
|
Gsmatch : constant String := "gsmatch=";
|
Gsmatch : constant String := "gsmatch=";
|
Gsmatch_Lequal : constant String := "gsmatch=lequal,";
|
Gsmatch_Lequal : constant String := "gsmatch=lequal,";
|
|
|
Symbol_File_Name : String_Access := null;
|
Symbol_File_Name : String_Access := null;
|
-- Name of the symbol file
|
-- Name of the symbol file
|
|
|
Long_Symbol_Length : constant := 100;
|
Long_Symbol_Length : constant := 100;
|
-- Magic length of symbols, over which the lines are split
|
-- Magic length of symbols, over which the lines are split
|
|
|
Sym_Policy : Policy := Autonomous;
|
Sym_Policy : Policy := Autonomous;
|
-- The symbol policy. Set by Initialize
|
-- The symbol policy. Set by Initialize
|
|
|
Major_ID : Integer := 1;
|
Major_ID : Integer := 1;
|
-- The Major ID. May be modified by Initialize if Library_Version is
|
-- The Major ID. May be modified by Initialize if Library_Version is
|
-- specified or if it is read from the reference symbol file.
|
-- specified or if it is read from the reference symbol file.
|
|
|
Soft_Major_ID : Boolean := True;
|
Soft_Major_ID : Boolean := True;
|
-- False if library version is specified in procedure Initialize.
|
-- False if library version is specified in procedure Initialize.
|
-- When True, Major_ID may be modified if found in the reference symbol
|
-- When True, Major_ID may be modified if found in the reference symbol
|
-- file.
|
-- file.
|
|
|
Minor_ID : Natural := 0;
|
Minor_ID : Natural := 0;
|
-- The Minor ID. May be modified if read from the reference symbol file
|
-- The Minor ID. May be modified if read from the reference symbol file
|
|
|
Soft_Minor_ID : Boolean := True;
|
Soft_Minor_ID : Boolean := True;
|
-- False if symbol policy is Autonomous, if library version is specified
|
-- False if symbol policy is Autonomous, if library version is specified
|
-- in procedure Initialize and is not the same as the major ID read from
|
-- in procedure Initialize and is not the same as the major ID read from
|
-- the reference symbol file. When True, Minor_ID may be increased in
|
-- the reference symbol file. When True, Minor_ID may be increased in
|
-- Compliant symbol policy.
|
-- Compliant symbol policy.
|
|
|
subtype Byte is Character;
|
subtype Byte is Character;
|
-- Object files are stream of bytes, but some of these bytes, those for
|
-- Object files are stream of bytes, but some of these bytes, those for
|
-- the names of the symbols, are ASCII characters.
|
-- the names of the symbols, are ASCII characters.
|
|
|
package Byte_IO is new Ada.Sequential_IO (Byte);
|
package Byte_IO is new Ada.Sequential_IO (Byte);
|
use Byte_IO;
|
use Byte_IO;
|
|
|
File : Byte_IO.File_Type;
|
File : Byte_IO.File_Type;
|
-- Each object file is read as a stream of bytes (characters)
|
-- Each object file is read as a stream of bytes (characters)
|
|
|
function Equal (Left, Right : Symbol_Data) return Boolean;
|
function Equal (Left, Right : Symbol_Data) return Boolean;
|
-- Test for equality of symbols
|
-- Test for equality of symbols
|
|
|
function Image (N : Integer) return String;
|
function Image (N : Integer) return String;
|
-- Returns the image of N, without the initial space
|
-- Returns the image of N, without the initial space
|
|
|
-----------
|
-----------
|
-- Equal --
|
-- Equal --
|
-----------
|
-----------
|
|
|
function Equal (Left, Right : Symbol_Data) return Boolean is
|
function Equal (Left, Right : Symbol_Data) return Boolean is
|
begin
|
begin
|
return Left.Name /= null and then
|
return Left.Name /= null and then
|
Right.Name /= null and then
|
Right.Name /= null and then
|
Left.Name.all = Right.Name.all and then
|
Left.Name.all = Right.Name.all and then
|
Left.Kind = Right.Kind and then
|
Left.Kind = Right.Kind and then
|
Left.Present = Right.Present;
|
Left.Present = Right.Present;
|
end Equal;
|
end Equal;
|
|
|
-----------
|
-----------
|
-- Image --
|
-- Image --
|
-----------
|
-----------
|
|
|
function Image (N : Integer) return String is
|
function Image (N : Integer) return String is
|
Result : constant String := N'Img;
|
Result : constant String := N'Img;
|
begin
|
begin
|
if Result (Result'First) = ' ' then
|
if Result (Result'First) = ' ' then
|
return Result (Result'First + 1 .. Result'Last);
|
return Result (Result'First + 1 .. Result'Last);
|
else
|
else
|
return Result;
|
return Result;
|
end if;
|
end if;
|
end Image;
|
end Image;
|
|
|
----------------
|
----------------
|
-- Initialize --
|
-- Initialize --
|
----------------
|
----------------
|
|
|
procedure Initialize
|
procedure Initialize
|
(Symbol_File : String;
|
(Symbol_File : String;
|
Reference : String;
|
Reference : String;
|
Symbol_Policy : Policy;
|
Symbol_Policy : Policy;
|
Quiet : Boolean;
|
Quiet : Boolean;
|
Version : String;
|
Version : String;
|
Success : out Boolean)
|
Success : out Boolean)
|
is
|
is
|
File : Ada.Text_IO.File_Type;
|
File : Ada.Text_IO.File_Type;
|
Line : String (1 .. 2_000);
|
Line : String (1 .. 2_000);
|
Last : Natural;
|
Last : Natural;
|
|
|
Offset : Natural;
|
Offset : Natural;
|
|
|
begin
|
begin
|
-- Record the symbol file name
|
-- Record the symbol file name
|
|
|
Symbol_File_Name := new String'(Symbol_File);
|
Symbol_File_Name := new String'(Symbol_File);
|
|
|
-- Record the policy
|
-- Record the policy
|
|
|
Sym_Policy := Symbol_Policy;
|
Sym_Policy := Symbol_Policy;
|
|
|
-- Record the version (Major ID)
|
-- Record the version (Major ID)
|
|
|
if Version = "" then
|
if Version = "" then
|
Major_ID := 1;
|
Major_ID := 1;
|
Soft_Major_ID := True;
|
Soft_Major_ID := True;
|
|
|
else
|
else
|
begin
|
begin
|
Major_ID := Integer'Value (Version);
|
Major_ID := Integer'Value (Version);
|
Soft_Major_ID := False;
|
Soft_Major_ID := False;
|
|
|
if Major_ID <= 0 then
|
if Major_ID <= 0 then
|
raise Constraint_Error;
|
raise Constraint_Error;
|
end if;
|
end if;
|
|
|
exception
|
exception
|
when Constraint_Error =>
|
when Constraint_Error =>
|
if not Quiet then
|
if not Quiet then
|
Put_Line ("Version """ & Version & """ is illegal.");
|
Put_Line ("Version """ & Version & """ is illegal.");
|
Put_Line ("On VMS, version must be a positive number");
|
Put_Line ("On VMS, version must be a positive number");
|
end if;
|
end if;
|
|
|
Success := False;
|
Success := False;
|
return;
|
return;
|
end;
|
end;
|
end if;
|
end if;
|
|
|
Minor_ID := 0;
|
Minor_ID := 0;
|
Soft_Minor_ID := Sym_Policy /= Autonomous;
|
Soft_Minor_ID := Sym_Policy /= Autonomous;
|
|
|
-- Empty the symbol tables
|
-- Empty the symbol tables
|
|
|
Symbol_Table.Set_Last (Original_Symbols, 0);
|
Symbol_Table.Set_Last (Original_Symbols, 0);
|
Symbol_Table.Set_Last (Complete_Symbols, 0);
|
Symbol_Table.Set_Last (Complete_Symbols, 0);
|
|
|
-- Assume that everything will be fine
|
-- Assume that everything will be fine
|
|
|
Success := True;
|
Success := True;
|
|
|
-- If policy is Compliant or Controlled, attempt to read the reference
|
-- If policy is Compliant or Controlled, attempt to read the reference
|
-- file. If policy is Restricted, attempt to read the symbol file.
|
-- file. If policy is Restricted, attempt to read the symbol file.
|
|
|
if Sym_Policy /= Autonomous then
|
if Sym_Policy /= Autonomous then
|
case Sym_Policy is
|
case Sym_Policy is
|
when Autonomous | Direct =>
|
when Autonomous | Direct =>
|
null;
|
null;
|
|
|
when Compliant | Controlled =>
|
when Compliant | Controlled =>
|
begin
|
begin
|
Open (File, In_File, Reference);
|
Open (File, In_File, Reference);
|
|
|
exception
|
exception
|
when Ada.Text_IO.Name_Error =>
|
when Ada.Text_IO.Name_Error =>
|
Success := False;
|
Success := False;
|
return;
|
return;
|
|
|
when X : others =>
|
when X : others =>
|
if not Quiet then
|
if not Quiet then
|
Put_Line ("could not open """ & Reference & """");
|
Put_Line ("could not open """ & Reference & """");
|
Put_Line (Exception_Message (X));
|
Put_Line (Exception_Message (X));
|
end if;
|
end if;
|
|
|
Success := False;
|
Success := False;
|
return;
|
return;
|
end;
|
end;
|
|
|
when Restricted =>
|
when Restricted =>
|
begin
|
begin
|
Open (File, In_File, Symbol_File);
|
Open (File, In_File, Symbol_File);
|
|
|
exception
|
exception
|
when Ada.Text_IO.Name_Error =>
|
when Ada.Text_IO.Name_Error =>
|
Success := False;
|
Success := False;
|
return;
|
return;
|
|
|
when X : others =>
|
when X : others =>
|
if not Quiet then
|
if not Quiet then
|
Put_Line ("could not open """ & Symbol_File & """");
|
Put_Line ("could not open """ & Symbol_File & """");
|
Put_Line (Exception_Message (X));
|
Put_Line (Exception_Message (X));
|
end if;
|
end if;
|
|
|
Success := False;
|
Success := False;
|
return;
|
return;
|
end;
|
end;
|
end case;
|
end case;
|
|
|
-- Read line by line
|
-- Read line by line
|
|
|
while not End_Of_File (File) loop
|
while not End_Of_File (File) loop
|
Offset := 0;
|
Offset := 0;
|
loop
|
loop
|
Get_Line (File, Line (Offset + 1 .. Line'Last), Last);
|
Get_Line (File, Line (Offset + 1 .. Line'Last), Last);
|
exit when Line (Last) /= '-';
|
exit when Line (Last) /= '-';
|
|
|
if End_Of_File (File) then
|
if End_Of_File (File) then
|
if not Quiet then
|
if not Quiet then
|
Put_Line ("symbol file """ & Reference &
|
Put_Line ("symbol file """ & Reference &
|
""" is incorrectly formatted:");
|
""" is incorrectly formatted:");
|
Put_Line ("""" & Line (1 .. Last) & """");
|
Put_Line ("""" & Line (1 .. Last) & """");
|
end if;
|
end if;
|
|
|
Close (File);
|
Close (File);
|
Success := False;
|
Success := False;
|
return;
|
return;
|
|
|
else
|
else
|
Offset := Last - 1;
|
Offset := Last - 1;
|
end if;
|
end if;
|
end loop;
|
end loop;
|
|
|
-- Ignore empty lines
|
-- Ignore empty lines
|
|
|
if Last = 0 then
|
if Last = 0 then
|
null;
|
null;
|
|
|
-- Ignore lines starting with "case_sensitive="
|
-- Ignore lines starting with "case_sensitive="
|
|
|
elsif Last > Case_Sensitive'Length
|
elsif Last > Case_Sensitive'Length
|
and then Line (1 .. Case_Sensitive'Length) = Case_Sensitive
|
and then Line (1 .. Case_Sensitive'Length) = Case_Sensitive
|
then
|
then
|
null;
|
null;
|
|
|
-- Line starting with "SYMBOL_VECTOR=("
|
-- Line starting with "SYMBOL_VECTOR=("
|
|
|
elsif Last > Symbol_Vector'Length
|
elsif Last > Symbol_Vector'Length
|
and then Line (1 .. Symbol_Vector'Length) = Symbol_Vector
|
and then Line (1 .. Symbol_Vector'Length) = Symbol_Vector
|
then
|
then
|
|
|
-- SYMBOL_VECTOR=(<symbol>=DATA)
|
-- SYMBOL_VECTOR=(<symbol>=DATA)
|
|
|
if Last > Symbol_Vector'Length + Equal_Data'Length and then
|
if Last > Symbol_Vector'Length + Equal_Data'Length and then
|
Line (Last - Equal_Data'Length + 1 .. Last) = Equal_Data
|
Line (Last - Equal_Data'Length + 1 .. Last) = Equal_Data
|
then
|
then
|
Symbol_Table.Append (Original_Symbols,
|
Symbol_Table.Append (Original_Symbols,
|
(Name =>
|
(Name =>
|
new String'(Line (Symbol_Vector'Length + 1 ..
|
new String'(Line (Symbol_Vector'Length + 1 ..
|
Last - Equal_Data'Length)),
|
Last - Equal_Data'Length)),
|
Kind => Data,
|
Kind => Data,
|
Present => True));
|
Present => True));
|
|
|
-- SYMBOL_VECTOR=(<symbol>=PROCEDURE)
|
-- SYMBOL_VECTOR=(<symbol>=PROCEDURE)
|
|
|
elsif Last > Symbol_Vector'Length + Equal_Procedure'Length
|
elsif Last > Symbol_Vector'Length + Equal_Procedure'Length
|
and then
|
and then
|
Line (Last - Equal_Procedure'Length + 1 .. Last) =
|
Line (Last - Equal_Procedure'Length + 1 .. Last) =
|
Equal_Procedure
|
Equal_Procedure
|
then
|
then
|
Symbol_Table.Append (Original_Symbols,
|
Symbol_Table.Append (Original_Symbols,
|
(Name =>
|
(Name =>
|
new String'(Line (Symbol_Vector'Length + 1 ..
|
new String'(Line (Symbol_Vector'Length + 1 ..
|
Last - Equal_Procedure'Length)),
|
Last - Equal_Procedure'Length)),
|
Kind => Proc,
|
Kind => Proc,
|
Present => True));
|
Present => True));
|
|
|
-- Anything else is incorrectly formatted
|
-- Anything else is incorrectly formatted
|
|
|
else
|
else
|
if not Quiet then
|
if not Quiet then
|
Put_Line ("symbol file """ & Reference &
|
Put_Line ("symbol file """ & Reference &
|
""" is incorrectly formatted:");
|
""" is incorrectly formatted:");
|
Put_Line ("""" & Line (1 .. Last) & """");
|
Put_Line ("""" & Line (1 .. Last) & """");
|
end if;
|
end if;
|
|
|
Close (File);
|
Close (File);
|
Success := False;
|
Success := False;
|
return;
|
return;
|
end if;
|
end if;
|
|
|
-- Lines with "gsmatch=lequal," or "gsmatch=equal,"
|
-- Lines with "gsmatch=lequal," or "gsmatch=equal,"
|
|
|
elsif Last > Gsmatch'Length
|
elsif Last > Gsmatch'Length
|
and then Line (1 .. Gsmatch'Length) = Gsmatch
|
and then Line (1 .. Gsmatch'Length) = Gsmatch
|
then
|
then
|
declare
|
declare
|
Start : Positive := Gsmatch'Length + 1;
|
Start : Positive := Gsmatch'Length + 1;
|
Finish : Positive := Start;
|
Finish : Positive := Start;
|
OK : Boolean := True;
|
OK : Boolean := True;
|
ID : Integer;
|
ID : Integer;
|
|
|
begin
|
begin
|
-- First, look for the first coma
|
-- First, look for the first coma
|
|
|
loop
|
loop
|
if Start >= Last - 1 then
|
if Start >= Last - 1 then
|
OK := False;
|
OK := False;
|
exit;
|
exit;
|
|
|
elsif Line (Start) = ',' then
|
elsif Line (Start) = ',' then
|
Start := Start + 1;
|
Start := Start + 1;
|
exit;
|
exit;
|
|
|
else
|
else
|
Start := Start + 1;
|
Start := Start + 1;
|
end if;
|
end if;
|
end loop;
|
end loop;
|
|
|
Finish := Start;
|
Finish := Start;
|
|
|
-- If the comma is found, get the Major and the Minor IDs
|
-- If the comma is found, get the Major and the Minor IDs
|
|
|
if OK then
|
if OK then
|
loop
|
loop
|
if Line (Finish) not in '0' .. '9'
|
if Line (Finish) not in '0' .. '9'
|
or else Finish >= Last - 1
|
or else Finish >= Last - 1
|
then
|
then
|
OK := False;
|
OK := False;
|
exit;
|
exit;
|
end if;
|
end if;
|
|
|
exit when Line (Finish + 1) = ',';
|
exit when Line (Finish + 1) = ',';
|
|
|
Finish := Finish + 1;
|
Finish := Finish + 1;
|
end loop;
|
end loop;
|
end if;
|
end if;
|
|
|
if OK then
|
if OK then
|
ID := Integer'Value (Line (Start .. Finish));
|
ID := Integer'Value (Line (Start .. Finish));
|
OK := ID /= 0;
|
OK := ID /= 0;
|
|
|
-- If Soft_Major_ID is True, it means that
|
-- If Soft_Major_ID is True, it means that
|
-- Library_Version was not specified.
|
-- Library_Version was not specified.
|
|
|
if Soft_Major_ID then
|
if Soft_Major_ID then
|
Major_ID := ID;
|
Major_ID := ID;
|
|
|
-- If the Major ID in the reference file is different
|
-- If the Major ID in the reference file is different
|
-- from the Library_Version, then the Minor ID will be 0
|
-- from the Library_Version, then the Minor ID will be 0
|
-- because there is no point in taking the Minor ID in
|
-- because there is no point in taking the Minor ID in
|
-- the reference file, or incrementing it. So, we set
|
-- the reference file, or incrementing it. So, we set
|
-- Soft_Minor_ID to False, so that we don't modify
|
-- Soft_Minor_ID to False, so that we don't modify
|
-- the Minor_ID later.
|
-- the Minor_ID later.
|
|
|
elsif Major_ID /= ID then
|
elsif Major_ID /= ID then
|
Soft_Minor_ID := False;
|
Soft_Minor_ID := False;
|
end if;
|
end if;
|
|
|
Start := Finish + 2;
|
Start := Finish + 2;
|
Finish := Start;
|
Finish := Start;
|
|
|
loop
|
loop
|
if Line (Finish) not in '0' .. '9' then
|
if Line (Finish) not in '0' .. '9' then
|
OK := False;
|
OK := False;
|
exit;
|
exit;
|
end if;
|
end if;
|
|
|
exit when Finish = Last;
|
exit when Finish = Last;
|
|
|
Finish := Finish + 1;
|
Finish := Finish + 1;
|
end loop;
|
end loop;
|
|
|
-- Only set Minor_ID if Soft_Minor_ID is True (see above)
|
-- Only set Minor_ID if Soft_Minor_ID is True (see above)
|
|
|
if OK and then Soft_Minor_ID then
|
if OK and then Soft_Minor_ID then
|
Minor_ID := Integer'Value (Line (Start .. Finish));
|
Minor_ID := Integer'Value (Line (Start .. Finish));
|
end if;
|
end if;
|
end if;
|
end if;
|
|
|
-- If OK is not True, that means the line is not correctly
|
-- If OK is not True, that means the line is not correctly
|
-- formatted.
|
-- formatted.
|
|
|
if not OK then
|
if not OK then
|
if not Quiet then
|
if not Quiet then
|
Put_Line ("symbol file """ & Reference &
|
Put_Line ("symbol file """ & Reference &
|
""" is incorrectly formatted");
|
""" is incorrectly formatted");
|
Put_Line ("""" & Line (1 .. Last) & """");
|
Put_Line ("""" & Line (1 .. Last) & """");
|
end if;
|
end if;
|
|
|
Close (File);
|
Close (File);
|
Success := False;
|
Success := False;
|
return;
|
return;
|
end if;
|
end if;
|
end;
|
end;
|
|
|
-- Anything else is incorrectly formatted
|
-- Anything else is incorrectly formatted
|
|
|
else
|
else
|
if not Quiet then
|
if not Quiet then
|
Put_Line ("unexpected line in symbol file """ &
|
Put_Line ("unexpected line in symbol file """ &
|
Reference & """");
|
Reference & """");
|
Put_Line ("""" & Line (1 .. Last) & """");
|
Put_Line ("""" & Line (1 .. Last) & """");
|
end if;
|
end if;
|
|
|
Close (File);
|
Close (File);
|
Success := False;
|
Success := False;
|
return;
|
return;
|
end if;
|
end if;
|
end loop;
|
end loop;
|
|
|
Close (File);
|
Close (File);
|
end if;
|
end if;
|
end Initialize;
|
end Initialize;
|
|
|
----------------
|
----------------
|
-- Processing --
|
-- Processing --
|
----------------
|
----------------
|
|
|
package body Processing is separate;
|
package body Processing is separate;
|
|
|
--------------
|
--------------
|
-- Finalize --
|
-- Finalize --
|
--------------
|
--------------
|
|
|
procedure Finalize
|
procedure Finalize
|
(Quiet : Boolean;
|
(Quiet : Boolean;
|
Success : out Boolean)
|
Success : out Boolean)
|
is
|
is
|
File : Ada.Text_IO.File_Type;
|
File : Ada.Text_IO.File_Type;
|
-- The symbol file
|
-- The symbol file
|
|
|
S_Data : Symbol_Data;
|
S_Data : Symbol_Data;
|
-- A symbol
|
-- A symbol
|
|
|
Cur : Positive := 1;
|
Cur : Positive := 1;
|
-- Most probable index in the Complete_Symbols of the current symbol
|
-- Most probable index in the Complete_Symbols of the current symbol
|
-- in Original_Symbol.
|
-- in Original_Symbol.
|
|
|
Found : Boolean;
|
Found : Boolean;
|
|
|
begin
|
begin
|
-- Nothing to be done if Initialize has never been called
|
-- Nothing to be done if Initialize has never been called
|
|
|
if Symbol_File_Name = null then
|
if Symbol_File_Name = null then
|
Success := False;
|
Success := False;
|
|
|
else
|
else
|
|
|
-- First find if the symbols in the reference symbol file are also
|
-- First find if the symbols in the reference symbol file are also
|
-- in the object files. Note that this is not done if the policy is
|
-- in the object files. Note that this is not done if the policy is
|
-- Autonomous, because no reference symbol file has been read.
|
-- Autonomous, because no reference symbol file has been read.
|
|
|
-- Expect the first symbol in the symbol file to also be the first
|
-- Expect the first symbol in the symbol file to also be the first
|
-- in Complete_Symbols.
|
-- in Complete_Symbols.
|
|
|
Cur := 1;
|
Cur := 1;
|
|
|
for Index_1 in 1 .. Symbol_Table.Last (Original_Symbols) loop
|
for Index_1 in 1 .. Symbol_Table.Last (Original_Symbols) loop
|
S_Data := Original_Symbols.Table (Index_1);
|
S_Data := Original_Symbols.Table (Index_1);
|
Found := False;
|
Found := False;
|
|
|
First_Object_Loop :
|
First_Object_Loop :
|
for Index_2 in Cur .. Symbol_Table.Last (Complete_Symbols) loop
|
for Index_2 in Cur .. Symbol_Table.Last (Complete_Symbols) loop
|
if Equal (S_Data, Complete_Symbols.Table (Index_2)) then
|
if Equal (S_Data, Complete_Symbols.Table (Index_2)) then
|
Cur := Index_2 + 1;
|
Cur := Index_2 + 1;
|
Complete_Symbols.Table (Index_2).Present := False;
|
Complete_Symbols.Table (Index_2).Present := False;
|
Found := True;
|
Found := True;
|
exit First_Object_Loop;
|
exit First_Object_Loop;
|
end if;
|
end if;
|
end loop First_Object_Loop;
|
end loop First_Object_Loop;
|
|
|
-- If the symbol could not be found between Cur and Last, try
|
-- If the symbol could not be found between Cur and Last, try
|
-- before Cur.
|
-- before Cur.
|
|
|
if not Found then
|
if not Found then
|
Second_Object_Loop :
|
Second_Object_Loop :
|
for Index_2 in 1 .. Cur - 1 loop
|
for Index_2 in 1 .. Cur - 1 loop
|
if Equal (S_Data, Complete_Symbols.Table (Index_2)) then
|
if Equal (S_Data, Complete_Symbols.Table (Index_2)) then
|
Cur := Index_2 + 1;
|
Cur := Index_2 + 1;
|
Complete_Symbols.Table (Index_2).Present := False;
|
Complete_Symbols.Table (Index_2).Present := False;
|
Found := True;
|
Found := True;
|
exit Second_Object_Loop;
|
exit Second_Object_Loop;
|
end if;
|
end if;
|
end loop Second_Object_Loop;
|
end loop Second_Object_Loop;
|
end if;
|
end if;
|
|
|
-- If the symbol is not found, mark it as such in the table
|
-- If the symbol is not found, mark it as such in the table
|
|
|
if not Found then
|
if not Found then
|
if (not Quiet) or else Sym_Policy = Controlled then
|
if (not Quiet) or else Sym_Policy = Controlled then
|
Put_Line ("symbol """ & S_Data.Name.all &
|
Put_Line ("symbol """ & S_Data.Name.all &
|
""" is no longer present in the object files");
|
""" is no longer present in the object files");
|
end if;
|
end if;
|
|
|
if Sym_Policy = Controlled or else Sym_Policy = Restricted then
|
if Sym_Policy = Controlled or else Sym_Policy = Restricted then
|
Success := False;
|
Success := False;
|
return;
|
return;
|
|
|
-- Any symbol that is undefined in the reference symbol file
|
-- Any symbol that is undefined in the reference symbol file
|
-- triggers an increase of the Major ID, because the new
|
-- triggers an increase of the Major ID, because the new
|
-- version of the library is no longer compatible with
|
-- version of the library is no longer compatible with
|
-- existing executables.
|
-- existing executables.
|
|
|
elsif Soft_Major_ID then
|
elsif Soft_Major_ID then
|
Major_ID := Major_ID + 1;
|
Major_ID := Major_ID + 1;
|
Minor_ID := 0;
|
Minor_ID := 0;
|
Soft_Major_ID := False;
|
Soft_Major_ID := False;
|
Soft_Minor_ID := False;
|
Soft_Minor_ID := False;
|
end if;
|
end if;
|
|
|
Original_Symbols.Table (Index_1).Present := False;
|
Original_Symbols.Table (Index_1).Present := False;
|
Free (Original_Symbols.Table (Index_1).Name);
|
Free (Original_Symbols.Table (Index_1).Name);
|
|
|
if Soft_Minor_ID then
|
if Soft_Minor_ID then
|
Minor_ID := Minor_ID + 1;
|
Minor_ID := Minor_ID + 1;
|
Soft_Minor_ID := False;
|
Soft_Minor_ID := False;
|
end if;
|
end if;
|
end if;
|
end if;
|
end loop;
|
end loop;
|
|
|
if Sym_Policy /= Restricted then
|
if Sym_Policy /= Restricted then
|
|
|
-- Append additional symbols, if any, to the Original_Symbols
|
-- Append additional symbols, if any, to the Original_Symbols
|
-- table.
|
-- table.
|
|
|
for Index in 1 .. Symbol_Table.Last (Complete_Symbols) loop
|
for Index in 1 .. Symbol_Table.Last (Complete_Symbols) loop
|
S_Data := Complete_Symbols.Table (Index);
|
S_Data := Complete_Symbols.Table (Index);
|
|
|
if S_Data.Present then
|
if S_Data.Present then
|
|
|
if Sym_Policy = Controlled then
|
if Sym_Policy = Controlled then
|
Put_Line ("symbol """ & S_Data.Name.all &
|
Put_Line ("symbol """ & S_Data.Name.all &
|
""" is not in the reference symbol file");
|
""" is not in the reference symbol file");
|
Success := False;
|
Success := False;
|
return;
|
return;
|
|
|
elsif Soft_Minor_ID then
|
elsif Soft_Minor_ID then
|
Minor_ID := Minor_ID + 1;
|
Minor_ID := Minor_ID + 1;
|
Soft_Minor_ID := False;
|
Soft_Minor_ID := False;
|
end if;
|
end if;
|
|
|
Symbol_Table.Append (Original_Symbols, S_Data);
|
Symbol_Table.Append (Original_Symbols, S_Data);
|
Complete_Symbols.Table (Index).Present := False;
|
Complete_Symbols.Table (Index).Present := False;
|
end if;
|
end if;
|
end loop;
|
end loop;
|
|
|
-- Create the symbol file
|
-- Create the symbol file
|
|
|
Create (File, Ada.Text_IO.Out_File, Symbol_File_Name.all);
|
Create (File, Ada.Text_IO.Out_File, Symbol_File_Name.all);
|
|
|
Put (File, Case_Sensitive);
|
Put (File, Case_Sensitive);
|
Put_Line (File, "yes");
|
Put_Line (File, "yes");
|
|
|
-- Put a line in the symbol file for each symbol in symbol table
|
-- Put a line in the symbol file for each symbol in symbol table
|
|
|
for Index in 1 .. Symbol_Table.Last (Original_Symbols) loop
|
for Index in 1 .. Symbol_Table.Last (Original_Symbols) loop
|
if Original_Symbols.Table (Index).Present then
|
if Original_Symbols.Table (Index).Present then
|
Put (File, Symbol_Vector);
|
Put (File, Symbol_Vector);
|
|
|
-- Split the line if symbol name length is too large
|
-- Split the line if symbol name length is too large
|
|
|
if Original_Symbols.Table (Index).Name'Length >
|
if Original_Symbols.Table (Index).Name'Length >
|
Long_Symbol_Length
|
Long_Symbol_Length
|
then
|
then
|
Put_Line (File, "-");
|
Put_Line (File, "-");
|
end if;
|
end if;
|
|
|
Put (File, Original_Symbols.Table (Index).Name.all);
|
Put (File, Original_Symbols.Table (Index).Name.all);
|
|
|
if Original_Symbols.Table (Index).Name'Length >
|
if Original_Symbols.Table (Index).Name'Length >
|
Long_Symbol_Length
|
Long_Symbol_Length
|
then
|
then
|
Put_Line (File, "-");
|
Put_Line (File, "-");
|
end if;
|
end if;
|
|
|
if Original_Symbols.Table (Index).Kind = Data then
|
if Original_Symbols.Table (Index).Kind = Data then
|
Put_Line (File, Equal_Data);
|
Put_Line (File, Equal_Data);
|
|
|
else
|
else
|
Put_Line (File, Equal_Procedure);
|
Put_Line (File, Equal_Procedure);
|
end if;
|
end if;
|
|
|
Free (Original_Symbols.Table (Index).Name);
|
Free (Original_Symbols.Table (Index).Name);
|
end if;
|
end if;
|
end loop;
|
end loop;
|
|
|
Put (File, Case_Sensitive);
|
Put (File, Case_Sensitive);
|
Put_Line (File, "NO");
|
Put_Line (File, "NO");
|
|
|
-- Put the version IDs
|
-- Put the version IDs
|
|
|
Put (File, Gsmatch_Lequal);
|
Put (File, Gsmatch_Lequal);
|
Put (File, Image (Major_ID));
|
Put (File, Image (Major_ID));
|
Put (File, ',');
|
Put (File, ',');
|
Put_Line (File, Image (Minor_ID));
|
Put_Line (File, Image (Minor_ID));
|
|
|
-- And we are done
|
-- And we are done
|
|
|
Close (File);
|
Close (File);
|
|
|
-- Reset both tables
|
-- Reset both tables
|
|
|
Symbol_Table.Set_Last (Original_Symbols, 0);
|
Symbol_Table.Set_Last (Original_Symbols, 0);
|
Symbol_Table.Set_Last (Complete_Symbols, 0);
|
Symbol_Table.Set_Last (Complete_Symbols, 0);
|
|
|
-- Clear the symbol file name
|
-- Clear the symbol file name
|
|
|
Free (Symbol_File_Name);
|
Free (Symbol_File_Name);
|
end if;
|
end if;
|
|
|
Success := True;
|
Success := True;
|
end if;
|
end if;
|
|
|
exception
|
exception
|
when X : others =>
|
when X : others =>
|
Put_Line ("unexpected exception raised while finalizing """
|
Put_Line ("unexpected exception raised while finalizing """
|
& Symbol_File_Name.all & """");
|
& Symbol_File_Name.all & """");
|
Put_Line (Exception_Information (X));
|
Put_Line (Exception_Information (X));
|
Success := False;
|
Success := False;
|
end Finalize;
|
end Finalize;
|
|
|
end Symbols;
|
end Symbols;
|
|
|
