gcc/ada/symbols-vms.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-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 version of this package
  27
  28 with Ada.Exceptions;    use Ada.Exceptions;
  29 with Ada.Sequential_IO;
  30 with Ada.Text_IO;       use Ada.Text_IO;
  31
  32 package body Symbols is
  33
  34    Case_Sensitive  : constant String := "case_sensitive=";
  35    Symbol_Vector   : constant String := "SYMBOL_VECTOR=(";
  36    Equal_Data      : constant String := "=DATA)";
  37    Equal_Procedure : constant String := "=PROCEDURE)";
  38    Gsmatch         : constant String := "gsmatch=";
  39    Gsmatch_Lequal  : constant String := "gsmatch=lequal,";
  40
  41    Symbol_File_Name : String_Access := null;
  42    --  Name of the symbol file
  43
  44    Long_Symbol_Length : constant := 100;
  45    --  Magic length of symbols, over which the lines are split
  46
  47    Sym_Policy : Policy := Autonomous;
  48    --  The symbol policy. Set by Initialize
  49
  50    Major_ID : Integer := 1;
  51    --  The Major ID. May be modified by Initialize if Library_Version is
  52    --  specified or if it is read from the reference symbol file.
  53
  54    Soft_Major_ID : Boolean := True;
  55    --  False if library version is specified in procedure Initialize.
  56    --  When True, Major_ID may be modified if found in the reference symbol
  57    --  file.
  58
  59    Minor_ID : Natural := 0;
  60    --  The Minor ID. May be modified if read from the reference symbol file
  61
  62    Soft_Minor_ID : Boolean := True;
  63    --  False if symbol policy is Autonomous, if library version is specified
  64    --  in procedure Initialize and is not the same as the major ID read from
  65    --  the reference symbol file. When True, Minor_ID may be increased in
  66    --  Compliant symbol policy.
  67
  68    subtype Byte is Character;
  69    --  Object files are stream of bytes, but some of these bytes, those for
  70    --  the names of the symbols, are ASCII characters.
  71
  72    package Byte_IO is new Ada.Sequential_IO (Byte);
  73    use Byte_IO;
  74
  75    File : Byte_IO.File_Type;
  76    --  Each object file is read as a stream of bytes (characters)
  77
  78    function Equal (Left, Right : Symbol_Data) return Boolean;
  79    --  Test for equality of symbols
  80
  81    function Image (N : Integer) return String;
  82    --  Returns the image of N, without the initial space
  83
  84    -----------
  85    -- Equal --
  86    -----------
  87
  88    function Equal (Left, Right : Symbol_Data) return Boolean is
  89    begin
  90       return Left.Name /= null and then
  91              Right.Name /= null and then
  92              Left.Name.all = Right.Name.all and then
  93              Left.Kind = Right.Kind and then
  94              Left.Present = Right.Present;
  95    end Equal;
  96
  97    -----------
  98    -- Image --
  99    -----------
 100
 101    function Image (N : Integer) return String is
 102       Result : constant String := N'Img;
 103    begin
 104       if Result (Result'First) = ' ' then
 105          return Result (Result'First + 1 .. Result'Last);
 106
 107       else
 108          return Result;
 109       end if;
 110    end Image;
 111
 112    ----------------
 113    -- Initialize --
 114    ----------------
 115
 116    procedure Initialize
 117      (Symbol_File   : String;
 118       Reference     : String;
 119       Symbol_Policy : Policy;
 120       Quiet         : Boolean;
 121       Version       : String;
 122       Success       : out Boolean)
 123    is
 124       File : Ada.Text_IO.File_Type;
 125       Line : String (1 .. 2_000);
 126       Last : Natural;
 127
 128       Offset : Natural;
 129
 130    begin
 131       --  Record the symbol file name
 132
 133       Symbol_File_Name := new String'(Symbol_File);
 134
 135       --  Record the policy
 136
 137       Sym_Policy := Symbol_Policy;
 138
 139       --  Record the version (Major ID)
 140
 141       if Version = "" then
 142          Major_ID := 1;
 143          Soft_Major_ID := True;
 144
 145       else
 146          begin
 147             Major_ID := Integer'Value (Version);
 148             Soft_Major_ID := False;
 149
 150             if Major_ID <= 0 then
 151                raise Constraint_Error;
 152             end if;
 153
 154          exception
 155             when Constraint_Error =>
 156                if not Quiet then
 157                   Put_Line ("Version """ & Version & """ is illegal.");
 158                   Put_Line ("On VMS, version must be a positive number");
 159                end if;
 160
 161                Success := False;
 162                return;
 163          end;
 164       end if;
 165
 166       Minor_ID := 0;
 167       Soft_Minor_ID := Sym_Policy /= Autonomous;
 168
 169       --  Empty the symbol tables
 170
 171       Symbol_Table.Set_Last (Original_Symbols, 0);
 172       Symbol_Table.Set_Last (Complete_Symbols, 0);
 173
 174       --  Assume that everything will be fine
 175
 176       Success := True;
 177
 178       --  If policy is Compliant or Controlled, attempt to read the reference
 179       --  file. If policy is Restricted, attempt to read the symbol file.
 180
 181       if Sym_Policy /= Autonomous then
 182          case Sym_Policy is
 183             when Autonomous | Direct =>
 184                null;
 185
 186             when Compliant | Controlled =>
 187                begin
 188                   Open (File, In_File, Reference);
 189
 190                exception
 191                   when Ada.Text_IO.Name_Error =>
 192                      Success := False;
 193                      return;
 194
 195                   when X : others =>
 196                      if not Quiet then
 197                         Put_Line ("could not open """ & Reference & """");
 198                         Put_Line (Exception_Message (X));
 199                      end if;
 200
 201                      Success := False;
 202                      return;
 203                end;
 204
 205             when Restricted =>
 206                begin
 207                   Open (File, In_File, Symbol_File);
 208
 209                exception
 210                   when Ada.Text_IO.Name_Error =>
 211                      Success := False;
 212                      return;
 213
 214                   when X : others =>
 215                      if not Quiet then
 216                         Put_Line ("could not open """ & Symbol_File & """");
 217                         Put_Line (Exception_Message (X));
 218                      end if;
 219
 220                      Success := False;
 221                      return;
 222                end;
 223          end case;
 224
 225          --  Read line by line
 226
 227          while not End_Of_File (File) loop
 228             Offset := 0;
 229             loop
 230                Get_Line (File, Line (Offset + 1 .. Line'Last), Last);
 231                exit when Line (Last) /= '-';
 232
 233                if End_Of_File (File) then
 234                   if not Quiet then
 235                      Put_Line ("symbol file """ & Reference &
 236                                """ is incorrectly formatted:");
 237                      Put_Line ("""" & Line (1 .. Last) & """");
 238                   end if;
 239
 240                   Close (File);
 241                   Success := False;
 242                   return;
 243
 244                else
 245                   Offset := Last - 1;
 246                end if;
 247             end loop;
 248
 249             --  Ignore empty lines
 250
 251             if Last = 0 then
 252                null;
 253
 254             --  Ignore lines starting with "case_sensitive="
 255
 256             elsif Last > Case_Sensitive'Length
 257               and then Line (1 .. Case_Sensitive'Length) = Case_Sensitive
 258             then
 259                null;
 260
 261             --  Line starting with "SYMBOL_VECTOR=("
 262
 263             elsif Last > Symbol_Vector'Length
 264               and then Line (1 .. Symbol_Vector'Length) = Symbol_Vector
 265             then
 266
 267                --  SYMBOL_VECTOR=(<symbol>=DATA)
 268
 269                if Last > Symbol_Vector'Length + Equal_Data'Length and then
 270                  Line (Last - Equal_Data'Length + 1 .. Last) = Equal_Data
 271                then
 272                   Symbol_Table.Append (Original_Symbols,
 273                     (Name =>
 274                        new String'(Line (Symbol_Vector'Length + 1 ..
 275                                          Last - Equal_Data'Length)),
 276                      Kind => Data,
 277                      Present => True));
 278
 279                --  SYMBOL_VECTOR=(<symbol>=PROCEDURE)
 280
 281                elsif Last > Symbol_Vector'Length + Equal_Procedure'Length
 282                  and then
 283                   Line (Last - Equal_Procedure'Length + 1 .. Last) =
 284                                                               Equal_Procedure
 285                then
 286                   Symbol_Table.Append (Original_Symbols,
 287                     (Name =>
 288                        new String'(Line (Symbol_Vector'Length + 1 ..
 289                                          Last - Equal_Procedure'Length)),
 290                      Kind => Proc,
 291                      Present => True));
 292
 293                --  Anything else is incorrectly formatted
 294
 295                else
 296                   if not Quiet then
 297                      Put_Line ("symbol file """ & Reference &
 298                                """ is incorrectly formatted:");
 299                      Put_Line ("""" & Line (1 .. Last) & """");
 300                   end if;
 301
 302                   Close (File);
 303                   Success := False;
 304                   return;
 305                end if;
 306
 307             --  Lines with "gsmatch=lequal," or "gsmatch=equal,"
 308
 309             elsif Last > Gsmatch'Length
 310               and then Line (1 .. Gsmatch'Length) = Gsmatch
 311             then
 312                declare
 313                   Start  : Positive := Gsmatch'Length + 1;
 314                   Finish : Positive := Start;
 315                   OK     : Boolean  := True;
 316                   ID     : Integer;
 317
 318                begin
 319                   --  First, look for the first coma
 320
 321                   loop
 322                      if Start >= Last - 1 then
 323                         OK := False;
 324                         exit;
 325
 326                      elsif Line (Start) = ',' then
 327                         Start := Start + 1;
 328                         exit;
 329
 330                      else
 331                         Start := Start + 1;
 332                      end if;
 333                   end loop;
 334
 335                   Finish := Start;
 336
 337                   --  If the comma is found, get the Major and the Minor IDs
 338
 339                   if OK then
 340                      loop
 341                         if Line (Finish) not in '0' .. '9'
 342                           or else Finish >= Last - 1
 343                         then
 344                            OK := False;
 345                            exit;
 346                         end if;
 347
 348                         exit when Line (Finish + 1) = ',';
 349
 350                         Finish := Finish + 1;
 351                      end loop;
 352                   end if;
 353
 354                   if OK then
 355                      ID := Integer'Value (Line (Start .. Finish));
 356                      OK := ID /= 0;
 357
 358                      --  If Soft_Major_ID is True, it means that
 359                      --  Library_Version was not specified.
 360
 361                      if Soft_Major_ID then
 362                         Major_ID := ID;
 363
 364                      --  If the Major ID in the reference file is different
 365                      --  from the Library_Version, then the Minor ID will be 0
 366                      --  because there is no point in taking the Minor ID in
 367                      --  the reference file, or incrementing it. So, we set
 368                      --  Soft_Minor_ID to False, so that we don't modify
 369                      --  the Minor_ID later.
 370
 371                      elsif Major_ID /= ID then
 372                         Soft_Minor_ID := False;
 373                      end if;
 374
 375                      Start := Finish + 2;
 376                      Finish := Start;
 377
 378                      loop
 379                         if Line (Finish) not in '0' .. '9' then
 380                            OK := False;
 381                            exit;
 382                         end if;
 383
 384                         exit when Finish = Last;
 385
 386                         Finish := Finish + 1;
 387                      end loop;
 388
 389                      --  Only set Minor_ID if Soft_Minor_ID is True (see above)
 390
 391                      if OK and then Soft_Minor_ID then
 392                         Minor_ID := Integer'Value (Line (Start .. Finish));
 393                      end if;
 394                   end if;
 395
 396                   --  If OK is not True, that means the line is not correctly
 397                   --  formatted.
 398
 399                   if not OK then
 400                      if not Quiet then
 401                         Put_Line ("symbol file """ & Reference &
 402                                   """ is incorrectly formatted");
 403                         Put_Line ("""" & Line (1 .. Last) & """");
 404                      end if;
 405
 406                      Close (File);
 407                      Success := False;
 408                      return;
 409                   end if;
 410                end;
 411
 412             --  Anything else is incorrectly formatted
 413
 414             else
 415                if not Quiet then
 416                   Put_Line ("unexpected line in symbol file """ &
 417                             Reference & """");
 418                   Put_Line ("""" & Line (1 .. Last) & """");
 419                end if;
 420
 421                Close (File);
 422                Success := False;
 423                return;
 424             end if;
 425          end loop;
 426
 427          Close (File);
 428       end if;
 429    end Initialize;
 430
 431    ----------------
 432    -- Processing --
 433    ----------------
 434
 435    package body Processing is separate;
 436
 437    --------------
 438    -- Finalize --
 439    --------------
 440
 441    procedure Finalize
 442      (Quiet   : Boolean;
 443       Success : out Boolean)
 444    is
 445       File   : Ada.Text_IO.File_Type;
 446       --  The symbol file
 447
 448       S_Data : Symbol_Data;
 449       --  A symbol
 450
 451       Cur    : Positive := 1;
 452       --  Most probable index in the Complete_Symbols of the current symbol
 453       --  in Original_Symbol.
 454
 455       Found  : Boolean;
 456
 457    begin
 458       --  Nothing to be done if Initialize has never been called
 459
 460       if Symbol_File_Name = null then
 461          Success := False;
 462
 463       else
 464
 465          --  First find if the symbols in the reference symbol file are also
 466          --  in the object files. Note that this is not done if the policy is
 467          --  Autonomous, because no reference symbol file has been read.
 468
 469          --  Expect the first symbol in the symbol file to also be the first
 470          --  in Complete_Symbols.
 471
 472          Cur := 1;
 473
 474          for Index_1 in 1 .. Symbol_Table.Last (Original_Symbols) loop
 475             S_Data := Original_Symbols.Table (Index_1);
 476             Found := False;
 477
 478             First_Object_Loop :
 479             for Index_2 in Cur .. Symbol_Table.Last (Complete_Symbols) loop
 480                if Equal (S_Data, Complete_Symbols.Table (Index_2)) then
 481                   Cur := Index_2 + 1;
 482                   Complete_Symbols.Table (Index_2).Present := False;
 483                   Found := True;
 484                   exit First_Object_Loop;
 485                end if;
 486             end loop First_Object_Loop;
 487
 488             --  If the symbol could not be found between Cur and Last, try
 489             --  before Cur.
 490
 491             if not Found then
 492                Second_Object_Loop :
 493                for Index_2 in 1 .. Cur - 1 loop
 494                   if Equal (S_Data, Complete_Symbols.Table (Index_2)) then
 495                      Cur := Index_2 + 1;
 496                      Complete_Symbols.Table (Index_2).Present := False;
 497                      Found := True;
 498                      exit Second_Object_Loop;
 499                   end if;
 500                end loop Second_Object_Loop;
 501             end if;
 502
 503             --  If the symbol is not found, mark it as such in the table
 504
 505             if not Found then
 506                if (not Quiet) or else Sym_Policy = Controlled then
 507                   Put_Line ("symbol """ & S_Data.Name.all &
 508                             """ is no longer present in the object files");
 509                end if;
 510
 511                if Sym_Policy = Controlled or else Sym_Policy = Restricted then
 512                   Success := False;
 513                   return;
 514
 515                --  Any symbol that is undefined in the reference symbol file
 516                --  triggers an increase of the Major ID, because the new
 517                --  version of the library is no longer compatible with
 518                --  existing executables.
 519
 520                elsif Soft_Major_ID then
 521                   Major_ID := Major_ID + 1;
 522                   Minor_ID := 0;
 523                   Soft_Major_ID := False;
 524                   Soft_Minor_ID := False;
 525                end if;
 526
 527                Original_Symbols.Table (Index_1).Present := False;
 528                Free (Original_Symbols.Table (Index_1).Name);
 529
 530                if Soft_Minor_ID then
 531                   Minor_ID := Minor_ID + 1;
 532                   Soft_Minor_ID := False;
 533                end if;
 534             end if;
 535          end loop;
 536
 537          if Sym_Policy /= Restricted then
 538
 539             --  Append additional symbols, if any, to the Original_Symbols
 540             --  table.
 541
 542             for Index in 1 .. Symbol_Table.Last (Complete_Symbols) loop
 543                S_Data := Complete_Symbols.Table (Index);
 544
 545                if S_Data.Present then
 546
 547                   if Sym_Policy = Controlled then
 548                      Put_Line ("symbol """ & S_Data.Name.all &
 549                                """ is not in the reference symbol file");
 550                      Success := False;
 551                      return;
 552
 553                   elsif Soft_Minor_ID then
 554                      Minor_ID := Minor_ID + 1;
 555                      Soft_Minor_ID := False;
 556                   end if;
 557
 558                   Symbol_Table.Append (Original_Symbols, S_Data);
 559                   Complete_Symbols.Table (Index).Present := False;
 560                end if;
 561             end loop;
 562
 563             --  Create the symbol file
 564
 565             Create (File, Ada.Text_IO.Out_File, Symbol_File_Name.all);
 566
 567             Put (File, Case_Sensitive);
 568             Put_Line (File, "yes");
 569
 570             --  Put a line in the symbol file for each symbol in symbol table
 571
 572             for Index in 1 .. Symbol_Table.Last (Original_Symbols) loop
 573                if Original_Symbols.Table (Index).Present then
 574                   Put (File, Symbol_Vector);
 575
 576                   --  Split the line if symbol name length is too large
 577
 578                   if Original_Symbols.Table (Index).Name'Length >
 579                     Long_Symbol_Length
 580                   then
 581                      Put_Line (File, "-");
 582                   end if;
 583
 584                   Put (File, Original_Symbols.Table (Index).Name.all);
 585
 586                   if Original_Symbols.Table (Index).Name'Length >
 587                     Long_Symbol_Length
 588                   then
 589                      Put_Line (File, "-");
 590                   end if;
 591
 592                   if Original_Symbols.Table (Index).Kind = Data then
 593                      Put_Line (File, Equal_Data);
 594
 595                   else
 596                      Put_Line (File, Equal_Procedure);
 597                   end if;
 598
 599                   Free (Original_Symbols.Table (Index).Name);
 600                end if;
 601             end loop;
 602
 603             Put (File, Case_Sensitive);
 604             Put_Line (File, "NO");
 605
 606             --  Put the version IDs
 607
 608             Put (File, Gsmatch_Lequal);
 609             Put (File, Image (Major_ID));
 610             Put (File, ',');
 611             Put_Line  (File, Image (Minor_ID));
 612
 613             --  And we are done
 614
 615             Close (File);
 616
 617             --  Reset both tables
 618
 619             Symbol_Table.Set_Last (Original_Symbols, 0);
 620             Symbol_Table.Set_Last (Complete_Symbols, 0);
 621
 622             --  Clear the symbol file name
 623
 624             Free (Symbol_File_Name);
 625          end if;
 626
 627          Success := True;
 628       end if;
 629
 630    exception
 631       when X : others =>
 632          Put_Line ("unexpected exception raised while finalizing """
 633                    & Symbol_File_Name.all & """");
 634          Put_Line (Exception_Information (X));
 635          Success := False;
 636    end Finalize;
 637
 638 end Symbols;