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