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-2010, 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    EMH : constant Number := 8;
  35    --  Code for the Module Header section
  36
  37    GSD : constant Number := 10;
  38    --  Code for the Global Symbol Definition section
  39
  40    C_SYM : constant Number := 1;
  41    --  Code for a Symbol subsection
  42
  43    V_DEF_Mask  : constant Number := 2 ** 1;
  44    V_NORM_Mask : constant Number := 2 ** 6;
  45    --  Comments ???
  46
  47    B : Byte;
  48
  49    Number_Of_Characters : Natural := 0;
  50    --  The number of characters of each section
  51
  52    Native_Format : Boolean;
  53    --  True if records are decoded by the system (like on VMS)
  54
  55    Has_Pad : Boolean;
  56    --  If true, a pad byte must be skipped before reading the next record
  57
  58    --  The following variables are used by procedure Process when reading an
  59    --  object file.
  60
  61    Code   : Number := 0;
  62    Length : Natural := 0;
  63
  64    Dummy : Number;
  65
  66    Nchars : Natural := 0;
  67    Flags  : Number  := 0;
  68
  69    Symbol : String (1 .. 255);
  70    LSymb  : Natural;
  71
  72    procedure Get (N : out Number);
  73    --  Read two bytes from the object file LSB first as unsigned 16 bit number
  74
  75    procedure Get (N : out Natural);
  76    --  Read two bytes from the object file, LSByte first, as a Natural
  77
  78    ---------
  79    -- Get --
  80    ---------
  81
  82    procedure Get (N : out Number) is
  83       C : Byte;
  84       LSByte : Number;
  85    begin
  86       Read (File, C);
  87       LSByte := Byte'Pos (C);
  88       Read (File, C);
  89       N := LSByte + (256 * Byte'Pos (C));
  90    end Get;
  91
  92    procedure Get (N : out Natural) is
  93       Result : Number;
  94    begin
  95       Get (Result);
  96       N := Natural (Result);
  97    end Get;
  98
  99    -------------
 100    -- Process --
 101    -------------
 102
 103    procedure Process
 104      (Object_File : String;
 105       Success     : out Boolean)
 106    is
 107       OK : Boolean := True;
 108
 109    begin
 110       --  Open the object file with Byte_IO. Return with Success = False if
 111       --  this fails.
 112
 113       begin
 114          Open (File, In_File, Object_File);
 115       exception
 116          when others =>
 117             Put_Line
 118               ("*** Unable to open object file """ & Object_File & """");
 119             Success := False;
 120             return;
 121       end;
 122
 123       --  Assume that the object file has a correct format
 124
 125       Success := True;
 126
 127       --  Check the file format in case of cross-tool
 128
 129       Get (Code);
 130       Get (Number_Of_Characters);
 131       Get (Dummy);
 132
 133       if Code = Dummy and then Number_Of_Characters = Natural (EMH) then
 134
 135          --  Looks like a cross tool
 136
 137          Native_Format := False;
 138          Number_Of_Characters := Natural (Dummy) - 4;
 139          Has_Pad := (Number_Of_Characters mod 2) = 1;
 140
 141       elsif Code = EMH then
 142          Native_Format := True;
 143          Number_Of_Characters := Number_Of_Characters - 6;
 144          Has_Pad := False;
 145
 146       else
 147          Put_Line ("file """ & Object_File & """ is not an object file");
 148          Close (File);
 149          Success := False;
 150          return;
 151       end if;
 152
 153       --  Skip the EMH section
 154
 155       for J in 1 .. Number_Of_Characters loop
 156          Read (File, B);
 157       end loop;
 158
 159       --  Get the different sections one by one from the object file
 160
 161       while not End_Of_File (File) loop
 162
 163          if not Native_Format then
 164
 165             --  Skip pad byte if present
 166
 167             if Has_Pad then
 168                Get (B);
 169             end if;
 170
 171             --  Skip record length
 172
 173             Get (Dummy);
 174          end if;
 175
 176          Get (Code);
 177          Get (Number_Of_Characters);
 178
 179          if not Native_Format then
 180             if Natural (Dummy) /= Number_Of_Characters then
 181
 182                --  Format error
 183
 184                raise Constraint_Error;
 185             end if;
 186
 187             Has_Pad := (Number_Of_Characters mod 2) = 1;
 188          end if;
 189
 190          --  The header is 4 bytes length
 191
 192          Number_Of_Characters := Number_Of_Characters - 4;
 193
 194          --  If this is not a Global Symbol Definition section, skip to the
 195          --  next section.
 196
 197          if Code /= GSD then
 198             for J in 1 .. Number_Of_Characters loop
 199                Read (File, B);
 200             end loop;
 201
 202          else
 203             --  Skip over the next 4 bytes
 204
 205             Get (Dummy);
 206             Get (Dummy);
 207             Number_Of_Characters := Number_Of_Characters - 4;
 208
 209             --  Get each subsection in turn
 210
 211             loop
 212                Get (Code);
 213                Get (Nchars);
 214                Get (Dummy);
 215                Get (Flags);
 216                Number_Of_Characters := Number_Of_Characters - 8;
 217                Nchars := Nchars - 8;
 218
 219                --  If this is a symbol and the V_DEF flag is set, get symbol
 220
 221                if Code = C_SYM and then ((Flags and V_DEF_Mask) /= 0) then
 222
 223                   --  First, reach the symbol length
 224
 225                   for J in 1 .. 25 loop
 226                      Read (File, B);
 227                      Nchars := Nchars - 1;
 228                      Number_Of_Characters := Number_Of_Characters - 1;
 229                   end loop;
 230
 231                   Length := Byte'Pos (B);
 232                   LSymb := 0;
 233
 234                   --  Get the symbol characters
 235
 236                   for J in 1 .. Nchars loop
 237                      Read (File, B);
 238                      Number_Of_Characters := Number_Of_Characters - 1;
 239
 240                      if Length > 0 then
 241                         LSymb := LSymb + 1;
 242                         Symbol (LSymb) := B;
 243                         Length := Length - 1;
 244                      end if;
 245                   end loop;
 246
 247                   --  Check if it is a symbol from a generic body
 248
 249                   OK := True;
 250
 251                   for J in 1 .. LSymb - 2 loop
 252                      if Symbol (J) = 'G' and then Symbol (J + 1) = 'P'
 253                        and then Symbol (J + 2) in '0' .. '9'
 254                      then
 255                         OK := False;
 256                         exit;
 257                      end if;
 258                   end loop;
 259
 260                   if OK then
 261
 262                      --  Create the new Symbol
 263
 264                      declare
 265                         S_Data : Symbol_Data;
 266
 267                      begin
 268                         S_Data.Name := new String'(Symbol (1 .. LSymb));
 269
 270                         --  The symbol kind (Data or Procedure) depends on the
 271                         --  V_NORM flag.
 272
 273                         if (Flags and V_NORM_Mask) = 0 then
 274                            S_Data.Kind := Data;
 275                         else
 276                            S_Data.Kind := Proc;
 277                         end if;
 278
 279                         --  Put the new symbol in the table
 280
 281                         Symbol_Table.Append (Complete_Symbols, S_Data);
 282                      end;
 283                   end if;
 284
 285                else
 286                   --  As it is not a symbol subsection, skip to the next
 287                   --  subsection.
 288
 289                   for J in 1 .. Nchars loop
 290                      Read (File, B);
 291                      Number_Of_Characters := Number_Of_Characters - 1;
 292                   end loop;
 293                end if;
 294
 295                --  Exit the GSD section when number of characters reaches zero
 296
 297                exit when Number_Of_Characters = 0;
 298             end loop;
 299          end if;
 300       end loop;
 301
 302       --  The object file has been processed, close it
 303
 304       Close (File);
 305
 306    exception
 307       --  For any exception, output an error message, close the object file
 308       --  and return with Success = False.
 309
 310       when X : others =>
 311          Put_Line ("unexpected exception raised while processing """
 312                    & Object_File & """");
 313          Put_Line (Exception_Information (X));
 314          Close (File);
 315          Success := False;
 316    end Process;
 317
 318 end Processing;