old-autovect-branch/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-2005 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 2,  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 COPYING.  If not, write --
  19 -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
  20 -- Boston, MA 02110-1301, USA.                                              --
  21 --                                                                          --
  22 -- GNAT was originally developed  by the GNAT team at  New York University. --
  23 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  24 --                                                                          --
  25 ------------------------------------------------------------------------------
  26
  27 --  This is the VMS/IA64 version of this package
  28
  29 with Ada.IO_Exceptions;
  30
  31 with Ada.Unchecked_Deallocation;
  32
  33 separate (Symbols)
  34 package body Processing is
  35
  36    type String_Array is array (Positive range <>) of String_Access;
  37    type Strings_Ptr is access String_Array;
  38
  39    procedure Free is
  40      new Ada.Unchecked_Deallocation (String_Array, Strings_Ptr);
  41
  42    type Section_Header is record
  43       Shname   : Integer;
  44       Shtype   : Integer;
  45       Shoffset : Integer;
  46       Shsize   : Integer;
  47       Shlink   : Integer;
  48    end record;
  49
  50    type Section_Header_Array is array (Natural range <>) of Section_Header;
  51    type Section_Header_Ptr is access Section_Header_Array;
  52
  53    procedure Free is
  54      new Ada.Unchecked_Deallocation (Section_Header_Array, Section_Header_Ptr);
  55
  56    -------------
  57    -- Process --
  58    -------------
  59
  60    procedure Process
  61      (Object_File : String;
  62       Success     : out Boolean)
  63    is
  64       B : Byte;
  65       H : Integer;
  66       W : Integer;
  67
  68       Str : String (1 .. 1000) := (others => ' ');
  69       Str_Last : Natural;
  70
  71       Strings : Strings_Ptr;
  72
  73       Shoff : Integer;
  74       Shnum : Integer;
  75       Shentsize : Integer;
  76
  77       Shname   : Integer;
  78       Shtype   : Integer;
  79       Shoffset : Integer;
  80       Shsize   : Integer;
  81       Shlink   : Integer;
  82
  83       Symtab_Index       : Natural := 0;
  84       String_Table_Index : Natural := 0;
  85
  86       End_Symtab : Integer;
  87
  88       Stname : Integer;
  89       Stinfo : Character;
  90       Sttype : Integer;
  91       Stbind : Integer;
  92       Stshndx : Integer;
  93
  94       Section_Headers : Section_Header_Ptr;
  95
  96       Offset   : Natural := 0;
  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
 103       procedure Get_Byte (B : out Byte) is
 104       begin
 105          Byte_IO.Read (File, B);
 106          Offset := Offset + 1;
 107       end Get_Byte;
 108
 109       procedure Get_Half (H : out Integer) is
 110          C1, C2 : Character;
 111       begin
 112          Get_Byte (C1); Get_Byte (C2);
 113          H :=
 114            Integer'(Character'Pos (C2)) * 256 + Integer'(Character'Pos (C1));
 115       end Get_Half;
 116
 117       procedure Get_Word (W : out Integer) is
 118          H1, H2 : Integer;
 119       begin
 120          Get_Half (H1); Get_Half (H2);
 121          W := H2 * 256 * 256 + H1;
 122       end Get_Word;
 123
 124       procedure Reset is
 125       begin
 126          Offset := 0;
 127          Byte_IO.Reset (File);
 128       end Reset;
 129
 130    begin
 131       --  Open the object file with Byte_IO. Return with Success = False if
 132       --  this fails.
 133
 134       begin
 135          Open (File, In_File, Object_File);
 136       exception
 137          when others =>
 138             Put_Line
 139               ("*** Unable to open object file """ & Object_File & """");
 140             Success := False;
 141             return;
 142       end;
 143
 144       --  Assume that the object file has a correct format
 145
 146       Success := True;
 147
 148       --  Skip ELF identification
 149
 150       while Offset < 16 loop
 151          Get_Byte (B);
 152       end loop;
 153
 154       --  Skip e_type
 155
 156       Get_Half (H);
 157
 158       --  Skip e_machine
 159
 160       Get_Half (H);
 161
 162       --  Skip e_version
 163
 164       Get_Word (W);
 165
 166       --  Skip e_entry
 167
 168       for J in 1 .. 8 loop
 169          Get_Byte (B);
 170       end loop;
 171
 172       --  Skip e_phoff
 173
 174       for J in 1 .. 8 loop
 175          Get_Byte (B);
 176       end loop;
 177
 178       Get_Word (Shoff);
 179
 180       --  Skip upper half of Shoff
 181
 182       for J in 1 .. 4 loop
 183          Get_Byte (B);
 184       end loop;
 185
 186       --  Skip e_flags
 187
 188       Get_Word (W);
 189
 190       --  Skip e_ehsize
 191
 192       Get_Half (H);
 193
 194       --  Skip e_phentsize
 195
 196       Get_Half (H);
 197
 198       --  Skip e_phnum
 199
 200       Get_Half (H);
 201
 202       Get_Half (Shentsize);
 203
 204       Get_Half (Shnum);
 205
 206       Section_Headers := new Section_Header_Array (0 .. Shnum - 1);
 207
 208       --  Go to Section Headers
 209
 210       while Offset < Shoff loop
 211          Get_Byte (B);
 212       end loop;
 213
 214       --  Reset Symtab_Index
 215
 216       Symtab_Index := 0;
 217
 218       for J in Section_Headers'Range loop
 219          --  Get the data for each Section Header
 220
 221          Get_Word (Shname);
 222          Get_Word (Shtype);
 223
 224          for K in 1 .. 16 loop
 225             Get_Byte (B);
 226          end loop;
 227
 228          Get_Word (Shoffset);
 229          Get_Word (W);
 230
 231          Get_Word (Shsize);
 232          Get_Word (W);
 233
 234          Get_Word (Shlink);
 235
 236          while (Offset - Shoff) mod Shentsize /= 0 loop
 237             Get_Byte (B);
 238          end loop;
 239
 240          --  If this is the Symbol Table Section Header, record its index
 241
 242          if Shtype = 2 then
 243             Symtab_Index := J;
 244          end if;
 245
 246          Section_Headers (J) := (Shname, Shtype, Shoffset, Shsize, Shlink);
 247       end loop;
 248
 249       if Symtab_Index = 0 then
 250          Success := False;
 251          return;
 252       end if;
 253
 254       End_Symtab :=
 255         Section_Headers (Symtab_Index).Shoffset +
 256         Section_Headers (Symtab_Index).Shsize;
 257
 258       String_Table_Index := Section_Headers (Symtab_Index).Shlink;
 259       Strings :=
 260         new String_Array (1 .. Section_Headers (String_Table_Index).Shsize);
 261
 262       --  Go get the String Table section for the Symbol Table
 263
 264       Reset;
 265
 266       while Offset < Section_Headers (String_Table_Index).Shoffset loop
 267          Get_Byte (B);
 268       end loop;
 269
 270       Offset := 0;
 271
 272       Get_Byte (B);  --  zero
 273
 274       while Offset < Section_Headers (String_Table_Index).Shsize loop
 275          Str_Last := 0;
 276
 277          loop
 278             Get_Byte (B);
 279             if B /= ASCII.NUL then
 280                Str_Last := Str_Last + 1;
 281                Str (Str_Last) := B;
 282
 283             else
 284                Strings (Offset - Str_Last - 1) :=
 285                  new String'(Str (1 .. Str_Last));
 286                exit;
 287             end if;
 288          end loop;
 289       end loop;
 290
 291       --  Go get the Symbol Table
 292
 293       Reset;
 294
 295       while Offset < Section_Headers (Symtab_Index).Shoffset loop
 296          Get_Byte (B);
 297       end loop;
 298
 299       while Offset < End_Symtab loop
 300          Get_Word (Stname);
 301          Get_Byte (Stinfo);
 302          Get_Byte (B);
 303          Get_Half (Stshndx);
 304          for J in 1 .. 4 loop
 305             Get_Word (W);
 306          end loop;
 307
 308          Sttype := Integer'(Character'Pos (Stinfo)) mod 16;
 309          Stbind := Integer'(Character'Pos (Stinfo)) / 16;
 310
 311          if (Sttype = 1 or else Sttype = 2)
 312               and then Stbind /= 0
 313               and then Stshndx /= 0
 314          then
 315             declare
 316                S_Data : Symbol_Data;
 317             begin
 318                S_Data.Name := new String'(Strings (Stname).all);
 319
 320                if Sttype = 1 then
 321                   S_Data.Kind := Data;
 322
 323                else
 324                   S_Data.Kind := Proc;
 325                end if;
 326
 327                --  Put the new symbol in the table
 328
 329                Symbol_Table.Increment_Last (Complete_Symbols);
 330                Complete_Symbols.Table
 331                  (Symbol_Table.Last (Complete_Symbols)) := S_Data;
 332             end;
 333          end if;
 334       end loop;
 335
 336       --  The object file has been processed, close it
 337
 338       Close (File);
 339
 340       --  Free the allocated memory
 341
 342       Free (Section_Headers);
 343
 344       for J in Strings'Range loop
 345          if Strings (J) /= null then
 346             Free (Strings (J));
 347          end if;
 348       end loop;
 349
 350       Free (Strings);
 351
 352    exception
 353       --  For any exception, output an error message, close the object file
 354       --  and return with Success = False.
 355
 356       when Ada.IO_Exceptions.End_Error =>
 357          Close (File);
 358
 359       when X : others =>
 360          Put_Line ("unexpected exception raised while processing """
 361                    & Object_File & """");
 362          Put_Line (Exception_Information (X));
 363          Close (File);
 364          Success := False;
 365    end Process;
 366
 367 end Processing;