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