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