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-2010, 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_CPU                   => -1,
 822         Main_Program               => None,
 823         No_Object                  => False,
 824         Normalize_Scalars          => False,
 825         Ofile_Full_Name            => Full_Object_File_Name,
 826         Queuing_Policy             => ' ',
 827         Restrictions               => No_Restrictions,
 828         SAL_Interface              => False,
 829         Sfile                      => No_File,
 830         Task_Dispatching_Policy    => ' ',
 831         Time_Slice_Value           => -1,
 832         Allocator_In_Body          => False,
 833         WC_Encoding                => 'b',
 834         Unit_Exception_Table       => False,
 835         Ver                        => (others => ' '),
 836         Ver_Len                    => 0,
 837         Zero_Cost_Exceptions       => False);
 838
 839       --  Now we acquire the input lines from the ALI file. Note that the
 840       --  convention in the following code is that as we enter each section,
 841       --  C is set to contain the first character of the following line.
 842
 843       C := Getc;
 844       Check_Unknown_Line;
 845
 846       --  Acquire library version
 847
 848       if C /= 'V' then
 849
 850          --  The V line missing really indicates trouble, most likely it
 851          --  means we don't have an ALI file at all, so here we give a
 852          --  fatal error even if we are in Ignore_Errors mode.
 853
 854          Fatal_Error;
 855
 856       elsif Ignore ('V') then
 857          Skip_Line;
 858
 859       else
 860          Checkc (' ');
 861          Skip_Space;
 862          Checkc ('"');
 863
 864          for J in 1 .. Ver_Len_Max loop
 865             C := Getc;
 866             exit when C = '"';
 867             ALIs.Table (Id).Ver (J) := C;
 868             ALIs.Table (Id).Ver_Len := J;
 869          end loop;
 870
 871          Skip_Eol;
 872       end if;
 873
 874       C := Getc;
 875       Check_Unknown_Line;
 876
 877       --  Acquire main program line if present
 878
 879       if C = 'M' then
 880          if Ignore ('M') then
 881             Skip_Line;
 882
 883          else
 884             Checkc (' ');
 885             Skip_Space;
 886
 887             C := Getc;
 888
 889             if C = 'F' then
 890                ALIs.Table (Id).Main_Program := Func;
 891             elsif C = 'P' then
 892                ALIs.Table (Id).Main_Program := Proc;
 893             else
 894                P := P - 1;
 895                Fatal_Error;
 896             end if;
 897
 898             Skip_Space;
 899
 900             if not At_Eol then
 901                if Nextc < 'A' then
 902                   ALIs.Table (Id).Main_Priority := Get_Nat;
 903                end if;
 904
 905                Skip_Space;
 906
 907                if Nextc = 'T' then
 908                   P := P + 1;
 909                   Checkc ('=');
 910                   ALIs.Table (Id).Time_Slice_Value := Get_Nat;
 911                end if;
 912
 913                Skip_Space;
 914
 915                if Nextc = 'A' then
 916                   P := P + 1;
 917                   Checkc ('B');
 918                   ALIs.Table (Id).Allocator_In_Body := True;
 919                end if;
 920
 921                Skip_Space;
 922
 923                if Nextc = 'C' then
 924                   P := P + 1;
 925                   Checkc ('=');
 926                   ALIs.Table (Id).Main_CPU := Get_Nat;
 927                end if;
 928
 929                Skip_Space;
 930
 931                Checkc ('W');
 932                Checkc ('=');
 933                ALIs.Table (Id).WC_Encoding := Getc;
 934             end if;
 935
 936             Skip_Eol;
 937          end if;
 938
 939          C := Getc;
 940       end if;
 941
 942       --  Acquire argument lines
 943
 944       First_Arg := Args.Last + 1;
 945
 946       A_Loop : loop
 947          Check_Unknown_Line;
 948          exit A_Loop when C /= 'A';
 949
 950          if Ignore ('A') then
 951             Skip_Line;
 952
 953          else
 954             Checkc (' ');
 955
 956             --  Scan out argument
 957
 958             Name_Len := 0;
 959             while not At_Eol loop
 960                Add_Char_To_Name_Buffer (Getc);
 961             end loop;
 962
 963             --  If -fstack-check, record that it occurred
 964
 965             if Name_Buffer (1 .. Name_Len) = "-fstack-check" then
 966                Stack_Check_Switch_Set := True;
 967             end if;
 968
 969             --  Store the argument
 970
 971             Args.Increment_Last;
 972             Args.Table (Args.Last) := new String'(Name_Buffer (1 .. Name_Len));
 973
 974             Skip_Eol;
 975          end if;
 976
 977          C := Getc;
 978       end loop A_Loop;
 979
 980       --  Acquire P line
 981
 982       Check_Unknown_Line;
 983
 984       while C /= 'P' loop
 985          if Ignore_Errors then
 986             if C = EOF then
 987                Fatal_Error;
 988             else
 989                Skip_Line;
 990                C := Nextc;
 991             end if;
 992          else
 993             Fatal_Error;
 994          end if;
 995       end loop;
 996
 997       if Ignore ('P') then
 998          Skip_Line;
 999
