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