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 DB
 819
 820             elsif C = 'D' then
 821                Checkc ('B');
 822                Detect_Blocking := True;
 823
 824             --  Processing for FD/FG/FI
 825
 826             elsif C = 'F' then
 827                Float_Format_Specified := Getc;
 828                ALIs.Table (Id).Float_Format := Float_Format_Specified;
 829
 830             --  Processing for Lx
 831
 832             elsif C = 'L' then
 833                Locking_Policy_Specified := Getc;
 834                ALIs.Table (Id).Locking_Policy := Locking_Policy_Specified;
 835
 836             --  Processing for flags starting with N
 837
 838             elsif C = 'N' then
 839                C := Getc;
 840
 841                --  Processing for NO
 842
 843                if C = 'O' then
 844                   ALIs.Table (Id).No_Object := True;
 845                   No_Object_Specified := True;
 846
 847                --  Processing for NR
 848
 849                elsif C = 'R' then
 850                   No_Run_Time_Mode           := True;
 851                   Configurable_Run_Time_Mode := True;
 852
 853                --  Processing for NS
 854
 855                elsif C = 'S' then
 856                   ALIs.Table (Id).Normalize_Scalars := True;
 857                   Normalize_Scalars_Specified := True;
 858                   NS_Found := True;
 859
 860                --  Invalid switch starting with N
 861
 862                else
 863                   Fatal_Error_Ignore;
 864                end if;
 865
 866             --  Processing for Qx
 867
 868             elsif C = 'Q' then
 869                Queuing_Policy_Specified := Getc;
 870                ALIs.Table (Id).Queuing_Policy := Queuing_Policy_Specified;
 871
 872             --  Processing for flags starting with S
 873
 874             elsif C = 'S' then
 875                C := Getc;
 876
 877                --  Processing for SL
 878
 879                if C = 'L' then
 880                   ALIs.Table (Id).Interface := True;
 881
 882                --  Processing for SS
 883
 884                elsif C = 'S' then
 885                   Opt.Sec_Stack_Used := True;
 886
 887                --  Invalid switch starting with S
 888
 889                else
 890                   Fatal_Error_Ignore;
 891                end if;
 892
 893             --  Processing for Tx
 894
 895             elsif C = 'T' then
 896                Task_Dispatching_Policy_Specified := Getc;
 897                ALIs.Table (Id).Task_Dispatching_Policy :=
 898                  Task_Dispatching_Policy_Specified;
 899
 900             --  Processing for switch starting with U
 901
 902             elsif C = 'U' then
 903                C := Getc;
 904
 905                --  Processing for UA
 906
 907                if C  = 'A' then
 908                   Unreserve_All_Interrupts_Specified := True;
 909
 910                --  Processing for UX
 911
 912                elsif C = 'X' then
 913                   ALIs.Table (Id).Unit_Exception_Table := True;
 914
 915                --  Invalid switches starting with U
 916
 917                else
 918                   Fatal_Error_Ignore;
 919                end if;
 920
 921             --  Processing for ZX
 922
 923             elsif C = 'Z' then
 924                C := Getc;
 925
 926                if C = 'X' then
 927                   ALIs.Table (Id).Zero_Cost_Exceptions := True;
 928                   Zero_Cost_Exceptions_Specified := True;
 929                else
 930                   Fatal_Error_Ignore;
 931                end if;
 932
 933             --  Invalid parameter
 934
 935             else
 936                C := Getc;
 937                Fatal_Error_Ignore;
 938             end if;
 939          end loop;
 940
 941          if not NS_Found then
 942             No_Normalize_Scalars_Specified := True;
 943          end if;
 944
 945          Skip_Eol;
 946       end if;
 947
 948       C := Getc;
 949       Check_Unknown_Line;
 950
 951       --  Acquire restrictions line
 952
 953       while C /= 'R' loop
 954          if Ignore_Errors then
 955             if C = EOF then
 956                Fatal_Error;
 957             else
 958                Skip_Line;
 959                C := Nextc;
 960             end if;
 961          else
 962             Fatal_Error;
 963          end if;
 964       end loop;
 965
 966       if Ignore ('R') then
 967          Skip_Line;
 968
 969       --  Process restrictions line
 970
 971       else
 972          Scan_Restrictions : declare
 973             Save_R : constant Restrictions_Info := Cumulative_Restrictions;
 974             --  Save cumulative restrictions in case we have a fatal error
 975
 976             Bad_R_Line : exception;
 977             --  Signal bad restrictions line
 978
 979          begin
 980             Checkc (' ');
 981             Skip_Space;
 982
 983             --  Acquire information for boolean restrictions
 984
 985             for R in All_Boolean_Restrictions loop
 986                C := Getc;
 987
 988                case C is
 989                   when 'v' =>
 990                      ALIs.Table (Id).Restrictions.Violated (R) := True;
 991                      Cumulative_Restrictions.Violated (R) := True;
 992
 993                   when 'r' =>
 994                      ALIs.Table (Id).Restrictions.Set (R) := True;
 995                      Cumulative_Restrictions.Set (R) := True;
 996
 997                   when 'n' =>
 998                      null;
 999
