gcc/ada/5vsymbol.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                              S Y M B O L S                               --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --          Copyright (C) 2003 Free Software Foundation, Inc.               --
  10 --                                                                          --
  11 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  12 -- terms of the  GNU General Public License as published  by the Free Soft- --
  13 -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
  14 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  15 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  16 -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  17 -- for  more details.  You should have  received  a copy of the GNU General --
  18 -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
  19 -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
  20 -- MA 02111-1307, USA.                                                      --
  21 --                                                                          --
  22 -- GNAT was originally developed  by the GNAT team at  New York University. --
  23 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  24 --                                                                          --
  25 ------------------------------------------------------------------------------
  26
  27 --  This is the VMS version of this package
  28
  29 with Ada.Exceptions;    use Ada.Exceptions;
  30 with Ada.Sequential_IO;
  31 with Ada.Text_IO;       use Ada.Text_IO;
  32
  33 package body Symbols is
  34
  35    Case_Sensitive  : constant String := "case_sensitive=";
  36    Symbol_Vector   : constant String := "SYMBOL_VECTOR=(";
  37    Equal_Data      : constant String := "=DATA)";
  38    Equal_Procedure : constant String := "=PROCEDURE)";
  39    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 not autonomous, attempt to read the reference file
 233
 234       if Sym_Policy /= Autonomous then
 235          begin
 236             Open (File, In_File, Reference);
 237
 238          exception
 239             when Ada.Text_IO.Name_Error =>
 240                return;
 241
 242             when X : others =>
 243                if not Quiet then
 244                   Put_Line ("could not open """ & Reference & """");
 245                   Put_Line (Exception_Message (X));
 246                end if;
 247
 248                Success := False;
 249                return;
 250          end;
 251
 252          --  Read line by line
 253
 254          while not End_Of_File (File) loop
 255             Get_Line (File, Line, Last);
 256
 257             --  Ignore empty lines
 258
 259             if Last = 0 then
 260                null;
 261
 262             --  Ignore lines starting with "case_sensitive="
 263
 264             elsif Last > Case_Sensitive'Length
 265               and then Line (1 .. Case_Sensitive'Length) = Case_Sensitive
 266             then
 267                null;
 268
 269             --  Line starting with "SYMBOL_VECTOR=("
 270
 271             elsif Last > Symbol_Vector'Length
 272               and then Line (1 .. Symbol_Vector'Length) = Symbol_Vector
 273             then
 274
 275                --  SYMBOL_VECTOR=(<symbol>=DATA)
 276
 277                if Last > Symbol_Vector'Length + Equal_Data'Length and then
 278                  Line (Last - Equal_Data'Length + 1 .. Last) = Equal_Data
 279                then
 280                   Symbol_Table.Increment_Last (Original_Symbols);
 281                   Original_Symbols.Table
 282                     (Symbol_Table.Last (Original_Symbols)) :=
 283                       (Name =>
 284                          new String'(Line (Symbol_Vector'Length + 1 ..
 285                                            Last - Equal_Data'Length)),
 286                        Kind => Data,
 287                        Present => True);
 288
 289                --  SYMBOL_VECTOR=(<symbol>=PROCEDURE)
 290
 291                elsif Last > Symbol_Vector'Length + Equal_Procedure'Length
 292                  and then
 293                   Line (Last - Equal_Procedure'Length + 1 .. Last) =
 294                                                               Equal_Procedure
 295                then
 296                   Symbol_Table.Increment_Last (Original_Symbols);
 297                   Original_Symbols.Table
 298                     (Symbol_Table.Last (Original_Symbols)) :=
 299                     (Name =>
 300                        new String'(Line (Symbol_Vector'Length + 1 ..
 301                                          Last - Equal_Procedure'Length)),
 302                      Kind => Proc,
 303                      Present => True);
 304
 305                --  Anything else is incorrectly formatted
 306
 307                else
 308                   if not Quiet then
 309                      Put_Line ("symbol file """ & Reference &
 310                                """ is incorrectly formatted:");
 311                      Put_Line ("""" & Line (1 .. Last) & """");
 312                   end if;
 313
 314                   Close (File);
 315                   Success := False;
 316                   return;
 317                end if;
 318
 319             --  Lines with "gsmatch=equal,<Major_ID>,<Minor_Id>
 320
 321             elsif Last > Gsmatch'Length
 322               and then Line (1 .. Gsmatch'Length) = Gsmatch
 323             then
 324                declare
 325                   Start  : Positive := Gsmatch'Length + 1;
 326                   Finish : Positive := Start;
 327                   OK     : Boolean  := True;
 328                   ID     : Integer;
 329
 330                begin
 331                   loop
 332                      if Line (Finish) not in '0' .. '9'
 333                        or else Finish >= Last - 1
 334                      then
 335                         OK := False;
 336                         exit;
 337                      end if;
 338
 339                      exit when Line (Finish + 1) = ',';
 340
 341                      Finish := Finish + 1;
 342                   end loop;
 343
 344                   if OK then
 345                      ID := Integer'Value (Line (Start .. Finish));
 346                      OK := ID /= 0;
 347
 348                      --  If Soft_Major_ID is True, it means that
 349                      --  Library_Version was not specified.
 350
 351                      if Soft_Major_ID then
 352                         Major_ID := ID;
 353
 354                      --  If the Major ID in the reference file is different
 355                      --  from the Library_Version, then the Minor ID will be 0
 356                      --  because there is no point in taking the Minor ID in
 357                      --  the reference file, or incrementing it. So, we set
 358                      --  Soft_Minor_ID to False, so that we don't modify
 359                      --  the Minor_ID later.
 360
 361                      elsif Major_ID /= ID then
 362                         Soft_Minor_ID := False;
 363                      end if;
 364
 365                      Start := Finish + 2;
 366                      Finish := Start;
 367
 368                      loop
 369                         if Line (Finish) not in '0' .. '9' then
 370                            OK := False;
 371                            exit;
 372                         end if;
 373
 374                         exit when Finish = Last;
 375
 376                         Finish := Finish + 1;
 377                      end loop;
 378
 379                      --  Only set Minor_ID if Soft_Minor_ID is True (see above)
 380
 381                      if OK and then Soft_Minor_ID then
 382                         Minor_ID := Integer'Value (Line (Start .. Finish));
 383                      end if;
 384                   end if;
 385
 386                   --  If OK is not True, that means the line is not correctly
 387                   --  formatted.
 388
 389                   if not OK then
 390                      if not Quiet then
 391                         Put_Line ("symbol file """ & Reference &
 392                                   """ is incorrectly formatted");
 393                         Put_Line ("""" & Line (1 .. Last) & """");
 394                      end if;
 395
 396                      Close (File);
 397                      Success := False;
 398                      return;
 399                   end if;
 400                end;
 401
 402             --  Anything else is incorrectly formatted
 403
 404             else
 405                if not Quiet then
 406                   Put_Line ("unexpected line in symbol file """ &
 407                             Reference & """");
 408                   Put_Line ("""" & Line (1 .. Last) & """");
 409                end if;
 410
 411                Close (File);
 412                Success := False;
 413                return;
 414             end if;
 415          end loop;
 416
 417          Close (File);
 418       end if;
 419    end Initialize;
 420
 421    -------------
 422    -- Process --
 423    -------------
 424
 425    procedure Process
 426      (Object_File : String;
 427       Success     : out Boolean)
 428    is
 429    begin
 430       --  Open the object file with Byte_IO. Return with Success = False if
 431       --  this fails.
 432
 433       begin
 434          Open (File, In_File, Object_File);
 435       exception
 436          when others =>
 437             Put_Line
 438               ("*** Unable to open object file """ & Object_File & """");
 439             Success := False;
 440             return;
 441       end;
 442
 443       --  Assume that the object file has a correct format
 444
 445       Success := True;
 446
 447       --  Get the different sections one by one from the object file
 448
 449       while not End_Of_File (File) loop
 450
 451          Get (Code);
 452          Get (Number_Of_Characters);
 453          Number_Of_Characters := Number_Of_Characters - 4;
 454
 455          --  If this is not a Global Symbol Definition section, skip to the
 456          --  next section.
 457
 458          if Code /= GSD then
 459
 460             for J in 1 .. Number_Of_Characters loop
 461                Read (File, B);
 462             end loop;
 463
 464          else
 465
 466             --  Skip over the next 4 bytes
 467
 468             Get (Dummy);
 469             Get (Dummy);
 470             Number_Of_Characters := Number_Of_Characters - 4;
 471
 472             --  Get each subsection in turn
 473
 474             loop
 475                Get (Code);
 476                Get (Nchars);
 477                Get (Dummy);
 478                Get (Flags);
 479                Number_Of_Characters := Number_Of_Characters - 8;
 480                Nchars := Nchars - 8;
 481
 482                --  If this is a symbol and the V_DEF flag is set, get the
 483                --  symbol.
 484
 485                if Code = C_SYM and then ((Flags and V_DEF_Mask) /= 0) then
 486                   --  First, reach the symbol length
 487
 488                   for J in 1 .. 25 loop
 489                      Read (File, B);
 490                      Nchars := Nchars - 1;
 491                      Number_Of_Characters := Number_Of_Characters - 1;
 492                   end loop;
 493
 494                   Length := Byte'Pos (B);
 495                   LSymb := 0;
 496
 497                   --  Get the symbol characters
 498
 499                   for J in 1 .. Nchars loop
 500                      Read (File, B);
 501                      Number_Of_Characters := Number_Of_Characters - 1;
 502                      if Length > 0 then
 503                         LSymb := LSymb + 1;
 504                         Symbol (LSymb) := B;
 505                         Length := Length - 1;
 506                      end if;
 507                   end loop;
 508
 509                   --  Create the new Symbol
 510
 511                   declare
 512                      S_Data : Symbol_Data;
 513                   begin
 514                      S_Data.Name := new String'(Symbol (1 .. LSymb));
 515
 516                      --  The symbol kind (Data or Procedure) depends on the
 517                      --  V_NORM flag.
 518
 519                      if (Flags and V_NORM_Mask) = 0 then
 520                         S_Data.Kind := Data;
 521
 522                      else
 523                         S_Data.Kind := Proc;
 524                      end if;
 525
 526                      --  Put the new symbol in the table
 527
 528                      Symbol_Table.Increment_Last (Complete_Symbols);
 529                      Complete_Symbols.Table
 530                        (Symbol_Table.Last (Complete_Symbols)) := S_Data;
 531                   end;
 532
 533                else
 534                   --  As it is not a symbol subsection, skip to the next
 535                   --  subsection.
 536
 537                   for J in 1 .. Nchars loop
 538                      Read (File, B);
 539                      Number_Of_Characters := Number_Of_Characters - 1;
 540                   end loop;
 541                end if;
 542
 543                --  Exit the GSD section when number of characters reaches 0
 544
 545                exit when Number_Of_Characters = 0;
 546             end loop;
 547          end if;
 548       end loop;
 549
 550       --  The object file has been processed, close it
 551
 552       Close (File);
 553
 554    exception
 555       --  For any exception, output an error message, close the object file
 556       --  and return with Success = False.
 557
 558       when X : others =>
 559          Put_Line ("unexpected exception raised while processing """
 560                    & Object_File & """");
 561          Put_Line (Exception_Information (X));
 562          Close (File);
 563          Success := False;
 564    end Process;
 565
 566    --------------
 567    -- Finalize --
 568    --------------
 569
 570    procedure Finalize
 571      (Quiet   : Boolean;
 572       Success : out Boolean)
 573    is
 574       File   : Ada.Text_IO.File_Type;
 575       --  The symbol file
 576
 577       S_Data : Symbol_Data;
 578       --  A symbol
 579
 580       Cur    : Positive := 1;
 581       --  Most probable index in the Complete_Symbols of the current symbol
 582       --  in Original_Symbol.
 583
 584       Found  : Boolean;
 585
 586    begin
 587       --  Nothing to be done if Initialize has never been called
 588
 589       if Symbol_File_Name = null then
 590          Success := False;
 591
 592       else
 593
 594          --  First find if the symbols in the reference symbol file are also
 595          --  in the object files. Note that this is not done if the policy is
 596          --  Autonomous, because no reference symbol file has been read.
 597
 598          --  Expect the first symbol in the symbol file to also be the first
 599          --  in Complete_Symbols.
 600
 601          Cur := 1;
 602
 603          for Index_1 in 1 .. Symbol_Table.Last (Original_Symbols) loop
 604             S_Data := Original_Symbols.Table (Index_1);
 605             Found := False;
 606
 607             First_Object_Loop :
 608             for Index_2 in Cur .. Symbol_Table.Last (Complete_Symbols) loop
 609                if Equal (S_Data, Complete_Symbols.Table (Index_2)) then
 610                   Cur := Index_2 + 1;
 611                   Complete_Symbols.Table (Index_2).Present := False;
 612                   Found := True;
 613                   exit First_Object_Loop;
 614                end if;
 615             end loop First_Object_Loop;
 616
 617             --  If the symbol could not be found between Cur and Last, try
 618             --  before Cur.
 619
 620             if not Found then
 621                Second_Object_Loop :
 622                for Index_2 in 1 .. Cur - 1 loop
 623                   if Equal (S_Data, Complete_Symbols.Table (Index_2)) then
 624                      Cur := Index_2 + 1;
 625                      Complete_Symbols.Table (Index_2).Present := False;
 626                      Found := True;
 627                      exit Second_Object_Loop;
 628                   end if;
 629                end loop Second_Object_Loop;
 630             end if;
 631
 632             --  If the symbol is not found, mark it as such in the table
 633
 634             if not Found then
 635                if (not Quiet) or else Sym_Policy = Controlled then
 636                   Put_Line ("symbol """ & S_Data.Name.all &
 637                             """ is no longer present in the object files");
 638                end if;
 639
 640                if Sym_Policy = Controlled then
 641                   Success := False;
 642                   return;
 643
 644                elsif Soft_Minor_ID then
 645                   Minor_ID := Minor_ID + 1;
 646                   Soft_Minor_ID := False;
 647                end if;
 648
 649                Original_Symbols.Table (Index_1).Present := False;
 650                Free (Original_Symbols.Table (Index_1).Name);
 651
 652                if Soft_Minor_ID then
 653                   Minor_ID := Minor_ID + 1;
 654                   Soft_Minor_ID := False;
 655                end if;
 656             end if;
 657          end loop;
 658
 659          --  Append additional symbols, if any, to the Original_Symbols table
 660
 661          for Index in 1 .. Symbol_Table.Last (Complete_Symbols) loop
 662             S_Data := Complete_Symbols.Table (Index);
 663
 664             if S_Data.Present then
 665
 666                if Sym_Policy = Controlled then
 667                   Put_Line ("symbol """ & S_Data.Name.all &
 668                             """ is not in the reference symbol file");
 669                   Success := False;
 670                   return;
 671
 672                elsif Soft_Minor_ID then
 673                   Minor_ID := Minor_ID + 1;
 674                   Soft_Minor_ID := False;
 675                end if;
 676
 677                Symbol_Table.Increment_Last (Original_Symbols);
 678                Original_Symbols.Table (Symbol_Table.Last (Original_Symbols)) :=
 679                  S_Data;
 680                Complete_Symbols.Table (Index).Present := False;
 681             end if;
 682          end loop;
 683
 684          --  Create the symbol file
 685
 686          Create (File, Ada.Text_IO.Out_File, Symbol_File_Name.all);
 687
 688          Put (File, Case_Sensitive);
 689          Put_Line (File, "yes");
 690
 691          --  Put a line in the symbol file for each symbol in the symbol table
 692
 693          for Index in 1 .. Symbol_Table.Last (Original_Symbols) loop
 694             if Original_Symbols.Table (Index).Present then
 695                Put (File, Symbol_Vector);
 696                Put (File, Original_Symbols.Table (Index).Name.all);
 697
 698                if Original_Symbols.Table (Index).Kind = Data then
 699                   Put_Line (File, Equal_Data);
 700
 701                else
 702                   Put_Line (File, Equal_Procedure);
 703                end if;
 704
 705                Free (Original_Symbols.Table (Index).Name);
 706             end if;
 707          end loop;
 708
 709          Put (File, Case_Sensitive);
 710          Put_Line (File, "NO");
 711
 712          --  Put the version IDs
 713
 714          Put (File, Gsmatch);
 715          Put (File, Image (Major_ID));
 716          Put (File, ',');
 717          Put_Line  (File, Image (Minor_ID));
 718
 719          --  And we are done
 720
 721          Close (File);
 722
 723          --  Reset both tables
 724
 725          Symbol_Table.Set_Last (Original_Symbols, 0);
 726          Symbol_Table.Set_Last (Complete_Symbols, 0);
 727
 728          --  Clear the symbol file name
 729
 730          Free (Symbol_File_Name);
 731
 732          Success := True;
 733       end if;
 734
 735    exception
 736       when X : others =>
 737          Put_Line ("unexpected exception raised while finalizing """
 738                    & Symbol_File_Name.all & """");
 739          Put_Line (Exception_Information (X));
 740          Success := False;
 741    end Finalize;
 742
 743 end Symbols;