| ------------------------------------------------------------------------------ |
| -- -- |
| -- 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; |
