From: Vincent Celier Date: Thu, 16 Jun 2005 08:29:44 +0000 (+0200) Subject: gnatsym.adb: Adapt to modification of package Symbols... X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=65b108320e2c468e783b36713d10a3319a2ebc6b;p=gcc.git gnatsym.adb: Adapt to modification of package Symbols... 2005-06-14 Vincent Celier * 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 --- diff --git a/gcc/ada/gnatsym.adb b/gcc/ada/gnatsym.adb index 790ff40531d..23ed29457f4 100644 --- a/gcc/ada/gnatsym.adb +++ b/gcc/ada/gnatsym.adb @@ -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 diff --git a/gcc/ada/symbols-processing-vms-alpha.adb b/gcc/ada/symbols-processing-vms-alpha.adb new file mode 100644 index 00000000000..c73bb087dbf --- /dev/null +++ b/gcc/ada/symbols-processing-vms-alpha.adb @@ -0,0 +1,235 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/symbols-processing-vms-ia64.adb b/gcc/ada/symbols-processing-vms-ia64.adb new file mode 100644 index 00000000000..66f7bdd5339 --- /dev/null +++ b/gcc/ada/symbols-processing-vms-ia64.adb @@ -0,0 +1,367 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/symbols-vms-alpha.adb b/gcc/ada/symbols-vms-alpha.adb deleted file mode 100644 index 4fb68318f99..00000000000 --- a/gcc/ada/symbols-vms-alpha.adb +++ /dev/null @@ -1,771 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT COMPILER COMPONENTS -- --- -- --- S Y M B O L S -- --- -- --- 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 version of this package - -with Ada.Exceptions; use Ada.Exceptions; -with Ada.Sequential_IO; -with Ada.Text_IO; use Ada.Text_IO; - -package body Symbols is - - Case_Sensitive : constant String := "case_sensitive="; - Symbol_Vector : constant String := "SYMBOL_VECTOR=("; - Equal_Data : constant String := "=DATA)"; - Equal_Procedure : constant String := "=PROCEDURE)"; - Gsmatch : constant String := "gsmatch=lequal,"; - - Symbol_File_Name : String_Access := null; - -- Name of the symbol file - - Sym_Policy : Policy := Autonomous; - -- The symbol policy. Set by Initialize - - Major_ID : Integer := 1; - -- The Major ID. May be modified by Initialize if Library_Version is - -- specified or if it is read from the reference symbol file. - - Soft_Major_ID : Boolean := True; - -- False if library version is specified in procedure Initialize. - -- When True, Major_ID may be modified if found in the reference symbol - -- file. - - Minor_ID : Natural := 0; - -- The Minor ID. May be modified if read from the reference symbol file - - Soft_Minor_ID : Boolean := True; - -- 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 - -- the reference symbol file. When True, Minor_ID may be increased in - -- Compliant symbol policy. - - subtype Byte is Character; - -- Object files are stream of bytes, but some of these bytes, those for - -- the names of the symbols, are ASCII characters. - - 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 - - ----------- - -- Equal -- - ----------- - - function Equal (Left, Right : Symbol_Data) return Boolean is - begin - return Left.Name /= null and then - Right.Name /= null and then - Left.Name.all = Right.Name.all and then - Left.Kind = Right.Kind and then - 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 -- - ----------- - - function Image (N : Integer) return String is - Result : constant String := N'Img; - begin - if Result (Result'First) = ' ' then - return Result (Result'First + 1 .. Result'Last); - - else - return Result; - end if; - end Image; - - ---------------- - -- Initialize -- - ---------------- - - procedure Initialize - (Symbol_File : String; - Reference : String; - Symbol_Policy : Policy; - Quiet : Boolean; - Version : String; - Success : out Boolean) - is - File : Ada.Text_IO.File_Type; - Line : String (1 .. 1_000); - Last : Natural; - - begin - -- Record the symbol file name - - Symbol_File_Name := new String'(Symbol_File); - - -- Record the policy - - Sym_Policy := Symbol_Policy; - - -- Record the version (Major ID) - - if Version = "" then - Major_ID := 1; - Soft_Major_ID := True; - - else - begin - Major_ID := Integer'Value (Version); - Soft_Major_ID := False; - - if Major_ID <= 0 then - raise Constraint_Error; - end if; - - exception - when Constraint_Error => - if not Quiet then - Put_Line ("Version """ & Version & """ is illegal."); - Put_Line ("On VMS, version must be a positive number"); - end if; - - Success := False; - return; - end; - end if; - - Minor_ID := 0; - Soft_Minor_ID := Sym_Policy /= Autonomous; - - -- Empty the symbol tables - - Symbol_Table.Set_Last (Original_Symbols, 0); - Symbol_Table.Set_Last (Complete_Symbols, 0); - - -- Assume that everything will be fine - - Success := True; - - -- If policy is Compliant or Controlled, attempt to read the reference - -- file. If policy is Restricted, attempt to read the symbol file. - - if Sym_Policy /= Autonomous then - case Sym_Policy is - when Autonomous => - null; - - when Compliant | Controlled => - begin - Open (File, In_File, Reference); - - exception - when Ada.Text_IO.Name_Error => - Success := False; - return; - - when X : others => - if not Quiet then - Put_Line ("could not open """ & Reference & """"); - Put_Line (Exception_Message (X)); - end if; - - Success := False; - return; - end; - - when Restricted => - begin - Open (File, In_File, Symbol_File); - - exception - when Ada.Text_IO.Name_Error => - Success := False; - return; - - when X : others => - if not Quiet then - Put_Line ("could not open """ & Symbol_File & """"); - Put_Line (Exception_Message (X)); - end if; - - Success := False; - return; - end; - end case; - - -- Read line by line - - while not End_Of_File (File) loop - Get_Line (File, Line, Last); - - -- Ignore empty lines - - if Last = 0 then - null; - - -- Ignore lines starting with "case_sensitive=" - - elsif Last > Case_Sensitive'Length - and then Line (1 .. Case_Sensitive'Length) = Case_Sensitive - then - null; - - -- Line starting with "SYMBOL_VECTOR=(" - - elsif Last > Symbol_Vector'Length - and then Line (1 .. Symbol_Vector'Length) = Symbol_Vector - then - - -- SYMBOL_VECTOR=(=DATA) - - if Last > Symbol_Vector'Length + Equal_Data'Length and then - Line (Last - Equal_Data'Length + 1 .. Last) = Equal_Data - then - Symbol_Table.Increment_Last (Original_Symbols); - Original_Symbols.Table - (Symbol_Table.Last (Original_Symbols)) := - (Name => - new String'(Line (Symbol_Vector'Length + 1 .. - Last - Equal_Data'Length)), - Kind => Data, - Present => True); - - -- SYMBOL_VECTOR=(=PROCEDURE) - - elsif Last > Symbol_Vector'Length + Equal_Procedure'Length - and then - Line (Last - Equal_Procedure'Length + 1 .. Last) = - Equal_Procedure - then - Symbol_Table.Increment_Last (Original_Symbols); - Original_Symbols.Table - (Symbol_Table.Last (Original_Symbols)) := - (Name => - new String'(Line (Symbol_Vector'Length + 1 .. - Last - Equal_Procedure'Length)), - Kind => Proc, - Present => True); - - -- Anything else is incorrectly formatted - - else - if not Quiet then - Put_Line ("symbol file """ & Reference & - """ is incorrectly formatted:"); - Put_Line ("""" & Line (1 .. Last) & """"); - end if; - - Close (File); - Success := False; - return; - end if; - - -- Lines with "gsmatch=equal,, - - elsif Last > Gsmatch'Length - and then Line (1 .. Gsmatch'Length) = Gsmatch - then - declare - Start : Positive := Gsmatch'Length + 1; - Finish : Positive := Start; - OK : Boolean := True; - ID : Integer; - - begin - 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; - - if OK then - ID := Integer'Value (Line (Start .. Finish)); - OK := ID /= 0; - - -- If Soft_Major_ID is True, it means that - -- Library_Version was not specified. - - if Soft_Major_ID then - Major_ID := ID; - - -- If the Major ID in the reference file is different - -- from the Library_Version, then the Minor ID will be 0 - -- because there is no point in taking the Minor ID in - -- the reference file, or incrementing it. So, we set - -- Soft_Minor_ID to False, so that we don't modify - -- the Minor_ID later. - - elsif Major_ID /= ID then - Soft_Minor_ID := False; - end if; - - Start := Finish + 2; - Finish := Start; - - loop - if Line (Finish) not in '0' .. '9' then - OK := False; - exit; - end if; - - exit when Finish = Last; - - Finish := Finish + 1; - end loop; - - -- Only set Minor_ID if Soft_Minor_ID is True (see above) - - if OK and then Soft_Minor_ID then - Minor_ID := Integer'Value (Line (Start .. Finish)); - end if; - end if; - - -- If OK is not True, that means the line is not correctly - -- formatted. - - if not OK then - if not Quiet then - Put_Line ("symbol file """ & Reference & - """ is incorrectly formatted"); - Put_Line ("""" & Line (1 .. Last) & """"); - end if; - - Close (File); - Success := False; - return; - end if; - end; - - -- Anything else is incorrectly formatted - - else - if not Quiet then - Put_Line ("unexpected line in symbol file """ & - Reference & """"); - Put_Line ("""" & Line (1 .. Last) & """"); - end if; - - Close (File); - Success := False; - return; - end if; - end loop; - - Close (File); - 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. - - when X : others => - Put_Line ("unexpected exception raised while processing """ - & Object_File & """"); - Put_Line (Exception_Information (X)); - Close (File); - Success := False; - end Process; - - -------------- - -- Finalize -- - -------------- - - procedure Finalize - (Quiet : Boolean; - Success : out Boolean) - is - File : Ada.Text_IO.File_Type; - -- The symbol file - - S_Data : Symbol_Data; - -- A symbol - - Cur : Positive := 1; - -- Most probable index in the Complete_Symbols of the current symbol - -- in Original_Symbol. - - Found : Boolean; - - begin - -- Nothing to be done if Initialize has never been called - - if Symbol_File_Name = null then - Success := False; - - else - - -- 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 - -- Autonomous, because no reference symbol file has been read. - - -- Expect the first symbol in the symbol file to also be the first - -- in Complete_Symbols. - - Cur := 1; - - for Index_1 in 1 .. Symbol_Table.Last (Original_Symbols) loop - S_Data := Original_Symbols.Table (Index_1); - Found := False; - - First_Object_Loop : - for Index_2 in Cur .. Symbol_Table.Last (Complete_Symbols) loop - if Equal (S_Data, Complete_Symbols.Table (Index_2)) then - Cur := Index_2 + 1; - Complete_Symbols.Table (Index_2).Present := False; - Found := True; - exit First_Object_Loop; - end if; - end loop First_Object_Loop; - - -- If the symbol could not be found between Cur and Last, try - -- before Cur. - - if not Found then - Second_Object_Loop : - for Index_2 in 1 .. Cur - 1 loop - if Equal (S_Data, Complete_Symbols.Table (Index_2)) then - Cur := Index_2 + 1; - Complete_Symbols.Table (Index_2).Present := False; - Found := True; - exit Second_Object_Loop; - end if; - end loop Second_Object_Loop; - end if; - - -- If the symbol is not found, mark it as such in the table - - if not Found then - if (not Quiet) or else Sym_Policy = Controlled then - Put_Line ("symbol """ & S_Data.Name.all & - """ is no longer present in the object files"); - end if; - - if Sym_Policy = Controlled or else Sym_Policy = Restricted then - Success := False; - return; - - elsif Soft_Major_ID then - Major_ID := Major_ID + 1; - Minor_ID := 0; - Soft_Major_ID := False; - Soft_Minor_ID := False; - end if; - - Original_Symbols.Table (Index_1).Present := False; - Free (Original_Symbols.Table (Index_1).Name); - end if; - end loop; - - if Sym_Policy /= Restricted then - - -- Append additional symbols, if any, to the Original_Symbols - -- table. - - for Index in 1 .. Symbol_Table.Last (Complete_Symbols) loop - S_Data := Complete_Symbols.Table (Index); - - if S_Data.Present then - - if Sym_Policy = Controlled then - Put_Line ("symbol """ & S_Data.Name.all & - """ is not in the reference symbol file"); - Success := False; - return; - - elsif Soft_Minor_ID then - Minor_ID := Minor_ID + 1; - Soft_Minor_ID := False; - end if; - - Symbol_Table.Increment_Last (Original_Symbols); - Original_Symbols.Table - (Symbol_Table.Last (Original_Symbols)) := S_Data; - Complete_Symbols.Table (Index).Present := False; - end if; - end loop; - - -- Create the symbol file - - Create (File, Ada.Text_IO.Out_File, Symbol_File_Name.all); - - Put (File, Case_Sensitive); - Put_Line (File, "yes"); - - -- Put a line in the symbol file for each symbol in symbol table - - for Index in 1 .. Symbol_Table.Last (Original_Symbols) loop - if Original_Symbols.Table (Index).Present then - Put (File, Symbol_Vector); - Put (File, Original_Symbols.Table (Index).Name.all); - - if Original_Symbols.Table (Index).Kind = Data then - Put_Line (File, Equal_Data); - - else - Put_Line (File, Equal_Procedure); - end if; - - Free (Original_Symbols.Table (Index).Name); - end if; - end loop; - - Put (File, Case_Sensitive); - Put_Line (File, "NO"); - - -- Put the version IDs - - Put (File, Gsmatch); - Put (File, Image (Major_ID)); - Put (File, ','); - Put_Line (File, Image (Minor_ID)); - - -- And we are done - - Close (File); - - -- Reset both tables - - Symbol_Table.Set_Last (Original_Symbols, 0); - Symbol_Table.Set_Last (Complete_Symbols, 0); - - -- Clear the symbol file name - - Free (Symbol_File_Name); - end if; - - Success := True; - end if; - - exception - when X : others => - Put_Line ("unexpected exception raised while finalizing """ - & Symbol_File_Name.all & """"); - Put_Line (Exception_Information (X)); - Success := False; - end Finalize; - -end Symbols; diff --git a/gcc/ada/symbols-vms.adb b/gcc/ada/symbols-vms.adb new file mode 100644 index 00000000000..6dcb4a4de42 --- /dev/null +++ b/gcc/ada/symbols-vms.adb @@ -0,0 +1,606 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT COMPILER COMPONENTS -- +-- -- +-- S Y M B O L S -- +-- -- +-- 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 version of this package + +with Ada.Exceptions; use Ada.Exceptions; +with Ada.Sequential_IO; +with Ada.Text_IO; use Ada.Text_IO; + +package body Symbols is + + Case_Sensitive : constant String := "case_sensitive="; + Symbol_Vector : constant String := "SYMBOL_VECTOR=("; + Equal_Data : constant String := "=DATA)"; + Equal_Procedure : constant String := "=PROCEDURE)"; + Gsmatch : constant String := "gsmatch="; + Gsmatch_Lequal : constant String := "gsmatch=lequal,"; + + Symbol_File_Name : String_Access := null; + -- Name of the symbol file + + Sym_Policy : Policy := Autonomous; + -- The symbol policy. Set by Initialize + + Major_ID : Integer := 1; + -- The Major ID. May be modified by Initialize if Library_Version is + -- specified or if it is read from the reference symbol file. + + Soft_Major_ID : Boolean := True; + -- False if library version is specified in procedure Initialize. + -- When True, Major_ID may be modified if found in the reference symbol + -- file. + + Minor_ID : Natural := 0; + -- The Minor ID. May be modified if read from the reference symbol file + + Soft_Minor_ID : Boolean := True; + -- 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 + -- the reference symbol file. When True, Minor_ID may be increased in + -- Compliant symbol policy. + + subtype Byte is Character; + -- Object files are stream of bytes, but some of these bytes, those for + -- the names of the symbols, are ASCII characters. + + package Byte_IO is new Ada.Sequential_IO (Byte); + use Byte_IO; + + File : Byte_IO.File_Type; + -- Each object file is read as a stream of bytes (characters) + + function Equal (Left, Right : Symbol_Data) return Boolean; + -- Test for equality of symbols + + function Image (N : Integer) return String; + -- Returns the image of N, without the initial space + + ----------- + -- Equal -- + ----------- + + function Equal (Left, Right : Symbol_Data) return Boolean is + begin + return Left.Name /= null and then + Right.Name /= null and then + Left.Name.all = Right.Name.all and then + Left.Kind = Right.Kind and then + Left.Present = Right.Present; + end Equal; + + ----------- + -- Image -- + ----------- + + function Image (N : Integer) return String is + Result : constant String := N'Img; + begin + if Result (Result'First) = ' ' then + return Result (Result'First + 1 .. Result'Last); + + else + return Result; + end if; + end Image; + + ---------------- + -- Initialize -- + ---------------- + + procedure Initialize + (Symbol_File : String; + Reference : String; + Symbol_Policy : Policy; + Quiet : Boolean; + Version : String; + Success : out Boolean) + is + File : Ada.Text_IO.File_Type; + Line : String (1 .. 1_000); + Last : Natural; + + begin + -- Record the symbol file name + + Symbol_File_Name := new String'(Symbol_File); + + -- Record the policy + + Sym_Policy := Symbol_Policy; + + -- Record the version (Major ID) + + if Version = "" then + Major_ID := 1; + Soft_Major_ID := True; + + else + begin + Major_ID := Integer'Value (Version); + Soft_Major_ID := False; + + if Major_ID <= 0 then + raise Constraint_Error; + end if; + + exception + when Constraint_Error => + if not Quiet then + Put_Line ("Version """ & Version & """ is illegal."); + Put_Line ("On VMS, version must be a positive number"); + end if; + + Success := False; + return; + end; + end if; + + Minor_ID := 0; + Soft_Minor_ID := Sym_Policy /= Autonomous; + + -- Empty the symbol tables + + Symbol_Table.Set_Last (Original_Symbols, 0); + Symbol_Table.Set_Last (Complete_Symbols, 0); + + -- Assume that everything will be fine + + Success := True; + + -- If policy is Compliant or Controlled, attempt to read the reference + -- file. If policy is Restricted, attempt to read the symbol file. + + if Sym_Policy /= Autonomous then + case Sym_Policy is + when Autonomous => + null; + + when Compliant | Controlled => + begin + Open (File, In_File, Reference); + + exception + when Ada.Text_IO.Name_Error => + Success := False; + return; + + when X : others => + if not Quiet then + Put_Line ("could not open """ & Reference & """"); + Put_Line (Exception_Message (X)); + end if; + + Success := False; + return; + end; + + when Restricted => + begin + Open (File, In_File, Symbol_File); + + exception + when Ada.Text_IO.Name_Error => + Success := False; + return; + + when X : others => + if not Quiet then + Put_Line ("could not open """ & Symbol_File & """"); + Put_Line (Exception_Message (X)); + end if; + + Success := False; + return; + end; + end case; + + -- Read line by line + + while not End_Of_File (File) loop + Get_Line (File, Line, Last); + + -- Ignore empty lines + + if Last = 0 then + null; + + -- Ignore lines starting with "case_sensitive=" + + elsif Last > Case_Sensitive'Length + and then Line (1 .. Case_Sensitive'Length) = Case_Sensitive + then + null; + + -- Line starting with "SYMBOL_VECTOR=(" + + elsif Last > Symbol_Vector'Length + and then Line (1 .. Symbol_Vector'Length) = Symbol_Vector + then + + -- SYMBOL_VECTOR=(=DATA) + + if Last > Symbol_Vector'Length + Equal_Data'Length and then + Line (Last - Equal_Data'Length + 1 .. Last) = Equal_Data + then + Symbol_Table.Increment_Last (Original_Symbols); + Original_Symbols.Table + (Symbol_Table.Last (Original_Symbols)) := + (Name => + new String'(Line (Symbol_Vector'Length + 1 .. + Last - Equal_Data'Length)), + Kind => Data, + Present => True); + + -- SYMBOL_VECTOR=(=PROCEDURE) + + elsif Last > Symbol_Vector'Length + Equal_Procedure'Length + and then + Line (Last - Equal_Procedure'Length + 1 .. Last) = + Equal_Procedure + then + Symbol_Table.Increment_Last (Original_Symbols); + Original_Symbols.Table + (Symbol_Table.Last (Original_Symbols)) := + (Name => + new String'(Line (Symbol_Vector'Length + 1 .. + Last - Equal_Procedure'Length)), + Kind => Proc, + Present => True); + + -- Anything else is incorrectly formatted + + else + if not Quiet then + Put_Line ("symbol file """ & Reference & + """ is incorrectly formatted:"); + Put_Line ("""" & Line (1 .. Last) & """"); + end if; + + Close (File); + Success := False; + return; + end if; + + -- Lines with "gsmatch=lequal," or "gsmatch=equal," + + elsif Last > Gsmatch'Length + and then Line (1 .. Gsmatch'Length) = Gsmatch + then + declare + Start : Positive := Gsmatch'Length + 1; + Finish : Positive := Start; + OK : Boolean := True; + ID : Integer; + + begin + -- First, look for the first coma + + loop + if Start >= Last - 1 then + OK := False; + exit; + + elsif Line (Start) = ',' then + Start := Start + 1; + exit; + + 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; + + -- If Soft_Major_ID is True, it means that + -- Library_Version was not specified. + + if Soft_Major_ID then + Major_ID := ID; + + -- If the Major ID in the reference file is different + -- from the Library_Version, then the Minor ID will be 0 + -- because there is no point in taking the Minor ID in + -- the reference file, or incrementing it. So, we set + -- Soft_Minor_ID to False, so that we don't modify + -- the Minor_ID later. + + elsif Major_ID /= ID then + Soft_Minor_ID := False; + end if; + + Start := Finish + 2; + Finish := Start; + + loop + if Line (Finish) not in '0' .. '9' then + OK := False; + exit; + end if; + + exit when Finish = Last; + + Finish := Finish + 1; + end loop; + + -- Only set Minor_ID if Soft_Minor_ID is True (see above) + + if OK and then Soft_Minor_ID then + Minor_ID := Integer'Value (Line (Start .. Finish)); + end if; + end if; + + -- If OK is not True, that means the line is not correctly + -- formatted. + + if not OK then + if not Quiet then + Put_Line ("symbol file """ & Reference & + """ is incorrectly formatted"); + Put_Line ("""" & Line (1 .. Last) & """"); + end if; + + Close (File); + Success := False; + return; + end if; + end; + + -- Anything else is incorrectly formatted + + else + if not Quiet then + Put_Line ("unexpected line in symbol file """ & + Reference & """"); + Put_Line ("""" & Line (1 .. Last) & """"); + end if; + + Close (File); + Success := False; + return; + end if; + end loop; + + Close (File); + end if; + end Initialize; + + ---------------- + -- Processing -- + ---------------- + + package body Processing is separate; + + -------------- + -- Finalize -- + -------------- + + procedure Finalize + (Quiet : Boolean; + Success : out Boolean) + is + File : Ada.Text_IO.File_Type; + -- The symbol file + + S_Data : Symbol_Data; + -- A symbol + + Cur : Positive := 1; + -- Most probable index in the Complete_Symbols of the current symbol + -- in Original_Symbol. + + Found : Boolean; + + begin + -- Nothing to be done if Initialize has never been called + + if Symbol_File_Name = null then + Success := False; + + else + + -- 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 + -- Autonomous, because no reference symbol file has been read. + + -- Expect the first symbol in the symbol file to also be the first + -- in Complete_Symbols. + + Cur := 1; + + for Index_1 in 1 .. Symbol_Table.Last (Original_Symbols) loop + S_Data := Original_Symbols.Table (Index_1); + Found := False; + + First_Object_Loop : + for Index_2 in Cur .. Symbol_Table.Last (Complete_Symbols) loop + if Equal (S_Data, Complete_Symbols.Table (Index_2)) then + Cur := Index_2 + 1; + Complete_Symbols.Table (Index_2).Present := False; + Found := True; + exit First_Object_Loop; + end if; + end loop First_Object_Loop; + + -- If the symbol could not be found between Cur and Last, try + -- before Cur. + + if not Found then + Second_Object_Loop : + for Index_2 in 1 .. Cur - 1 loop + if Equal (S_Data, Complete_Symbols.Table (Index_2)) then + Cur := Index_2 + 1; + Complete_Symbols.Table (Index_2).Present := False; + Found := True; + exit Second_Object_Loop; + end if; + end loop Second_Object_Loop; + end if; + + -- If the symbol is not found, mark it as such in the table + + if not Found then + if (not Quiet) or else Sym_Policy = Controlled then + Put_Line ("symbol """ & S_Data.Name.all & + """ is no longer present in the object files"); + end if; + + if Sym_Policy = Controlled or else Sym_Policy = Restricted then + 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; + Soft_Major_ID := False; + Soft_Minor_ID := False; + end if; + + 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; + + if Sym_Policy /= Restricted then + + -- Append additional symbols, if any, to the Original_Symbols + -- table. + + for Index in 1 .. Symbol_Table.Last (Complete_Symbols) loop + S_Data := Complete_Symbols.Table (Index); + + if S_Data.Present then + + if Sym_Policy = Controlled then + Put_Line ("symbol """ & S_Data.Name.all & + """ is not in the reference symbol file"); + Success := False; + return; + + elsif Soft_Minor_ID then + Minor_ID := Minor_ID + 1; + Soft_Minor_ID := False; + end if; + + Symbol_Table.Increment_Last (Original_Symbols); + Original_Symbols.Table + (Symbol_Table.Last (Original_Symbols)) := S_Data; + Complete_Symbols.Table (Index).Present := False; + end if; + end loop; + + -- Create the symbol file + + Create (File, Ada.Text_IO.Out_File, Symbol_File_Name.all); + + Put (File, Case_Sensitive); + Put_Line (File, "yes"); + + -- Put a line in the symbol file for each symbol in symbol table + + for Index in 1 .. Symbol_Table.Last (Original_Symbols) loop + if Original_Symbols.Table (Index).Present then + Put (File, Symbol_Vector); + Put (File, Original_Symbols.Table (Index).Name.all); + + if Original_Symbols.Table (Index).Kind = Data then + Put_Line (File, Equal_Data); + + else + Put_Line (File, Equal_Procedure); + end if; + + Free (Original_Symbols.Table (Index).Name); + end if; + end loop; + + Put (File, Case_Sensitive); + Put_Line (File, "NO"); + + -- Put the version IDs + + Put (File, Gsmatch_Lequal); + Put (File, Image (Major_ID)); + Put (File, ','); + Put_Line (File, Image (Minor_ID)); + + -- And we are done + + Close (File); + + -- Reset both tables + + Symbol_Table.Set_Last (Original_Symbols, 0); + Symbol_Table.Set_Last (Complete_Symbols, 0); + + -- Clear the symbol file name + + Free (Symbol_File_Name); + end if; + + Success := True; + end if; + + exception + when X : others => + Put_Line ("unexpected exception raised while finalizing """ + & Symbol_File_Name.all & """"); + Put_Line (Exception_Information (X)); + Success := False; + end Finalize; + +end Symbols; diff --git a/gcc/ada/symbols.adb b/gcc/ada/symbols.adb index 0ccd4cbf666..6f021b904f2 100644 --- a/gcc/ada/symbols.adb +++ b/gcc/ada/symbols.adb @@ -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 -- diff --git a/gcc/ada/symbols.ads b/gcc/ada/symbols.ads index 81a87d00b6a..049751b652d 100644 --- a/gcc/ada/symbols.ads +++ b/gcc/ada/symbols.ads @@ -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;