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