------------------------------------------------------------------------------ -- -- -- GNAT COMPILER COMPONENTS -- -- -- -- S Y M B O L S . P R O C E S S I N G -- -- -- -- B o d y -- -- -- -- Copyright (C) 2004-2009, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- -- ware Foundation; either version 3, or (at your option) any later ver- -- -- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- -- for more details. You should have received a copy of the GNU General -- -- Public License distributed with GNAT; see file COPYING3. If not, go to -- -- http://www.gnu.org/licenses for a complete copy of the license. -- -- -- -- GNAT was originally developed by the GNAT team at New York University. -- -- Extensive contributions were provided by Ada Core Technologies Inc. -- -- -- ------------------------------------------------------------------------------ -- This is the VMS/IA64 version of this package with Ada.IO_Exceptions; with Ada.Unchecked_Deallocation; separate (Symbols) package body Processing is type String_Array is array (Positive range <>) of String_Access; type Strings_Ptr is access String_Array; procedure Free is new Ada.Unchecked_Deallocation (String_Array, Strings_Ptr); type Section_Header is record Shname : Integer; Shtype : Integer; Shoffset : Integer; Shsize : Integer; Shlink : Integer; end record; type Section_Header_Array is array (Natural range <>) of Section_Header; type Section_Header_Ptr is access Section_Header_Array; procedure Free is new Ada.Unchecked_Deallocation (Section_Header_Array, Section_Header_Ptr); ------------- -- Process -- ------------- procedure Process (Object_File : String; Success : out Boolean) is B : Byte; W : Integer; Str : String (1 .. 1000) := (others => ' '); Str_Last : Natural; Strings : Strings_Ptr; Shoff : Integer; Shnum : Integer; Shentsize : Integer; Shname : Integer; Shtype : Integer; Shoffset : Integer; Shsize : Integer; Shlink : Integer; Symtab_Index : Natural := 0; String_Table_Index : Natural := 0; End_Symtab : Integer; Stname : Integer; Stinfo : Character; Stother : Character; Sttype : Integer; Stbind : Integer; Stshndx : Integer; Stvis : Integer; STV_Internal : constant := 1; STV_Hidden : constant := 2; Section_Headers : Section_Header_Ptr; Offset : Natural := 0; OK : Boolean := True; procedure Get_Byte (B : out Byte); -- Read one byte from the object file procedure Get_Half (H : out Integer); -- Read one half work from the object file procedure Get_Word (W : out Integer); -- Read one full word from the object file procedure Reset; -- Restart reading the object file procedure Skip_Half; -- Read and disregard one half word from the object file -------------- -- Get_Byte -- -------------- procedure Get_Byte (B : out Byte) is begin Byte_IO.Read (File, B); Offset := Offset + 1; end Get_Byte; -------------- -- Get_Half -- -------------- procedure Get_Half (H : out Integer) is C1, C2 : Character; begin Get_Byte (C1); Get_Byte (C2); H := Integer'(Character'Pos (C2)) * 256 + Integer'(Character'Pos (C1)); end Get_Half; -------------- -- Get_Word -- -------------- procedure Get_Word (W : out Integer) is H1, H2 : Integer; begin Get_Half (H1); Get_Half (H2); W := H2 * 256 * 256 + H1; end Get_Word; ----------- -- Reset -- ----------- procedure Reset is begin Offset := 0; Byte_IO.Reset (File); end Reset; --------------- -- Skip_Half -- --------------- procedure Skip_Half is B : Byte; pragma Unreferenced (B); begin Byte_IO.Read (File, B); Byte_IO.Read (File, B); Offset := Offset + 2; end Skip_Half; -- Start of processing for Process begin -- Open the object file with Byte_IO. Return with Success = False if -- this fails. begin Open (File, In_File, Object_File); exception when others => Put_Line ("*** Unable to open object file """ & Object_File & """"); Success := False; return; end; -- Assume that the object file has a correct format Success := True; -- Skip ELF identification while Offset < 16 loop Get_Byte (B); end loop; -- Skip e_type Skip_Half; -- Skip e_machine Skip_Half; -- Skip e_version Get_Word (W); -- Skip e_entry for J in 1 .. 8 loop Get_Byte (B); end loop; -- Skip e_phoff for J in 1 .. 8 loop Get_Byte (B); end loop; Get_Word (Shoff); -- Skip upper half of Shoff for J in 1 .. 4 loop Get_Byte (B); end loop; -- Skip e_flags Get_Word (W); -- Skip e_ehsize Skip_Half; -- Skip e_phentsize Skip_Half; -- Skip e_phnum Skip_Half; Get_Half (Shentsize); Get_Half (Shnum); Section_Headers := new Section_Header_Array (0 .. Shnum - 1); -- Go to Section Headers while Offset < Shoff loop Get_Byte (B); end loop; -- Reset Symtab_Index Symtab_Index := 0; for J in Section_Headers'Range loop -- Get the data for each Section Header Get_Word (Shname); Get_Word (Shtype); for K in 1 .. 16 loop Get_Byte (B); end loop; Get_Word (Shoffset); Get_Word (W); Get_Word (Shsize); Get_Word (W); Get_Word (Shlink); while (Offset - Shoff) mod Shentsize /= 0 loop Get_Byte (B); end loop; -- If this is the Symbol Table Section Header, record its index if Shtype = 2 then Symtab_Index := J; end if; Section_Headers (J) := (Shname, Shtype, Shoffset, Shsize, Shlink); end loop; if Symtab_Index = 0 then Success := False; return; end if; End_Symtab := Section_Headers (Symtab_Index).Shoffset + Section_Headers (Symtab_Index).Shsize; String_Table_Index := Section_Headers (Symtab_Index).Shlink; Strings := new String_Array (1 .. Section_Headers (String_Table_Index).Shsize); -- Go get the String Table section for the Symbol Table Reset; while Offset < Section_Headers (String_Table_Index).Shoffset loop Get_Byte (B); end loop; Offset := 0; Get_Byte (B); -- zero while Offset < Section_Headers (String_Table_Index).Shsize loop Str_Last := 0; loop Get_Byte (B); if B /= ASCII.NUL then Str_Last := Str_Last + 1; Str (Str_Last) := B; else Strings (Offset - Str_Last - 1) := new String'(Str (1 .. Str_Last)); exit; end if; end loop; end loop; -- Go get the Symbol Table Reset; while Offset < Section_Headers (Symtab_Index).Shoffset loop Get_Byte (B); end loop; while Offset < End_Symtab loop Get_Word (Stname); Get_Byte (Stinfo); Get_Byte (Stother); Get_Half (Stshndx); for J in 1 .. 4 loop Get_Word (W); end loop; Sttype := Integer'(Character'Pos (Stinfo)) mod 16; Stbind := Integer'(Character'Pos (Stinfo)) / 16; Stvis := Integer'(Character'Pos (Stother)) mod 4; if (Sttype = 1 or else Sttype = 2) and then Stbind /= 0 and then Stshndx /= 0 and then Stvis /= STV_Internal and then Stvis /= STV_Hidden then -- Check if this is a symbol from a generic body OK := True; for J in Strings (Stname)'First .. Strings (Stname)'Last - 2 loop if Strings (Stname) (J) = 'G' and then Strings (Stname) (J + 1) = 'P' and then Strings (Stname) (J + 2) in '0' .. '9' then OK := False; exit; end if; end loop; if OK then declare S_Data : Symbol_Data; begin S_Data.Name := new String'(Strings (Stname).all); if Sttype = 1 then S_Data.Kind := Data; else S_Data.Kind := Proc; end if; -- Put the new symbol in the table Symbol_Table.Append (Complete_Symbols, S_Data); end; end if; end if; end loop; -- The object file has been processed, close it Close (File); -- Free the allocated memory Free (Section_Headers); for J in Strings'Range loop if Strings (J) /= null then Free (Strings (J)); end if; end loop; Free (Strings); exception -- For any exception, output an error message, close the object file -- and return with Success = False. when Ada.IO_Exceptions.End_Error => Close (File); when X : others => Put_Line ("unexpected exception raised while processing """ & Object_File & """"); Put_Line (Exception_Information (X)); Close (File); Success := False; end Process; end Processing;