1000                   when others =>
1001                      Fatal_Error;
1002                end case;
1003             end loop;
1004
1005             --  Acquire information for parameter restrictions
1006
1007             for RP in All_Parameter_Restrictions loop
1008
1009                --  Acquire restrictions pragma information
1010
1011                case Getc is
1012                   when 'n' =>
1013                      null;
1014
1015                   when 'r' =>
1016                      ALIs.Table (Id).Restrictions.Set (RP) := True;
1017
1018                      declare
1019                         N : constant Integer := Integer (Get_Nat);
1020                      begin
1021                         ALIs.Table (Id).Restrictions.Value (RP) := N;
1022
1023                         if Cumulative_Restrictions.Set (RP) then
1024                            Cumulative_Restrictions.Value (RP) :=
1025                              Integer'Min
1026                                (Cumulative_Restrictions.Value (RP), N);
1027                         else
1028                            Cumulative_Restrictions.Set (RP) := True;
1029                            Cumulative_Restrictions.Value (RP) := N;
1030                         end if;
1031                      end;
1032
1033                   when others =>
1034                      Fatal_Error;
1035                end case;
1036
1037                --  Acquire restrictions violations information
1038
1039                case Getc is
1040                   when 'n' =>
1041                      null;
1042
1043                   when 'v' =>
1044                      ALIs.Table (Id).Restrictions.Violated (RP) := True;
1045                      Cumulative_Restrictions.Violated (RP) := True;
1046
1047                      declare
1048                         N : constant Integer := Integer (Get_Nat);
1049                         pragma Unsuppress (Overflow_Check);
1050
1051                      begin
1052                         ALIs.Table (Id).Restrictions.Count (RP) := N;
1053
1054                         if RP in Checked_Max_Parameter_Restrictions then
1055                            Cumulative_Restrictions.Count (RP) :=
1056                              Integer'Max
1057                                (Cumulative_Restrictions.Count (RP), N);
1058                         else
1059                            Cumulative_Restrictions.Count (RP) :=
1060                              Cumulative_Restrictions.Count (RP) + N;
1061                         end if;
1062
1063                      exception
1064                         when Constraint_Error =>
1065
1066                            --  A constraint error comes from the addition in
1067                            --  the else branch. We reset to the maximum and
1068                            --  indicate that the real value is now unknown.
1069
1070                            Cumulative_Restrictions.Value (RP) := Integer'Last;
1071                            Cumulative_Restrictions.Unknown (RP) := True;
1072                      end;
1073
1074                      if Nextc = '+' then
1075                         Skipc;
1076                         ALIs.Table (Id).Restrictions.Unknown (RP) := True;
1077                         Cumulative_Restrictions.Unknown (RP) := True;
1078                      end if;
1079
1080                   when others =>
1081                      Fatal_Error;
1082                end case;
1083             end loop;
1084
1085             Skip_Eol;
1086
1087          --  Here if error during scanning of restrictions line
1088
1089          exception
1090             when Bad_R_Line =>
1091
1092                --  In Ignore_Errors mode, undo any changes to restrictions
1093                --  from this unit, and continue on.
1094
1095                if Ignore_Errors then
1096                   Cumulative_Restrictions := Save_R;
1097                   ALIs.Table (Id).Restrictions := Restrictions_Initial;
1098
1099                --  In normal mode, this is a fatal error
1100
1101                else
1102                   Fatal_Error;
1103                end if;
1104
1105          end Scan_Restrictions;
1106       end if;
1107
1108       --  Acquire 'I' lines if present
1109
1110       C := Getc;
1111       Check_Unknown_Line;
1112
1113       while C = 'I' loop
1114          if Ignore ('I') then
1115             Skip_Line;
1116
1117          else
1118             declare
1119                Int_Num : Nat;
1120                I_State : Character;
1121                Line_No : Nat;
1122
1123             begin
1124                Int_Num := Get_Nat;
1125                Skip_Space;
1126                I_State := Getc;
1127                Line_No := Get_Nat;
1128
1129                Interrupt_States.Append (
1130                  (Interrupt_Id    => Int_Num,
1131                   Interrupt_State => I_State,
1132                   IS_Pragma_Line  => Line_No));
1133
1134                ALIs.Table (Id).Last_Interrupt_State := Interrupt_States.Last;
1135                Skip_Eol;
1136             end;
1137          end if;
1138
1139          C := Getc;
1140       end loop;
1141
1142       --  Loop to acquire unit entries
1143
1144       U_Loop : loop
1145          Check_Unknown_Line;
1146          exit U_Loop when C /= 'U';
1147
1148          --  Note: as per spec, we never ignore U lines
1149
1150          Checkc (' ');
1151          Skip_Space;
1152          Units.Increment_Last;
1153
1154          if ALIs.Table (Id).First_Unit = No_Unit_Id then
1155             ALIs.Table (Id).First_Unit := Units.Last;
1156          end if;
1157
1158          Units.Table (Units.Last).Uname           := Get_Name;
1159          Units.Table (Units.Last).Predefined      := Is_Predefined_Unit;
1160          Units.Table (Units.Last).Internal        := Is_Internal_Unit;
1161          Units.Table (Units.Last).My_ALI          := Id;
1162          Units.Table (Units.Last).Sfile           := Get_Name (Lower => True);
1163          Units.Table (Units.Last).Pure            := False;
1164          Units.Table (Units.Last).Preelab         := False;
1165          Units.Table (Units.Last).No_Elab         := False;
1166          Units.Table (Units.Last).Shared_Passive  := False;
1167          Units.Table (Units.Last).RCI             := False;
1168          Units.Table (Units.Last).Remote_Types    := False;
1169          Units.Table (Units.Last).Has_RACW        := False;
1170          Units.Table (Units.Last).Init_Scalars    := False;
1171          Units.Table (Units.Last).Is_Generic      := False;
1172          Units.Table (Units.Last).Icasing         := Mixed_Case;
1173          Units.Table (Units.Last).Kcasing         := All_Lower_Case;
1174          Units.Table (Units.Last).Dynamic_Elab    := False;
1175          Units.Table (Units.Last).Elaborate_Body  := False;
1176          Units.Table (Units.Last).Set_Elab_Entity := False;
1177          Units.Table (Units.Last).Version         := "00000000";
1178          Units.Table (Units.Last).First_With      := Withs.Last + 1;
1179          Units.Table (Units.Last).First_Arg       := First_Arg;
1180          Units.Table (Units.Last).Elab_Position   := 0;
1181          Units.Table (Units.Last).Interface       := ALIs.Table (Id).Interface;
1182          Units.Table (Units.Last).Body_Needed_For_SAL := False;
1183
1184          if Debug_Flag_U then
1185             Write_Str (" ----> reading unit ");
1186             Write_Int (Int (Units.Last));
1187             Write_Str ("  ");
1188             Write_Unit_Name (Units.Table (Units.Last).Uname);
1189             Write_Str (" from file ");
1190             Write_Name (Units.Table (Units.Last).Sfile);
1191             Write_Eol;
1192          end if;
1193
1194          --  Check for duplicated unit in different files
1195
1196          declare
1197             Info : constant Int := Get_Name_Table_Info
1198                                      (Units.Table (Units.Last).Uname);
1199          begin
1200             if Info /= 0
1201               and then Units.Table (Units.Last).Sfile /=
1202                        Units.Table (Unit_Id (Info)).Sfile
1203             then
1204                --  If Err is set then ignore duplicate unit name. This is the
1205                --  case of a call from gnatmake, where the situation can arise
1206                --  from substitution of source files. In such situations, the
1207                --  processing in gnatmake will always result in any required
1208                --  recompilations in any case, and if we consider this to be
1209                --  an error we get strange cases (for example when a generic
1210                --  instantiation is replaced by a normal package) where we
1211                --  read the old ali file, decide to recompile, and then decide
1212                --  that the old and new ali files are incompatible.
1213
1214                if Err then
1215                   null;
1216
1217                --  If Err is not set, then this is a fatal error. This is
1218                --  the case of being called from the binder, where we must
1219                --  definitely diagnose this as an error.
1220
1221                else
1222                   Set_Standard_Error;
1223                   Write_Str ("error: duplicate unit name: ");
1224                   Write_Eol;
1225
1226                   Write_Str ("error: unit """);
1227                   Write_Unit_Name (Units.Table (Units.Last).Uname);
1228                   Write_Str (""" found in file """);
1229                   Write_Name_Decoded (Units.Table (Units.Last).Sfile);
1230                   Write_Char ('"');
1231                   Write_Eol;
1232
1233                   Write_Str ("error: unit """);
1234                   Write_Unit_Name (Units.Table (Unit_Id (Info)).Uname);
1235                   Write_Str (""" found in file """);
1236                   Write_Name_Decoded (Units.Table (Unit_Id (Info)).Sfile);
1237                   Write_Char ('"');
1238                   Write_Eol;
1239
1240                   Exit_Program (E_Fatal);
1241                end if;
1242             end if;
1243          end;
1244
1245          Set_Name_Table_Info
1246            (Units.Table (Units.Last).Uname, Int (Units.Last));
1247
1248          --  Scan out possible version and other parameters
1249
1250          loop
1251             Skip_Space;
1252             exit when At_Eol;
1253             C := Getc;
1254
1255             --  Version field
1256
1257             if C in '0' .. '9' or else C in 'a' .. 'f' then
1258                Units.Table (Units.Last).Version (1) := C;
1259
1260                for J in 2 .. 8 loop
1261                   C := Getc;
1262                   Units.Table (Units.Last).Version (J) := C;
1263                end loop;
1264
1265             --  BN parameter (Body needed)
1266
1267             elsif C = 'B' then
1268                C := Getc;
1269
1270                if C = 'N' then
1271                   Check_At_End_Of_Field;
1272                   Units.Table (Units.Last).Body_Needed_For_SAL := True;
1273                else
1274                   Fatal_Error_Ignore;
1275                end if;
1276
1277
1278             --  DE parameter (Dynamic elaboration checks)
1279
1280             elsif C = 'D' then
1281                C := Getc;
1282
1283                if C = 'E' then
1284                   Check_At_End_Of_Field;
1285                   Units.Table (Units.Last).Dynamic_Elab := True;
1286                   Dynamic_Elaboration_Checks_Specified := True;
1287                else
1288                   Fatal_Error_Ignore;
1289                end if;
1290
1291             --  EB/EE parameters
1292
1293             elsif C = 'E' then
1294                C := Getc;
1295
1296                if C = 'B' then
1297                   Units.Table (Units.Last).Elaborate_Body := True;
1298                elsif C = 'E' then
1299                   Units.Table (Units.Last).Set_Elab_Entity := True;
1300                else
1301                   Fatal_Error_Ignore;
1302                end if;
1303
1304                Check_At_End_Of_Field;
1305
1306             --  GE parameter (generic)
1307
1308             elsif C = 'G' then
1309                C := Getc;
1310
1311                if C = 'E' then
1312                   Check_At_End_Of_Field;
1313                   Units.Table (Units.Last).Is_Generic := True;
1314                else
1315                   Fatal_Error_Ignore;
1316                end if;
1317
1318             --  IL/IS/IU parameters
1319
1320             elsif C = 'I' then
1321                C := Getc;
1322
1323                if C = 'L' then
1324                   Units.Table (Units.Last).Icasing := All_Lower_Case;
1325                elsif C = 'S' then
1326                   Units.Table (Units.Last).Init_Scalars := True;
1327                   Initialize_Scalars_Used := True;
1328                elsif C = 'U' then
1329                   Units.Table (Units.Last).Icasing := All_Upper_Case;
1330                else
1331                   Fatal_Error_Ignore;
1332                end if;
1333
1334                Check_At_End_Of_Field;
1335
1336             --  KM/KU parameters
1337
1338             elsif C = 'K' then
1339                C := Getc;
1340
1341                if C = 'M' then
1342                   Units.Table (Units.Last).Kcasing := Mixed_Case;
1343                elsif C = 'U' then
1344                   Units.Table (Units.Last).Kcasing := All_Upper_Case;
1345                else
1346                   Fatal_Error_Ignore;
1347                end if;
1348
1349                Check_At_End_Of_Field;
1350
1351             --  NE parameter
1352
1353             elsif C = 'N' then
1354                C := Getc;
1355
1356                if C = 'E' then
1357                   Units.Table (Units.Last).No_Elab := True;
1358                   Check_At_End_Of_Field;
1359                else
1360                   Fatal_Error_Ignore;
1361                end if;
1362
1363
1364             --  PR/PU/PK parameters
1365
1366             elsif C = 'P' then
1367                C := Getc;
1368
1369                if C = 'R' then
1370                   Units.Table (Units.Last).Preelab := True;
1371                elsif C = 'U' then
1372                   Units.Table (Units.Last).Pure := True;
1373                elsif C = 'K' then
1374                   Units.Table (Units.Last).Unit_Kind := 'p';
1375                else
1376                   Fatal_Error_Ignore;
1377                end if;
1378
1379                Check_At_End_Of_Field;
1380
1381             --  RC/RT parameters
1382
1383             elsif C = 'R' then
1384                C := Getc;
1385
1386                if C = 'C' then
1387                   Units.Table (Units.Last).RCI := True;
1388                elsif C = 'T' then
1389                   Units.Table (Units.Last).Remote_Types := True;
1390                elsif C = 'A' then
1391                   Units.Table (Units.Last).Has_RACW := True;
1392                else
1393                   Fatal_Error_Ignore;
1394                end if;
1395
1396                Check_At_End_Of_Field;
1397
1398             elsif C = 'S' then
1399                C := Getc;
1400
1401                if C = 'P' then
1402                   Units.Table (Units.Last).Shared_Passive := True;
1403                elsif C = 'U' then
1404                   Units.Table (Units.Last).Unit_Kind := 's';
1405                else
1406                   Fatal_Error_Ignore;
1407                end if;
1408
1409                Check_At_End_Of_Field;
1410
1411             else
1412                C := Getc;
1413                Fatal_Error_Ignore;
1414             end if;
1415          end loop;
1416
1417          Skip_Eol;
1418
1419          --  Check if static elaboration model used
1420
1421          if not Units.Table (Units.Last).Dynamic_Elab
1422            and then not Units.Table (Units.Last).Internal
1423          then
1424             Static_Elaboration_Model_Used := True;
1425          end if;
1426
1427          C := Getc;
1428
1429          --  Scan out With lines for this unit
1430
1431          With_Loop : loop
1432             Check_Unknown_Line;
1433             exit With_Loop when C /= 'W';
1434
1435             if Ignore ('W') then
1436                Skip_Line;
1437
1438             else
1439                Checkc (' ');
1440                Skip_Space;
1441                Withs.Increment_Last;
1442                Withs.Table (Withs.Last).Uname              := Get_Name;
1443                Withs.Table (Withs.Last).Elaborate          := False;
1444                Withs.Table (Withs.Last).Elaborate_All      := False;
1445                Withs.Table (Withs.Last).Elab_All_Desirable := False;
1446                Withs.Table (Withs.Last).Interface          := False;
1447
1448                --  Generic case with no object file available
1449
1450                if At_Eol then
1451                   Withs.Table (Withs.Last).Sfile := No_File;
1452                   Withs.Table (Withs.Last).Afile := No_File;
1453
1454                --  Normal case
1455
1456                else
1457                   Withs.Table (Withs.Last).Sfile := Get_Name (Lower => True);
1458                   Withs.Table (Withs.Last).Afile := Get_Name;
1459
1460                   --  Scan out possible E, EA, and NE parameters
1461
1462                   while not At_Eol loop
1463                      Skip_Space;
1464
1465                      if Nextc = 'E' then
1466                         P := P + 1;
1467
1468                         if At_End_Of_Field then
1469                            Withs.Table (Withs.Last).Elaborate := True;
1470
1471                         elsif Nextc = 'A' then
1472                            P := P + 1;
1473                            Check_At_End_Of_Field;
1474                            Withs.Table (Withs.Last).Elaborate_All := True;
1475
1476                         else
1477                            Checkc ('D');
1478                            Check_At_End_Of_Field;
1479
1480                            --  Store ED indication unless ignore required
1481
1482                            if not Ignore_ED then
1483                               Withs.Table (Withs.Last).Elab_All_Desirable :=
1484                                 True;
1485                            end if;
1486                         end if;
1487                      end if;
1488                   end loop;
1489                end if;
1490
1491                Skip_Eol;
1492             end if;
1493
1494             C := Getc;
1495          end loop With_Loop;
1496
1497          Units.Table (Units.Last).Last_With := Withs.Last;
1498          Units.Table (Units.Last).Last_Arg  := Args.Last;
1499
1500          --  If there are linker options lines present, scan them
1501
1502          Name_Len := 0;
1503
1504          Linker_Options_Loop : loop
1505             Check_Unknown_Line;
1506             exit Linker_Options_Loop when C /= 'L';
1507
1508             if Ignore ('L') then
1509                Skip_Line;
1510
1511             else
1512                Checkc (' ');
1513                Skip_Space;
1514                Checkc ('"');
1515
1516                loop
1517                   C := Getc;
1518
1519                   if C < Character'Val (16#20#)
1520                     or else C > Character'Val (16#7E#)
1521                   then
1522                      Fatal_Error_Ignore;
1523
1524                   elsif C = '{' then
1525                      C := Character'Val (0);
1526
1527                      declare
1528                         V : Natural;
1529
1530                      begin
1531                         V := 0;
1532                         for J in 1 .. 2 loop
1533                            C := Getc;
1534
1535                            if C in '0' .. '9' then
1536                               V := V * 16 +
1537                                      Character'Pos (C) -
1538                                        Character'Pos ('0');
1539
1540                            elsif C in 'A' .. 'F' then
1541                               V := V * 16 +
1542                                      Character'Pos (C) -
1543                                        Character'Pos ('A') +
1544                                          10;
1545
1546                            else
1547                               Fatal_Error_Ignore;
1548                            end if;
1549                         end loop;
1550
1551                         Checkc ('}');
1552                         Add_Char_To_Name_Buffer (Character'Val (V));
1553                      end;
1554
1555                   else
1556                      if C = '"' then
1557                         exit when Nextc /= '"';
1558                         C := Getc;
1559                      end if;
1560
1561                      Add_Char_To_Name_Buffer (C);
1562                   end if;
1563                end loop;
1564
1565                Add_Char_To_Name_Buffer (nul);
1566                Skip_Eol;
1567             end if;
1568
1569             C := Getc;
1570          end loop Linker_Options_Loop;
1571
1572          --  Store the linker options entry if one was found
1573
1574          if Name_Len /= 0 then
1575             Linker_Options.Increment_Last;
1576
1577             Linker_Options.Table (Linker_Options.Last).Name :=
1578               Name_Enter;
1579
1580             Linker_Options.Table (Linker_Options.Last).Unit :=
1581               Units.Last;
1582
1583             Linker_Options.Table (Linker_Options.Last).Internal_File :=
1584               Is_Internal_File_Name (F);
1585
1586             Linker_Options.Table (Linker_Options.Last).Original_Pos :=
1587               Linker_Options.Last;
1588          end if;
1589       end loop U_Loop;
1590
1591       --  End loop through units for one ALI file
1592
1593       ALIs.Table (Id).Last_Unit := Units.Last;
1594       ALIs.Table (Id).Sfile := Units.Table (ALIs.Table (Id).First_Unit).Sfile;
1595
1596       --  Set types of the units (there can be at most 2 of them)
1597
1598       if ALIs.Table (Id).First_Unit /= ALIs.Table (Id).Last_Unit then
1599          Units.Table (ALIs.Table (Id).First_Unit).Utype := Is_Body;
1600          Units.Table (ALIs.Table (Id).Last_Unit).Utype  := Is_Spec;
1601
1602       else
1603          --  Deal with body only and spec only cases, note that the reason we
1604          --  do our own checking of the name (rather than using Is_Body_Name)
1605          --  is that Uname drags in far too much compiler junk!
1606
1607          Get_Name_String (Units.Table (Units.Last).Uname);
1608
1609          if Name_Buffer (Name_Len) = 'b' then
1610             Units.Table (Units.Last).Utype := Is_Body_Only;
1611          else
1612             Units.Table (Units.Last).Utype := Is_Spec_Only;
1613          end if;
1614       end if;
1615
1616       --  Scan out external version references and put in hash table
1617
1618       E_Loop : loop
1619          Check_Unknown_Line;
1620          exit E_Loop when C /= 'E';
1621
1622          if Ignore ('E') then
1623             Skip_Line;
1624
1625          else
1626             Checkc (' ');
1627             Skip_Space;
1628
1629             Name_Len := 0;
1630             Name_Len := 0;
1631             loop
1632                C := Getc;
1633
1634                if C < ' ' then
1635                   Fatal_Error;
1636                end if;
1637
1638                exit when At_End_Of_Field;
1639                Add_Char_To_Name_Buffer (C);
1640             end loop;
1641
1642             Version_Ref.Set (new String'(Name_Buffer (1 .. Name_Len)), True);
1643             Skip_Eol;
1644          end if;
1645
1646          C := Getc;
1647       end loop E_Loop;
1648
1649       --  Scan out source dependency lines for this ALI file
1650
1651       ALIs.Table (Id).First_Sdep := Sdep.Last + 1;
1652
1653       D_Loop : loop
1654          Check_Unknown_Line;
1655          exit D_Loop when C /= 'D';
1656
1657          if Ignore ('D') then
1658             Skip_Line;
1659
1660          else
1661             Checkc (' ');
1662             Skip_Space;
1663             Sdep.Increment_Last;
1664             Sdep.Table (Sdep.Last).Sfile := Get_Name (Lower => True);
1665             Sdep.Table (Sdep.Last).Stamp := Get_Stamp;
1666             Sdep.Table (Sdep.Last).Dummy_Entry :=
1667               (Sdep.Table (Sdep.Last).Stamp = Dummy_Time_Stamp);
1668
1669             --  Acquire checksum value
1670
1671             Skip_Space;
1672
1673             declare
1674                Ctr : Natural;
1675                Chk : Word;
1676
1677             begin
1678                Ctr := 0;
1679                Chk := 0;
1680
1681                loop
1682                   exit when At_Eol or else Ctr = 8;
1683
1684                   if Nextc in '0' .. '9' then
1685                      Chk := Chk * 16 +
1686                               Character'Pos (Nextc) - Character'Pos ('0');
1687
1688                   elsif Nextc in 'a' .. 'f' then
1689                      Chk := Chk * 16 +
1690                               Character'Pos (Nextc) - Character'Pos ('a') + 10;
1691
1692                   else
1693                      exit;
1694                   end if;
1695
1696                   Ctr := Ctr + 1;
1697                   P := P + 1;
1698                end loop;
1699
1700                if Ctr = 8 and then At_End_Of_Field then
1701                   Sdep.Table (Sdep.Last).Checksum := Chk;
1702                else
1703                   Fatal_Error;
1704                end if;
1705             end;
1706
1707             --  Acquire subunit and reference file name entries
1708
1709             Sdep.Table (Sdep.Last).Subunit_Name := No_Name;
1710             Sdep.Table (Sdep.Last).Rfile        :=
1711               Sdep.Table (Sdep.Last).Sfile;
1712             Sdep.Table (Sdep.Last).Start_Line   := 1;
1713
1714             if not At_Eol then
1715                Skip_Space;
1716
1717                --  Here for subunit name
1718
1719                if Nextc not in '0' .. '9' then
1720                   Name_Len := 0;
1721
1722                   while not At_End_Of_Field loop
1723                      Name_Len := Name_Len + 1;
1724                      Name_Buffer (Name_Len) := Getc;
1725                   end loop;
1726
1727                   Sdep.Table (Sdep.Last).Subunit_Name := Name_Enter;
1728                   Skip_Space;
1729                end if;
1730
1731                --  Here for reference file name entry
1732
1733                if Nextc in '0' .. '9' then
1734                   Sdep.Table (Sdep.Last).Start_Line := Get_Nat;
1735                   Checkc (':');
1736
1737                   Name_Len := 0;
1738
1739                   while not At_End_Of_Field loop
1740                      Name_Len := Name_Len + 1;
1741                      Name_Buffer (Name_Len) := Getc;
1742                   end loop;
1743
1744                   Sdep.Table (Sdep.Last).Rfile := Name_Enter;
1745                end if;
1746             end if;
1747
1748             Skip_Eol;
1749          end if;
1750
1751          C := Getc;
1752       end loop D_Loop;
1753
1754       ALIs.Table (Id).Last_Sdep := Sdep.Last;
1755
1756       --  We must at this stage be at an Xref line or the end of file
1757
1758       if C = EOF then
1759          return Id;
1760       end if;
1761
1762       Check_Unknown_Line;
1763
1764       if C /= 'X' then
1765          Fatal_Error;
1766       end if;
1767
1768       --  If we are ignoring Xref sections we are done (we ignore all
1769       --  remaining lines since only xref related lines follow X).
1770
1771       if Ignore ('X') and then not Debug_Flag_X then
1772          return Id;
1773       end if;
1774
1775       --  Loop through Xref sections
1776
1777       X_Loop : loop
1778          Check_Unknown_Line;
1779          exit X_Loop when C /= 'X';
1780
1781          --  Make new entry in section table
1782
1783          Xref_Section.Increment_Last;
1784
1785          Read_Refs_For_One_File : declare
1786             XS : Xref_Section_Record renames
1787                    Xref_Section.Table (Xref_Section.Last);
1788
1789             Current_File_Num : Sdep_Id;
1790             --  Keeps track of the current file number (changed by nn|)
1791
1792          begin
1793             XS.File_Num     := Sdep_Id (Get_Nat + Nat (First_Sdep_Entry) - 1);
1794             XS.File_Name    := Get_Name;
1795             XS.First_Entity := Xref_Entity.Last + 1;
1796
1797             Current_File_Num := XS.File_Num;
1798
1799             Skip_Space;
1800
1801             Skip_Eol;
1802             C := Nextc;
1803
1804             --  Loop through Xref entities
1805
1806             while C /= 'X' and then C /= EOF loop
1807                Xref_Entity.Increment_Last;
1808
1809                Read_Refs_For_One_Entity : declare
1810                   XE : Xref_Entity_Record renames
1811                          Xref_Entity.Table (Xref_Entity.Last);
1812                   N  : Nat;
1813
1814                   procedure Read_Instantiation_Reference;
1815                   --  Acquire instantiation reference. Caller has checked
1816                   --  that current character is '[' and on return the cursor
1817                   --  is skipped past the corresponding closing ']'.
1818
1819                   ----------------------------------
1820                   -- Read_Instantiation_Reference --
1821                   ----------------------------------
1822
1823                   procedure Read_Instantiation_Reference is
1824                      Local_File_Num : Sdep_Id := Current_File_Num;
1825
1826                   begin
1827                      Xref.Increment_Last;
1828
1829                      declare
1830                         XR : Xref_Record renames Xref.Table (Xref.Last);
1831
1832                      begin
1833                         P := P + 1; -- skip [
1834                         N := Get_Nat;
1835
1836                         if Nextc = '|' then
1837                            XR.File_Num :=
1838                              Sdep_Id (N + Nat (First_Sdep_Entry) - 1);
1839                            Local_File_Num := XR.File_Num;
1840                            P := P + 1;
1841                            N := Get_Nat;
1842
1843                         else
1844                            XR.File_Num := Local_File_Num;
1845                         end if;
1846
1847                         XR.Line  := N;
1848                         XR.Rtype := ' ';
1849                         XR.Col   := 0;
1850
1851                         --  Recursive call for next reference
1852
1853                         if Nextc = '[' then
1854                            pragma Warnings (Off); -- kill recursion warning
1855                            Read_Instantiation_Reference;
1856                            pragma Warnings (On);
1857                         end if;
1858
1859                         --  Skip closing bracket after recursive call
1860
1861                         P := P + 1;
1862                      end;
1863                   end Read_Instantiation_Reference;
1864
1865                --  Start of processing for Read_Refs_For_One_Entity
1866
1867                begin
1868                   XE.Line   := Get_Nat;
1869                   XE.Etype  := Getc;
1870                   XE.Col    := Get_Nat;
1871                   XE.Lib    := (Getc = '*');
1872                   XE.Entity := Get_Name;
1873
1874                   Current_File_Num := XS.File_Num;
1875
1876                   --  Renaming reference is present
1877
1878                   if Nextc = '=' then
1879                      P := P + 1;
1880                      XE.Rref_Line := Get_Nat;
1881
1882                      if Getc /= ':' then
1883                         Fatal_Error;
1884                      end if;
1885
1886                      XE.Rref_Col := Get_Nat;
1887
1888                   --  No renaming reference present
1889
1890                   else
1891                      XE.Rref_Line := 0;
1892                      XE.Rref_Col  := 0;
1893                   end if;
1894
1895                   Skip_Space;
1896
1897                   --  See if type reference present
1898
1899                   case Nextc is
1900                      when '<'    => XE.Tref := Tref_Derived;
1901                      when '('    => XE.Tref := Tref_Access;
1902                      when '{'    => XE.Tref := Tref_Type;
1903                      when others => XE.Tref := Tref_None;
1904                   end case;
1905
1906                   --  Case of typeref field present
1907
1908                   if XE.Tref /= Tref_None then
1909                      P := P + 1; -- skip opening bracket
1910
1911                      if Nextc in 'a' .. 'z' then
1912                         XE.Tref_File_Num        := No_Sdep_Id;
1913                         XE.Tref_Line            := 0;
1914                         XE.Tref_Type            := ' ';
1915                         XE.Tref_Col             := 0;
1916                         XE.Tref_Standard_Entity :=
1917                           Get_Name (Ignore_Spaces => True);
1918
1919                      else
1920                         N := Get_Nat;
1921
1922                         if Nextc = '|' then
1923                            XE.Tref_File_Num :=
1924                              Sdep_Id (N + Nat (First_Sdep_Entry) - 1);
1925                            P := P + 1;
1926                            N := Get_Nat;
1927
1928                         else
1929                            XE.Tref_File_Num := Current_File_Num;
1930                         end if;
1931
1932                         XE.Tref_Line            := N;
1933                         XE.Tref_Type            := Getc;
1934                         XE.Tref_Col             := Get_Nat;
1935                         XE.Tref_Standard_Entity := No_Name;
1936                      end if;
1937
1938                      --  ??? Temporary workaround for nested generics case:
1939                      --     4i4 Directories{1|4I9[4|6[3|3]]}
1940                      --  See C918-002
1941
1942                      declare
1943                         Nested_Brackets : Natural := 0;
1944
1945                      begin
1946                         loop
1947                            case Nextc is
1948                               when '['   =>
1949                                  Nested_Brackets := Nested_Brackets + 1;
1950                               when ']' =>
1951                                  Nested_Brackets := Nested_Brackets - 1;
1952                               when others =>
1953                                  if Nested_Brackets = 0 then
1954                                     exit;
1955                                  end if;
1956                            end case;
1957
1958                            Skipc;
1959                         end loop;
1960                      end;
1961
1962                      P := P + 1; -- skip closing bracket
1963                      Skip_Space;
1964
1965                   --  No typeref entry present
1966
1967                   else
1968                      XE.Tref_File_Num        := No_Sdep_Id;
1969                      XE.Tref_Line            := 0;
1970                      XE.Tref_Type            := ' ';
1971                      XE.Tref_Col             := 0;
1972                      XE.Tref_Standard_Entity := No_Name;
1973                   end if;
1974
1975                   XE.First_Xref := Xref.Last + 1;
1976
1977                   --  Loop through cross-references for this entity
1978
1979                   loop
1980                      Skip_Space;
1981
1982                      if At_Eol then
1983                         Skip_Eol;
1984                         exit when Nextc /= '.';
1985                         P := P + 1;
1986                      end if;
1987
1988                      Xref.Increment_Last;
1989
1990                      declare
1991                         XR : Xref_Record renames Xref.Table (Xref.Last);
1992
1993                      begin
1994                         N := Get_Nat;
1995
1996                         if Nextc = '|' then
1997                            XR.File_Num :=
1998                              Sdep_Id (N + Nat (First_Sdep_Entry) - 1);
1999                            Current_File_Num := XR.File_Num;
2000                            P := P + 1;
2001                            N := Get_Nat;
2002                         else
2003                            XR.File_Num := Current_File_Num;
2004                         end if;
2005
2006                         XR.Line  := N;
2007                         XR.Rtype := Getc;
2008
2009                         --  Imported entities reference as in:
2010                         --    494b<c,__gnat_copy_attribs>25
2011                         --  ??? Simply skipped for now
2012
2013                         if Nextc = '<' then
2014                            while Getc /= '>' loop
2015                               null;
2016                            end loop;
2017                         end if;
2018
2019                         XR.Col   := Get_Nat;
2020
2021                         if Nextc = '[' then
2022                            Read_Instantiation_Reference;
2023                         end if;
2024                      end;
2025                   end loop;
2026
2027                   --  Record last cross-reference
2028
2029                   XE.Last_Xref := Xref.Last;
2030                   C := Nextc;
2031                end Read_Refs_For_One_Entity;
2032             end loop;
2033
2034             --  Record last entity
2035
2036             XS.Last_Entity := Xref_Entity.Last;
2037
2038          end Read_Refs_For_One_File;
2039
2040          C := Getc;
2041       end loop X_Loop;
2042
2043       --  Here after dealing with xref sections
2044
2045       if C /= EOF and then C /= 'X' then
2046          Fatal_Error;
2047       end if;
2048
2049       return Id;
2050
2051    exception
2052       when Bad_ALI_Format =>
2053          return No_ALI_Id;
2054
2055    end Scan_ALI;
2056
2057    ---------
2058    -- SEq --
2059    ---------
2060
2061    function SEq (F1, F2 : String_Ptr) return Boolean is
2062    begin
2063       return F1.all = F2.all;
2064    end SEq;
2065
2066    -----------
2067    -- SHash --
2068    -----------
2069
2070    function SHash (S : String_Ptr) return Vindex is
2071       H : Word;
2072
2073    begin
2074       H := 0;
2075       for J in S.all'Range loop
2076          H := H * 2 + Character'Pos (S (J));
2077       end loop;
2078
2079       return Vindex (Vindex'First + Vindex (H mod Vindex'Range_Length));
2080    end SHash;
2081
2082 end ALI;