gcc/ada/symbols-vms-alpha.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-2004 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    Gsmatch         : constant String := "gsmatch=equal,";
  40
  41    Symbol_File_Name : String_Access := null;
  42    --  Name of the symbol file
  43
  44    Sym_Policy : Policy := Autonomous;
  45    --  The symbol policy. Set by Initialize
  46
  47    Major_ID : Integer := 1;
  48    --  The Major ID. May be modified by Initialize if Library_Version is
  49    --  specified or if it is read from the reference symbol file.
  50
  51    Soft_Major_ID : Boolean := True;
  52    --  False if library version is specified in procedure Initialize.
  53    --  When True, Major_ID may be modified if found in the reference symbol
  54    --  file.
  55
  56    Minor_ID : Natural := 0;
  57    --  The Minor ID. May be modified if read from the reference symbol file
  58
  59    Soft_Minor_ID : Boolean := True;
  60    --  False if symbol policy is Autonomous, if library version is specified
  61    --  in procedure Initialize and is not the same as the major ID read from
  62    --  the reference symbol file. When True, Minor_ID may be increased in
  63    --  Compliant symbol policy.
  64
  65    subtype Byte is Character;
  66    --  Object files are stream of bytes, but some of these bytes, those for
  67    --  the names of the symbols, are ASCII characters.
  68
  69    package Byte_IO is new Ada.Sequential_IO (Byte);
  70    use Byte_IO;
  71
  72    type Number is mod 2**16;
  73    --  16 bits unsigned number for number of characters
  74
  75    GSD : constant Number := 10;
  76    --  Code for the Global Symbol Definition section
  77
  78    C_SYM : constant Number := 1;
  79    --  Code for a Symbol subsection
  80
  81    V_DEF_Mask  : constant Number := 2**1;
  82    V_NORM_Mask : constant Number := 2**6;
  83
  84    File : Byte_IO.File_Type;
  85    --  Each object file is read as a stream of bytes (characters)
  86
  87    B : Byte;
  88
  89    Number_Of_Characters : Natural := 0;
  90    --  The number of characters of each section
  91
  92    --  The following variables are used by procedure Process when reading an
  93    --  object file.
  94
  95    Code   : Number := 0;
  96    Length : Natural := 0;
  97
  98    Dummy : Number;
  99
 100    Nchars : Natural := 0;
 101    Flags  : Number  := 0;
 102
 103    Symbol : String (1 .. 255);
 104    LSymb  : Natural;
 105
 106    function Equal (Left, Right : Symbol_Data) return Boolean;
 107    --  Test for equality of symbols
 108
 109    procedure Get (N : out Number);
 110    --  Read two bytes from the object file LSB first as unsigned 16 bit number
 111
 112    procedure Get (N : out Natural);
 113    --  Read two bytes from the object file, LSByte first, as a Natural
 114
 115
 116    function Image (N : Integer) return String;
 117    --  Returns the image of N, without the initial space
 118
 119    -----------
 120    -- Equal --
 121    -----------
 122
 123    function Equal (Left, Right : Symbol_Data) return Boolean is
 124    begin
 125       return Left.Name /= null and then
 126              Right.Name /= null and then
 127              Left.Name.all = Right.Name.all and then
 128              Left.Kind = Right.Kind and then
 129              Left.Present = Right.Present;
 130    end Equal;
 131
 132    ---------
 133    -- Get --
 134    ---------
 135
 136    procedure Get (N : out Number) is
 137       C : Byte;
 138       LSByte : Number;
 139    begin
 140       Read (File, C);
 141       LSByte := Byte'Pos (C);
 142       Read (File, C);
 143       N := LSByte + (256 * Byte'Pos (C));
 144    end Get;
 145
 146    procedure Get (N : out Natural) is
 147       Result : Number;
 148    begin
 149       Get (Result);
 150       N := Natural (Result);
 151    end Get;
 152
 153    -----------
 154    -- Image --
 155    -----------
 156
 157    function Image (N : Integer) return String is
 158       Result : constant String := N'Img;
 159    begin
 160       if Result (Result'First) = ' ' then
 161          return Result (Result'First + 1 .. Result'Last);
 162
 163       else
 164          return Result;
 165       end if;
 166    end Image;
 167
 168    ----------------
 169    -- Initialize --
 170    ----------------
 171
 172    procedure Initialize
 173      (Symbol_File   : String;
 174       Reference     : String;
 175       Symbol_Policy : Policy;
 176       Quiet         : Boolean;
 177       Version       : String;
 178       Success       : out Boolean)
 179    is
 180       File : Ada.Text_IO.File_Type;
 181       Line : String (1 .. 1_000);
 182       Last : Natural;
 183
 184    begin
 185       --  Record the symbol file name
 186
 187       Symbol_File_Name := new String'(Symbol_File);
 188
 189       --  Record the policy
 190
 191       Sym_Policy := Symbol_Policy;
 192
 193       --  Record the version (Major ID)
 194
 195       if Version = "" then
 196          Major_ID := 1;
 197          Soft_Major_ID := True;
 198
 199       else
 200          begin
 201             Major_ID := Integer'Value (Version);
 202             Soft_Major_ID := False;
 203
 204             if Major_ID <= 0 then
 205                raise Constraint_Error;
 206             end if;
 207
 208          exception
 209             when Constraint_Error =>
 210                if not Quiet then
 211                   Put_Line ("Version """ & Version & """ is illegal.");
 212                   Put_Line ("On VMS, version must be a positive number");
 213                end if;
 214
 215                Success := False;
 216                return;
 217          end;
 218       end if;
 219
 220       Minor_ID := 0;
 221       Soft_Minor_ID := Sym_Policy /= Autonomous;
 222
 223       --  Empty the symbol tables
 224
 225       Symbol_Table.Set_Last (Original_Symbols, 0);
 226       Symbol_Table.Set_Last (Complete_Symbols, 0);
 227
 228       --  Assume that everything will be fine
 229
 230       Success := True;
 231
 232       --  If policy is Compliant or Controlled, attempt to read the reference
 233       --  file. If policy is Restricted, attempt to read the symbol file.
 234
 235       if Sym_Policy /= Autonomous then
 236          case Sym_Policy is
 237             when Autonomous =>
 238                null;
 239
 240             when Compliant | Controlled =>
 241                begin
 242                   Open (File, In_File, Reference);
 243
 244                exception
 245                   when Ada.Text_IO.Name_Error =>
 246                      Success := False;
 247                      return;
 248
 249                   when X : others =>
 250                      if not Quiet then
 251                         Put_Line ("could not open """ & Reference & """");
 252                         Put_Line (Exception_Message (X));
 253                      end if;
 254
 255                      Success := False;
 256                      return;
 257                end;
 258
 259             when Restricted =>
 260                begin
 261                   Open (File, In_File, Symbol_File);
 262
 263                exception
 264                   when Ada.Text_IO.Name_Error =>
 265                      Success := False;
 266                      return;
 267
 268                   when X : others =>
 269                      if not Quiet then
 270                         Put_Line ("could not open """ & Symbol_File & """");
 271                         Put_Line (Exception_Message (X));
 272                      end if;
 273
 274                      Success := False;
 275                      return;
 276                end;
 277          end case;
 278
 279          --  Read line by line
 280
 281          while not End_Of_File (File) loop
 282             Get_Line (File, Line, Last);
 283
 284             --  Ignore empty lines
 285
 286             if Last = 0 then
 287                null;
 288
 289             --  Ignore lines starting with "case_sensitive="
 290
 291             elsif Last > Case_Sensitive'Length
 292               and then Line (1 .. Case_Sensitive'Length) = Case_Sensitive
 293             then
 294                null;
 295
 296             --  Line starting with "SYMBOL_VECTOR=("
 297
 298             elsif Last > Symbol_Vector'Length
 299               and then Line (1 .. Symbol_Vector'Length) = Symbol_Vector
 300             then
 301
 302                --  SYMBOL_VECTOR=(<symbol>=DATA)
 303
 304                if Last > Symbol_Vector'Length + Equal_Data'Length and then
 305                  Line (Last - Equal_Data'Length + 1 .. Last) = Equal_Data
 306                then
 307                   Symbol_Table.Increment_Last (Original_Symbols);
 308                   Original_Symbols.Table
 309                     (Symbol_Table.Last (Original_Symbols)) :=
 310                       (Name =>
 311                          new String'(Line (Symbol_Vector'Length + 1 ..
 312                                            Last - Equal_Data'Length)),
 313                        Kind => Data,
 314                        Present => True);
 315
 316                --  SYMBOL_VECTOR=(<symbol>=PROCEDURE)
 317
 318                elsif Last > Symbol_Vector'Length + Equal_Procedure'Length
 319                  and then
 320                   Line (Last - Equal_Procedure'Length + 1 .. Last) =
 321                                                               Equal_Procedure
 322                then
 323                   Symbol_Table.Increment_Last (Original_Symbols);
 324                   Original_Symbols.Table
 325                     (Symbol_Table.Last (Original_Symbols)) :=
 326                     (Name =>
 327                        new String'(Line (Symbol_Vector'Length + 1 ..
 328                                          Last - Equal_Procedure'Length)),
 329                      Kind => Proc,
 330                      Present => True);
 331
 332                --  Anything else is incorrectly formatted
 333
 334                else
 335                   if not Quiet then
 336                      Put_Line ("symbol file """ & Reference &
 337                                """ is incorrectly formatted:");
 338                      Put_Line ("""" & Line (1 .. Last) & """");
 339                   end if;
 340
 341                   Close (File);
 342                   Success := False;
 343                   return;
 344                end if;
 345
 346             --  Lines with "gsmatch=equal,<Major_ID>,<Minor_Id>
 347
 348             elsif Last > Gsmatch'Length
 349               and then Line (1 .. Gsmatch'Length) = Gsmatch
 350             then
 351                declare
 352                   Start  : Positive := Gsmatch'Length + 1;
 353                   Finish : Positive := Start;
 354                   OK     : Boolean  := True;
 355                   ID     : Integer;
 356
 357                begin
 358                   loop
 359                      if Line (Finish) not in '0' .. '9'
 360                        or else Finish >= Last - 1
 361                      then
 362                         OK := False;
 363                         exit;
 364                      end if;
 365
 366                      exit when Line (Finish + 1) = ',';
 367
 368                      Finish := Finish + 1;
 369                   end loop;
 370
 371                   if OK then
 372                      ID := Integer'Value (Line (Start .. Finish));
 373                      OK := ID /= 0;
 374
 375                      --  If Soft_Major_ID is True, it means that
 376                      --  Library_Version was not specified.
 377
 378                      if Soft_Major_ID then
 379                         Major_ID := ID;
 380
 381                      --  If the Major ID in the reference file is different
 382                      --  from the Library_Version, then the Minor ID will be 0
 383                      --  because there is no point in taking the Minor ID in
 384                      --  the reference file, or incrementing it. So, we set
 385                      --  Soft_Minor_ID to False, so that we don't modify
 386                      --  the Minor_ID later.
 387
 388                      elsif Major_ID /= ID then
 389                         Soft_Minor_ID := False;
 390                      end if;
 391
 392                      Start := Finish + 2;
 393                      Finish := Start;
 394
 395                      loop
 396                         if Line (Finish) not in '0' .. '9' then
 397                            OK := False;
 398                            exit;
 399                         end if;
 400
 401                         exit when Finish = Last;
 402
 403                         Finish := Finish + 1;
 404                      end loop;
 405
 406                      --  Only set Minor_ID if Soft_Minor_ID is True (see above)
 407
 408                      if OK and then Soft_Minor_ID then
 409                         Minor_ID := Integer'Value (Line (Start .. Finish));
 410                      end if;
 411                   end if;
 412
 413                   --  If OK is not True, that means the line is not correctly
 414                   --  formatted.
 415
 416                   if not OK then
 417                      if not Quiet then
 418                         Put_Line ("symbol file """ & Reference &
 419                                   """ is incorrectly formatted");
 420                         Put_Line ("""" & Line (1 .. Last) & """");
 421                      end if;
 422
 423                      Close (File);
 424                      Success := False;
 425                      return;
 426                   end if;
 427                end;
 428
 429             --  Anything else is incorrectly formatted
 430
 431             else
 432                if not Quiet then
 433                   Put_Line ("unexpected line in symbol file """ &
 434                             Reference & """");
 435                   Put_Line ("""" & Line (1 .. Last) & """");
 436                end if;
 437
 438                Close (File);
 439                Success := False;
 440                return;
 441             end if;
 442          end loop;
 443
 444          Close (File);
 445       end if;
 446    end Initialize;
 447
 448    -------------
 449    -- Process --
 450    -------------
 451
 452    procedure Process
 453      (Object_File : String;
 454       Success     : out Boolean)
 455    is
 456    begin
 457       --  Open the object file with Byte_IO. Return with Success = False if
 458       --  this fails.
 459
 460       begin
 461          Open (File, In_File, Object_File);
 462       exception
 463          when others =>
 464             Put_Line
 465               ("*** Unable to open object file """ & Object_File & """");
 466             Success := False;
 467             return;
 468       end;
 469
 470       --  Assume that the object file has a correct format
 471
 472       Success := True;
 473
 474       --  Get the different sections one by one from the object file
 475
 476       while not End_Of_File (File) loop
 477
 478          Get (Code);
 479          Get (Number_Of_Characters);
 480          Number_Of_Characters := Number_Of_Characters - 4;
 481
 482          --  If this is not a Global Symbol Definition section, skip to the
 483          --  next section.
 484
 485          if Code /= GSD then
 486
 487             for J in 1 .. Number_Of_Characters loop
 488                Read (File, B);
 489             end loop;
 490
 491          else
 492
 493             --  Skip over the next 4 bytes
 494
 495             Get (Dummy);
 496             Get (Dummy);
 497             Number_Of_Characters := Number_Of_Characters - 4;
 498
 499             --  Get each subsection in turn
 500
 501             loop
 502                Get (Code);
 503                Get (Nchars);
 504                Get (Dummy);
 505                Get (Flags);
 506                Number_Of_Characters := Number_Of_Characters - 8;
 507                Nchars := Nchars - 8;
 508
 509                --  If this is a symbol and the V_DEF flag is set, get the
 510                --  symbol.
 511
 512                if Code = C_SYM and then ((Flags and V_DEF_Mask) /= 0) then
 513                   --  First, reach the symbol length
 514
 515                   for J in 1 .. 25 loop
 516                      Read (File, B);
 517                      Nchars := Nchars - 1;
 518                      Number_Of_Characters := Number_Of_Characters - 1;
 519                   end loop;
 520
 521                   Length := Byte'Pos (B);
 522                   LSymb := 0;
 523
 524                   --  Get the symbol characters
 525
 526                   for J in 1 .. Nchars loop
 527                      Read (File, B);
 528                      Number_Of_Characters := Number_Of_Characters - 1;
 529                      if Length > 0 then
 530                         LSymb := LSymb + 1;
 531                         Symbol (LSymb) := B;
 532                         Length := Length - 1;
 533                      end if;
 534                   end loop;
 535
 536                   --  Create the new Symbol
 537
 538                   declare
 539                      S_Data : Symbol_Data;
 540                   begin
 541                      S_Data.Name := new String'(Symbol (1 .. LSymb));
 542
 543                      --  The symbol kind (Data or Procedure) depends on the
 544                      --  V_NORM flag.
 545
 546                      if (Flags and V_NORM_Mask) = 0 then
 547                         S_Data.Kind := Data;
 548
 549                      else
 550                         S_Data.Kind := Proc;
 551                      end if;
 552
 553                      --  Put the new symbol in the table
 554
 555                      Symbol_Table.Increment_Last (Complete_Symbols);
 556                      Complete_Symbols.Table
 557                        (Symbol_Table.Last (Complete_Symbols)) := S_Data;
 558                   end;
 559
 560                else
 561                   --  As it is not a symbol subsection, skip to the next
 562                   --  subsection.
 563
 564                   for J in 1 .. Nchars loop
 565                      Read (File, B);
 566                      Number_Of_Characters := Number_Of_Characters - 1;
 567                   end loop;
 568                end if;
 569
 570                --  Exit the GSD section when number of characters reaches 0
 571
 572                exit when Number_Of_Characters = 0;
 573             end loop;
 574          end if;
 575       end loop;
 576
 577       --  The object file has been processed, close it
 578
 579       Close (File);
 580
 581    exception
 582       --  For any exception, output an error message, close the object file
 583       --  and return with Success = False.
 584
 585       when X : others =>
 586          Put_Line ("unexpected exception raised while processing """
 587                    & Object_File & """");
 588          Put_Line (Exception_Information (X));
 589          Close (File);
 590          Success := False;
 591    end Process;
 592
 593    --------------
 594    -- Finalize --
 595    --------------
 596
 597    procedure Finalize
 598      (Quiet   : Boolean;
 599       Success : out Boolean)
 600    is
 601       File   : Ada.Text_IO.File_Type;
 602       --  The symbol file
 603
 604       S_Data : Symbol_Data;
 605       --  A symbol
 606
 607       Cur    : Positive := 1;
 608       --  Most probable index in the Complete_Symbols of the current symbol
 609       --  in Original_Symbol.
 610
 611       Found  : Boolean;
 612
 613    begin
 614       --  Nothing to be done if Initialize has never been called
 615
 616       if Symbol_File_Name = null then
 617          Success := False;
 618
 619       else
 620
 621          --  First find if the symbols in the reference symbol file are also
 622          --  in the object files. Note that this is not done if the policy is
 623          --  Autonomous, because no reference symbol file has been read.
 624
 625          --  Expect the first symbol in the symbol file to also be the first
 626          --  in Complete_Symbols.
 627
 628          Cur := 1;
 629
 630          for Index_1 in 1 .. Symbol_Table.Last (Original_Symbols) loop
 631             S_Data := Original_Symbols.Table (Index_1);
 632             Found := False;
 633
 634             First_Object_Loop :
 635             for Index_2 in Cur .. Symbol_Table.Last (Complete_Symbols) loop
 636                if Equal (S_Data, Complete_Symbols.Table (Index_2)) then
 637                   Cur := Index_2 + 1;
 638                   Complete_Symbols.Table (Index_2).Present := False;
 639                   Found := True;
 640                   exit First_Object_Loop;
 641                end if;
 642             end loop First_Object_Loop;
 643
 644             --  If the symbol could not be found between Cur and Last, try
 645             --  before Cur.
 646
 647             if not Found then
 648                Second_Object_Loop :
 649                for Index_2 in 1 .. Cur - 1 loop
 650                   if Equal (S_Data, Complete_Symbols.Table (Index_2)) then
 651                      Cur := Index_2 + 1;
 652                      Complete_Symbols.Table (Index_2).Present := False;
 653                      Found := True;
 654                      exit Second_Object_Loop;
 655                   end if;
 656                end loop Second_Object_Loop;
 657             end if;
 658
 659             --  If the symbol is not found, mark it as such in the table
 660
 661             if not Found then
 662                if (not Quiet) or else Sym_Policy = Controlled then
 663                   Put_Line ("symbol """ & S_Data.Name.all &
 664                             """ is no longer present in the object files");
 665                end if;
 666
 667                if Sym_Policy = Controlled or else Sym_Policy = Restricted then
 668                   Success := False;
 669                   return;
 670
 671                elsif Soft_Minor_ID then
 672                   Minor_ID := Minor_ID + 1;
 673                   Soft_Minor_ID := False;
 674                end if;
 675
 676                Original_Symbols.Table (Index_1).Present := False;
 677                Free (Original_Symbols.Table (Index_1).Name);
 678
 679                if Soft_Minor_ID then
 680                   Minor_ID := Minor_ID + 1;
 681                   Soft_Minor_ID := False;
 682                end if;
 683             end if;
 684          end loop;
 685
 686          if Sym_Policy /= Restricted then
 687
 688             --  Append additional symbols, if any, to the Original_Symbols
 689             --  table.
 690
 691             for Index in 1 .. Symbol_Table.Last (Complete_Symbols) loop
 692                S_Data := Complete_Symbols.Table (Index);
 693
 694                if S_Data.Present then
 695
 696                   if Sym_Policy = Controlled then
 697                      Put_Line ("symbol """ & S_Data.Name.all &
 698                                """ is not in the reference symbol file");
 699                      Success := False;
 700                      return;
 701
 702                   elsif Soft_Minor_ID then
 703                      Minor_ID := Minor_ID + 1;
 704                      Soft_Minor_ID := False;
 705                   end if;
 706
 707                   Symbol_Table.Increment_Last (Original_Symbols);
 708                   Original_Symbols.Table
 709                     (Symbol_Table.Last (Original_Symbols)) := S_Data;
 710                   Complete_Symbols.Table (Index).Present := False;
 711                end if;
 712             end loop;
 713
 714             --  Create the symbol file
 715
 716             Create (File, Ada.Text_IO.Out_File, Symbol_File_Name.all);
 717
 718             Put (File, Case_Sensitive);
 719             Put_Line (File, "yes");
 720
 721             --  Put a line in the symbol file for each symbol in symbol table
 722
 723             for Index in 1 .. Symbol_Table.Last (Original_Symbols) loop
 724                if Original_Symbols.Table (Index).Present then
 725                   Put (File, Symbol_Vector);
 726                   Put (File, Original_Symbols.Table (Index).Name.all);
 727
 728                   if Original_Symbols.Table (Index).Kind = Data then
 729                      Put_Line (File, Equal_Data);
 730
 731                   else
 732                      Put_Line (File, Equal_Procedure);
 733                   end if;
 734
 735                   Free (Original_Symbols.Table (Index).Name);
 736                end if;
 737             end loop;
 738
 739             Put (File, Case_Sensitive);
 740             Put_Line (File, "NO");
 741
 742             --  Put the version IDs
 743
 744             Put (File, Gsmatch);
 745             Put (File, Image (Major_ID));
 746             Put (File, ',');
 747             Put_Line  (File, Image (Minor_ID));
 748
 749             --  And we are done
 750
 751             Close (File);
 752
 753             --  Reset both tables
 754
 755             Symbol_Table.Set_Last (Original_Symbols, 0);
 756             Symbol_Table.Set_Last (Complete_Symbols, 0);
 757
 758             --  Clear the symbol file name
 759
 760             Free (Symbol_File_Name);
 761          end if;
 762
 763          Success := True;
 764       end if;
 765
 766    exception
 767       when X : others =>
 768          Put_Line ("unexpected exception raised while finalizing """
 769                    & Symbol_File_Name.all & """");
 770          Put_Line (Exception_Information (X));
 771          Success := False;
 772    end Finalize;
 773
 774 end Symbols;