gcc/ada/ali.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                                  A L I                                   --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --          Copyright (C) 1992-2009, 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 with Butil;  use Butil;
  27 with Debug;  use Debug;
  28 with Fname;  use Fname;
  29 with Opt;    use Opt;
  30 with Osint;  use Osint;
  31 with Output; use Output;
  32
  33 package body ALI is
  34
  35    use ASCII;
  36    --  Make control characters visible
  37
  38    --  The following variable records which characters currently are
  39    --  used as line type markers in the ALI file. This is used in
  40    --  Scan_ALI to detect (or skip) invalid lines.
  41
  42    Known_ALI_Lines : constant array (Character range 'A' .. 'Z') of Boolean :=
  43      ('V'    => True,   -- version
  44       'M'    => True,   -- main program
  45       'A'    => True,   -- argument
  46       'P'    => True,   -- program
  47       'R'    => True,   -- restriction
  48       'I'    => True,   -- interrupt
  49       'U'    => True,   -- unit
  50       'W'    => True,   -- with
  51       'L'    => True,   -- linker option
  52       'N'    => True,   -- notes
  53       'E'    => True,   -- external
  54       'D'    => True,   -- dependency
  55       'X'    => True,   -- xref
  56       'S'    => True,   -- specific dispatching
  57       'Y'    => True,   -- limited_with
  58       others => False);
  59
  60    --------------------
  61    -- Initialize_ALI --
  62    --------------------
  63
  64    procedure Initialize_ALI is
  65    begin
  66       --  When (re)initializing ALI data structures the ALI user expects to
  67       --  get a fresh set of data structures. Thus we first need to erase the
  68       --  marks put in the name table by the previous set of ALI routine calls.
  69       --  These two loops are empty and harmless the first time in.
  70
  71       for J in ALIs.First .. ALIs.Last loop
  72          Set_Name_Table_Info (ALIs.Table (J).Afile, 0);
  73       end loop;
  74
  75       for J in Units.First .. Units.Last loop
  76          Set_Name_Table_Info (Units.Table (J).Uname, 0);
  77       end loop;
  78
  79       --  Free argument table strings
  80
  81       for J in Args.First .. Args.Last loop
  82          Free (Args.Table (J));
  83       end loop;
  84
  85       --  Initialize all tables
  86
  87       ALIs.Init;
  88       No_Deps.Init;
  89       Units.Init;
  90       Withs.Init;
  91       Sdep.Init;
  92       Linker_Options.Init;
  93       Notes.Init;
  94       Xref_Section.Init;
  95       Xref_Entity.Init;
  96       Xref.Init;
  97       Version_Ref.Reset;
  98
  99       --  Add dummy zero'th item in Linker_Options and Notes for sort calls
 100
 101       Linker_Options.Increment_Last;
 102       Notes.Increment_Last;
 103
 104       --  Initialize global variables recording cumulative options in all
 105       --  ALI files that are read for a given processing run in gnatbind.
 106
 107       Dynamic_Elaboration_Checks_Specified := False;
 108       Float_Format_Specified               := ' ';
 109       Locking_Policy_Specified             := ' ';
 110       No_Normalize_Scalars_Specified       := False;
 111       No_Object_Specified                  := False;
 112       Normalize_Scalars_Specified          := False;
 113       Queuing_Policy_Specified             := ' ';
 114       Static_Elaboration_Model_Used        := False;
 115       Task_Dispatching_Policy_Specified    := ' ';
 116       Unreserve_All_Interrupts_Specified   := False;
 117       Zero_Cost_Exceptions_Specified       := False;
 118    end Initialize_ALI;
 119
 120    --------------
 121    -- Scan_ALI --
 122    --------------
 123
 124    function Scan_ALI
 125      (F                : File_Name_Type;
 126       T                : Text_Buffer_Ptr;
 127       Ignore_ED        : Boolean;
 128       Err              : Boolean;
 129       Read_Xref        : Boolean := False;
 130       Read_Lines       : String  := "";
 131       Ignore_Lines     : String  := "X";
 132       Ignore_Errors    : Boolean := False;
 133       Directly_Scanned : Boolean := False) return ALI_Id
 134    is
 135       P         : Text_Ptr := T'First;
 136       Line      : Logical_Line_Number := 1;
 137       Id        : ALI_Id;
 138       C         : Character;
 139       NS_Found  : Boolean;
 140       First_Arg : Arg_Id;
 141
 142       Ignore : array (Character range 'A' .. 'Z') of Boolean;
 143       --  Ignore (X) is set to True if lines starting with X are to
 144       --  be ignored by Scan_ALI and skipped, and False if the lines
 145       --  are to be read and processed.
 146
 147       Bad_ALI_Format : exception;
 148       --  Exception raised by Fatal_Error if Err is True
 149
 150       function At_Eol return Boolean;
 151       --  Test if at end of line
 152
 153       function At_End_Of_Field return Boolean;
 154       --  Test if at end of line, or if at blank or horizontal tab
 155
 156       procedure Check_At_End_Of_Field;
 157       --  Check if we are at end of field, fatal error if not
 158
 159       procedure Checkc (C : Character);
 160       --  Check next character is C. If so bump past it, if not fatal error
 161
 162       procedure Check_Unknown_Line;
 163       --  If Ignore_Errors mode, then checks C to make sure that it is not
 164       --  an unknown ALI line type characters, and if so, skips lines
 165       --  until the first character of the line is one of these characters,
 166       --  at which point it does a Getc to put that character in C. The
 167       --  call has no effect if C is already an appropriate character.
 168       --  If not in Ignore_Errors mode, a fatal error is signalled if the
 169       --  line is unknown. Note that if C is an EOL on entry, the line is
 170       --  skipped (it is assumed that blank lines are never significant).
 171       --  If C is EOF on entry, the call has no effect (it is assumed that
 172       --  the caller will properly handle this case).
 173
 174       procedure Fatal_Error;
 175       --  Generate fatal error message for badly formatted ALI file if
 176       --  Err is false, or raise Bad_ALI_Format if Err is True.
 177
 178       procedure Fatal_Error_Ignore;
 179       pragma Inline (Fatal_Error_Ignore);
 180       --  In Ignore_Errors mode, has no effect, otherwise same as Fatal_Error
 181
 182       function Getc return Character;
 183       --  Get next character, bumping P past the character obtained
 184
 185       function Get_File_Name (Lower : Boolean := False) return File_Name_Type;
 186       --  Skip blanks, then scan out a file name (name is left in Name_Buffer
 187       --  with length in Name_Len, as well as returning a File_Name_Type value.
 188       --  If lower is false, the case is unchanged, if Lower is True then the
 189       --  result is forced to all lower case for systems where file names are
 190       --  not case sensitive. This ensures that gnatbind works correctly
 191       --  regardless of the case of the file name on all systems. The scan
 192       --  is terminated by a end of line, space or horizontal tab. Any other
 193       --  special characters are included in the returned name.
 194
 195       function Get_Name
 196         (Ignore_Spaces  : Boolean := False;
 197          Ignore_Special : Boolean := False) return Name_Id;
 198       --  Skip blanks, then scan out a name (name is left in Name_Buffer with
 199       --  length in Name_Len, as well as being returned in Name_Id form).
 200       --  If Lower is set to True then the Name_Buffer will be converted to
 201       --  all lower case, for systems where file names are not case sensitive.
 202       --  This ensures that gnatbind works correctly regardless of the case
 203       --  of the file name on all systems. The termination condition depends
 204       --  on the settings of Ignore_Spaces and Ignore_Special:
 205       --
 206       --    If Ignore_Spaces is False (normal case), then scan is terminated
 207       --    by the normal end of field condition (EOL, space, horizontal tab)
 208       --
 209       --    If Ignore_Special is False (normal case), the scan is terminated by
 210       --    a typeref bracket or an equal sign except for the special case of
 211       --    an operator name starting with a double quote which is terminated
 212       --    by another double quote.
 213       --
 214       --  It is an error to set both Ignore_Spaces and Ignore_Special to True.
 215       --  This function handles wide characters properly.
 216
 217       function Get_Nat return Nat;
 218       --  Skip blanks, then scan out an unsigned integer value in Nat range
 219       --  raises ALI_Reading_Error if the encoutered type is not natural.
 220
 221       function Get_Stamp return Time_Stamp_Type;
 222       --  Skip blanks, then scan out a time stamp
 223
 224       function Get_Unit_Name return Unit_Name_Type;
 225       --  Skip blanks, then scan out a file name (name is left in Name_Buffer
 226       --  with length in Name_Len, as well as returning a Unit_Name_Type value.
 227       --  The case is unchanged and terminated by a normal end of field.
 228
 229       function Nextc return Character;
 230       --  Return current character without modifying pointer P
 231
 232       procedure Get_Typeref
 233         (Current_File_Num : Sdep_Id;
 234          Ref             : out Tref_Kind;
 235          File_Num        : out Sdep_Id;
 236          Line            : out Nat;
 237          Ref_Type        : out Character;
 238          Col             : out Nat;
 239          Standard_Entity : out Name_Id);
 240       --  Parse the definition of a typeref (<...>, {...} or (...))
 241
 242       procedure Skip_Eol;
 243       --  Skip past spaces, then skip past end of line (fatal error if not
 244       --  at end of line). Also skips past any following blank lines.
 245
 246       procedure Skip_Line;
 247       --  Skip rest of current line and any following blank lines
 248
 249       procedure Skip_Space;
 250       --  Skip past white space (blanks or horizontal tab)
 251
 252       procedure Skipc;
 253       --  Skip past next character, does not affect value in C. This call
 254       --  is like calling Getc and ignoring the returned result.
 255
 256       ---------------------
 257       -- At_End_Of_Field --
 258       ---------------------
 259
 260       function At_End_Of_Field return Boolean is
 261       begin
 262          return Nextc <= ' ';
 263       end At_End_Of_Field;
 264
 265       ------------
 266       -- At_Eol --
 267       ------------
 268
 269       function At_Eol return Boolean is
 270       begin
 271          return Nextc = EOF or else Nextc = CR or else Nextc = LF;
 272       end At_Eol;
 273
 274       ---------------------------
 275       -- Check_At_End_Of_Field --
 276       ---------------------------
 277
 278       procedure Check_At_End_Of_Field is
 279       begin
 280          if not At_End_Of_Field then
 281             if Ignore_Errors then
 282                while Nextc > ' ' loop
 283                   P := P + 1;
 284                end loop;
 285             else
 286                Fatal_Error;
 287             end if;
 288          end if;
 289       end Check_At_End_Of_Field;
 290
 291       ------------------------
 292       -- Check_Unknown_Line --
 293       ------------------------
 294
 295       procedure Check_Unknown_Line is
 296       begin
 297          while C not in 'A' .. 'Z'
 298            or else not Known_ALI_Lines (C)
 299          loop
 300             if C = CR or else C = LF then
 301                Skip_Line;
 302                C := Nextc;
 303
 304             elsif C = EOF then
 305                return;
 306
 307             elsif Ignore_Errors then
 308                Skip_Line;
 309                C := Getc;
 310
 311             else
 312                Fatal_Error;
 313             end if;
 314          end loop;
 315       end Check_Unknown_Line;
 316
 317       ------------
 318       -- Checkc --
 319       ------------
 320
 321       procedure Checkc (C : Character) is
 322       begin
 323          if Nextc = C then
 324             P := P + 1;
 325          elsif Ignore_Errors then
 326             P := P + 1;
 327          else
 328             Fatal_Error;
 329          end if;
 330       end Checkc;
 331
 332       -----------------
 333       -- Fatal_Error --
 334       -----------------
 335
 336       procedure Fatal_Error is
 337          Ptr1 : Text_Ptr;
 338          Ptr2 : Text_Ptr;
 339          Col  : Int;
 340
 341          procedure Wchar (C : Character);
 342          --  Write a single character, replacing horizontal tab by spaces
 343
 344          procedure Wchar (C : Character) is
 345          begin
 346             if C = HT then
 347                loop
 348                   Wchar (' ');
 349                   exit when Col mod 8 = 0;
 350                end loop;
 351
 352             else
 353                Write_Char (C);
 354                Col := Col + 1;
 355             end if;
 356          end Wchar;
 357
 358       --  Start of processing for Fatal_Error
 359
 360       begin
 361          if Err then
 362             raise Bad_ALI_Format;
 363          end if;
 364
 365          Set_Standard_Error;
 366          Write_Str ("fatal error: file ");
 367          Write_Name (F);
 368          Write_Str (" is incorrectly formatted");
 369          Write_Eol;
 370
 371          Write_Str ("make sure you are using consistent versions " &
 372
 373          --  Split the following line so that it can easily be transformed for
 374          --  e.g. JVM/.NET back-ends where the compiler has a different name.
 375
 376                     "of gcc/gnatbind");
 377
 378          Write_Eol;
 379
 380          --  Find start of line
 381
 382          Ptr1 := P;
 383          while Ptr1 > T'First
 384            and then T (Ptr1 - 1) /= CR
 385            and then T (Ptr1 - 1) /= LF
 386          loop
 387             Ptr1 := Ptr1 - 1;
 388          end loop;
 389
 390          Write_Int (Int (Line));
 391          Write_Str (". ");
 392
 393          if Line < 100 then
 394             Write_Char (' ');
 395          end if;
 396
 397          if Line < 10 then
 398             Write_Char (' ');
 399          end if;
 400
 401          Col := 0;
 402          Ptr2 := Ptr1;
 403
 404          while Ptr2 < T'Last
 405            and then T (Ptr2) /= CR
 406            and then T (Ptr2) /= LF
 407          loop
 408             Wchar (T (Ptr2));
 409             Ptr2 := Ptr2 + 1;
 410          end loop;
 411
 412          Write_Eol;
 413
 414          Write_Str ("     ");
 415          Col := 0;
 416
 417          while Ptr1 < P loop
 418             if T (Ptr1) = HT then
 419                Wchar (HT);
 420             else
 421                Wchar (' ');
 422             end if;
 423
 424             Ptr1 := Ptr1 + 1;
 425          end loop;
 426
 427          Wchar ('|');
 428          Write_Eol;
 429
 430          Exit_Program (E_Fatal);
 431       end Fatal_Error;
 432
 433       ------------------------
 434       -- Fatal_Error_Ignore --
 435       ------------------------
 436
 437       procedure Fatal_Error_Ignore is
 438       begin
 439          if not Ignore_Errors then
 440             Fatal_Error;
 441          end if;
 442       end Fatal_Error_Ignore;
 443
 444       -------------------
 445       -- Get_File_Name --
 446       -------------------
 447
 448       function Get_File_Name
 449         (Lower : Boolean := False) return File_Name_Type
 450       is
 451          F : Name_Id;
 452
 453       begin
 454          F := Get_Name (Ignore_Special => True);
 455
 456          --  Convert file name to all lower case if file names are not case
 457          --  sensitive. This ensures that we handle names in the canonical
 458          --  lower case format, regardless of the actual case.
 459
 460          if Lower and not File_Names_Case_Sensitive then
 461             Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
 462             return Name_Find;
 463          else
 464             return File_Name_Type (F);
 465          end if;
 466       end Get_File_Name;
 467
 468       --------------
 469       -- Get_Name --
 470       --------------
 471
 472       function Get_Name
 473         (Ignore_Spaces  : Boolean := False;
 474          Ignore_Special : Boolean := False) return Name_Id
 475       is
 476       begin
 477          Name_Len := 0;
 478          Skip_Space;
 479
 480          if At_Eol then
 481             if Ignore_Errors then
 482                return Error_Name;
 483             else
 484                Fatal_Error;
 485             end if;
 486          end if;
 487
 488          loop
 489             Add_Char_To_Name_Buffer (Getc);
 490
 491             exit when At_End_Of_Field and then not Ignore_Spaces;
 492
 493             if not Ignore_Special then
 494                if Name_Buffer (1) = '"' then
 495                   exit when Name_Len > 1 and then Name_Buffer (Name_Len) = '"';
 496
 497                else
 498                   --  Terminate on parens or angle brackets or equal sign
 499
 500                   exit when Nextc = '(' or else Nextc = ')'
 501                     or else Nextc = '{' or else Nextc = '}'
 502                     or else Nextc = '<' or else Nextc = '>'
 503                     or else Nextc = '=';
 504
 505                   --  Terminate if left bracket not part of wide char sequence
 506                   --  Note that we only recognize brackets notation so far ???
 507
 508                   exit when Nextc = '[' and then T (P + 1) /= '"';
 509
 510                   --  Terminate if right bracket not part of wide char sequence
 511
 512                   exit when Nextc = ']' and then T (P - 1) /= '"';
 513                end if;
 514             end if;
 515          end loop;
 516
 517          return Name_Find;
 518       end Get_Name;
 519
 520       -------------------
 521       -- Get_Unit_Name --
 522       -------------------
 523
 524       function Get_Unit_Name return Unit_Name_Type is
 525       begin
 526          return Unit_Name_Type (Get_Name);
 527       end Get_Unit_Name;
 528
 529       -------------
 530       -- Get_Nat --
 531       -------------
 532
 533       function Get_Nat return Nat is
 534          V : Nat;
 535
 536       begin
 537          Skip_Space;
 538
 539          --  Check if we are on a number. In the case of bad ALI files, this
 540          --  may not be true.
 541
 542          if not (Nextc in '0' .. '9') then
 543             Fatal_Error;
 544          end if;
 545
 546          V := 0;
 547          loop
 548             V := V * 10 + (Character'Pos (Getc) - Character'Pos ('0'));
 549
 550             exit when At_End_Of_Field;
 551             exit when Nextc < '0' or else Nextc > '9';
 552          end loop;
 553
 554          return V;
 555       end Get_Nat;
 556
 557       ---------------
 558       -- Get_Stamp --
 559       ---------------
 560
 561       function Get_Stamp return Time_Stamp_Type is
 562          T     : Time_Stamp_Type;
 563          Start : Integer;
 564
 565       begin
 566          Skip_Space;
 567
 568          if At_Eol then
 569             if Ignore_Errors then
 570                return Dummy_Time_Stamp;
 571             else
 572                Fatal_Error;
 573             end if;
 574          end if;
 575
 576          --  Following reads old style time stamp missing first two digits
 577
 578          if Nextc in '7' .. '9' then
 579             T (1) := '1';
 580             T (2) := '9';
 581             Start := 3;
 582
 583          --  Normal case of full year in time stamp
 584
 585          else
 586             Start := 1;
 587          end if;
 588
 589          for J in Start .. T'Last loop
 590             T (J) := Getc;
 591          end loop;
 592
 593          return T;
 594       end Get_Stamp;
 595
 596       -----------------
 597       -- Get_Typeref --
 598       -----------------
 599
 600       procedure Get_Typeref
 601         (Current_File_Num : Sdep_Id;
 602          Ref              : out Tref_Kind;
 603          File_Num         : out Sdep_Id;
 604          Line             : out Nat;
 605          Ref_Type         : out Character;
 606          Col              : out Nat;
 607          Standard_Entity  : out Name_Id)
 608       is
 609          N : Nat;
 610       begin
 611          case Nextc is
 612             when '<'    => Ref := Tref_Derived;
 613             when '('    => Ref := Tref_Access;
 614             when '{'    => Ref := Tref_Type;
 615             when others => Ref := Tref_None;
 616          end case;
 617
 618          --  Case of typeref field present
 619
 620          if Ref /= Tref_None then
 621             P := P + 1; -- skip opening bracket
 622
 623             if Nextc in 'a' .. 'z' then
 624                File_Num        := No_Sdep_Id;
 625                Line            := 0;
 626                Ref_Type        := ' ';
 627                Col             := 0;
 628                Standard_Entity := Get_Name (Ignore_Spaces => True);
 629             else
 630                N := Get_Nat;
 631
 632                if Nextc = '|' then
 633                   File_Num := Sdep_Id (N + Nat (First_Sdep_Entry) - 1);
 634                   P := P + 1;
 635                   N := Get_Nat;
 636                else
 637                   File_Num := Current_File_Num;
 638                end if;
 639
 640                Line            := N;
 641                Ref_Type        := Getc;
 642                Col             := Get_Nat;
 643                Standard_Entity := No_Name;
 644             end if;
 645
 646             --  ??? Temporary workaround for nested generics case:
 647             --     4i4 Directories{1|4I9[4|6[3|3]]}
 648             --  See C918-002
 649
 650             declare
 651                Nested_Brackets : Natural := 0;
 652
 653             begin
 654                loop
 655                   case Nextc is
 656                      when '['   =>
 657                         Nested_Brackets := Nested_Brackets + 1;
 658                      when ']' =>
 659                         Nested_Brackets := Nested_Brackets - 1;
 660                      when others =>
 661                         if Nested_Brackets = 0 then
 662                            exit;
 663                         end if;
 664                   end case;
 665
 666                   Skipc;
 667                end loop;
 668             end;
 669
 670             P := P + 1; -- skip closing bracket
 671             Skip_Space;
 672
 673          --  No typeref entry present
 674
 675          else
 676             File_Num        := No_Sdep_Id;
 677             Line            := 0;
 678             Ref_Type        := ' ';
 679             Col             := 0;
 680             Standard_Entity := No_Name;
 681          end if;
 682       end Get_Typeref;
 683
 684       ----------
 685       -- Getc --
 686       ----------
 687
 688       function Getc return Character is
 689       begin
 690          if P = T'Last then
 691             return EOF;
 692          else
 693             P := P + 1;
 694             return T (P - 1);
 695          end if;
 696       end Getc;
 697
 698       -----------
 699       -- Nextc --
 700       -----------
 701
 702       function Nextc return Character is
 703       begin
 704          return T (P);
 705       end Nextc;
 706
 707       --------------
 708       -- Skip_Eol --
 709       --------------
 710
 711       procedure Skip_Eol is
 712       begin
 713          Skip_Space;
 714
 715          if not At_Eol then
 716             if Ignore_Errors then
 717                while not At_Eol loop
 718                   P := P + 1;
 719                end loop;
 720             else
 721                Fatal_Error;
 722             end if;
 723          end if;
 724
 725          --  Loop to skip past blank lines (first time through skips this EOL)
 726
 727          while Nextc < ' ' and then Nextc /= EOF loop
 728             if Nextc = LF then
 729                Line := Line + 1;
 730             end if;
 731
 732             P := P + 1;
 733          end loop;
 734       end Skip_Eol;
 735
 736       ---------------
 737       -- Skip_Line --
 738       ---------------
 739
 740       procedure Skip_Line is
 741       begin
 742          while not At_Eol loop
 743             P := P + 1;
 744          end loop;
 745
 746          Skip_Eol;
 747       end Skip_Line;
 748
 749       ----------------
 750       -- Skip_Space --
 751       ----------------
 752
 753       procedure Skip_Space is
 754       begin
 755          while Nextc = ' ' or else Nextc = HT loop
 756             P := P + 1;
 757          end loop;
 758       end Skip_Space;
 759
 760       -----------
 761       -- Skipc --
 762       -----------
 763
 764       procedure Skipc is
 765       begin
 766          if P /= T'Last then
 767             P := P + 1;
 768          end if;
 769       end Skipc;
 770
 771    --  Start of processing for Scan_ALI
 772
 773    begin
 774       First_Sdep_Entry := Sdep.Last + 1;
 775
 776       --  Acquire lines to be ignored
 777
 778       if Read_Xref then
 779          Ignore := ('U' | 'W' | 'Y' | 'D' | 'X' => False, others => True);
 780
 781       --  Read_Lines parameter given
 782
 783       elsif Read_Lines /= "" then
 784          Ignore := ('U' => False, others => True);
 785
 786          for J in Read_Lines'Range loop
 787             Ignore (Read_Lines (J)) := False;
 788          end loop;
 789
 790       --  Process Ignore_Lines parameter
 791
 792       else
 793          Ignore := (others => False);
 794
 795          for J in Ignore_Lines'Range loop
 796             pragma Assert (Ignore_Lines (J) /= 'U');
 797             Ignore (Ignore_Lines (J)) := True;
 798          end loop;
 799       end if;
 800
 801       --  Setup ALI Table entry with appropriate defaults
 802
 803       ALIs.Increment_Last;
 804       Id := ALIs.Last;
 805       Set_Name_Table_Info (F, Int (Id));
 806
 807       ALIs.Table (Id) := (
 808         Afile                      => F,
 809         Compile_Errors             => False,
 810         First_Interrupt_State      => Interrupt_States.Last + 1,
 811         First_Sdep                 => No_Sdep_Id,
 812         First_Specific_Dispatching => Specific_Dispatching.Last + 1,
 813         First_Unit                 => No_Unit_Id,
 814         Float_Format               => 'I',
 815         Last_Interrupt_State       => Interrupt_States.Last,
 816         Last_Sdep                  => No_Sdep_Id,
 817         Last_Specific_Dispatching  => Specific_Dispatching.Last,
 818         Last_Unit                  => No_Unit_Id,
 819         Locking_Policy             => ' ',
 820         Main_Priority              => -1,
 821         Main_Program               => None,
 822         No_Object                  => False,
 823         Normalize_Scalars          => False,
 824         Ofile_Full_Name            => Full_Object_File_Name,
 825         Queuing_Policy             => ' ',
 826         Restrictions               => No_Restrictions,
 827         SAL_Interface              => False,
 828         Sfile                      => No_File,
 829         Task_Dispatching_Policy    => ' ',
 830         Time_Slice_Value           => -1,
 831         WC_Encoding                => 'b',
 832         Unit_Exception_Table       => False,
 833         Ver                        => (others => ' '),
 834         Ver_Len                    => 0,
 835         Zero_Cost_Exceptions       => False);
 836
 837       --  Now we acquire the input lines from the ALI file. Note that the
 838       --  convention in the following code is that as we enter each section,
 839       --  C is set to contain the first character of the following line.
 840
 841       C := Getc;
 842       Check_Unknown_Line;
 843
 844       --  Acquire library version
 845
 846       if C /= 'V' then
 847
 848          --  The V line missing really indicates trouble, most likely it
 849          --  means we don't have an ALI file at all, so here we give a
 850          --  fatal error even if we are in Ignore_Errors mode.
 851
 852          Fatal_Error;
 853
 854       elsif Ignore ('V') then
 855          Skip_Line;
 856
 857       else
 858          Checkc (' ');
 859          Skip_Space;
 860          Checkc ('"');
 861
 862          for J in 1 .. Ver_Len_Max loop
 863             C := Getc;
 864             exit when C = '"';
 865             ALIs.Table (Id).Ver (J) := C;
 866             ALIs.Table (Id).Ver_Len := J;
 867          end loop;
 868
 869          Skip_Eol;
 870       end if;
 871
 872       C := Getc;
 873       Check_Unknown_Line;
 874
 875       --  Acquire main program line if present
 876
 877       if C = 'M' then
 878          if Ignore ('M') then
 879             Skip_Line;
 880
 881          else
 882             Checkc (' ');
 883             Skip_Space;
 884
 885             C := Getc;
 886
 887             if C = 'F' then
 888                ALIs.Table (Id).Main_Program := Func;
 889             elsif C = 'P' then
 890                ALIs.Table (Id).Main_Program := Proc;
 891             else
 892                P := P - 1;
 893                Fatal_Error;
 894             end if;
 895
 896             Skip_Space;
 897
 898             if not At_Eol then
 899                if Nextc < 'A' then
 900                   ALIs.Table (Id).Main_Priority := Get_Nat;
 901                end if;
 902
 903                Skip_Space;
 904
 905                if Nextc = 'T' then
 906                   P := P + 1;
 907                   Checkc ('=');
 908                   ALIs.Table (Id).Time_Slice_Value := Get_Nat;
 909                end if;
 910
 911                Skip_Space;
 912
 913                Checkc ('W');
 914                Checkc ('=');
 915                ALIs.Table (Id).WC_Encoding := Getc;
 916             end if;
 917
 918             Skip_Eol;
 919          end if;
 920
 921          C := Getc;
 922       end if;
 923
 924       --  Acquire argument lines
 925
 926       First_Arg := Args.Last + 1;
 927
 928       A_Loop : loop
 929          Check_Unknown_Line;
 930          exit A_Loop when C /= 'A';
 931
 932          if Ignore ('A') then
 933             Skip_Line;
 934
 935          else
 936             Checkc (' ');
 937
 938             --  Scan out argument
 939
 940             Name_Len := 0;
 941             while not At_Eol loop
 942                Add_Char_To_Name_Buffer (Getc);
 943             end loop;
 944
 945             --  If -fstack-check, record that it occurred
 946
 947             if Name_Buffer (1 .. Name_Len) = "-fstack-check" then
 948                Stack_Check_Switch_Set := True;
 949             end if;
 950
 951             --  Store the argument
 952
 953             Args.Increment_Last;
 954             Args.Table (Args.Last) := new String'(Name_Buffer (1 .. Name_Len));
 955
 956             Skip_Eol;
 957          end if;
 958
 959          C := Getc;
 960       end loop A_Loop;
 961
 962       --  Acquire P line
 963
 964       Check_Unknown_Line;
 965
 966       while C /= 'P' loop
 967          if Ignore_Errors then
 968             if C = EOF then
 969                Fatal_Error;
 970             else
 971                Skip_Line;
 972                C := Nextc;
 973             end if;
 974          else
 975             Fatal_Error;
 976          end if;
 977       end loop;
 978
 979       if Ignore ('P') then
 980          Skip_Line;
 981
 982       --  Process P line
 983
 984       else
 985          NS_Found := False;
 986
 987          while not At_Eol loop
 988             Checkc (' ');
 989             Skip_Space;
 990             C := Getc;
 991
 992             --  Processing for CE
 993
 994             if C = 'C' then
 995                Checkc ('E');
 996                ALIs.Table (Id).Compile_Errors := True;
 997
 998             --  Processing for DB
 999
1000             elsif C = 'D' then
1001                Checkc ('B');
1002                Detect_Blocking := True;
1003
1004             --  Processing for FD/FG/FI
1005
1006             elsif C = 'F' then
1007                Float_Format_Specified := Getc;
1008                ALIs.Table (Id).Float_Format := Float_Format_Specified;
1009
1010             --  Processing for Lx
1011
1012             elsif C = 'L' then
1013                Locking_Policy_Specified := Getc;
1014                ALIs.Table (Id).Locking_Policy := Locking_Policy_Specified;
1015
1016             --  Processing for flags starting with N
1017
1018             elsif C = 'N' then
1019                C := Getc;
1020
1021                --  Processing for NO
1022
1023                if C = 'O' then
1024                   ALIs.Table (Id).No_Object := True;
1025                   No_Object_Specified := True;
1026
1027                --  Processing for NR
1028
1029                elsif C = 'R' then
1030                   No_Run_Time_Mode           := True;
1031                   Configurable_Run_Time_Mode := True;
1032
1033                --  Processing for NS
1034
1035                elsif C = 'S' then
1036                   ALIs.Table (Id).Normalize_Scalars := True;
1037                   Normalize_Scalars_Specified := True;
1038                   NS_Found := True;
1039
1040                --  Invalid switch starting with N
1041
1042                else
1043                   Fatal_Error_Ignore;
1044                end if;
1045
1046             --  Processing for Qx
1047
1048             elsif C = 'Q' then
1049                Queuing_Policy_Specified := Getc;
1050                ALIs.Table (Id).Queuing_Policy := Queuing_Policy_Specified;
1051
1052             --  Processing for flags starting with S
1053
1054             elsif C = 'S' then
1055                C := Getc;
1056
1057                --  Processing for SL
1058
1059                if C = 'L' then
1060                   ALIs.Table (Id).SAL_Interface := True;
1061
1062                --  Processing for SS
1063
1064                elsif C = 'S' then
1065                   Opt.Sec_Stack_Used := True;
1066
1067                --  Invalid switch starting with S
1068
1069                else
1070                   Fatal_Error_Ignore;
1071                end if;
1072
1073             --  Processing for Tx
1074
1075             elsif C = 'T' then
1076                Task_Dispatching_Policy_Specified := Getc;
1077                ALIs.Table (Id).Task_Dispatching_Policy :=
1078                  Task_Dispatching_Policy_Specified;
1079
1080             --  Processing for switch starting with U
1081
1082             elsif C = 'U' then
1083                C := Getc;
1084
1085                --  Processing for UA
1086
1087                if C  = 'A' then
1088                   Unreserve_All_Interrupts_Specified := True;
1089
1090                --  Processing for UX
1091
1092                elsif C = 'X' then
1093                   ALIs.Table (Id).Unit_Exception_Table := True;
1094
1095                --  Invalid switches starting with U
1096
1097                else
1098                   Fatal_Error_Ignore;
1099                end if;
1100
1101             --  Processing for ZX
1102
1103             elsif C = 'Z' then
1104                C := Getc;
1105
1106                if C = 'X' then
1107                   ALIs.Table (Id).Zero_Cost_Exceptions := True;
1108                   Zero_Cost_Exceptions_Specified := True;
1109                else
1110                   Fatal_Error_Ignore;
1111                end if;
1112
1113             --  Invalid parameter
1114
1115             else
1116                C := Getc;
1117                Fatal_Error_Ignore;
1118             end if;
1119          end loop;
1120
1121          if not NS_Found then
1122             No_Normalize_Scalars_Specified := True;
1123          end if;
1124
1125          Skip_Eol;
1126       end if;
1127
1128       C := Getc;
1129       Check_Unknown_Line;
1130
1131       --  Acquire first restrictions line
1132
1133       while C /= 'R' loop
1134          if Ignore_Errors then
1135             if C = EOF then
1136                Fatal_Error;
1137             else
1138                Skip_Line;
1139                C := Nextc;
1140             end if;
1141          else
1142             Fatal_Error;
1143          end if;
1144       end loop;
1145
1146       if Ignore ('R') then
1147          Skip_Line;
1148
1149       --  Process restrictions line
1150
1151       else
1152          Scan_Restrictions : declare
1153             Save_R : constant Restrictions_Info := Cumulative_Restrictions;
1154             --  Save cumulative restrictions in case we have a fatal error
1155
1156             Bad_R_Line : exception;
1157             --  Signal bad restrictions line (raised on unexpected character)
1158
1159          begin
1160             Checkc (' ');
1161             Skip_Space;
1162
1163             --  Acquire information for boolean restrictions
1164
1165             for R in All_Boolean_Restrictions loop
1166                C := Getc;
1167
1168                case C is
1169                   when 'v' =>
1170                      ALIs.Table (Id).Restrictions.Violated (R) := True;
1171                      Cumulative_Restrictions.Violated (R) := True;
1172
1173                   when 'r' =>
1174                      ALIs.Table (Id).Restrictions.Set (R) := True;
1175                      Cumulative_Restrictions.Set (R) := True;
1176
1177                   when 'n' =>
1178                      null;
1179
1180                   when others =>
1181                      raise Bad_R_Line;
1182                end case;
1183             end loop;
1184
1185             --  Acquire information for parameter restrictions
1186
1187             for RP in All_Parameter_Restrictions loop
1188
1189                --  Acquire restrictions pragma information
1190
1191                case Getc is
1192                   when 'n' =>
1193                      null;
1194
1195                   when 'r' =>
1196                      ALIs.Table (Id).Restrictions.Set (RP) := True;
1197
1198                      declare
1199                         N : constant Integer := Integer (Get_Nat);
1200                      begin
1201                         ALIs.Table (Id).Restrictions.Value (RP) := N;
1202
1203                         if Cumulative_Restrictions.Set (RP) then
1204                            Cumulative_Restrictions.Value (RP) :=
1205                              Integer'Min
1206                                (Cumulative_Restrictions.Value (RP), N);
1207                         else
1208                            Cumulative_Restrictions.Set (RP) := True;
1209                            Cumulative_Restrictions.Value (RP) := N;
1210                         end if;
1211                      end;
1212
1213                   when others =>
1214                      raise Bad_R_Line;
1215                end case;
1216
1217                --  Acquire restrictions violations information
1218
1219                case Getc is
1220                   when 'n' =>
1221                      null;
1222
1223                   when 'v' =>
1224                      ALIs.Table (Id).Restrictions.Violated (RP) := True;
1225                      Cumulative_Restrictions.Violated (RP) := True;
1226
1227                      declare
1228                         N : constant Integer := Integer (Get_Nat);
1229                         pragma Unsuppress (Overflow_Check);
1230
1231                      begin
1232                         ALIs.Table (Id).Restrictions.Count (RP) := N;
1233
1234                         if RP in Checked_Max_Parameter_Restrictions then
1235                            Cumulative_Restrictions.Count (RP) :=
1236                              Integer'Max
1237                                (Cumulative_Restrictions.Count (RP), N);
1238                         else
1239                            Cumulative_Restrictions.Count (RP) :=
1240                              Cumulative_Restrictions.Count (RP) + N;
1241                         end if;
1242
1243                      exception
1244                         when Constraint_Error =>
1245
1246                            --  A constraint error comes from the addition in
1247                            --  the else branch. We reset to the maximum and
1248                            --  indicate that the real value is now unknown.
1249
1250                            Cumulative_Restrictions.Value (RP) := Integer'Last;
1251                            Cumulative_Restrictions.Unknown (RP) := True;
1252                      end;
1253
1254                      if Nextc = '+' then
1255                         Skipc;
1256                         ALIs.Table (Id).Restrictions.Unknown (RP) := True;
1257                         Cumulative_Restrictions.Unknown (RP) := True;
1258                      end if;
1259
1260                   when others =>
1261                      raise Bad_R_Line;
1262                end case;
1263             end loop;
1264
1265             Skip_Eol;
1266
1267          --  Here if error during scanning of restrictions line
1268
1269          exception
1270             when Bad_R_Line =>
1271
1272                --  In Ignore_Errors mode, undo any changes to restrictions
1273                --  from this unit, and continue on.
1274
1275                if Ignore_Errors then
1276                   Cumulative_Restrictions := Save_R;
1277                   ALIs.Table (Id).Restrictions := No_Restrictions;
1278                   Skip_Eol;
1279
1280                --  In normal mode, this is a fatal error
1281
1282                else
1283                   Fatal_Error;
1284                end if;
1285
1286          end Scan_Restrictions;
1287       end if;
1288
1289       --  Acquire additional restrictions (No_Dependence) lines if present
1290
1291       C := Getc;
1292       while C = 'R' loop
1293          if Ignore ('R') then
1294             Skip_Line;
1295          else
1296             Skip_Space;
1297             No_Deps.Append ((Id, Get_Name));
1298          end if;
1299
1300          Skip_Eol;
1301          C := Getc;
1302       end loop;
1303
1304       --  Acquire 'I' lines if present
1305
1306       Check_Unknown_Line;
1307
1308       while C = 'I' loop
1309          if Ignore ('I') then
1310             Skip_Line;
1311
1312          else
1313             declare
1314                Int_Num : Nat;
1315                I_State : Character;
1316                Line_No : Nat;
1317
1318             begin
1319                Int_Num := Get_Nat;
1320                Skip_Space;
1321                I_State := Getc;
1322                Line_No := Get_Nat;
1323
1324                Interrupt_States.Append (
1325                  (Interrupt_Id    => Int_Num,
1326                   Interrupt_State => I_State,
1327                   IS_Pragma_Line  => Line_No));
1328
1329                ALIs.Table (Id).Last_Interrupt_State := Interrupt_States.Last;
1330                Skip_Eol;
1331             end;
1332          end if;
1333
1334          C := Getc;
1335       end loop;
1336
1337       --  Acquire 'S' lines if present
1338
1339       Check_Unknown_Line;
1340
1341       while C = 'S' loop
1342          if Ignore ('S') then
1343             Skip_Line;
1344
1345          else
1346             declare
1347                Policy     : Character;
1348                First_Prio : Nat;
1349                Last_Prio  : Nat;
1350                Line_No    : Nat;
1351
1352             begin
1353                Checkc (' ');
1354                Skip_Space;
1355
1356                Policy := Getc;
1357                Skip_Space;
1358                First_Prio := Get_Nat;
1359                Last_Prio := Get_Nat;
1360                Line_No := Get_Nat;
1361
1362                Specific_Dispatching.Append (
1363                  (Dispatching_Policy => Policy,
1364                   First_Priority     => First_Prio,
1365                   Last_Priority      => Last_Prio,
1366                   PSD_Pragma_Line    => Line_No));
1367
1368                ALIs.Table (Id).Last_Specific_Dispatching :=
1369                  Specific_Dispatching.Last;
1370
1371                Skip_Eol;
1372             end;
1373          end if;
1374
1375          C := Getc;
1376       end loop;
1377
1378       --  Loop to acquire unit entries
1379
1380       U_Loop : loop
1381          Check_Unknown_Line;
1382          exit U_Loop when C /= 'U';
1383
1384          --  Note: as per spec, we never ignore U lines
1385
1386          Checkc (' ');
1387          Skip_Space;
1388          Units.Increment_Last;
1389
1390          if ALIs.Table (Id).First_Unit = No_Unit_Id then
1391             ALIs.Table (Id).First_Unit := Units.Last;
1392          end if;
1393
1394          declare
1395             UL : Unit_Record renames Units.Table (Units.Last);
1396
1397          begin
1398             UL.Uname                    := Get_Unit_Name;
1399             UL.Predefined               := Is_Predefined_Unit;
1400             UL.Internal                 := Is_Internal_Unit;
1401             UL.My_ALI                   := Id;
1402             UL.Sfile                    := Get_File_Name (Lower => True);
1403             UL.Pure                     := False;
1404             UL.Preelab                  := False;
1405             UL.No_Elab                  := False;
1406             UL.Shared_Passive           := False;
1407             UL.RCI                      := False;
1408             UL.Remote_Types             := False;
1409             UL.Has_RACW                 := False;
1410             UL.Init_Scalars             := False;
1411             UL.Is_Generic               := False;
1412             UL.Icasing                  := Mixed_Case;
1413             UL.Kcasing                  := All_Lower_Case;
1414             UL.Dynamic_Elab             := False;
1415             UL.Elaborate_Body           := False;
1416             UL.Set_Elab_Entity          := False;
1417             UL.Version                  := "00000000";
1418             UL.First_With               := Withs.Last + 1;
1419             UL.First_Arg                := First_Arg;
1420             UL.Elab_Position            := 0;
1421             UL.SAL_Interface            := ALIs.Table (Id).SAL_Interface;
1422             UL.Directly_Scanned         := Directly_Scanned;
1423             UL.Body_Needed_For_SAL      := False;
1424             UL.Elaborate_Body_Desirable := False;
1425             UL.Optimize_Alignment       := 'O';
1426
1427             if Debug_Flag_U then
1428                Write_Str (" ----> reading unit ");
1429                Write_Int (Int (Units.Last));
1430                Write_Str ("  ");
1431                Write_Unit_Name (UL.Uname);
1432                Write_Str (" from file ");
1433                Write_Name (UL.Sfile);
1434                Write_Eol;
1435             end if;
1436          end;
1437
1438          --  Check for duplicated unit in different files
1439
1440          declare
1441             Info : constant Int := Get_Name_Table_Info
1442                                      (Units.Table (Units.Last).Uname);
1443          begin
1444             if Info /= 0
1445               and then Units.Table (Units.Last).Sfile /=
1446                        Units.Table (Unit_Id (Info)).Sfile
1447             then
1448                --  If Err is set then ignore duplicate unit name. This is the
1449                --  case of a call from gnatmake, where the situation can arise
1450                --  from substitution of source files. In such situations, the
1451                --  processing in gnatmake will always result in any required
1452                --  recompilations in any case, and if we consider this to be
1453                --  an error we get strange cases (for example when a generic
1454                --  instantiation is replaced by a normal package) where we
1455                --  read the old ali file, decide to recompile, and then decide
1456                --  that the old and new ali files are incompatible.
1457
1458                if Err then
1459                   null;
1460
1461                --  If Err is not set, then this is a fatal error. This is
1462                --  the case of being called from the binder, where we must
1463                --  definitely diagnose this as an error.
1464
1465                else
1466                   Set_Standard_Error;
1467                   Write_Str ("error: duplicate unit name: ");
1468                   Write_Eol;
1469
1470                   Write_Str ("error: unit """);
1471                   Write_Unit_Name (Units.Table (Units.Last).Uname);
1472                   Write_Str (""" found in file """);
1473                   Write_Name_Decoded (Units.Table (Units.Last).Sfile);
1474                   Write_Char ('"');
1475                   Write_Eol;
1476
1477                   Write_Str ("error: unit """);
1478                   Write_Unit_Name (Units.Table (Unit_Id (Info)).Uname);
1479                   Write_Str (""" found in file """);
1480                   Write_Name_Decoded (Units.Table (Unit_Id (Info)).Sfile);
1481                   Write_Char ('"');
1482                   Write_Eol;
1483
1484                   Exit_Program (E_Fatal);
1485                end if;
1486             end if;
1487          end;
1488
1489          Set_Name_Table_Info
1490            (Units.Table (Units.Last).Uname, Int (Units.Last));
1491
1492          --  Scan out possible version and other parameters
1493
1494          loop
1495             Skip_Space;
1496             exit when At_Eol;
1497             C := Getc;
1498
1499             --  Version field
1500
1501             if C in '0' .. '9' or else C in 'a' .. 'f' then
1502                Units.Table (Units.Last).Version (1) := C;
1503
1504                for J in 2 .. 8 loop
1505                   C := Getc;
1506                   Units.Table (Units.Last).Version (J) := C;
1507                end loop;
1508
1509             --  BD/BN parameters
1510
1511             elsif C = 'B' then
1512                C := Getc;
1513
1514                if C = 'D' then
1515                   Check_At_End_Of_Field;
1516                   Units.Table (Units.Last).Elaborate_Body_Desirable := True;
1517
1518                elsif C = 'N' then
1519                   Check_At_End_Of_Field;
1520                   Units.Table (Units.Last).Body_Needed_For_SAL := True;
1521
1522                else
1523                   Fatal_Error_Ignore;
1524                end if;
1525
1526             --  DE parameter (Dynamic elaboration checks)
1527
1528             elsif C = 'D' then
1529                C := Getc;
1530
1531                if C = 'E' then
1532                   Check_At_End_Of_Field;
1533                   Units.Table (Units.Last).Dynamic_Elab := True;
1534                   Dynamic_Elaboration_Checks_Specified := True;
1535                else
1536                   Fatal_Error_Ignore;
1537                end if;
1538
1539             --  EB/EE parameters
1540
1541             elsif C = 'E' then
1542                C := Getc;
1543
1544                if C = 'B' then
1545                   Units.Table (Units.Last).Elaborate_Body := True;
1546                elsif C = 'E' then
1547                   Units.Table (Units.Last).Set_Elab_Entity := True;
1548                else
1549                   Fatal_Error_Ignore;
1550                end if;
1551
1552                Check_At_End_Of_Field;
1553
1554             --  GE parameter (generic)
1555
1556             elsif C = 'G' then
1557                C := Getc;
1558
1559                if C = 'E' then
1560                   Check_At_End_Of_Field;
1561                   Units.Table (Units.Last).Is_Generic := True;
1562                else
1563                   Fatal_Error_Ignore;
1564                end if;
1565
1566             --  IL/IS/IU parameters
1567
1568             elsif C = 'I' then
1569                C := Getc;
1570
1571                if C = 'L' then
1572                   Units.Table (Units.Last).Icasing := All_Lower_Case;
1573                elsif C = 'S' then
1574                   Units.Table (Units.Last).Init_Scalars := True;
1575                   Initialize_Scalars_Used := True;
1576                elsif C = 'U' then
1577                   Units.Table (Units.Last).Icasing := All_Upper_Case;
1578                else
1579                   Fatal_Error_Ignore;
1580                end if;
1581
1582                Check_At_End_Of_Field;
1583
1584             --  KM/KU parameters
1585
1586             elsif C = 'K' then
1587                C := Getc;
1588
1589                if C = 'M' then
1590                   Units.Table (Units.Last).Kcasing := Mixed_Case;
1591                elsif C = 'U' then
1592                   Units.Table (Units.Last).Kcasing := All_Upper_Case;
1593                else
1594                   Fatal_Error_Ignore;
1595                end if;
1596
1597                Check_At_End_Of_Field;
1598
1599             --  NE parameter
1600
1601             elsif C = 'N' then
1602                C := Getc;
1603
1604                if C = 'E' then
1605                   Units.Table (Units.Last).No_Elab := True;
1606                   Check_At_End_Of_Field;
1607                else
1608                   Fatal_Error_Ignore;
1609                end if;
1610
1611             --  PR/PU/PK parameters
1612
1613             elsif C = 'P' then
1614                C := Getc;
1615
1616                if C = 'R' then
1617                   Units.Table (Units.Last).Preelab := True;
1618                elsif C = 'U' then
1619                   Units.Table (Units.Last).Pure := True;
1620                elsif C = 'K' then
1621                   Units.Table (Units.Last).Unit_Kind := 'p';
1622                else
1623                   Fatal_Error_Ignore;
1624                end if;
1625
1626                Check_At_End_Of_Field;
1627
1628             --  OL/OO/OS/OT parameters
1629
1630             elsif C = 'O' then
1631                C := Getc;
1632
1633                if C = 'L' or else C = 'O' or else C = 'S' or else C = 'T' then
1634                   Units.Table (Units.Last).Optimize_Alignment := C;
1635                else
1636                   Fatal_Error_Ignore;
1637                end if;
1638
1639                Check_At_End_Of_Field;
1640
1641             --  RC/RT parameters
1642
1643             elsif C = 'R' then
1644                C := Getc;
1645
1646                if C = 'C' then
1647                   Units.Table (Units.Last).RCI := True;
1648                elsif C = 'T' then
1649                   Units.Table (Units.Last).Remote_Types := True;
1650                elsif C = 'A' then
1651                   Units.Table (Units.Last).Has_RACW := True;
1652                else
1653                   Fatal_Error_Ignore;
1654                end if;
1655
1656                Check_At_End_Of_Field;
1657
1658             elsif C = 'S' then
1659                C := Getc;
1660
1661                if C = 'P' then
1662                   Units.Table (Units.Last).Shared_Passive := True;
1663                elsif C = 'U' then
1664                   Units.Table (Units.Last).Unit_Kind := 's';
1665                else
1666                   Fatal_Error_Ignore;
1667                end if;
1668
1669                Check_At_End_Of_Field;
1670
1671             else
1672                C := Getc;
1673                Fatal_Error_Ignore;
1674             end if;
1675          end loop;
1676
1677          Skip_Eol;
1678
1679          --  Check if static elaboration model used
1680
1681          if not Units.Table (Units.Last).Dynamic_Elab
1682            and then not Units.Table (Units.Last).Internal
1683          then
1684             Static_Elaboration_Model_Used := True;
1685          end if;
1686
1687          C := Getc;
1688
1689          --  Scan out With lines for this unit
1690
1691          With_Loop : loop
1692             Check_Unknown_Line;
1693             exit With_Loop when C /= 'W' and then C /= 'Y';
1694
1695             if Ignore ('W') then
1696                Skip_Line;
1697
1698             else
1699                Checkc (' ');
1700                Skip_Space;
1701                Withs.Increment_Last;
1702                Withs.Table (Withs.Last).Uname              := Get_Unit_Name;
1703                Withs.Table (Withs.Last).Elaborate          := False;
1704                Withs.Table (Withs.Last).Elaborate_All      := False;
1705                Withs.Table (Withs.Last).Elab_Desirable     := False;
1706                Withs.Table (Withs.Last).Elab_All_Desirable := False;
1707                Withs.Table (Withs.Last).SAL_Interface      := False;
1708                Withs.Table (Withs.Last).Limited_With       := (C = 'Y');
1709
1710                --  Generic case with no object file available
1711
1712                if At_Eol then
1713                   Withs.Table (Withs.Last).Sfile := No_File;
1714                   Withs.Table (Withs.Last).Afile := No_File;
1715
1716                --  Normal case
1717
1718                else
1719                   Withs.Table (Withs.Last).Sfile := Get_File_Name
1720                                                       (Lower => True);
1721                   Withs.Table (Withs.Last).Afile := Get_File_Name
1722                                                       (Lower => True);
1723
1724                   --  Scan out possible E, EA, ED, and AD parameters
1725
1726                   while not At_Eol loop
1727                      Skip_Space;
1728
1729                      if Nextc = 'A' then
1730                         P := P + 1;
1731                         Checkc ('D');
1732                         Check_At_End_Of_Field;
1733
1734                         --  Store AD indication unless ignore required
1735
1736                         if not Ignore_ED then
1737                            Withs.Table (Withs.Last).Elab_All_Desirable :=
1738                              True;
1739                         end if;
1740
1741                      elsif Nextc = 'E' then
1742                         P := P + 1;
1743
1744                         if At_End_Of_Field then
1745                            Withs.Table (Withs.Last).Elaborate := True;
1746
1747                         elsif Nextc = 'A' then
1748                            P := P + 1;
1749                            Check_At_End_Of_Field;
1750                            Withs.Table (Withs.Last).Elaborate_All := True;
1751
1752                         else
1753                            Checkc ('D');
1754                            Check_At_End_Of_Field;
1755
1756                            --  Store ED indication unless ignore required
1757
1758                            if not Ignore_ED then
1759                               Withs.Table (Withs.Last).Elab_Desirable :=
1760                                 True;
1761                            end if;
1762                         end if;
1763
1764                      else
1765                         Fatal_Error;
1766                      end if;
1767                   end loop;
1768                end if;
1769
1770                Skip_Eol;
1771             end if;
1772
1773             C := Getc;
1774          end loop With_Loop;
1775
1776          Units.Table (Units.Last).Last_With := Withs.Last;
1777          Units.Table (Units.Last).Last_Arg  := Args.Last;
1778
1779          --  If there are linker options lines present, scan them
1780
1781          Name_Len := 0;
1782
1783          Linker_Options_Loop : loop
1784             Check_Unknown_Line;
1785             exit Linker_Options_Loop when C /= 'L';
1786
1787             if Ignore ('L') then
1788                Skip_Line;
1789
1790             else
1791                Checkc (' ');
1792                Skip_Space;
1793                Checkc ('"');
1794
1795                loop
1796                   C := Getc;
1797
1798                   if C < Character'Val (16#20#)
1799                     or else C > Character'Val (16#7E#)
1800                   then
1801                      Fatal_Error_Ignore;
1802
1803                   elsif C = '{' then
1804                      C := Character'Val (0);
1805
1806                      declare
1807                         V : Natural;
1808
1809                      begin
1810                         V := 0;
1811                         for J in 1 .. 2 loop
1812                            C := Getc;
1813
1814                            if C in '0' .. '9' then
1815                               V := V * 16 +
1816                                      Character'Pos (C) -
1817                                        Character'Pos ('0');
1818
1819                            elsif C in 'A' .. 'F' then
1820                               V := V * 16 +
1821                                      Character'Pos (C) -
1822                                        Character'Pos ('A') +
1823                                          10;
1824
1825                            else
1826                               Fatal_Error_Ignore;
1827                            end if;
1828                         end loop;
1829
1830                         Checkc ('}');
1831                         Add_Char_To_Name_Buffer (Character'Val (V));
1832                      end;
1833
1834                   else
1835                      if C = '"' then
1836                         exit when Nextc /= '"';
1837                         C := Getc;
1838                      end if;
1839
1840                      Add_Char_To_Name_Buffer (C);
1841                   end if;
1842                end loop;
1843
1844                Add_Char_To_Name_Buffer (NUL);
1845                Skip_Eol;
1846             end if;
1847
1848             C := Getc;
1849          end loop Linker_Options_Loop;
1850
1851          --  Store the linker options entry if one was found
1852
1853          if Name_Len /= 0 then
1854             Linker_Options.Increment_Last;
1855
1856             Linker_Options.Table (Linker_Options.Last).Name :=
1857               Name_Enter;
1858
1859             Linker_Options.Table (Linker_Options.Last).Unit :=
1860               Units.Last;
1861
1862             Linker_Options.Table (Linker_Options.Last).Internal_File :=
1863               Is_Internal_File_Name (F);
1864
1865             Linker_Options.Table (Linker_Options.Last).Original_Pos :=
1866               Linker_Options.Last;
1867          end if;
1868
1869          --  If there are notes present, scan them
1870
1871          Notes_Loop : loop
1872             Check_Unknown_Line;
1873             exit Notes_Loop when C /= 'N';
1874
1875             if Ignore ('N') then
1876                Skip_Line;
1877
1878             else
1879                Checkc (' ');
1880
1881                Notes.Increment_Last;
1882                Notes.Table (Notes.Last).Pragma_Type := Getc;
1883                Notes.Table (Notes.Last).Pragma_Line := Get_Nat;
1884                Checkc (':');
1885                Notes.Table (Notes.Last).Pragma_Col  := Get_Nat;
1886                Notes.Table (Notes.Last).Unit        := Units.Last;
1887
1888                if At_Eol then
1889                   Notes.Table (Notes.Last).Pragma_Args := No_Name;
1890
1891                else
1892                   Checkc (' ');
1893
1894                   Name_Len := 0;
1895                   while not At_Eol loop
1896                      Add_Char_To_Name_Buffer (Getc);
1897                   end loop;
1898
1899                   Notes.Table (Notes.Last).Pragma_Args := Name_Enter;
1900                end if;
1901
1902                Skip_Eol;
1903             end if;
1904
1905             C := Getc;
1906          end loop Notes_Loop;
1907       end loop U_Loop;
1908
1909       --  End loop through units for one ALI file
1910
1911       ALIs.Table (Id).Last_Unit := Units.Last;
1912       ALIs.Table (Id).Sfile := Units.Table (ALIs.Table (Id).First_Unit).Sfile;
1913
1914       --  Set types of the units (there can be at most 2 of them)
1915
1916       if ALIs.Table (Id).First_Unit /= ALIs.Table (Id).Last_Unit then
1917          Units.Table (ALIs.Table (Id).First_Unit).Utype := Is_Body;
1918          Units.Table (ALIs.Table (Id).Last_Unit).Utype  := Is_Spec;
1919
1920       else
1921          --  Deal with body only and spec only cases, note that the reason we
1922          --  do our own checking of the name (rather than using Is_Body_Name)
1923          --  is that Uname drags in far too much compiler junk!
1924
1925          Get_Name_String (Units.Table (Units.Last).Uname);
1926
1927          if Name_Buffer (Name_Len) = 'b' then
1928             Units.Table (Units.Last).Utype := Is_Body_Only;
1929          else
1930             Units.Table (Units.Last).Utype := Is_Spec_Only;
1931          end if;
1932       end if;
1933
1934       --  Scan out external version references and put in hash table
1935
1936       E_Loop : loop
1937          Check_Unknown_Line;
1938          exit E_Loop when C /= 'E';
1939
1940          if Ignore ('E') then
1941             Skip_Line;
1942
1943          else
1944             Checkc (' ');
1945             Skip_Space;
1946
1947             Name_Len := 0;
1948             Name_Len := 0;
1949             loop
1950                C := Getc;
1951
1952                if C < ' ' then
1953                   Fatal_Error;
1954                end if;
1955
1956                exit when At_End_Of_Field;
1957                Add_Char_To_Name_Buffer (C);
1958             end loop;
1959
1960             Version_Ref.Set (new String'(Name_Buffer (1 .. Name_Len)), True);
1961             Skip_Eol;
1962          end if;
1963
1964          C := Getc;
1965       end loop E_Loop;
1966
1967       --  Scan out source dependency lines for this ALI file
1968
1969       ALIs.Table (Id).First_Sdep := Sdep.Last + 1;
1970
1971       D_Loop : loop
1972          Check_Unknown_Line;
1973          exit D_Loop when C /= 'D';
1974
1975          if Ignore ('D') then
1976             Skip_Line;
1977
1978          else
1979             Checkc (' ');
1980             Skip_Space;
1981             Sdep.Increment_Last;
1982
1983             --  In the following call, Lower is not set to True, this is either
1984             --  a bug, or it deserves a special comment as to why this is so???
1985
1986             Sdep.Table (Sdep.Last).Sfile := Get_File_Name;
1987
1988             Sdep.Table (Sdep.Last).Stamp := Get_Stamp;
1989             Sdep.Table (Sdep.Last).Dummy_Entry :=
1990               (Sdep.Table (Sdep.Last).Stamp = Dummy_Time_Stamp);
1991
1992             --  Acquire checksum value
1993
1994             Skip_Space;
1995
1996             declare
1997                Ctr : Natural;
1998                Chk : Word;
1999
2000             begin
2001                Ctr := 0;
2002                Chk := 0;
2003
2004                loop
2005                   exit when At_Eol or else Ctr = 8;
2006
2007                   if Nextc in '0' .. '9' then
2008                      Chk := Chk * 16 +
2009                               Character'Pos (Nextc) - Character'Pos ('0');
2010
2011                   elsif Nextc in 'a' .. 'f' then
2012                      Chk := Chk * 16 +
2013                               Character'Pos (Nextc) - Character'Pos ('a') + 10;
2014
2015                   else
2016                      exit;
2017                   end if;
2018
2019                   Ctr := Ctr + 1;
2020                   P := P + 1;
2021                end loop;
2022
2023                if Ctr = 8 and then At_End_Of_Field then
2024                   Sdep.Table (Sdep.Last).Checksum := Chk;
2025                else
2026                   Fatal_Error;
2027                end if;
2028             end;
2029
2030             --  Acquire subunit and reference file name entries
2031
2032             Sdep.Table (Sdep.Last).Subunit_Name := No_Name;
2033             Sdep.Table (Sdep.Last).Rfile        :=
2034               Sdep.Table (Sdep.Last).Sfile;
2035             Sdep.Table (Sdep.Last).Start_Line   := 1;
2036
2037             if not At_Eol then
2038                Skip_Space;
2039
2040                --  Here for subunit name
2041
2042                if Nextc not in '0' .. '9' then
2043                   Name_Len := 0;
2044                   while not At_End_Of_Field loop
2045                      Add_Char_To_Name_Buffer (Getc);
2046                   end loop;
2047
2048                   --  Set the subunit name. Note that we use Name_Find rather
2049                   --  than Name_Enter here as the subunit name may already
2050                   --  have been put in the name table by the Project Manager.
2051
2052                   Sdep.Table (Sdep.Last).Subunit_Name := Name_Find;
2053
2054                   Skip_Space;
2055                end if;
2056
2057                --  Here for reference file name entry
2058
2059                if Nextc in '0' .. '9' then
2060                   Sdep.Table (Sdep.Last).Start_Line := Get_Nat;
2061                   Checkc (':');
2062
2063                   Name_Len := 0;
2064
2065                   while not At_End_Of_Field loop
2066                      Add_Char_To_Name_Buffer (Getc);
2067                   end loop;
2068
2069                   Sdep.Table (Sdep.Last).Rfile := Name_Enter;
2070                end if;
2071             end if;
2072
2073             Skip_Eol;
2074          end if;
2075
2076          C := Getc;
2077       end loop D_Loop;
2078
2079       ALIs.Table (Id).Last_Sdep := Sdep.Last;
2080
2081       --  We must at this stage be at an Xref line or the end of file
2082
2083       if C = EOF then
2084          return Id;
2085       end if;
2086
2087       Check_Unknown_Line;
2088
2089       if C /= 'X' then
2090          Fatal_Error;
2091       end if;
2092
2093       --  If we are ignoring Xref sections we are done (we ignore all
2094       --  remaining lines since only xref related lines follow X).
2095
2096       if Ignore ('X') and then not Debug_Flag_X then
2097          return Id;
2098       end if;
2099
2100       --  Loop through Xref sections
2101
2102       X_Loop : loop
2103          Check_Unknown_Line;
2104          exit X_Loop when C /= 'X';
2105
2106          --  Make new entry in section table
2107
2108          Xref_Section.Increment_Last;
2109
2110          Read_Refs_For_One_File : declare
2111             XS : Xref_Section_Record renames
2112                    Xref_Section.Table (Xref_Section.Last);
2113
2114             Current_File_Num : Sdep_Id;
2115             --  Keeps track of the current file number (changed by nn|)
2116
2117          begin
2118             XS.File_Num     := Sdep_Id (Get_Nat + Nat (First_Sdep_Entry) - 1);
2119             XS.File_Name    := Get_File_Name;
2120             XS.First_Entity := Xref_Entity.Last + 1;
2121
2122             Current_File_Num := XS.File_Num;
2123
2124             Skip_Space;
2125
2126             Skip_Eol;
2127             C := Nextc;
2128
2129             --  Loop through Xref entities
2130
2131             while C /= 'X' and then C /= EOF loop
2132                Xref_Entity.Increment_Last;
2133
2134                Read_Refs_For_One_Entity : declare
2135                   XE : Xref_Entity_Record renames
2136                          Xref_Entity.Table (Xref_Entity.Last);
2137                   N  : Nat;
2138
2139                   procedure Read_Instantiation_Reference;
2140                   --  Acquire instantiation reference. Caller has checked
2141                   --  that current character is '[' and on return the cursor
2142                   --  is skipped past the corresponding closing ']'.
2143
2144                   ----------------------------------
2145                   -- Read_Instantiation_Reference --
2146                   ----------------------------------
2147
2148                   procedure Read_Instantiation_Reference is
2149                      Local_File_Num : Sdep_Id := Current_File_Num;
2150
2151                   begin
2152                      Xref.Increment_Last;
2153
2154                      declare
2155                         XR : Xref_Record renames Xref.Table (Xref.Last);
2156
2157                      begin
2158                         P := P + 1; -- skip [
2159                         N := Get_Nat;
2160
2161                         if Nextc = '|' then
2162                            XR.File_Num :=
2163                              Sdep_Id (N + Nat (First_Sdep_Entry) - 1);
2164                            Local_File_Num := XR.File_Num;
2165                            P := P + 1;
2166                            N := Get_Nat;
2167
2168                         else
2169                            XR.File_Num := Local_File_Num;
2170                         end if;
2171
2172                         XR.Line  := N;
2173                         XR.Rtype := ' ';
2174                         XR.Col   := 0;
2175
2176                         --  Recursive call for next reference
2177
2178                         if Nextc = '[' then
2179                            pragma Warnings (Off); -- kill recursion warning
2180                            Read_Instantiation_Reference;
2181                            pragma Warnings (On);
2182                         end if;
2183
2184                         --  Skip closing bracket after recursive call
2185
2186                         P := P + 1;
2187                      end;
2188                   end Read_Instantiation_Reference;
2189
2190                --  Start of processing for Read_Refs_For_One_Entity
2191
2192                begin
2193                   XE.Line   := Get_Nat;
2194                   XE.Etype  := Getc;
2195                   XE.Col    := Get_Nat;
2196                   XE.Lib    := (Getc = '*');
2197                   XE.Entity := Get_Name;
2198
2199                   --  Handle the information about generic instantiations
2200
2201                   if Nextc = '[' then
2202                      Skipc; --  Opening '['
2203                      N := Get_Nat;
2204
2205                      if Nextc /= '|' then
2206                         XE.Iref_File_Num := Current_File_Num;
2207                         XE.Iref_Line     := N;
2208                      else
2209                         XE.Iref_File_Num :=
2210                           Sdep_Id (N + Nat (First_Sdep_Entry) - 1);
2211                         Skipc;
2212                         XE.Iref_Line := Get_Nat;
2213                      end if;
2214
2215                      if Getc /= ']' then
2216                         Fatal_Error;
2217                      end if;
2218
2219                   else
2220                      XE.Iref_File_Num := No_Sdep_Id;
2221                      XE.Iref_Line     := 0;
2222                   end if;
2223
2224                   Current_File_Num := XS.File_Num;
2225
2226                   --  Renaming reference is present
2227
2228                   if Nextc = '=' then
2229                      P := P + 1;
2230                      XE.Rref_Line := Get_Nat;
2231
2232                      if Getc /= ':' then
2233                         Fatal_Error;
2234                      end if;
2235
2236                      XE.Rref_Col := Get_Nat;
2237
2238                   --  No renaming reference present
2239
2240                   else
2241                      XE.Rref_Line := 0;
2242                      XE.Rref_Col  := 0;
2243                   end if;
2244
2245                   Skip_Space;
2246
2247                   XE.Oref_File_Num := No_Sdep_Id;
2248                   XE.Tref_File_Num := No_Sdep_Id;
2249                   XE.Tref          := Tref_None;
2250                   XE.First_Xref    := Xref.Last + 1;
2251
2252                   --  Loop to check for additional info present
2253
2254                   loop
2255                      declare
2256                         Ref  : Tref_Kind;
2257                         File : Sdep_Id;
2258                         Line : Nat;
2259                         Typ  : Character;
2260                         Col  : Nat;
2261                         Std  : Name_Id;
2262
2263                      begin
2264                         Get_Typeref
2265                           (Current_File_Num, Ref, File, Line, Typ, Col, Std);
2266                         exit when Ref = Tref_None;
2267
2268                         --  Do we have an overriding procedure?
2269
2270                         if Ref = Tref_Derived and then Typ = 'p' then
2271                            XE.Oref_File_Num := File;
2272                            XE.Oref_Line     := Line;
2273                            XE.Oref_Col      := Col;
2274
2275                         --  Arrays never override anything, and <> points to
2276                         --  the index types instead
2277
2278                         elsif Ref = Tref_Derived and then XE.Etype = 'A' then
2279
2280                            --  Index types are stored in the list of references
2281
2282                            Xref.Increment_Last;
2283
2284                            declare
2285                               XR : Xref_Record renames Xref.Table (Xref.Last);
2286                            begin
2287                               XR.File_Num := File;
2288                               XR.Line     := Line;
2289                               XR.Rtype    := Array_Index_Reference;
2290                               XR.Col      := Col;
2291                               XR.Name     := Std;
2292                            end;
2293
2294                         --  Interfaces are stored in the list of references,
2295                         --  although the parent type itself is stored in XE.
2296                         --  The first interface (when there are only
2297                         --  interfaces) is stored in XE.Tref*)
2298
2299                         elsif Ref = Tref_Derived
2300                           and then Typ = 'R'
2301                           and then XE.Tref_File_Num /= No_Sdep_Id
2302                         then
2303                            Xref.Increment_Last;
2304
2305                            declare
2306                               XR : Xref_Record renames Xref.Table (Xref.Last);
2307                            begin
2308                               XR.File_Num := File;
2309                               XR.Line     := Line;
2310                               XR.Rtype    := Interface_Reference;
2311                               XR.Col      := Col;
2312                               XR.Name     := Std;
2313                            end;
2314
2315                         else
2316                            XE.Tref                 := Ref;
2317                            XE.Tref_File_Num        := File;
2318                            XE.Tref_Line            := Line;
2319                            XE.Tref_Type            := Typ;
2320                            XE.Tref_Col             := Col;
2321                            XE.Tref_Standard_Entity := Std;
2322                         end if;
2323                      end;
2324                   end loop;
2325
2326                   --  Loop through cross-references for this entity
2327
2328                   loop
2329                      Skip_Space;
2330
2331                      if At_Eol then
2332                         Skip_Eol;
2333                         exit when Nextc /= '.';
2334                         P := P + 1;
2335                      end if;
2336
2337                      Xref.Increment_Last;
2338
2339                      declare
2340                         XR : Xref_Record renames Xref.Table (Xref.Last);
2341
2342                      begin
2343                         N := Get_Nat;
2344
2345                         if Nextc = '|' then
2346                            XR.File_Num :=
2347                              Sdep_Id (N + Nat (First_Sdep_Entry) - 1);
2348                            Current_File_Num := XR.File_Num;
2349                            P := P + 1;
2350                            N := Get_Nat;
2351                         else
2352                            XR.File_Num := Current_File_Num;
2353                         end if;
2354
2355                         XR.Line  := N;
2356                         XR.Rtype := Getc;
2357
2358                         --  Imported entities reference as in:
2359                         --    494b<c,__gnat_copy_attribs>25
2360                         --  ??? Simply skipped for now
2361
2362                         if Nextc = '<' then
2363                            while Getc /= '>' loop
2364                               null;
2365                            end loop;
2366                         end if;
2367
2368                         XR.Col   := Get_Nat;
2369
2370                         if Nextc = '[' then
2371                            Read_Instantiation_Reference;
2372                         end if;
2373                      end;
2374                   end loop;
2375
2376                   --  Record last cross-reference
2377
2378                   XE.Last_Xref := Xref.Last;
2379                   C := Nextc;
2380
2381                exception
2382                   when Bad_ALI_Format =>
2383
2384                      --  If ignoring errors, then we skip a line with an
2385                      --  unexpected error, and try to continue subsequent
2386                      --  xref lines.
2387
2388                      if Ignore_Errors then
2389                         Xref_Entity.Decrement_Last;
2390                         Skip_Line;
2391                         C := Nextc;
2392
2393                      --  Otherwise, we reraise the fatal exception
2394
2395                      else
2396                         raise;
2397                      end if;
2398                end Read_Refs_For_One_Entity;
2399             end loop;
2400
2401             --  Record last entity
2402
2403             XS.Last_Entity := Xref_Entity.Last;
2404
2405          end Read_Refs_For_One_File;
2406
2407          C := Getc;
2408       end loop X_Loop;
2409
2410       --  Here after dealing with xref sections
2411
2412       if C /= EOF and then C /= 'X' then
2413          Fatal_Error;
2414       end if;
2415
2416       return Id;
2417
2418    exception
2419       when Bad_ALI_Format =>
2420          return No_ALI_Id;
2421    end Scan_ALI;
2422
2423    ---------
2424    -- SEq --
2425    ---------
2426
2427    function SEq (F1, F2 : String_Ptr) return Boolean is
2428    begin
2429       return F1.all = F2.all;
2430    end SEq;
2431
2432    -----------
2433    -- SHash --
2434    -----------
2435
2436    function SHash (S : String_Ptr) return Vindex is
2437       H : Word;
2438
2439    begin
2440       H := 0;
2441       for J in S.all'Range loop
2442          H := H * 2 + Character'Pos (S (J));
2443       end loop;
2444
2445       return Vindex (Vindex'First + Vindex (H mod Vindex'Range_Length));
2446    end SHash;
2447
2448 end ALI;