gcc/ada/ali.adb

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