1000       --  Process P line
1001
1002       else
1003          NS_Found := False;
1004
1005          while not At_Eol loop
1006             Checkc (' ');
1007             Skip_Space;
1008             C := Getc;
1009
1010             --  Processing for CE
1011
1012             if C = 'C' then
1013                Checkc ('E');
1014                ALIs.Table (Id).Compile_Errors := True;
1015
1016             --  Processing for DB
1017
1018             elsif C = 'D' then
1019                Checkc ('B');
1020                Detect_Blocking := True;
1021
1022             --  Processing for FD/FG/FI
1023
1024             elsif C = 'F' then
1025                Float_Format_Specified := Getc;
1026                ALIs.Table (Id).Float_Format := Float_Format_Specified;
1027
1028             --  Processing for Lx
1029
1030             elsif C = 'L' then
1031                Locking_Policy_Specified := Getc;
1032                ALIs.Table (Id).Locking_Policy := Locking_Policy_Specified;
1033
1034             --  Processing for flags starting with N
1035
1036             elsif C = 'N' then
1037                C := Getc;
1038
1039                --  Processing for NO
1040
1041                if C = 'O' then
1042                   ALIs.Table (Id).No_Object := True;
1043                   No_Object_Specified := True;
1044
1045                --  Processing for NR
1046
1047                elsif C = 'R' then
1048                   No_Run_Time_Mode           := True;
1049                   Configurable_Run_Time_Mode := True;
1050
1051                --  Processing for NS
1052
1053                elsif C = 'S' then
1054                   ALIs.Table (Id).Normalize_Scalars := True;
1055                   Normalize_Scalars_Specified := True;
1056                   NS_Found := True;
1057
1058                --  Invalid switch starting with N
1059
1060                else
1061                   Fatal_Error_Ignore;
1062                end if;
1063
1064             --  Processing for Qx
1065
1066             elsif C = 'Q' then
1067                Queuing_Policy_Specified := Getc;
1068                ALIs.Table (Id).Queuing_Policy := Queuing_Policy_Specified;
1069
1070             --  Processing for flags starting with S
1071
1072             elsif C = 'S' then
1073                C := Getc;
1074
1075                --  Processing for SL
1076
1077                if C = 'L' then
1078                   ALIs.Table (Id).SAL_Interface := True;
1079
1080                --  Processing for SS
1081
1082                elsif C = 'S' then
1083                   Opt.Sec_Stack_Used := True;
1084
1085                --  Invalid switch starting with S
1086
1087                else
1088                   Fatal_Error_Ignore;
1089                end if;
1090
1091             --  Processing for Tx
1092
1093             elsif C = 'T' then
1094                Task_Dispatching_Policy_Specified := Getc;
1095                ALIs.Table (Id).Task_Dispatching_Policy :=
1096                  Task_Dispatching_Policy_Specified;
1097
1098             --  Processing for switch starting with U
1099
1100             elsif C = 'U' then
1101                C := Getc;
1102
1103                --  Processing for UA
1104
1105                if C  = 'A' then
1106                   Unreserve_All_Interrupts_Specified := True;
1107
1108                --  Processing for UX
1109
1110                elsif C = 'X' then
1111                   ALIs.Table (Id).Unit_Exception_Table := True;
1112
1113                --  Invalid switches starting with U
1114
1115                else
1116                   Fatal_Error_Ignore;
1117                end if;
1118
1119             --  Processing for ZX
1120
1121             elsif C = 'Z' then
1122                C := Getc;
1123
1124                if C = 'X' then
1125                   ALIs.Table (Id).Zero_Cost_Exceptions := True;
1126                   Zero_Cost_Exceptions_Specified := True;
1127                else
1128                   Fatal_Error_Ignore;
1129                end if;
1130
1131             --  Invalid parameter
1132
1133             else
1134                C := Getc;
1135                Fatal_Error_Ignore;
1136             end if;
1137          end loop;
1138
1139          if not NS_Found then
1140             No_Normalize_Scalars_Specified := True;
1141          end if;
1142
1143          Skip_Eol;
1144       end if;
1145
1146       C := Getc;
1147       Check_Unknown_Line;
1148
1149       --  Acquire first restrictions line
1150
1151       while C /= 'R' loop
1152          if Ignore_Errors then
1153             if C = EOF then
1154                Fatal_Error;
1155             else
1156                Skip_Line;
1157                C := Nextc;
1158             end if;
1159          else
1160             Fatal_Error;
1161          end if;
1162       end loop;
1163
1164       if Ignore ('R') then
1165          Skip_Line;
1166
1167       --  Process restrictions line
1168
1169       else
1170          Scan_Restrictions : declare
1171             Save_R : constant Restrictions_Info := Cumulative_Restrictions;
1172             --  Save cumulative restrictions in case we have a fatal error
1173
1174             Bad_R_Line : exception;
1175             --  Signal bad restrictions line (raised on unexpected character)
1176
1177          begin
1178             Checkc (' ');
1179             Skip_Space;
1180
1181             --  Acquire information for boolean restrictions
1182
1183             for R in All_Boolean_Restrictions loop
1184                C := Getc;
1185
1186                case C is
1187                   when 'v' =>
1188                      ALIs.Table (Id).Restrictions.Violated (R) := True;
1189                      Cumulative_Restrictions.Violated (R) := True;
1190
1191                   when 'r' =>
1192                      ALIs.Table (Id).Restrictions.Set (R) := True;
1193                      Cumulative_Restrictions.Set (R) := True;
1194
1195                   when 'n' =>
1196                      null;
1197
1198                   when others =>
1199                      raise Bad_R_Line;
1200                end case;
1201             end loop;
1202
1203             --  Acquire information for parameter restrictions
1204
1205             for RP in All_Parameter_Restrictions loop
1206
1207                --  Acquire restrictions pragma information
1208
1209                case Getc is
1210                   when 'n' =>
1211                      null;
1212
1213                   when 'r' =>
1214                      ALIs.Table (Id).Restrictions.Set (RP) := True;
1215
1216                      declare
1217                         N : constant Integer := Integer (Get_Nat);
1218                      begin
1219                         ALIs.Table (Id).Restrictions.Value (RP) := N;
1220
1221                         if Cumulative_Restrictions.Set (RP) then
1222                            Cumulative_Restrictions.Value (RP) :=
1223                              Integer'Min
1224                                (Cumulative_Restrictions.Value (RP), N);
1225                         else
1226                            Cumulative_Restrictions.Set (RP) := True;
1227                            Cumulative_Restrictions.Value (RP) := N;
1228                         end if;
1229                      end;
1230
1231                   when others =>
1232                      raise Bad_R_Line;
1233                end case;
1234
1235                --  Acquire restrictions violations information
1236
1237                case Getc is
1238                   when 'n' =>
1239                      null;
1240
1241                   when 'v' =>
1242                      ALIs.Table (Id).Restrictions.Violated (RP) := True;
1243                      Cumulative_Restrictions.Violated (RP) := True;
1244
1245                      declare
1246                         N : constant Integer := Integer (Get_Nat);
1247                         pragma Unsuppress (Overflow_Check);
1248
1249                      begin
1250                         ALIs.Table (Id).Restrictions.Count (RP) := N;
1251
1252                         if RP in Checked_Max_Parameter_Restrictions then
1253                            Cumulative_Restrictions.Count (RP) :=
1254                              Integer'Max
1255                                (Cumulative_Restrictions.Count (RP), N);
1256                         else
1257                            Cumulative_Restrictions.Count (RP) :=
1258                              Cumulative_Restrictions.Count (RP) + N;
1259                         end if;
1260
1261                      exception
1262                         when Constraint_Error =>
1263
1264                            --  A constraint error comes from the addition in
1265                            --  the else branch. We reset to the maximum and
1266                            --  indicate that the real value is now unknown.
1267
1268                            Cumulative_Restrictions.Value (RP) := Integer'Last;
1269                            Cumulative_Restrictions.Unknown (RP) := True;
1270                      end;
1271
1272                      if Nextc = '+' then
1273                         Skipc;
1274                         ALIs.Table (Id).Restrictions.Unknown (RP) := True;
1275                         Cumulative_Restrictions.Unknown (RP) := True;
1276                      end if;
1277
1278                   when others =>
1279                      raise Bad_R_Line;
1280                end case;
1281             end loop;
1282
1283             Skip_Eol;
1284
1285          --  Here if error during scanning of restrictions line
1286
1287          exception
1288             when Bad_R_Line =>
1289
1290                --  In Ignore_Errors mode, undo any changes to restrictions
1291                --  from this unit, and continue on.
1292
1293                if Ignore_Errors then
1294                   Cumulative_Restrictions := Save_R;
1295                   ALIs.Table (Id).Restrictions := No_Restrictions;
1296                   Skip_Eol;
1297
1298                --  In normal mode, this is a fatal error
1299
1300                else
1301                   Fatal_Error;
1302                end if;
1303
1304          end Scan_Restrictions;
1305       end if;
1306
1307       --  Acquire additional restrictions (No_Dependence) lines if present
1308
1309       C := Getc;
1310       while C = 'R' loop
1311          if Ignore ('R') then
1312             Skip_Line;
1313          else
1314             Skip_Space;
1315             No_Deps.Append ((Id, Get_Name));
1316             Skip_Eol;
1317          end if;
1318
1319          C := Getc;
1320       end loop;
1321
1322       --  Acquire 'I' lines if present
1323
1324       Check_Unknown_Line;
1325
1326       while C = 'I' loop
1327          if Ignore ('I') then
1328             Skip_Line;
1329
1330          else
1331             declare
1332                Int_Num : Nat;
1333                I_State : Character;
1334                Line_No : Nat;
1335
1336             begin
1337                Int_Num := Get_Nat;
1338                Skip_Space;
1339                I_State := Getc;
1340                Line_No := Get_Nat;
1341
1342                Interrupt_States.Append (
1343                  (Interrupt_Id    => Int_Num,
1344                   Interrupt_State => I_State,
1345                   IS_Pragma_Line  => Line_No));
1346
1347                ALIs.Table (Id).Last_Interrupt_State := Interrupt_States.Last;
1348                Skip_Eol;
1349             end;
1350          end if;
1351
1352          C := Getc;
1353       end loop;
1354
1355       --  Acquire 'S' lines if present
1356
1357       Check_Unknown_Line;
1358
1359       while C = 'S' loop
1360          if Ignore ('S') then
1361             Skip_Line;
1362
1363          else
1364             declare
1365                Policy     : Character;
1366                First_Prio : Nat;
1367                Last_Prio  : Nat;
1368                Line_No    : Nat;
1369
1370             begin
1371                Checkc (' ');
1372                Skip_Space;
1373
1374                Policy := Getc;
1375                Skip_Space;
1376                First_Prio := Get_Nat;
1377                Last_Prio := Get_Nat;
1378                Line_No := Get_Nat;
1379
1380                Specific_Dispatching.Append (
1381                  (Dispatching_Policy => Policy,
1382                   First_Priority     => First_Prio,
1383                   Last_Priority      => Last_Prio,
1384                   PSD_Pragma_Line    => Line_No));
1385
1386                ALIs.Table (Id).Last_Specific_Dispatching :=
1387                  Specific_Dispatching.Last;
1388
1389                Skip_Eol;
1390             end;
1391          end if;
1392
1393          C := Getc;
1394       end loop;
1395
1396       --  Loop to acquire unit entries
1397
1398       U_Loop : loop
1399          Check_Unknown_Line;
1400          exit U_Loop when C /= 'U';
1401
1402          --  Note: as per spec, we never ignore U lines
1403
1404          Checkc (' ');
1405          Skip_Space;
1406          Units.Increment_Last;
1407
1408          if ALIs.Table (Id).First_Unit = No_Unit_Id then
1409             ALIs.Table (Id).First_Unit := Units.Last;
1410          end if;
1411
1412          declare
1413             UL : Unit_Record renames Units.Table (Units.Last);
1414
1415          begin
1416             UL.Uname                    := Get_Unit_Name;
1417             UL.Predefined               := Is_Predefined_Unit;
1418             UL.Internal                 := Is_Internal_Unit;
1419             UL.My_ALI                   := Id;
1420             UL.Sfile                    := Get_File_Name (Lower => True);
1421             UL.Pure                     := False;
1422             UL.Preelab                  := False;
1423             UL.No_Elab                  := False;
1424             UL.Shared_Passive           := False;
1425             UL.RCI                      := False;
1426             UL.Remote_Types             := False;
1427             UL.Has_RACW                 := False;
1428             UL.Init_Scalars             := False;
1429             UL.Is_Generic               := False;
1430             UL.Icasing                  := Mixed_Case;
1431             UL.Kcasing                  := All_Lower_Case;
1432             UL.Dynamic_Elab             := False;
1433             UL.Elaborate_Body           := False;
1434             UL.Set_Elab_Entity          := False;
1435             UL.Version                  := "00000000";
1436             UL.First_With               := Withs.Last + 1;
1437             UL.First_Arg                := First_Arg;
1438             UL.Elab_Position            := 0;
1439             UL.SAL_Interface            := ALIs.Table (Id).SAL_Interface;
1440             UL.Directly_Scanned         := Directly_Scanned;
1441             UL.Body_Needed_For_SAL      := False;
1442             UL.Elaborate_Body_Desirable := False;
1443             UL.Optimize_Alignment       := 'O';
1444
1445             if Debug_Flag_U then
1446                Write_Str (" ----> reading unit ");
1447                Write_Int (Int (Units.Last));
1448                Write_Str ("  ");
1449                Write_Unit_Name (UL.Uname);
1450                Write_Str (" from file ");
1451                Write_Name (UL.Sfile);
1452                Write_Eol;
1453             end if;
1454          end;
1455
1456          --  Check for duplicated unit in different files
1457
1458          declare
1459             Info : constant Int := Get_Name_Table_Info
1460                                      (Units.Table (Units.Last).Uname);
1461          begin
1462             if Info /= 0
1463               and then Units.Table (Units.Last).Sfile /=
1464                        Units.Table (Unit_Id (Info)).Sfile
1465             then
1466                --  If Err is set then ignore duplicate unit name. This is the
1467                --  case of a call from gnatmake, where the situation can arise
1468                --  from substitution of source files. In such situations, the
1469                --  processing in gnatmake will always result in any required
1470                --  recompilations in any case, and if we consider this to be
1471                --  an error we get strange cases (for example when a generic
1472                --  instantiation is replaced by a normal package) where we
1473                --  read the old ali file, decide to recompile, and then decide
1474                --  that the old and new ali files are incompatible.
1475
1476                if Err then
1477                   null;
1478
1479                --  If Err is not set, then this is a fatal error. This is
1480                --  the case of being called from the binder, where we must
1481                --  definitely diagnose this as an error.
1482
1483                else
1484                   Set_Standard_Error;
1485                   Write_Str ("error: duplicate unit name: ");
1486                   Write_Eol;
1487
1488                   Write_Str ("error: unit """);
1489                   Write_Unit_Name (Units.Table (Units.Last).Uname);
1490                   Write_Str (""" found in file """);
1491                   Write_Name_Decoded (Units.Table (Units.Last).Sfile);
1492                   Write_Char ('"');
1493                   Write_Eol;
1494
1495                   Write_Str ("error: unit """);
1496                   Write_Unit_Name (Units.Table (Unit_Id (Info)).Uname);
1497                   Write_Str (""" found in file """);
1498                   Write_Name_Decoded (Units.Table (Unit_Id (Info)).Sfile);
1499                   Write_Char ('"');
1500                   Write_Eol;
1501
1502                   Exit_Program (E_Fatal);
1503                end if;
1504             end if;
1505          end;
1506
1507          Set_Name_Table_Info
1508            (Units.Table (Units.Last).Uname, Int (Units.Last));
1509
1510          --  Scan out possible version and other parameters
1511
1512          loop
1513             Skip_Space;
1514             exit when At_Eol;
1515             C := Getc;
1516
1517             --  Version field
1518
1519             if C in '0' .. '9' or else C in 'a' .. 'f' then
1520                Units.Table (Units.Last).Version (1) := C;
1521
1522                for J in 2 .. 8 loop
1523                   C := Getc;
1524                   Units.Table (Units.Last).Version (J) := C;
1525                end loop;
1526
1527             --  BD/BN parameters
1528
1529             elsif C = 'B' then
1530                C := Getc;
1531
1532                if C = 'D' then
1533                   Check_At_End_Of_Field;
1534                   Units.Table (Units.Last).Elaborate_Body_Desirable := True;
1535
1536                elsif C = 'N' then
1537                   Check_At_End_Of_Field;
1538                   Units.Table (Units.Last).Body_Needed_For_SAL := True;
1539
1540                else
1541                   Fatal_Error_Ignore;
1542                end if;
1543
1544             --  DE parameter (Dynamic elaboration checks)
1545
1546             elsif C = 'D' then
1547                C := Getc;
1548
1549                if C = 'E' then
1550                   Check_At_End_Of_Field;
1551                   Units.Table (Units.Last).Dynamic_Elab := True;
1552                   Dynamic_Elaboration_Checks_Specified := True;
1553                else
1554                   Fatal_Error_Ignore;
1555                end if;
1556
1557             --  EB/EE parameters
1558
1559             elsif C = 'E' then
1560                C := Getc;
1561
1562                if C = 'B' then
1563                   Units.Table (Units.Last).Elaborate_Body := True;
1564                elsif C = 'E' then
1565                   Units.Table (Units.Last).Set_Elab_Entity := True;
1566                else
1567                   Fatal_Error_Ignore;
1568                end if;
1569
1570                Check_At_End_Of_Field;
1571
1572             --  GE parameter (generic)
1573
1574             elsif C = 'G' then
1575                C := Getc;
1576
1577                if C = 'E' then
1578                   Check_At_End_Of_Field;
1579                   Units.Table (Units.Last).Is_Generic := True;
1580                else
1581                   Fatal_Error_Ignore;
1582                end if;
1583
1584             --  IL/IS/IU parameters
1585
1586             elsif C = 'I' then
1587                C := Getc;
1588
1589                if C = 'L' then
1590                   Units.Table (Units.Last).Icasing := All_Lower_Case;
1591                elsif C = 'S' then
1592                   Units.Table (Units.Last).Init_Scalars := True;
1593                   Initialize_Scalars_Used := True;
1594                elsif C = 'U' then
1595                   Units.Table (Units.Last).Icasing := All_Upper_Case;
1596                else
1597                   Fatal_Error_Ignore;
1598                end if;
1599
1600                Check_At_End_Of_Field;
1601
1602             --  KM/KU parameters
1603
1604             elsif C = 'K' then
1605                C := Getc;
1606
1607                if C = 'M' then
1608                   Units.Table (Units.Last).Kcasing := Mixed_Case;
1609                elsif C = 'U' then
1610                   Units.Table (Units.Last).Kcasing := All_Upper_Case;
1611                else
1612                   Fatal_Error_Ignore;
1613                end if;
1614
1615                Check_At_End_Of_Field;
1616
1617             --  NE parameter
1618
1619             elsif C = 'N' then
1620                C := Getc;
1621
1622                if C = 'E' then
1623                   Units.Table (Units.Last).No_Elab := True;
1624                   Check_At_End_Of_Field;
1625                else
1626                   Fatal_Error_Ignore;
1627                end if;
1628
1629             --  PR/PU/PK parameters
1630
1631             elsif C = 'P' then
1632                C := Getc;
1633
1634                if C = 'R' then
1635                   Units.Table (Units.Last).Preelab := True;
1636                elsif C = 'U' then
1637                   Units.Table (Units.Last).Pure := True;
1638                elsif C = 'K' then
1639                   Units.Table (Units.Last).Unit_Kind := 'p';
1640                else
1641                   Fatal_Error_Ignore;
1642                end if;
1643
1644                Check_At_End_Of_Field;
1645
1646             --  OL/OO/OS/OT parameters
1647
1648             elsif C = 'O' then
1649                C := Getc;
1650
1651                if C = 'L' or else C = 'O' or else C = 'S' or else C = 'T' then
1652                   Units.Table (Units.Last).Optimize_Alignment := C;
1653                else
1654                   Fatal_Error_Ignore;
1655                end if;
1656
1657                Check_At_End_Of_Field;
1658
1659             --  RC/RT parameters
1660
1661             elsif C = 'R' then
1662                C := Getc;
1663
1664                if C = 'C' then
1665                   Units.Table (Units.Last).RCI := True;
1666                elsif C = 'T' then
1667                   Units.Table (Units.Last).Remote_Types := True;
1668                elsif C = 'A' then
1669                   Units.Table (Units.Last).Has_RACW := True;
1670                else
1671                   Fatal_Error_Ignore;
1672                end if;
1673
1674                Check_At_End_Of_Field;
1675
1676             elsif C = 'S' then
1677                C := Getc;
1678
1679                if C = 'P' then
1680                   Units.Table (Units.Last).Shared_Passive := True;
1681                elsif C = 'U' then
1682                   Units.Table (Units.Last).Unit_Kind := 's';
1683                else
1684                   Fatal_Error_Ignore;
1685                end if;
1686
1687                Check_At_End_Of_Field;
1688
1689             else
1690                C := Getc;
1691                Fatal_Error_Ignore;
1692             end if;
1693          end loop;
1694
1695          Skip_Eol;
1696
1697          --  Check if static elaboration model used
1698
1699          if not Units.Table (Units.Last).Dynamic_Elab
1700            and then not Units.Table (Units.Last).Internal
1701          then
1702             Static_Elaboration_Model_Used := True;
1703          end if;
1704
1705          C := Getc;
1706
1707          --  Scan out With lines for this unit
1708
1709          With_Loop : loop
1710             Check_Unknown_Line;
1711             exit With_Loop when C /= 'W' and then C /= 'Y';
1712
1713             if Ignore ('W') then
1714                Skip_Line;
1715
1716             else
1717                Checkc (' ');
1718                Skip_Space;
1719                Withs.Increment_Last;
1720                Withs.Table (Withs.Last).Uname              := Get_Unit_Name;
1721                Withs.Table (Withs.Last).Elaborate          := False;
1722                Withs.Table (Withs.Last).Elaborate_All      := False;
1723                Withs.Table (Withs.Last).Elab_Desirable     := False;
1724                Withs.Table (Withs.Last).Elab_All_Desirable := False;
1725                Withs.Table (Withs.Last).SAL_Interface      := False;
1726                Withs.Table (Withs.Last).Limited_With       := (C = 'Y');
1727
1728                --  Generic case with no object file available
1729
1730                if At_Eol then
1731                   Withs.Table (Withs.Last).Sfile := No_File;
1732                   Withs.Table (Withs.Last).Afile := No_File;
1733
1734                --  Normal case
1735
1736                else
1737                   Withs.Table (Withs.Last).Sfile := Get_File_Name
1738                                                       (Lower => True);
1739                   Withs.Table (Withs.Last).Afile := Get_File_Name
1740                                                       (Lower => True);
1741
1742                   --  Scan out possible E, EA, ED, and AD parameters
1743
1744                   while not At_Eol loop
1745                      Skip_Space;
1746
1747                      if Nextc = 'A' then
1748                         P := P + 1;
1749                         Checkc ('D');
1750                         Check_At_End_Of_Field;
1751
1752                         --  Store AD indication unless ignore required
1753
1754                         if not Ignore_ED then
1755                            Withs.Table (Withs.Last).Elab_All_Desirable :=
1756                              True;
1757                         end if;
1758
1759                      elsif Nextc = 'E' then
1760                         P := P + 1;
1761
1762                         if At_End_Of_Field then
1763                            Withs.Table (Withs.Last).Elaborate := True;
1764
1765                         elsif Nextc = 'A' then
1766                            P := P + 1;
1767                            Check_At_End_Of_Field;
1768                            Withs.Table (Withs.Last).Elaborate_All := True;
1769
1770                         else
1771                            Checkc ('D');
1772                            Check_At_End_Of_Field;
1773
1774                            --  Store ED indication unless ignore required
1775
1776                            if not Ignore_ED then
1777                               Withs.Table (Withs.Last).Elab_Desirable :=
1778                                 True;
1779                            end if;
1780                         end if;
1781
1782                      else
1783                         Fatal_Error;
1784                      end if;
1785                   end loop;
1786                end if;
1787
1788                Skip_Eol;
1789             end if;
1790
1791             C := Getc;
1792          end loop With_Loop;
1793
1794          Units.Table (Units.Last).Last_With := Withs.Last;
1795          Units.Table (Units.Last).Last_Arg  := Args.Last;
1796
1797          --  If there are linker options lines present, scan them
1798
1799          Name_Len := 0;
1800
1801          Linker_Options_Loop : loop
1802             Check_Unknown_Line;
1803             exit Linker_Options_Loop when C /= 'L';
1804
1805             if Ignore ('L') then
1806                Skip_Line;
1807
1808             else
1809                Checkc (' ');
1810                Skip_Space;
1811                Checkc ('"');
1812
1813                loop
1814                   C := Getc;
1815
1816                   if C < Character'Val (16#20#)
1817                     or else C > Character'Val (16#7E#)
1818                   then
1819                      Fatal_Error_Ignore;
1820
1821                   elsif C = '{' then
1822                      C := Character'Val (0);
1823
1824                      declare
1825                         V : Natural;
1826
1827                      begin
1828                         V := 0;
1829                         for J in 1 .. 2 loop
1830                            C := Getc;
1831
1832                            if C in '0' .. '9' then
1833                               V := V * 16 +
1834                                      Character'Pos (C) -
1835                                        Character'Pos ('0');
1836
1837                            elsif C in 'A' .. 'F' then
1838                               V := V * 16 +
1839                                      Character'Pos (C) -
1840                                        Character'Pos ('A') +
1841                                          10;
1842
1843                            else
1844                               Fatal_Error_Ignore;
1845                            end if;
1846                         end loop;
1847
1848                         Checkc ('}');
1849                         Add_Char_To_Name_Buffer (Character'Val (V));
1850                      end;
1851
1852                   else
1853                      if C = '"' then
1854                         exit when Nextc /= '"';
1855                         C := Getc;
1856                      end if;
1857
1858                      Add_Char_To_Name_Buffer (C);
1859                   end if;
1860                end loop;
1861
1862                Add_Char_To_Name_Buffer (NUL);
1863                Skip_Eol;
1864             end if;
1865
1866             C := Getc;
1867          end loop Linker_Options_Loop;
1868
1869          --  Store the linker options entry if one was found
1870
1871          if Name_Len /= 0 then
1872             Linker_Options.Increment_Last;
1873
1874             Linker_Options.Table (Linker_Options.Last).Name :=
1875               Name_Enter;
1876
1877             Linker_Options.Table (Linker_Options.Last).Unit :=
1878               Units.Last;
1879
1880             Linker_Options.Table (Linker_Options.Last).Internal_File :=
1881               Is_Internal_File_Name (F);
1882
1883             Linker_Options.Table (Linker_Options.Last).Original_Pos :=
1884               Linker_Options.Last;
1885          end if;
1886
1887          --  If there are notes present, scan them
1888
1889          Notes_Loop : loop
1890             Check_Unknown_Line;
1891             exit Notes_Loop when C /= 'N';
1892
1893             if Ignore ('N') then
1894                Skip_Line;
1895
1896             else
1897                Checkc (' ');
1898
1899                Notes.Increment_Last;
1900                Notes.Table (Notes.Last).Pragma_Type := Getc;
1901                Notes.Table (Notes.Last).Pragma_Line := Get_Nat;
1902                Checkc (':');
1903                Notes.Table (Notes.Last).Pragma_Col  := Get_Nat;
1904                Notes.Table (Notes.Last).Unit        := Units.Last;
1905
1906                if At_Eol then
1907                   Notes.Table (Notes.Last).Pragma_Args := No_Name;
1908
1909                else
1910                   Checkc (' ');
1911
1912                   Name_Len := 0;
1913                   while not At_Eol loop
1914                      Add_Char_To_Name_Buffer (Getc);
1915                   end loop;
1916
1917                   Notes.Table (Notes.Last).Pragma_Args := Name_Enter;
1918                end if;
1919
1920                Skip_Eol;
1921             end if;
1922
1923             C := Getc;
1924          end loop Notes_Loop;
1925       end loop U_Loop;
1926
1927       --  End loop through units for one ALI file
1928
1929       ALIs.Table (Id).Last_Unit := Units.Last;
1930       ALIs.Table (Id).Sfile := Units.Table (ALIs.Table (Id).First_Unit).Sfile;
1931
1932       --  Set types of the units (there can be at most 2 of them)
1933
1934       if ALIs.Table (Id).First_Unit /= ALIs.Table (Id).Last_Unit then
1935          Units.Table (ALIs.Table (Id).First_Unit).Utype := Is_Body;
1936          Units.Table (ALIs.Table (Id).Last_Unit).Utype  := Is_Spec;
1937
1938       else
1939          --  Deal with body only and spec only cases, note that the reason we
1940          --  do our own checking of the name (rather than using Is_Body_Name)
1941          --  is that Uname drags in far too much compiler junk!
1942
1943          Get_Name_String (Units.Table (Units.Last).Uname);
1944
1945          if Name_Buffer (Name_Len) = 'b' then
1946             Units.Table (Units.Last).Utype := Is_Body_Only;
1947          else
1948             Units.Table (Units.Last).Utype := Is_Spec_Only;
1949          end if;
1950       end if;
1951
1952       --  Scan out external version references and put in hash table
1953
1954       E_Loop : loop
1955          Check_Unknown_Line;
1956          exit E_Loop when C /= 'E';
1957
1958          if Ignore ('E') then
1959             Skip_Line;
1960
1961          else
1962             Checkc (' ');
1963             Skip_Space;
1964
1965             Name_Len := 0;
1966             Name_Len := 0;
1967             loop
1968                C := Getc;
1969
1970                if C < ' ' then
1971                   Fatal_Error;
1972                end if;
1973
1974                exit when At_End_Of_Field;
1975                Add_Char_To_Name_Buffer (C);
1976             end loop;
1977
1978             Version_Ref.Set (new String'(Name_Buffer (1 .. Name_Len)), True);
1979             Skip_Eol;
1980          end if;
1981
1982          C := Getc;
1983       end loop E_Loop;
1984
1985       --  Scan out source dependency lines for this ALI file
1986
1987       ALIs.Table (Id).First_Sdep := Sdep.Last + 1;
1988
1989       D_Loop : loop
1990          Check_Unknown_Line;
1991          exit D_Loop when C /= 'D';
1992
1993          if Ignore ('D') then
1994             Skip_Line;
1995
1996          else
1997             Checkc (' ');
1998             Skip_Space;
1999             Sdep.Increment_Last;
2000
2001             --  In the following call, Lower is not set to True, this is either
2002             --  a bug, or it deserves a special comment as to why this is so???
2003
2004             Sdep.Table (Sdep.Last).Sfile := Get_File_Name;
2005
2006             Sdep.Table (Sdep.Last).Stamp := Get_Stamp;
2007             Sdep.Table (Sdep.Last).Dummy_Entry :=
2008               (Sdep.Table (Sdep.Last).Stamp = Dummy_Time_Stamp);
2009
2010             --  Acquire checksum value
2011
2012             Skip_Space;
2013
2014             declare
2015                Ctr : Natural;
2016                Chk : Word;
2017
2018             begin
2019                Ctr := 0;
2020                Chk := 0;
2021
2022                loop
2023                   exit when At_Eol or else Ctr = 8;
2024
2025                   if Nextc in '0' .. '9' then
2026                      Chk := Chk * 16 +
2027                               Character'Pos (Nextc) - Character'Pos ('0');
2028
2029                   elsif Nextc in 'a' .. 'f' then
2030                      Chk := Chk * 16 +
2031                               Character'Pos (Nextc) - Character'Pos ('a') + 10;
2032
2033                   else
2034                      exit;
2035                   end if;
2036
2037                   Ctr := Ctr + 1;
2038                   P := P + 1;
2039                end loop;
2040
2041                if Ctr = 8 and then At_End_Of_Field then
2042                   Sdep.Table (Sdep.Last).Checksum := Chk;
2043                else
2044                   Fatal_Error;
2045                end if;
2046             end;
2047
2048             --  Acquire subunit and reference file name entries
2049
2050             Sdep.Table (Sdep.Last).Subunit_Name := No_Name;
2051             Sdep.Table (Sdep.Last).Rfile        :=
2052               Sdep.Table (Sdep.Last).Sfile;
2053             Sdep.Table (Sdep.Last).Start_Line   := 1;
2054
2055             if not At_Eol then
2056                Skip_Space;
2057
2058                --  Here for subunit name
2059
2060                if Nextc not in '0' .. '9' then
2061                   Name_Len := 0;
2062                   while not At_End_Of_Field loop
2063                      Add_Char_To_Name_Buffer (Getc);
2064                   end loop;
2065
2066                   --  Set the subunit name. Note that we use Name_Find rather
2067                   --  than Name_Enter here as the subunit name may already
2068                   --  have been put in the name table by the Project Manager.
2069
2070                   Sdep.Table (Sdep.Last).Subunit_Name := Name_Find;
2071
2072                   Skip_Space;
2073                end if;
2074
2075                --  Here for reference file name entry
2076
2077                if Nextc in '0' .. '9' then
2078                   Sdep.Table (Sdep.Last).Start_Line := Get_Nat;
2079                   Checkc (':');
2080
2081                   Name_Len := 0;
2082
2083                   while not At_End_Of_Field loop
2084                      Add_Char_To_Name_Buffer (Getc);
2085                   end loop;
2086
2087                   Sdep.Table (Sdep.Last).Rfile := Name_Enter;
2088                end if;
2089             end if;
2090
2091             Skip_Eol;
2092          end if;
2093
2094          C := Getc;
2095       end loop D_Loop;
2096
2097       ALIs.Table (Id).Last_Sdep := Sdep.Last;
2098
2099       --  We must at this stage be at an Xref line or the end of file
2100
2101       if C = EOF then
2102          return Id;
2103       end if;
2104
2105       Check_Unknown_Line;
2106
2107       if C /= 'X' then
2108          Fatal_Error;
2109       end if;
2110
2111       --  If we are ignoring Xref sections we are done (we ignore all
2112       --  remaining lines since only xref related lines follow X).
2113
2114       if Ignore ('X') and then not Debug_Flag_X then
2115          return Id;
2116       end if;
2117
2118       --  Loop through Xref sections
2119
2120       X_Loop : loop
2121          Check_Unknown_Line;
2122          exit X_Loop when C /= 'X';
2123
2124          --  Make new entry in section table
2125
2126          Xref_Section.Increment_Last;
2127
2128          Read_Refs_For_One_File : declare
2129             XS : Xref_Section_Record renames
2130                    Xref_Section.Table (Xref_Section.Last);
2131
2132             Current_File_Num : Sdep_Id;
2133             --  Keeps track of the current file number (changed by nn|)
2134
2135          begin
2136             XS.File_Num     := Sdep_Id (Get_Nat + Nat (First_Sdep_Entry) - 1);
2137             XS.File_Name    := Get_File_Name;
2138             XS.First_Entity := Xref_Entity.Last + 1;
2139
2140             Current_File_Num := XS.File_Num;
2141
2142             Skip_Space;
2143
2144             Skip_Eol;
2145             C := Nextc;
2146
2147             --  Loop through Xref entities
2148
2149             while C /= 'X' and then C /= EOF loop
2150                Xref_Entity.Increment_Last;
2151
2152                Read_Refs_For_One_Entity : declare
2153                   XE : Xref_Entity_Record renames
2154                          Xref_Entity.Table (Xref_Entity.Last);
2155                   N  : Nat;
2156
2157                   procedure Read_Instantiation_Reference;
2158                   --  Acquire instantiation reference. Caller has checked
2159                   --  that current character is '[' and on return the cursor
2160                   --  is skipped past the corresponding closing ']'.
2161
2162                   ----------------------------------
2163                   -- Read_Instantiation_Reference --
2164                   ----------------------------------
2165
2166                   procedure Read_Instantiation_Reference is
2167                      Local_File_Num : Sdep_Id := Current_File_Num;
2168
2169                   begin
2170                      Xref.Increment_Last;
2171
2172                      declare
2173                         XR : Xref_Record renames Xref.Table (Xref.Last);
2174
2175                      begin
2176                         P := P + 1; -- skip [
2177                         N := Get_Nat;
2178
2179                         if Nextc = '|' then
2180                            XR.File_Num :=
2181                              Sdep_Id (N + Nat (First_Sdep_Entry) - 1);
2182                            Local_File_Num := XR.File_Num;
2183                            P := P + 1;
2184                            N := Get_Nat;
2185
2186                         else
2187                            XR.File_Num := Local_File_Num;
2188                         end if;
2189
2190                         XR.Line  := N;
2191                         XR.Rtype := ' ';
2192                         XR.Col   := 0;
2193
2194                         --  Recursive call for next reference
2195
2196                         if Nextc = '[' then
2197                            pragma Warnings (Off); -- kill recursion warning
2198                            Read_Instantiation_Reference;
2199                            pragma Warnings (On);
2200                         end if;
2201
2202                         --  Skip closing bracket after recursive call
2203
2204                         P := P + 1;
2205                      end;
2206                   end Read_Instantiation_Reference;
2207
2208                --  Start of processing for Read_Refs_For_One_Entity
2209
2210                begin
2211                   XE.Line  := Get_Nat;
2212                   XE.Etype := Getc;
2213                   XE.Col   := Get_Nat;
2214
2215                   case Getc is
2216                      when '*' =>
2217                         XE.Visibility := Global;
2218                      when '+' =>
2219                         XE.Visibility := Static;
2220                      when others =>
2221                         XE.Visibility := Other;
2222                   end case;
2223
2224                   XE.Entity := Get_Name;
2225
2226                   --  Handle the information about generic instantiations
2227
2228                   if Nextc = '[' then
2229                      Skipc; --  Opening '['
2230                      N := Get_Nat;
2231
2232                      if Nextc /= '|' then
2233                         XE.Iref_File_Num := Current_File_Num;
2234                         XE.Iref_Line     := N;
2235                      else
2236                         XE.Iref_File_Num :=
2237                           Sdep_Id (N + Nat (First_Sdep_Entry) - 1);
2238                         Skipc;
2239                         XE.Iref_Line := Get_Nat;
2240                      end if;
2241
2242                      if Getc /= ']' then
2243                         Fatal_Error;
2244                      end if;
2245
2246                   else
2247                      XE.Iref_File_Num := No_Sdep_Id;
2248                      XE.Iref_Line     := 0;
2249                   end if;
2250
2251                   Current_File_Num := XS.File_Num;
2252
2253                   --  Renaming reference is present
2254
2255                   if Nextc = '=' then
2256                      P := P + 1;
2257                      XE.Rref_Line := Get_Nat;
2258
2259                      if Getc /= ':' then
2260                         Fatal_Error;
2261                      end if;
2262
2263                      XE.Rref_Col := Get_Nat;
2264
2265                   --  No renaming reference present
2266
2267                   else
2268                      XE.Rref_Line := 0;
2269                      XE.Rref_Col  := 0;
2270                   end if;
2271
2272                   Skip_Space;
2273
2274                   XE.Oref_File_Num := No_Sdep_Id;
2275                   XE.Tref_File_Num := No_Sdep_Id;
2276                   XE.Tref          := Tref_None;
2277                   XE.First_Xref    := Xref.Last + 1;
2278
2279                   --  Loop to check for additional info present
2280
2281                   loop
2282                      declare
2283                         Ref  : Tref_Kind;
2284                         File : Sdep_Id;
2285                         Line : Nat;
2286                         Typ  : Character;
2287                         Col  : Nat;
2288                         Std  : Name_Id;
2289
2290                      begin
2291                         Get_Typeref
2292                           (Current_File_Num, Ref, File, Line, Typ, Col, Std);
2293                         exit when Ref = Tref_None;
2294
2295                         --  Do we have an overriding procedure?
2296
2297                         if Ref = Tref_Derived and then Typ = 'p' then
2298                            XE.Oref_File_Num := File;
2299                            XE.Oref_Line     := Line;
2300                            XE.Oref_Col      := Col;
2301
2302                         --  Arrays never override anything, and <> points to
2303                         --  the index types instead
2304
2305                         elsif Ref = Tref_Derived and then XE.Etype = 'A' then
2306
2307                            --  Index types are stored in the list of references
2308
2309                            Xref.Increment_Last;
2310
2311                            declare
2312                               XR : Xref_Record renames Xref.Table (Xref.Last);
2313                            begin
2314                               XR.File_Num := File;
2315                               XR.Line     := Line;
2316                               XR.Rtype    := Array_Index_Reference;
2317                               XR.Col      := Col;
2318                               XR.Name     := Std;
2319                            end;
2320
2321                         --  Interfaces are stored in the list of references,
2322                         --  although the parent type itself is stored in XE.
2323                         --  The first interface (when there are only
2324                         --  interfaces) is stored in XE.Tref*)
2325
2326                         elsif Ref = Tref_Derived
2327                           and then Typ = 'R'
2328                           and then XE.Tref_File_Num /= No_Sdep_Id
2329                         then
2330                            Xref.Increment_Last;
2331
2332                            declare
2333                               XR : Xref_Record renames Xref.Table (Xref.Last);
2334                            begin
2335                               XR.File_Num := File;
2336                               XR.Line     := Line;
2337                               XR.Rtype    := Interface_Reference;
2338                               XR.Col      := Col;
2339                               XR.Name     := Std;
2340                            end;
2341
2342                         else
2343                            XE.Tref                 := Ref;
2344                            XE.Tref_File_Num        := File;
2345                            XE.Tref_Line            := Line;
2346                            XE.Tref_Type            := Typ;
2347                            XE.Tref_Col             := Col;
2348                            XE.Tref_Standard_Entity := Std;
2349                         end if;
2350                      end;
2351                   end loop;
2352
2353                   --  Loop through cross-references for this entity
2354
2355                   loop
2356                      Skip_Space;
2357
2358                      if At_Eol then
2359                         Skip_Eol;
2360                         exit when Nextc /= '.';
2361                         P := P + 1;
2362                      end if;
2363
2364                      Xref.Increment_Last;
2365
2366                      declare
2367                         XR : Xref_Record renames Xref.Table (Xref.Last);
2368
2369                      begin
2370                         N := Get_Nat;
2371
2372                         if Nextc = '|' then
2373                            XR.File_Num :=
2374                              Sdep_Id (N + Nat (First_Sdep_Entry) - 1);
2375                            Current_File_Num := XR.File_Num;
2376                            P := P + 1;
2377                            N := Get_Nat;
2378                         else
2379                            XR.File_Num := Current_File_Num;
2380                         end if;
2381
2382                         XR.Line  := N;
2383                         XR.Rtype := Getc;
2384
2385                         --  Imported entities reference as in:
2386                         --    494b<c,__gnat_copy_attribs>25
2387                         --  ??? Simply skipped for now
2388
2389                         if Nextc = '<' then
2390                            while Getc /= '>' loop
2391                               null;
2392                            end loop;
2393                         end if;
2394
2395                         XR.Col   := Get_Nat;
2396
2397                         if Nextc = '[' then
2398                            Read_Instantiation_Reference;
2399                         end if;
2400                      end;
2401                   end loop;
2402
2403                   --  Record last cross-reference
2404
2405                   XE.Last_Xref := Xref.Last;
2406                   C := Nextc;
2407
2408                exception
2409                   when Bad_ALI_Format =>
2410
2411                      --  If ignoring errors, then we skip a line with an
2412                      --  unexpected error, and try to continue subsequent
2413                      --  xref lines.
2414
2415                      if Ignore_Errors then
2416                         Xref_Entity.Decrement_Last;
2417                         Skip_Line;
2418                         C := Nextc;
2419
2420                      --  Otherwise, we reraise the fatal exception
2421
2422                      else
2423                         raise;
2424                      end if;
2425                end Read_Refs_For_One_Entity;
2426             end loop;
2427
2428             --  Record last entity
2429
2430             XS.Last_Entity := Xref_Entity.Last;
2431
2432          end Read_Refs_For_One_File;
2433
2434          C := Getc;
2435       end loop X_Loop;
2436
2437       --  Here after dealing with xref sections
2438
2439       if C /= EOF and then C /= 'X' then
2440          Fatal_Error;
2441       end if;
2442
2443       return Id;
2444
2445    exception
2446       when Bad_ALI_Format =>
2447          return No_ALI_Id;
2448    end Scan_ALI;
2449
2450    ---------
2451    -- SEq --
2452    ---------
2453
2454    function SEq (F1, F2 : String_Ptr) return Boolean is
2455    begin
2456       return F1.all = F2.all;
2457    end SEq;
2458
2459    -----------
2460    -- SHash --
2461    -----------
2462
2463    function SHash (S : String_Ptr) return Vindex is
2464       H : Word;
2465
2466    begin
2467       H := 0;
2468       for J in S.all'Range loop
2469          H := H * 2 + Character'Pos (S (J));
2470       end loop;
2471
2472       return Vindex (Vindex'First + Vindex (H mod Vindex'Range_Length));
2473    end SHash;
2474
2475 end ALI;