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-2009, 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       W : Integer;
  65
  66       Str : String (1 .. 1000) := (others => ' ');
  67       Str_Last : Natural;
  68
  69       Strings : Strings_Ptr;
  70
  71       Shoff : Integer;
  72       Shnum : Integer;
  73       Shentsize : Integer;
  74
  75       Shname   : Integer;
  76       Shtype   : Integer;
  77       Shoffset : Integer;
  78       Shsize   : Integer;
  79       Shlink   : Integer;
  80
  81       Symtab_Index       : Natural := 0;
  82       String_Table_Index : Natural := 0;
  83
  84       End_Symtab : Integer;
  85
  86       Stname  : Integer;
  87       Stinfo  : Character;
  88       Stother : Character;
  89       Sttype  : Integer;
  90       Stbind  : Integer;
  91       Stshndx : Integer;
  92       Stvis   : Integer;
  93
  94       STV_Internal : constant := 1;
  95       STV_Hidden   : constant := 2;
  96
  97       Section_Headers : Section_Header_Ptr;
  98
  99       Offset : Natural := 0;
 100       OK     : Boolean := True;
 101
 102       procedure Get_Byte (B : out Byte);
 103       --  Read one byte from the object file
 104
 105       procedure Get_Half (H : out Integer);
 106       --  Read one half work from the object file
 107
 108       procedure Get_Word (W : out Integer);
 109       --  Read one full word from the object file
 110
 111       procedure Reset;
 112       --  Restart reading the object file
 113
 114       procedure Skip_Half;
 115       --  Read and disregard one half word from the object file
 116
 117       --------------
 118       -- Get_Byte --
 119       --------------
 120
 121       procedure Get_Byte (B : out Byte) is
 122       begin
 123          Byte_IO.Read (File, B);
 124          Offset := Offset + 1;
 125       end Get_Byte;
 126
 127       --------------
 128       -- Get_Half --
 129       --------------
 130
 131       procedure Get_Half (H : out Integer) is
 132          C1, C2 : Character;
 133       begin
 134          Get_Byte (C1); Get_Byte (C2);
 135          H :=
 136            Integer'(Character'Pos (C2)) * 256 + Integer'(Character'Pos (C1));
 137       end Get_Half;
 138
 139       --------------
 140       -- Get_Word --
 141       --------------
 142
 143       procedure Get_Word (W : out Integer) is
 144          H1, H2 : Integer;
 145       begin
 146          Get_Half (H1); Get_Half (H2);
 147          W := H2 * 256 * 256 + H1;
 148       end Get_Word;
 149
 150       -----------
 151       -- Reset --
 152       -----------
 153
 154       procedure Reset is
 155       begin
 156          Offset := 0;
 157          Byte_IO.Reset (File);
 158       end Reset;
 159
 160       ---------------
 161       -- Skip_Half --
 162       ---------------
 163
 164       procedure Skip_Half is
 165          B : Byte;
 166          pragma Unreferenced (B);
 167       begin
 168          Byte_IO.Read (File, B);
 169          Byte_IO.Read (File, B);
 170          Offset := Offset + 2;
 171       end Skip_Half;
 172
 173    --  Start of processing for Process
 174
 175    begin
 176       --  Open the object file with Byte_IO. Return with Success = False if
 177       --  this fails.
 178
 179       begin
 180          Open (File, In_File, Object_File);
 181       exception
 182          when others =>
 183             Put_Line
 184               ("*** Unable to open object file """ & Object_File & """");
 185             Success := False;
 186             return;
 187       end;
 188
 189       --  Assume that the object file has a correct format
 190
 191       Success := True;
 192
 193       --  Skip ELF identification
 194
 195       while Offset < 16 loop
 196          Get_Byte (B);
 197       end loop;
 198
 199       --  Skip e_type
 200
 201       Skip_Half;
 202
 203       --  Skip e_machine
 204
 205       Skip_Half;
 206
 207       --  Skip e_version
 208
 209       Get_Word (W);
 210
 211       --  Skip e_entry
 212
 213       for J in 1 .. 8 loop
 214          Get_Byte (B);
 215       end loop;
 216
 217       --  Skip e_phoff
 218
 219       for J in 1 .. 8 loop
 220          Get_Byte (B);
 221       end loop;
 222
 223       Get_Word (Shoff);
 224
 225       --  Skip upper half of Shoff
 226
 227       for J in 1 .. 4 loop
 228          Get_Byte (B);
 229       end loop;
 230
 231       --  Skip e_flags
 232
 233       Get_Word (W);
 234
 235       --  Skip e_ehsize
 236
 237       Skip_Half;
 238
 239       --  Skip e_phentsize
 240
 241       Skip_Half;
 242
 243       --  Skip e_phnum
 244
 245       Skip_Half;
 246
 247       Get_Half (Shentsize);
 248
 249       Get_Half (Shnum);
 250
 251       Section_Headers := new Section_Header_Array (0 .. Shnum - 1);
 252
 253       --  Go to Section Headers
 254
 255       while Offset < Shoff loop
 256          Get_Byte (B);
 257       end loop;
 258
 259       --  Reset Symtab_Index
 260
 261       Symtab_Index := 0;
 262
 263       for J in Section_Headers'Range loop
 264
 265          --  Get the data for each Section Header
 266
 267          Get_Word (Shname);
 268          Get_Word (Shtype);
 269
 270          for K in 1 .. 16 loop
 271             Get_Byte (B);
 272          end loop;
 273
 274          Get_Word (Shoffset);
 275          Get_Word (W);
 276
 277          Get_Word (Shsize);
 278          Get_Word (W);
 279
 280          Get_Word (Shlink);
 281
 282          while (Offset - Shoff) mod Shentsize /= 0 loop
 283             Get_Byte (B);
 284          end loop;
 285
 286          --  If this is the Symbol Table Section Header, record its index
 287
 288          if Shtype = 2 then
 289             Symtab_Index := J;
 290          end if;
 291
 292          Section_Headers (J) := (Shname, Shtype, Shoffset, Shsize, Shlink);
 293       end loop;
 294
 295       if Symtab_Index = 0 then
 296          Success := False;
 297          return;
 298       end if;
 299
 300       End_Symtab :=
 301         Section_Headers (Symtab_Index).Shoffset +
 302         Section_Headers (Symtab_Index).Shsize;
 303
 304       String_Table_Index := Section_Headers (Symtab_Index).Shlink;
 305       Strings :=
 306         new String_Array (1 .. Section_Headers (String_Table_Index).Shsize);
 307
 308       --  Go get the String Table section for the Symbol Table
 309
 310       Reset;
 311
 312       while Offset < Section_Headers (String_Table_Index).Shoffset loop
 313          Get_Byte (B);
 314       end loop;
 315
 316       Offset := 0;
 317
 318       Get_Byte (B);  --  zero
 319
 320       while Offset < Section_Headers (String_Table_Index).Shsize loop
 321          Str_Last := 0;
 322
 323          loop
 324             Get_Byte (B);
 325             if B /= ASCII.NUL then
 326                Str_Last := Str_Last + 1;
 327                Str (Str_Last) := B;
 328
 329             else
 330                Strings (Offset - Str_Last - 1) :=
 331                  new String'(Str (1 .. Str_Last));
 332                exit;
 333             end if;
 334          end loop;
 335       end loop;
 336
 337       --  Go get the Symbol Table
 338
 339       Reset;
 340
 341       while Offset < Section_Headers (Symtab_Index).Shoffset loop
 342          Get_Byte (B);
 343       end loop;
 344
 345       while Offset < End_Symtab loop
 346          Get_Word (Stname);
 347          Get_Byte (Stinfo);
 348          Get_Byte (Stother);
 349          Get_Half (Stshndx);
 350          for J in 1 .. 4 loop
 351             Get_Word (W);
 352          end loop;
 353
 354          Sttype := Integer'(Character'Pos (Stinfo)) mod 16;
 355          Stbind := Integer'(Character'Pos (Stinfo)) / 16;
 356          Stvis  := Integer'(Character'Pos (Stother)) mod 4;
 357
 358          if (Sttype = 1 or else Sttype = 2)
 359               and then Stbind /= 0
 360               and then Stshndx /= 0
 361               and then Stvis /= STV_Internal
 362               and then Stvis /= STV_Hidden
 363          then
 364             --  Check if this is a symbol from a generic body
 365
 366             OK := True;
 367
 368             for J in Strings (Stname)'First .. Strings (Stname)'Last - 2 loop
 369                if Strings (Stname) (J) = 'G'
 370                  and then Strings (Stname) (J + 1) = 'P'
 371                  and then Strings (Stname) (J + 2) in '0' .. '9'
 372                then
 373                   OK := False;
 374                   exit;
 375                end if;
 376             end loop;
 377
 378             if OK then
 379                declare
 380                   S_Data : Symbol_Data;
 381                begin
 382                   S_Data.Name := new String'(Strings (Stname).all);
 383
 384                   if Sttype = 1 then
 385                      S_Data.Kind := Data;
 386
 387                   else
 388                      S_Data.Kind := Proc;
 389                   end if;
 390
 391                   --  Put the new symbol in the table
 392
 393                   Symbol_Table.Append (Complete_Symbols, S_Data);
 394                end;
 395             end if;
 396          end if;
 397       end loop;
 398
 399       --  The object file has been processed, close it
 400
 401       Close (File);
 402
 403       --  Free the allocated memory
 404
 405       Free (Section_Headers);
 406
 407       for J in Strings'Range loop
 408          if Strings (J) /= null then
 409             Free (Strings (J));
 410          end if;
 411       end loop;
 412
 413       Free (Strings);
 414
 415    exception
 416       --  For any exception, output an error message, close the object file
 417       --  and return with Success = False.
 418
 419       when Ada.IO_Exceptions.End_Error =>
 420          Close (File);
 421
 422       when X : others =>
 423          Put_Line ("unexpected exception raised while processing """
 424                    & Object_File & """");
 425          Put_Line (Exception_Information (X));
 426          Close (File);
 427          Success := False;
 428    end Process;
 429
 430 end Processing;