gomp-20050608-branch/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-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 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    begin
  99       --  Open the object file with Byte_IO. Return with Success = False if
 100       --  this fails.
 101
 102       begin
 103          Open (File, In_File, Object_File);
 104       exception
 105          when others =>
 106             Put_Line
 107               ("*** Unable to open object file """ & Object_File & """");
 108             Success := False;
 109             return;
 110       end;
 111
 112       --  Assume that the object file has a correct format
 113
 114       Success := True;
 115
 116       --  Get the different sections one by one from the object file
 117
 118       while not End_Of_File (File) loop
 119
 120          Get (Code);
 121          Get (Number_Of_Characters);
 122          Number_Of_Characters := Number_Of_Characters - 4;
 123
 124          --  If this is not a Global Symbol Definition section, skip to the
 125          --  next section.
 126
 127          if Code /= GSD then
 128
 129             for J in 1 .. Number_Of_Characters loop
 130                Read (File, B);
 131             end loop;
 132
 133          else
 134
 135             --  Skip over the next 4 bytes
 136
 137             Get (Dummy);
 138             Get (Dummy);
 139             Number_Of_Characters := Number_Of_Characters - 4;
 140
 141             --  Get each subsection in turn
 142
 143             loop
 144                Get (Code);
 145                Get (Nchars);
 146                Get (Dummy);
 147                Get (Flags);
 148                Number_Of_Characters := Number_Of_Characters - 8;
 149                Nchars := Nchars - 8;
 150
 151                --  If this is a symbol and the V_DEF flag is set, get the
 152                --  symbol.
 153
 154                if Code = C_SYM and then ((Flags and V_DEF_Mask) /= 0) then
 155                   --  First, reach the symbol length
 156
 157                   for J in 1 .. 25 loop
 158                      Read (File, B);
 159                      Nchars := Nchars - 1;
 160                      Number_Of_Characters := Number_Of_Characters - 1;
 161                   end loop;
 162
 163                   Length := Byte'Pos (B);
 164                   LSymb := 0;
 165
 166                   --  Get the symbol characters
 167
 168                   for J in 1 .. Nchars loop
 169                      Read (File, B);
 170                      Number_Of_Characters := Number_Of_Characters - 1;
 171                      if Length > 0 then
 172                         LSymb := LSymb + 1;
 173                         Symbol (LSymb) := B;
 174                         Length := Length - 1;
 175                      end if;
 176                   end loop;
 177
 178                   --  Create the new Symbol
 179
 180                   declare
 181                      S_Data : Symbol_Data;
 182                   begin
 183                      S_Data.Name := new String'(Symbol (1 .. LSymb));
 184
 185                      --  The symbol kind (Data or Procedure) depends on the
 186                      --  V_NORM flag.
 187
 188                      if (Flags and V_NORM_Mask) = 0 then
 189                         S_Data.Kind := Data;
 190
 191                      else
 192                         S_Data.Kind := Proc;
 193                      end if;
 194
 195                      --  Put the new symbol in the table
 196
 197                      Symbol_Table.Increment_Last (Complete_Symbols);
 198                      Complete_Symbols.Table
 199                        (Symbol_Table.Last (Complete_Symbols)) := S_Data;
 200                   end;
 201
 202                else
 203                   --  As it is not a symbol subsection, skip to the next
 204                   --  subsection.
 205
 206                   for J in 1 .. Nchars loop
 207                      Read (File, B);
 208                      Number_Of_Characters := Number_Of_Characters - 1;
 209                   end loop;
 210                end if;
 211
 212                --  Exit the GSD section when number of characters reaches 0
 213
 214                exit when Number_Of_Characters = 0;
 215             end loop;
 216          end if;
 217       end loop;
 218
 219       --  The object file has been processed, close it
 220
 221       Close (File);
 222
 223    exception
 224       --  For any exception, output an error message, close the object file
 225       --  and return with Success = False.
 226
 227       when X : others =>
 228          Put_Line ("unexpected exception raised while processing """
 229                    & Object_File & """");
 230          Put_Line (Exception_Information (X));
 231          Close (File);
 232          Success := False;
 233    end Process;
 234
 235 end Processing;