diff options
Diffstat (limited to 'gcc-4.9/gcc/ada/symbols-processing-vms-ia64.adb')
| -rw-r--r-- | gcc-4.9/gcc/ada/symbols-processing-vms-ia64.adb | 430 |
1 files changed, 430 insertions, 0 deletions
diff --git a/gcc-4.9/gcc/ada/symbols-processing-vms-ia64.adb b/gcc-4.9/gcc/ada/symbols-processing-vms-ia64.adb new file mode 100644 index 000000000..beb099e40 --- /dev/null +++ b/gcc-4.9/gcc/ada/symbols-processing-vms-ia64.adb @@ -0,0 +1,430 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; |