gcc/ada/symbols-processing-vms-alpha.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) 2003-2006, 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 Alpha version of this package
  28
  29 separate (Symbols)
  30 package body Processing is
  31
  32    type Number is mod 2**16;
  33    --  16 bits unsigned number for number of characters
  34
  35    GSD : constant Number := 10;
  36    --  Code for the Global Symbol Definition section
  37
  38    C_SYM : constant Number := 1;
  39    --  Code for a Symbol subsection
  40
  41    V_DEF_Mask  : constant Number := 2**1;
  42    V_NORM_Mask : constant Number := 2**6;
  43
  44    B : Byte;
  45
  46    Number_Of_Characters : Natural := 0;
  47    --  The number of characters of each section
  48
  49    --  The following variables are used by procedure Process when reading an
  50    --  object file.
  51
  52    Code   : Number := 0;
  53    Length : Natural := 0;
  54
  55    Dummy : Number;
  56
  57    Nchars : Natural := 0;
  58    Flags  : Number  := 0;
  59
  60    Symbol : String (1 .. 255);
  61    LSymb  : Natural;
  62
  63    procedure Get (N : out Number);
  64    --  Read two bytes from the object file LSB first as unsigned 16 bit number
  65
  66    procedure Get (N : out Natural);
  67    --  Read two bytes from the object file, LSByte first, as a Natural
  68
  69    ---------
  70    -- Get --
  71    ---------
  72
  73    procedure Get (N : out Number) is
  74       C : Byte;
  75       LSByte : Number;
  76    begin
  77       Read (File, C);
  78       LSByte := Byte'Pos (C);
  79       Read (File, C);
  80       N := LSByte + (256 * Byte'Pos (C));
  81    end Get;
  82
  83    procedure Get (N : out Natural) is
  84       Result : Number;
  85    begin
  86       Get (Result);
  87       N := Natural (Result);
  88    end Get;
  89
  90    -------------
  91    -- Process --
  92    -------------
  93
  94    procedure Process
  95      (Object_File : String;
  96       Success     : out Boolean)
  97    is
  98       OK : Boolean := True;
  99
 100    begin
 101       --  Open the object file with Byte_IO. Return with Success = False if
 102       --  this fails.
 103
 104       begin
 105          Open (File, In_File, Object_File);
 106       exception
 107          when others =>
 108             Put_Line
 109               ("*** Unable to open object file """ & Object_File & """");
 110             Success := False;
 111             return;
 112       end;
 113
 114       --  Assume that the object file has a correct format
 115
 116       Success := True;
 117
 118       --  Get the different sections one by one from the object file
 119
 120       while not End_Of_File (File) loop
 121
 122          Get (Code);
 123          Get (Number_Of_Characters);
 124          Number_Of_Characters := Number_Of_Characters - 4;
 125
 126          --  If this is not a Global Symbol Definition section, skip to the
 127          --  next section.
 128
 129          if Code /= GSD then
 130
 131             for J in 1 .. Number_Of_Characters loop
 132                Read (File, B);
 133             end loop;
 134
 135          else
 136
 137             --  Skip over the next 4 bytes
 138
 139             Get (Dummy);
 140             Get (Dummy);
 141             Number_Of_Characters := Number_Of_Characters - 4;
 142
 143             --  Get each subsection in turn
 144
 145             loop
 146                Get (Code);
 147                Get (Nchars);
 148                Get (Dummy);
 149                Get (Flags);
 150                Number_Of_Characters := Number_Of_Characters - 8;
 151                Nchars := Nchars - 8;
 152
 153                --  If this is a symbol and the V_DEF flag is set, get the
 154                --  symbol.
 155
 156                if Code = C_SYM and then ((Flags and V_DEF_Mask) /= 0) then
 157                   --  First, reach the symbol length
 158
 159                   for J in 1 .. 25 loop
 160                      Read (File, B);
 161                      Nchars := Nchars - 1;
 162                      Number_Of_Characters := Number_Of_Characters - 1;
 163                   end loop;
 164
 165                   Length := Byte'Pos (B);
 166                   LSymb := 0;
 167
 168                   --  Get the symbol characters
 169
 170                   for J in 1 .. Nchars loop
 171                      Read (File, B);
 172                      Number_Of_Characters := Number_Of_Characters - 1;
 173                      if Length > 0 then
 174                         LSymb := LSymb + 1;
 175                         Symbol (LSymb) := B;
 176                         Length := Length - 1;
 177                      end if;
 178                   end loop;
 179
 180                   --  Check if it is a symbol from a generic body
 181
 182                   OK := True;
 183
 184                   for J in 1 .. LSymb - 2 loop
 185                      if Symbol (J) = 'G' and then Symbol (J + 1) = 'P'
 186                        and then Symbol (J + 2) in '0' .. '9'
 187                      then
 188                         OK := False;
 189                         exit;
 190                      end if;
 191                   end loop;
 192
 193                   if OK then
 194
 195                      --  Create the new Symbol
 196
 197                      declare
 198                         S_Data : Symbol_Data;
 199
 200                      begin
 201                         S_Data.Name := new String'(Symbol (1 .. LSymb));
 202
 203                         --  The symbol kind (Data or Procedure) depends on the
 204                         --  V_NORM flag.
 205
 206                         if (Flags and V_NORM_Mask) = 0 then
 207                            S_Data.Kind := Data;
 208
 209                         else
 210                            S_Data.Kind := Proc;
 211                         end if;
 212
 213                         --  Put the new symbol in the table
 214
 215                         Symbol_Table.Increment_Last (Complete_Symbols);
 216                         Complete_Symbols.Table
 217                           (Symbol_Table.Last (Complete_Symbols)) := S_Data;
 218                      end;
 219                   end if;
 220
 221                else
 222                   --  As it is not a symbol subsection, skip to the next
 223                   --  subsection.
 224
 225                   for J in 1 .. Nchars loop
 226                      Read (File, B);
 227                      Number_Of_Characters := Number_Of_Characters - 1;
 228                   end loop;
 229                end if;
 230
 231                --  Exit the GSD section when number of characters reaches 0
 232
 233                exit when Number_Of_Characters = 0;
 234             end loop;
 235          end if;
 236       end loop;
 237
 238       --  The object file has been processed, close it
 239
 240       Close (File);
 241
 242    exception
 243       --  For any exception, output an error message, close the object file
 244       --  and return with Success = False.
 245
 246       when X : others =>
 247          Put_Line ("unexpected exception raised while processing """
 248                    & Object_File & """");
 249          Put_Line (Exception_Information (X));
 250          Close (File);
 251          Success := False;
 252    end Process;
 253
 254 end Processing;