Subversion Repositories openrisc

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