gcc/ada/ali.adb

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