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