/gcc/ada/symbols-processing-vms-ia64.adb
Ada | 430 lines | 239 code | 116 blank | 75 comment | 25 complexity | bf8e04a5f99d39d6216f1435f11087e0 MD5 | raw file
- ------------------------------------------------------------------------------
- -- --
- -- 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;