gcc/ada/5vsymbol.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                              S Y M B O L S                               --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --          Copyright (C) 2003 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,  59 Temple Place - Suite 330,  Boston, --
  20 -- MA 02111-1307, 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 version of this package
  28
  29 with Ada.Exceptions;    use Ada.Exceptions;
  30 with Ada.Sequential_IO;
  31 with Ada.Text_IO;       use Ada.Text_IO;
  32
  33 package body Symbols is
  34
  35    Case_Sensitive  : constant String := "case_sensitive=";
  36    Symbol_Vector   : constant String := "SYMBOL_VECTOR=(";
  37    Equal_Data      : constant String := "=DATA)";
  38    Equal_Procedure : constant String := "=PROCEDURE)";
  39
  40    Symbol_File_Name : String_Access := null;
  41    --  Name of the symbol file
  42
  43    subtype Byte is Character;
  44    --  Object files are stream of bytes, but some of these bytes, those for
  45    --  the names of the symbols, are ASCII characters.
  46
  47    package Byte_IO is new Ada.Sequential_IO (Byte);
  48    use Byte_IO;
  49
  50    type Number is mod 2**16;
  51    --  16 bits unsigned number for number of characters
  52
  53    GSD : constant Number := 10;
  54    --  Code for the Global Symbol Definition section
  55
  56    C_SYM : constant Number := 1;
  57    --  Code for a Symbol subsection
  58
  59    V_DEF_Mask  : constant Number := 2**1;
  60    V_NORM_Mask : constant Number := 2**6;
  61
  62    File : Byte_IO.File_Type;
  63    --  Each object file is read as a stream of bytes (characters)
  64
  65    B : Byte;
  66
  67    Number_Of_Characters : Natural := 0;
  68    --  The number of characters of each section
  69
  70    Code   : Number := 0;
  71    Length : Natural := 0;
  72
  73    Dummy : Number;
  74
  75    Nchars : Natural := 0;
  76    Flags  : Number  := 0;
  77
  78    Symbol : String (1 .. 255);
  79    LSymb  : Natural;
  80
  81    function Equal (Left, Right : Symbol_Data) return Boolean;
  82    --  Test for equality of symbols
  83
  84    procedure Get (N : out Number);
  85    --  Read two bytes from the object file LSB first as unsigned 16 bit number
  86
  87    procedure Get (N : out Natural);
  88    --  Read two bytes from the object file, LSByte first, as a Natural
  89
  90    -----------
  91    -- Equal --
  92    -----------
  93
  94    function Equal (Left, Right : Symbol_Data) return Boolean is
  95    begin
  96       return Left.Name /= null and then
  97              Right.Name /= null and then
  98              Left.Name.all = Right.Name.all and then
  99              Left.Kind = Right.Kind and then
 100              Left.Present = Right.Present;
 101    end Equal;
 102
 103    ---------
 104    -- Get --
 105    ---------
 106
 107    procedure Get (N : out Number) is
 108       C : Byte;
 109       LSByte : Number;
 110    begin
 111       Read (File, C);
 112       LSByte := Byte'Pos (C);
 113       Read (File, C);
 114       N := LSByte + (256 * Byte'Pos (C));
 115    end Get;
 116
 117    procedure Get (N : out Natural) is
 118       Result : Number;
 119    begin
 120       Get (Result);
 121       N := Natural (Result);
 122    end Get;
 123
 124    ----------------
 125    -- Initialize --
 126    ----------------
 127
 128    procedure Initialize
 129      (Symbol_File : String;
 130       Force       : Boolean;
 131       Quiet       : Boolean;
 132       Success     : out Boolean)
 133    is
 134       File : Ada.Text_IO.File_Type;
 135       Line : String (1 .. 1_000);
 136       Last : Natural;
 137
 138    begin
 139       --  Record the symbol file name
 140
 141       Symbol_File_Name := new String'(Symbol_File);
 142
 143       --  Empty the symbol tables
 144
 145       Symbol_Table.Set_Last (Original_Symbols, 0);
 146       Symbol_Table.Set_Last (Complete_Symbols, 0);
 147
 148       --  Assume that everything will be fine
 149
 150       Success := True;
 151
 152       --  If Force is not set, attempt to read the symbol file
 153
 154       if not Force then
 155          begin
 156             Open (File, In_File, Symbol_File);
 157
 158          exception
 159             when Ada.Text_IO.Name_Error =>
 160                return;
 161
 162             when X : others =>
 163                if not Quiet then
 164                   Put_Line ("could not open """ & Symbol_File & """");
 165                   Put_Line (Exception_Message (X));
 166                end if;
 167
 168                Success := False;
 169                return;
 170          end;
 171
 172          while not End_Of_File (File) loop
 173             Get_Line (File, Line, Last);
 174
 175             if Last = 0 then
 176                null;
 177
 178             elsif Last > Case_Sensitive'Length
 179               and then Line (1 .. Case_Sensitive'Length) = Case_Sensitive
 180             then
 181                null;
 182
 183             elsif Last > Symbol_Vector'Length
 184               and then Line (1 .. Symbol_Vector'Length) = Symbol_Vector
 185             then
 186                if Last > Symbol_Vector'Length + Equal_Data'Length and then
 187                  Line (Last - Equal_Data'Length + 1 .. Last) = Equal_Data
 188                then
 189                   Symbol_Table.Increment_Last (Original_Symbols);
 190                   Original_Symbols.Table
 191                     (Symbol_Table.Last (Original_Symbols)) :=
 192                       (Name =>
 193                          new String'(Line (Symbol_Vector'Length + 1 ..
 194                                            Last - Equal_Data'Length)),
 195                        Kind => Data,
 196                        Present => True);
 197
 198                elsif Last > Symbol_Vector'Length + Equal_Procedure'Length
 199                  and then
 200                   Line (Last - Equal_Procedure'Length + 1 .. Last) =
 201                                                               Equal_Procedure
 202                then
 203                   Symbol_Table.Increment_Last (Original_Symbols);
 204                   Original_Symbols.Table
 205                     (Symbol_Table.Last (Original_Symbols)) :=
 206                     (Name =>
 207                        new String'(Line (Symbol_Vector'Length + 1 ..
 208                                          Last - Equal_Procedure'Length)),
 209                      Kind => Proc,
 210                      Present => True);
 211
 212                else
 213                   if not Quiet then
 214                      Put_Line ("symbol file """ & Symbol_File &
 215                                """ is incorrectly formatted:");
 216                      Put_Line ("""" & Line (1 .. Last) & """");
 217                   end if;
 218
 219                   Close (File);
 220                   Success := False;
 221                   return;
 222                end if;
 223
 224             else
 225                if not Quiet then
 226                   Put_Line ("unexpected line in symbol file """ &
 227                             Symbol_File & """");
 228                   Put_Line ("""" & Line (1 .. Last) & """");
 229                end if;
 230
 231                Close (File);
 232                Success := False;
 233                return;
 234             end if;
 235          end loop;
 236
 237          Close (File);
 238       end if;
 239    end Initialize;
 240
 241    -------------
 242    -- Process --
 243    -------------
 244
 245    procedure Process
 246      (Object_File : String;
 247       Success     : out Boolean)
 248    is
 249    begin
 250       --  Open the object file. Return with Success = False if this fails.
 251
 252       begin
 253          Open (File, In_File, Object_File);
 254       exception
 255          when others =>
 256             Put_Line
 257               ("*** Unable to open object file """ & Object_File & """");
 258             Success := False;
 259             return;
 260       end;
 261
 262       --  Assume that the object file has a correct format
 263
 264       Success := True;
 265
 266       --  Get the different sections one by one from the object file
 267
 268       while not End_Of_File (File) loop
 269
 270          Get (Code);
 271          Get (Number_Of_Characters);
 272          Number_Of_Characters := Number_Of_Characters - 4;
 273
 274          --  If this is not a Global Symbol Definition section, skip to the
 275          --  next section.
 276
 277          if Code /= GSD then
 278
 279             for J in 1 .. Number_Of_Characters loop
 280                Read (File, B);
 281             end loop;
 282
 283          else
 284
 285             --  Skip over the next 4 bytes
 286
 287             Get (Dummy);
 288             Get (Dummy);
 289             Number_Of_Characters := Number_Of_Characters - 4;
 290
 291             --  Get each subsection in turn
 292
 293             loop
 294                Get (Code);
 295                Get (Nchars);
 296                Get (Dummy);
 297                Get (Flags);
 298                Number_Of_Characters := Number_Of_Characters - 8;
 299                Nchars := Nchars - 8;
 300
 301                --  If this is a symbol and the V_DEF flag is set, get the
 302                --  symbol.
 303
 304                if Code = C_SYM and then ((Flags and V_DEF_Mask) /= 0) then
 305                   --  First, reach the symbol length
 306
 307                   for J in 1 .. 25 loop
 308                      Read (File, B);
 309                      Nchars := Nchars - 1;
 310                      Number_Of_Characters := Number_Of_Characters - 1;
 311                   end loop;
 312
 313                   Length := Byte'Pos (B);
 314                   LSymb := 0;
 315
 316                   --  Get the symbol characters
 317
 318                   for J in 1 .. Nchars loop
 319                      Read (File, B);
 320                      Number_Of_Characters := Number_Of_Characters - 1;
 321                      if Length > 0 then
 322                         LSymb := LSymb + 1;
 323                         Symbol (LSymb) := B;
 324                         Length := Length - 1;
 325                      end if;
 326                   end loop;
 327
 328                   --  Create the new Symbol
 329
 330                   declare
 331                      S_Data : Symbol_Data;
 332                   begin
 333                      S_Data.Name := new String'(Symbol (1 .. LSymb));
 334
 335                      --  The symbol kind (Data or Procedure) depends on the
 336                      --  V_NORM flag.
 337
 338                      if (Flags and V_NORM_Mask) = 0 then
 339                         S_Data.Kind := Data;
 340
 341                      else
 342                         S_Data.Kind := Proc;
 343                      end if;
 344
 345                      --  Put the new symbol in the table
 346
 347                      Symbol_Table.Increment_Last (Complete_Symbols);
 348                      Complete_Symbols.Table
 349                        (Symbol_Table.Last (Complete_Symbols)) := S_Data;
 350                   end;
 351
 352                else
 353                   --  As it is not a symbol subsection, skip to the next
 354                   --  subsection.
 355
 356                   for J in 1 .. Nchars loop
 357                      Read (File, B);
 358                      Number_Of_Characters := Number_Of_Characters - 1;
 359                   end loop;
 360                end if;
 361
 362                --  Exit the GSD section when number of characters reaches 0
 363
 364                exit when Number_Of_Characters = 0;
 365             end loop;
 366          end if;
 367       end loop;
 368
 369       --  The object file has been processed, close it
 370
 371       Close (File);
 372
 373    exception
 374       --  For any exception, output an error message, close the object file
 375       --  and return with Success = False.
 376
 377       when X : others =>
 378          Put_Line ("unexpected exception raised while processing """
 379                    & Object_File & """");
 380          Put_Line (Exception_Information (X));
 381          Close (File);
 382          Success := False;
 383    end Process;
 384
 385    --------------
 386    -- Finalize --
 387    --------------
 388
 389    procedure Finalize
 390      (Quiet   : Boolean;
 391       Success : out Boolean)
 392    is
 393       File   : Ada.Text_IO.File_Type;
 394       --  The symbol file
 395
 396       S_Data : Symbol_Data;
 397       --  A symbol
 398
 399       Cur    : Positive := 1;
 400       --  Most probable index in the Complete_Symbols of the current symbol
 401       --  in Original_Symbol.
 402
 403       Found  : Boolean;
 404
 405    begin
 406       --  Nothing to be done if Initialize has never been called
 407
 408       if Symbol_File_Name = null then
 409          Success := False;
 410
 411       else
 412
 413          --  First find if the symbols in the symbol file are also in the
 414          --  object files.
 415
 416          --  Expect the first symbol in the symbol file to also be the first
 417          --  in Complete_Symbols.
 418
 419          Cur := 1;
 420
 421          for Index_1 in 1 .. Symbol_Table.Last (Original_Symbols) loop
 422             S_Data := Original_Symbols.Table (Index_1);
 423             Found := False;
 424
 425             First_Object_Loop :
 426             for Index_2 in Cur .. Symbol_Table.Last (Complete_Symbols) loop
 427                if Equal (S_Data, Complete_Symbols.Table (Index_2)) then
 428                   Cur := Index_2 + 1;
 429                   Complete_Symbols.Table (Index_2).Present := False;
 430                   Found := True;
 431                   exit First_Object_Loop;
 432                end if;
 433             end loop First_Object_Loop;
 434
 435             --  If the symbol could not be found between Cur and Last, try
 436             --  before Cur.
 437
 438             if not Found then
 439                Second_Object_Loop :
 440                for Index_2 in 1 .. Cur - 1 loop
 441                   if Equal (S_Data, Complete_Symbols.Table (Index_2)) then
 442                      Cur := Index_2 + 1;
 443                      Complete_Symbols.Table (Index_2).Present := False;
 444                      Found := True;
 445                      exit Second_Object_Loop;
 446                   end if;
 447                end loop Second_Object_Loop;
 448             end if;
 449
 450             --  If the symbol is not found, mark it as such in the table
 451
 452             if not Found then
 453                if not Quiet then
 454                   Put_Line ("symbol """ & S_Data.Name.all &
 455                             """ is no longer present in the object files");
 456                end if;
 457
 458                Original_Symbols.Table (Index_1).Present := False;
 459                Free (Original_Symbols.Table (Index_1).Name);
 460             end if;
 461          end loop;
 462
 463          --  Append additional symbols, if any, to the Original_Symbols table
 464
 465          for Index in 1 .. Symbol_Table.Last (Complete_Symbols) loop
 466             S_Data := Complete_Symbols.Table (Index);
 467
 468             if S_Data.Present then
 469                Symbol_Table.Increment_Last (Original_Symbols);
 470                Original_Symbols.Table (Symbol_Table.Last (Original_Symbols)) :=
 471                  S_Data;
 472                Complete_Symbols.Table (Index).Present := False;
 473             end if;
 474          end loop;
 475
 476          --  Create the symbol file
 477
 478          Create (File, Ada.Text_IO.Out_File, Symbol_File_Name.all);
 479
 480          Put (File, Case_Sensitive);
 481          Put_Line (File, "yes");
 482
 483          --  Put a line in the symbol file for each symbol in the symbol table
 484
 485          for Index in 1 .. Symbol_Table.Last (Original_Symbols) loop
 486             if Original_Symbols.Table (Index).Present then
 487                Put (File, Symbol_Vector);
 488                Put (File, Original_Symbols.Table (Index).Name.all);
 489
 490                if Original_Symbols.Table (Index).Kind = Data then
 491                   Put_Line (File, Equal_Data);
 492
 493                else
 494                   Put_Line (File, Equal_Procedure);
 495                end if;
 496
 497                Free (Original_Symbols.Table (Index).Name);
 498             end if;
 499          end loop;
 500
 501          Put (File, Case_Sensitive);
 502          Put_Line (File, "NO");
 503
 504          --  And we are done
 505
 506          Close (File);
 507
 508          --  Reset both tables
 509
 510          Symbol_Table.Set_Last (Original_Symbols, 0);
 511          Symbol_Table.Set_Last (Complete_Symbols, 0);
 512
 513          --  Clear the symbol file name
 514
 515          Free (Symbol_File_Name);
 516
 517          Success := True;
 518       end if;
 519
 520    exception
 521       when X : others =>
 522          Put_Line ("unexpected exception raised while finalizing """
 523                    & Symbol_File_Name.all & """");
 524          Put_Line (Exception_Information (X));
 525          Success := False;
 526    end Finalize;
 527
 528 end Symbols;