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