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