gcc/ada/symbols-processing-vms-ia64.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                    S Y M B O L S . P R O C E S S I N G                   --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --          Copyright (C) 2004-2007, Free Software Foundation, Inc.         --
  10 --                                                                          --
  11 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  12 -- terms of the  GNU General Public License as published  by the Free Soft- --
  13 -- ware  Foundation;  either version 3,  or (at your option) any later ver- --
  14 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  15 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  16 -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  17 -- for  more details.  You should have  received  a copy of the GNU General --
  18 -- Public License  distributed with GNAT; see file COPYING3.  If not, go to --
  19 -- http://www.gnu.org/licenses for a complete copy of the license.          --
  20 --                                                                          --
  21 -- GNAT was originally developed  by the GNAT team at  New York University. --
  22 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  23 --                                                                          --
  24 ------------------------------------------------------------------------------
  25
  26 --  This is the VMS/IA64 version of this package
  27
  28 with Ada.IO_Exceptions;
  29
  30 with Ada.Unchecked_Deallocation;
  31
  32 separate (Symbols)
  33 package body Processing is
  34
  35    type String_Array is array (Positive range <>) of String_Access;
  36    type Strings_Ptr is access String_Array;
  37
  38    procedure Free is
  39      new Ada.Unchecked_Deallocation (String_Array, Strings_Ptr);
  40
  41    type Section_Header is record
  42       Shname   : Integer;
  43       Shtype   : Integer;
  44       Shoffset : Integer;
  45       Shsize   : Integer;
  46       Shlink   : Integer;
  47    end record;
  48
  49    type Section_Header_Array is array (Natural range <>) of Section_Header;
  50    type Section_Header_Ptr is access Section_Header_Array;
  51
  52    procedure Free is
  53      new Ada.Unchecked_Deallocation (Section_Header_Array, Section_Header_Ptr);
  54
  55    -------------
  56    -- Process --
  57    -------------
  58
  59    procedure Process
  60      (Object_File : String;
  61       Success     : out Boolean)
  62    is
  63       B : Byte;
  64       H : Integer;
  65       W : Integer;
  66
  67       Str : String (1 .. 1000) := (others => ' ');
  68       Str_Last : Natural;
  69
  70       Strings : Strings_Ptr;
  71
  72       Shoff : Integer;
  73       Shnum : Integer;
  74       Shentsize : Integer;
  75
  76       Shname   : Integer;
  77       Shtype   : Integer;
  78       Shoffset : Integer;
  79       Shsize   : Integer;
  80       Shlink   : Integer;
  81
  82       Symtab_Index       : Natural := 0;
  83       String_Table_Index : Natural := 0;
  84
  85       End_Symtab : Integer;
  86
  87       Stname  : Integer;
  88       Stinfo  : Character;
  89       Sttype  : Integer;
  90       Stbind  : Integer;
  91       Stshndx : Integer;
  92
  93       Section_Headers : Section_Header_Ptr;
  94
  95       Offset : Natural := 0;
  96       OK     : Boolean := True;
  97
  98       procedure Get_Byte (B : out Byte);
  99       procedure Get_Half (H : out Integer);
 100       procedure Get_Word (W : out Integer);
 101       procedure Reset;
 102       --  All the above require comments ???
 103
 104       --------------
 105       -- Get_Byte --
 106       --------------
 107
 108       procedure Get_Byte (B : out Byte) is
 109       begin
 110          Byte_IO.Read (File, B);
 111          Offset := Offset + 1;
 112       end Get_Byte;
 113
 114       --------------
 115       -- Get_Half --
 116       --------------
 117
 118       procedure Get_Half (H : out Integer) is
 119          C1, C2 : Character;
 120       begin
 121          Get_Byte (C1); Get_Byte (C2);
 122          H :=
 123            Integer'(Character'Pos (C2)) * 256 + Integer'(Character'Pos (C1));
 124       end Get_Half;
 125
 126       --------------
 127       -- Get_Word --
 128       --------------
 129
 130       procedure Get_Word (W : out Integer) is
 131          H1, H2 : Integer;
 132       begin
 133          Get_Half (H1); Get_Half (H2);
 134          W := H2 * 256 * 256 + H1;
 135       end Get_Word;
 136
 137       -----------
 138       -- Reset --
 139       -----------
 140
 141       procedure Reset is
 142       begin
 143          Offset := 0;
 144          Byte_IO.Reset (File);
 145       end Reset;
 146
 147    --  Start of processing for Process
 148
 149    begin
 150       --  Open the object file with Byte_IO. Return with Success = False if
 151       --  this fails.
 152
 153       begin
 154          Open (File, In_File, Object_File);
 155       exception
 156          when others =>
 157             Put_Line
 158               ("*** Unable to open object file """ & Object_File & """");
 159             Success := False;
 160             return;
 161       end;
 162
 163       --  Assume that the object file has a correct format
 164
 165       Success := True;
 166
 167       --  Skip ELF identification
 168
 169       while Offset < 16 loop
 170          Get_Byte (B);
 171       end loop;
 172
 173       --  Skip e_type
 174
 175       Get_Half (H);
 176
 177       --  Skip e_machine
 178
 179       Get_Half (H);
 180
 181       --  Skip e_version
 182
 183       Get_Word (W);
 184
 185       --  Skip e_entry
 186
 187       for J in 1 .. 8 loop
 188          Get_Byte (B);
 189       end loop;
 190
 191       --  Skip e_phoff
 192
 193       for J in 1 .. 8 loop
 194          Get_Byte (B);
 195       end loop;
 196
 197       Get_Word (Shoff);
 198
 199       --  Skip upper half of Shoff
 200
 201       for J in 1 .. 4 loop
 202          Get_Byte (B);
 203       end loop;
 204
 205       --  Skip e_flags
 206
 207       Get_Word (W);
 208
 209       --  Skip e_ehsize
 210
 211       Get_Half (H);
 212
 213       --  Skip e_phentsize
 214
 215       Get_Half (H);
 216
 217       --  Skip e_phnum
 218
 219       Get_Half (H);
 220
 221       Get_Half (Shentsize);
 222
 223       Get_Half (Shnum);
 224
 225       Section_Headers := new Section_Header_Array (0 .. Shnum - 1);
 226
 227       --  Go to Section Headers
 228
 229       while Offset < Shoff loop
 230          Get_Byte (B);
 231       end loop;
 232
 233       --  Reset Symtab_Index
 234
 235       Symtab_Index := 0;
 236
 237       for J in Section_Headers'Range loop
 238
 239          --  Get the data for each Section Header
 240
 241          Get_Word (Shname);
 242          Get_Word (Shtype);
 243
 244          for K in 1 .. 16 loop
 245             Get_Byte (B);
 246          end loop;
 247
 248          Get_Word (Shoffset);
 249          Get_Word (W);
 250
 251          Get_Word (Shsize);
 252          Get_Word (W);
 253
 254          Get_Word (Shlink);
 255
 256          while (Offset - Shoff) mod Shentsize /= 0 loop
 257             Get_Byte (B);
 258          end loop;
 259
 260          --  If this is the Symbol Table Section Header, record its index
 261
 262          if Shtype = 2 then
 263             Symtab_Index := J;
 264          end if;
 265
 266          Section_Headers (J) := (Shname, Shtype, Shoffset, Shsize, Shlink);
 267       end loop;
 268
 269       if Symtab_Index = 0 then
 270          Success := False;
 271          return;
 272       end if;
 273
 274       End_Symtab :=
 275         Section_Headers (Symtab_Index).Shoffset +
 276         Section_Headers (Symtab_Index).Shsize;
 277
 278       String_Table_Index := Section_Headers (Symtab_Index).Shlink;
 279       Strings :=
 280         new String_Array (1 .. Section_Headers (String_Table_Index).Shsize);
 281
 282       --  Go get the String Table section for the Symbol Table
 283
 284       Reset;
 285
 286       while Offset < Section_Headers (String_Table_Index).Shoffset loop
 287          Get_Byte (B);
 288       end loop;
 289
 290       Offset := 0;
 291
 292       Get_Byte (B);  --  zero
 293
 294       while Offset < Section_Headers (String_Table_Index).Shsize loop
 295          Str_Last := 0;
 296
 297          loop
 298             Get_Byte (B);
 299             if B /= ASCII.NUL then
 300                Str_Last := Str_Last + 1;
 301                Str (Str_Last) := B;
 302
 303             else
 304                Strings (Offset - Str_Last - 1) :=
 305                  new String'(Str (1 .. Str_Last));
 306                exit;
 307             end if;
 308          end loop;
 309       end loop;
 310
 311       --  Go get the Symbol Table
 312
 313       Reset;
 314
 315       while Offset < Section_Headers (Symtab_Index).Shoffset loop
 316          Get_Byte (B);
 317       end loop;
 318
 319       while Offset < End_Symtab loop
 320          Get_Word (Stname);
 321          Get_Byte (Stinfo);
 322          Get_Byte (B);
 323          Get_Half (Stshndx);
 324          for J in 1 .. 4 loop
 325             Get_Word (W);
 326          end loop;
 327
 328          Sttype := Integer'(Character'Pos (Stinfo)) mod 16;
 329          Stbind := Integer'(Character'Pos (Stinfo)) / 16;
 330
 331          if (Sttype = 1 or else Sttype = 2)
 332               and then Stbind /= 0
 333               and then Stshndx /= 0
 334          then
 335             --  Check if this is a symbol from a generic body
 336
 337             OK := True;
 338
 339             for J in Strings (Stname)'First .. Strings (Stname)'Last - 2 loop
 340                if Strings (Stname) (J) = 'G'
 341                  and then Strings (Stname) (J + 1) = 'P'
 342                  and then Strings (Stname) (J + 2) in '0' .. '9'
 343                then
 344                   OK := False;
 345                   exit;
 346                end if;
 347             end loop;
 348
 349             if OK then
 350                declare
 351                   S_Data : Symbol_Data;
 352                begin
 353                   S_Data.Name := new String'(Strings (Stname).all);
 354
 355                   if Sttype = 1 then
 356                      S_Data.Kind := Data;
 357
 358                   else
 359                      S_Data.Kind := Proc;
 360                   end if;
 361
 362                   --  Put the new symbol in the table
 363
 364                   Symbol_Table.Append (Complete_Symbols, S_Data);
 365                end;
 366             end if;
 367          end if;
 368       end loop;
 369
 370       --  The object file has been processed, close it
 371
 372       Close (File);
 373
 374       --  Free the allocated memory
 375
 376       Free (Section_Headers);
 377
 378       for J in Strings'Range loop
 379          if Strings (J) /= null then
 380             Free (Strings (J));
 381          end if;
 382       end loop;
 383
 384       Free (Strings);
 385
 386    exception
 387       --  For any exception, output an error message, close the object file
 388       --  and return with Success = False.
 389
 390       when Ada.IO_Exceptions.End_Error =>
 391          Close (File);
 392
 393       when X : others =>
 394          Put_Line ("unexpected exception raised while processing """
 395                    & Object_File & """");
 396          Put_Line (Exception_Information (X));
 397          Close (File);
 398          Success := False;
 399    end Process;
 400
 401 end Processing;