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-2023, Free Software Foundation, Inc.         --
  10 --                                                                          --
  11 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  12 -- terms of the  GNU General Public License as published  by the Free Soft- --
  13 -- ware  Foundation;  either version 3,  or (at your option) any later ver- --
  14 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  15 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  16 -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  17 -- for  more details.  You should have  received  a copy of the GNU General --
  18 -- Public License  distributed with GNAT; see file COPYING3.  If not, go to --
  19 -- http://www.gnu.org/licenses for a complete copy of the license.          --
  20 --                                                                          --
  21 -- GNAT was originally developed  by the GNAT team at  New York University. --
  22 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  23 --                                                                          --
  24 ------------------------------------------------------------------------------
  25
  26 with Butil;  use Butil;
  27 with Debug;  use Debug;
  28 with Fname;  use Fname;
  29 with Opt;    use Opt;
  30 with Osint;  use Osint;
  31 with Output; use Output;
  32 with Snames; use Snames;
  33
  34 with GNAT;                 use GNAT;
  35 with GNAT.Dynamic_HTables; use GNAT.Dynamic_HTables;
  36 with System.String_Hash;
  37
  38 package body ALI is
  39
  40    use ASCII;
  41    --  Make control characters visible
  42
  43    -----------
  44    -- Types --
  45    -----------
  46
  47    --  The following type represents an invocation construct
  48
  49    type Invocation_Construct_Record is record
  50       Body_Placement : Declaration_Placement_Kind := No_Declaration_Placement;
  51       --  The location of the invocation construct's body with respect to the
  52       --  unit where it is declared.
  53
  54       Kind : Invocation_Construct_Kind := Regular_Construct;
  55       --  The nature of the invocation construct
  56
  57       Signature : Invocation_Signature_Id := No_Invocation_Signature;
  58       --  The invocation signature that uniquely identifies the invocation
  59       --  construct in the ALI space.
  60
  61       Spec_Placement : Declaration_Placement_Kind := No_Declaration_Placement;
  62       --  The location of the invocation construct's spec with respect to the
  63       --  unit where it is declared.
  64    end record;
  65
  66    --  The following type represents an invocation relation. It associates an
  67    --  invoker that activates/calls/instantiates with a target.
  68
  69    type Invocation_Relation_Record is record
  70       Extra : Name_Id := No_Name;
  71       --  The name of an additional entity used in error diagnostics
  72
  73       Invoker : Invocation_Signature_Id := No_Invocation_Signature;
  74       --  The invocation signature that uniquely identifies the invoker within
  75       --  the ALI space.
  76
  77       Kind : Invocation_Kind := No_Invocation;
  78       --  The nature of the invocation
  79
  80       Target : Invocation_Signature_Id := No_Invocation_Signature;
  81       --  The invocation signature that uniquely identifies the target within
  82       --  the ALI space.
  83    end record;
  84
  85    --  The following type represents an invocation signature. Its purpose is
  86    --  to uniquely identify an invocation construct within the ALI space. The
  87    --  signature comprises several pieces, some of which are used in error
  88    --  diagnostics by the binder. Identification issues are resolved as
  89    --  follows:
  90    --
  91    --    * The Column, Line, and Locations attributes together differentiate
  92    --      between homonyms. In most cases, the Column and Line are sufficient
  93    --      except when generic instantiations are involved. Together, the three
  94    --      attributes offer a sequence of column-line pairs that eventually
  95    --      reflect the location within the generic template.
  96    --
  97    --    * The Name attribute differentiates between invocation constructs at
  98    --      the scope level. Since it is illegal for two entities with the same
  99    --      name to coexist in the same scope, the Name attribute is sufficient
 100    --      to distinguish them. Overloaded entities are already handled by the
 101    --      Column, Line, and Locations attributes.
 102    --
 103    --    * The Scope attribute differentiates between invocation constructs at
 104    --      various levels of nesting.
 105
 106    type Invocation_Signature_Record is record
 107       Column : Nat := 0;
 108       --  The column number where the invocation construct is declared
 109
 110       Line : Nat := 0;
 111       --  The line number where the invocation construct is declared
 112
 113       Locations : Name_Id := No_Name;
 114       --  Sequence of column and line numbers within nested instantiations
 115
 116       Name : Name_Id := No_Name;
 117       --  The name of the invocation construct
 118
 119       Scope : Name_Id := No_Name;
 120       --  The qualified name of the scope where the invocation construct is
 121       --  declared.
 122    end record;
 123
 124    ---------------------
 125    -- Data structures --
 126    ---------------------
 127
 128    package Invocation_Constructs is new Table.Table
 129      (Table_Index_Type     => Invocation_Construct_Id,
 130       Table_Component_Type => Invocation_Construct_Record,
 131       Table_Low_Bound      => First_Invocation_Construct,
 132       Table_Initial        => 2500,
 133       Table_Increment      => 200,
 134       Table_Name           => "Invocation_Constructs");
 135
 136    package Invocation_Relations is new Table.Table
 137      (Table_Index_Type     => Invocation_Relation_Id,
 138       Table_Component_Type => Invocation_Relation_Record,
 139       Table_Low_Bound      => First_Invocation_Relation,
 140       Table_Initial        => 2500,
 141       Table_Increment      => 200,
 142       Table_Name           => "Invocation_Relation");
 143
 144    package Invocation_Signatures is new Table.Table
 145      (Table_Index_Type     => Invocation_Signature_Id,
 146       Table_Component_Type => Invocation_Signature_Record,
 147       Table_Low_Bound      => First_Invocation_Signature,
 148       Table_Initial        => 2500,
 149       Table_Increment      => 200,
 150       Table_Name           => "Invocation_Signatures");
 151
 152    procedure Destroy (IS_Id : in out Invocation_Signature_Id);
 153    --  Destroy an invocation signature with id IS_Id
 154
 155    function Hash
 156      (IS_Rec : Invocation_Signature_Record) return Bucket_Range_Type;
 157    --  Obtain the hash of key IS_Rec
 158
 159    package Sig_Map is new Dynamic_Hash_Tables
 160      (Key_Type              => Invocation_Signature_Record,
 161       Value_Type            => Invocation_Signature_Id,
 162       No_Value              => No_Invocation_Signature,
 163       Expansion_Threshold   => 1.5,
 164       Expansion_Factor      => 2,
 165       Compression_Threshold => 0.3,
 166       Compression_Factor    => 2,
 167       "="                   => "=",
 168       Destroy_Value         => Destroy,
 169       Hash                  => Hash);
 170
 171    --  The following map relates invocation signature records to invocation
 172    --  signature ids.
 173
 174    Sig_To_Sig_Map : constant Sig_Map.Dynamic_Hash_Table :=
 175                       Sig_Map.Create (500);
 176
 177    --  The folowing table maps declaration placement kinds to character codes
 178    --  for invocation construct encoding in ALI files.
 179
 180    Declaration_Placement_Codes :
 181      constant array (Declaration_Placement_Kind) of Character :=
 182        (In_Body                  => 'b',
 183         In_Spec                  => 's',
 184         No_Declaration_Placement => 'Z');
 185
 186    Compile_Time_Invocation_Graph_Encoding : Invocation_Graph_Encoding_Kind :=
 187                                               No_Encoding;
 188    --  The invocation-graph encoding format as specified at compile time. Do
 189    --  not manipulate this value directly.
 190
 191    --  The following table maps invocation kinds to character codes for
 192    --  invocation relation encoding in ALI files.
 193
 194    Invocation_Codes :
 195      constant array (Invocation_Kind) of Character :=
 196        (Accept_Alternative                     => 'a',
 197         Access_Taken                           => 'b',
 198         Call                                   => 'c',
 199         Controlled_Adjustment                  => 'd',
 200         Controlled_Finalization                => 'e',
 201         Controlled_Initialization              => 'f',
 202         Default_Initial_Condition_Verification => 'g',
 203         Initial_Condition_Verification         => 'h',
 204         Instantiation                          => 'i',
 205         Internal_Controlled_Adjustment         => 'j',
 206         Internal_Controlled_Finalization       => 'k',
 207         Internal_Controlled_Initialization     => 'l',
 208         Invariant_Verification                 => 'm',
 209         Postcondition_Verification             => 'n',
 210         Protected_Entry_Call                   => 'o',
 211         Protected_Subprogram_Call              => 'p',
 212         Task_Activation                        => 'q',
 213         Task_Entry_Call                        => 'r',
 214         Type_Initialization                    => 's',
 215         No_Invocation                          => 'Z');
 216
 217    --  The following table maps invocation construct kinds to character codes
 218    --  for invocation construct encoding in ALI files.
 219
 220    Invocation_Construct_Codes :
 221      constant array (Invocation_Construct_Kind) of Character :=
 222        (Elaborate_Body_Procedure => 'b',
 223         Elaborate_Spec_Procedure => 's',
 224         Regular_Construct        => 'Z');
 225
 226    --  The following table maps invocation-graph encoding kinds to character
 227    --  codes for invocation-graph encoding in ALI files.
 228
 229    Invocation_Graph_Encoding_Codes :
 230      constant array (Invocation_Graph_Encoding_Kind) of Character :=
 231        (Full_Path_Encoding => 'f',
 232         Endpoints_Encoding => 'e',
 233         No_Encoding        => 'Z');
 234
 235    --  The following table maps invocation-graph line kinds to character codes
 236    --  used in ALI files.
 237
 238    Invocation_Graph_Line_Codes :
 239      constant array (Invocation_Graph_Line_Kind) of Character :=
 240        (Invocation_Construct_Line        => 'c',
 241         Invocation_Graph_Attributes_Line => 'a',
 242         Invocation_Relation_Line         => 'r');
 243
 244    --  The following variable records which characters currently are used as
 245    --  line type markers in the ALI file. This is used in Scan_ALI to detect
 246    --  (or skip) invalid lines.
 247
 248    Known_ALI_Lines : constant array (Character range 'A' .. 'Z') of Boolean :=
 249      ('A' | --  argument
 250       'C' | --  SCO information
 251       'D' | --  dependency
 252       'E' | --  external
 253       'G' | --  invocation graph
 254       'I' | --  interrupt
 255       'K' | --  CUDA kernels
 256       'L' | --  linker option
 257       'M' | --  main program
 258       'N' | --  notes
 259       'P' | --  program
 260       'R' | --  restriction
 261       'S' | --  specific dispatching
 262       'T' | --  task stack information
 263       'U' | --  unit
 264       'V' | --  version
 265       'W' | --  with
 266       'X' | --  xref
 267       'Y' | --  limited_with
 268       'Z'   --  implicit with from instantiation
 269           => True,
 270
 271       --  Still available:
 272
 273       'B' | 'F' | 'H' | 'J' | 'O' | 'Q' => False);
 274
 275    ------------------------------
 276    -- Add_Invocation_Construct --
 277    ------------------------------
 278
 279    procedure Add_Invocation_Construct
 280      (Body_Placement : Declaration_Placement_Kind;
 281       Kind           : Invocation_Construct_Kind;
 282       Signature      : Invocation_Signature_Id;
 283       Spec_Placement : Declaration_Placement_Kind;
 284       Update_Units   : Boolean := True)
 285    is
 286    begin
 287       pragma Assert (Present (Signature));
 288
 289       --  Create a invocation construct from the scanned attributes
 290
 291       Invocation_Constructs.Append
 292         ((Body_Placement => Body_Placement,
 293           Kind           => Kind,
 294           Signature      => Signature,
 295           Spec_Placement => Spec_Placement));
 296
 297       --  Update the invocation construct counter of the current unit only when
 298       --  requested by the caller.
 299
 300       if Update_Units then
 301          declare
 302             Curr_Unit : Unit_Record renames Units.Table (Units.Last);
 303
 304          begin
 305             Curr_Unit.Last_Invocation_Construct := Invocation_Constructs.Last;
 306          end;
 307       end if;
 308    end Add_Invocation_Construct;
 309
 310    -----------------------------
 311    -- Add_Invocation_Relation --
 312    -----------------------------
 313
 314    procedure Add_Invocation_Relation
 315      (Extra        : Name_Id;
 316       Invoker      : Invocation_Signature_Id;
 317       Kind         : Invocation_Kind;
 318       Target       : Invocation_Signature_Id;
 319       Update_Units : Boolean := True)
 320    is
 321    begin
 322       pragma Assert (Present (Invoker));
 323       pragma Assert (Kind /= No_Invocation);
 324       pragma Assert (Present (Target));
 325
 326       --  Create an invocation relation from the scanned attributes
 327
 328       Invocation_Relations.Append
 329         ((Extra   => Extra,
 330           Invoker => Invoker,
 331           Kind    => Kind,
 332           Target  => Target));
 333
 334       --  Update the invocation relation counter of the current unit only when
 335       --  requested by the caller.
 336
 337       if Update_Units then
 338          declare
 339             Curr_Unit : Unit_Record renames Units.Table (Units.Last);
 340
 341          begin
 342             Curr_Unit.Last_Invocation_Relation := Invocation_Relations.Last;
 343          end;
 344       end if;
 345    end Add_Invocation_Relation;
 346
 347    --------------------
 348    -- Body_Placement --
 349    --------------------
 350
 351    function Body_Placement
 352      (IC_Id : Invocation_Construct_Id) return Declaration_Placement_Kind
 353    is
 354    begin
 355       pragma Assert (Present (IC_Id));
 356       return Invocation_Constructs.Table (IC_Id).Body_Placement;
 357    end Body_Placement;
 358
 359    ----------------------------------------
 360    -- Code_To_Declaration_Placement_Kind --
 361    ----------------------------------------
 362
 363    function Code_To_Declaration_Placement_Kind
 364      (Code : Character) return Declaration_Placement_Kind
 365    is
 366    begin
 367       --  Determine which placement kind corresponds to the character code by
 368       --  traversing the contents of the mapping table.
 369
 370       for Kind in Declaration_Placement_Kind loop
 371          if Declaration_Placement_Codes (Kind) = Code then
 372             return Kind;
 373          end if;
 374       end loop;
 375
 376       raise Program_Error;
 377    end Code_To_Declaration_Placement_Kind;
 378
 379    ---------------------------------------
 380    -- Code_To_Invocation_Construct_Kind --
 381    ---------------------------------------
 382
 383    function Code_To_Invocation_Construct_Kind
 384      (Code : Character) return Invocation_Construct_Kind
 385    is
 386    begin
 387       --  Determine which invocation construct kind matches the character code
 388       --  by traversing the contents of the mapping table.
 389
 390       for Kind in Invocation_Construct_Kind loop
 391          if Invocation_Construct_Codes (Kind) = Code then
 392             return Kind;
 393          end if;
 394       end loop;
 395
 396       raise Program_Error;
 397    end Code_To_Invocation_Construct_Kind;
 398
 399    --------------------------------------------
 400    -- Code_To_Invocation_Graph_Encoding_Kind --
 401    --------------------------------------------
 402
 403    function Code_To_Invocation_Graph_Encoding_Kind
 404      (Code : Character) return Invocation_Graph_Encoding_Kind
 405    is
 406    begin
 407       --  Determine which invocation-graph encoding kind matches the character
 408       --  code by traversing the contents of the mapping table.
 409
 410       for Kind in Invocation_Graph_Encoding_Kind loop
 411          if Invocation_Graph_Encoding_Codes (Kind) = Code then
 412             return Kind;
 413          end if;
 414       end loop;
 415
 416       raise Program_Error;
 417    end Code_To_Invocation_Graph_Encoding_Kind;
 418
 419    -----------------------------
 420    -- Code_To_Invocation_Kind --
 421    -----------------------------
 422
 423    function Code_To_Invocation_Kind
 424      (Code : Character) return Invocation_Kind
 425    is
 426    begin
 427       --  Determine which invocation kind corresponds to the character code by
 428       --  traversing the contents of the mapping table.
 429
 430       for Kind in Invocation_Kind loop
 431          if Invocation_Codes (Kind) = Code then
 432             return Kind;
 433          end if;
 434       end loop;
 435
 436       raise Program_Error;
 437    end Code_To_Invocation_Kind;
 438
 439    ----------------------------------------
 440    -- Code_To_Invocation_Graph_Line_Kind --
 441    ----------------------------------------
 442
 443    function Code_To_Invocation_Graph_Line_Kind
 444      (Code : Character) return Invocation_Graph_Line_Kind
 445    is
 446    begin
 447       --  Determine which invocation-graph line kind matches the character
 448       --  code by traversing the contents of the mapping table.
 449
 450       for Kind in Invocation_Graph_Line_Kind loop
 451          if Invocation_Graph_Line_Codes (Kind) = Code then
 452             return Kind;
 453          end if;
 454       end loop;
 455
 456       raise Program_Error;
 457    end Code_To_Invocation_Graph_Line_Kind;
 458
 459    ------------
 460    -- Column --
 461    ------------
 462
 463    function Column (IS_Id : Invocation_Signature_Id) return Nat is
 464    begin
 465       pragma Assert (Present (IS_Id));
 466       return Invocation_Signatures.Table (IS_Id).Column;
 467    end Column;
 468
 469    ----------------------------------------
 470    -- Declaration_Placement_Kind_To_Code --
 471    ----------------------------------------
 472
 473    function Declaration_Placement_Kind_To_Code
 474      (Kind : Declaration_Placement_Kind) return Character
 475    is
 476    begin
 477       return Declaration_Placement_Codes (Kind);
 478    end Declaration_Placement_Kind_To_Code;
 479
 480    -------------
 481    -- Destroy --
 482    -------------
 483
 484    procedure Destroy (IS_Id : in out Invocation_Signature_Id) is
 485       pragma Unreferenced (IS_Id);
 486    begin
 487       null;
 488    end Destroy;
 489
 490    -----------
 491    -- Extra --
 492    -----------
 493
 494    function Extra (IR_Id : Invocation_Relation_Id) return Name_Id is
 495    begin
 496       pragma Assert (Present (IR_Id));
 497       return Invocation_Relations.Table (IR_Id).Extra;
 498    end Extra;
 499
 500    -----------------------------------
 501    -- For_Each_Invocation_Construct --
 502    -----------------------------------
 503
 504    procedure For_Each_Invocation_Construct
 505      (Processor : Invocation_Construct_Processor_Ptr)
 506    is
 507    begin
 508       pragma Assert (Processor /= null);
 509
 510       for IC_Id in Invocation_Constructs.First ..
 511                    Invocation_Constructs.Last
 512       loop
 513          Processor.all (IC_Id);
 514       end loop;
 515    end For_Each_Invocation_Construct;
 516
 517    -----------------------------------
 518    -- For_Each_Invocation_Construct --
 519    -----------------------------------
 520
 521    procedure For_Each_Invocation_Construct
 522      (U_Id      : Unit_Id;
 523       Processor : Invocation_Construct_Processor_Ptr)
 524    is
 525       pragma Assert (Present (U_Id));
 526       pragma Assert (Processor /= null);
 527
 528       U_Rec : Unit_Record renames Units.Table (U_Id);
 529
 530    begin
 531       for IC_Id in U_Rec.First_Invocation_Construct ..
 532                    U_Rec.Last_Invocation_Construct
 533       loop
 534          Processor.all (IC_Id);
 535       end loop;
 536    end For_Each_Invocation_Construct;
 537
 538    ----------------------------------
 539    -- For_Each_Invocation_Relation --
 540    ----------------------------------
 541
 542    procedure For_Each_Invocation_Relation
 543      (Processor : Invocation_Relation_Processor_Ptr)
 544    is
 545    begin
 546       pragma Assert (Processor /= null);
 547
 548       for IR_Id in Invocation_Relations.First ..
 549                    Invocation_Relations.Last
 550       loop
 551          Processor.all (IR_Id);
 552       end loop;
 553    end For_Each_Invocation_Relation;
 554
 555    ----------------------------------
 556    -- For_Each_Invocation_Relation --
 557    ----------------------------------
 558
 559    procedure For_Each_Invocation_Relation
 560      (U_Id      : Unit_Id;
 561       Processor : Invocation_Relation_Processor_Ptr)
 562    is
 563       pragma Assert (Present (U_Id));
 564       pragma Assert (Processor /= null);
 565
 566       U_Rec : Unit_Record renames Units.Table (U_Id);
 567
 568    begin
 569       for IR_Id in U_Rec.First_Invocation_Relation ..
 570                    U_Rec.Last_Invocation_Relation
 571       loop
 572          Processor.all (IR_Id);
 573       end loop;
 574    end For_Each_Invocation_Relation;
 575
 576    ----------
 577    -- Hash --
 578    ----------
 579
 580    function Hash
 581      (IS_Rec : Invocation_Signature_Record) return Bucket_Range_Type
 582    is
 583       function String_Hash is new System.String_Hash.Hash
 584         (Char_Type => Character,
 585          Key_Type  => String,
 586          Hash_Type => Bucket_Range_Type);
 587
 588       Buffer : Bounded_String (2052);
 589
 590    begin
 591       --  The hash is obtained from a signature based on the scope, name, line
 592       --  number, column number, and locations, in the following format:
 593       --
 594       --         scope__name__line_column__locations
 595
 596       Append (Buffer, IS_Rec.Scope);
 597       Append (Buffer, "__");
 598       Append (Buffer, IS_Rec.Name);
 599       Append (Buffer, "__");
 600       Append (Buffer, IS_Rec.Line);
 601       Append (Buffer, '_');
 602       Append (Buffer, IS_Rec.Column);
 603
 604       if IS_Rec.Locations /= No_Name then
 605          Append (Buffer, "__");
 606          Append (Buffer, IS_Rec.Locations);
 607       end if;
 608
 609       return String_Hash (To_String (Buffer));
 610    end Hash;
 611
 612    --------------------
 613    -- Initialize_ALI --
 614    --------------------
 615
 616    procedure Initialize_ALI is
 617    begin
 618       --  When (re)initializing ALI data structures the ALI user expects to
 619       --  get a fresh set of data structures. Thus we first need to erase the
 620       --  marks put in the name table by the previous set of ALI routine calls.
 621       --  These two loops are empty and harmless the first time in.
 622
 623       for J in ALIs.First .. ALIs.Last loop
 624          Set_Name_Table_Int (ALIs.Table (J).Afile, 0);
 625       end loop;
 626
 627       for J in Units.First .. Units.Last loop
 628          Set_Name_Table_Int (Units.Table (J).Uname, 0);
 629       end loop;
 630
 631       --  Free argument table strings
 632
 633       for J in Args.First .. Args.Last loop
 634          Free (Args.Table (J));
 635       end loop;
 636
 637       --  Initialize all tables
 638
 639       ALIs.Init;
 640       Invocation_Constructs.Init;
 641       Invocation_Relations.Init;
 642       Invocation_Signatures.Init;
 643       Linker_Options.Init;
 644       No_Deps.Init;
 645       Notes.Init;
 646       Sdep.Init;
 647       Units.Init;
 648       Version_Ref.Reset;
 649       Withs.Init;
 650       Xref_Entity.Init;
 651       Xref.Init;
 652       Xref_Section.Init;
 653
 654       --  Add dummy zeroth item in Linker_Options and Notes for sort calls
 655
 656       Linker_Options.Increment_Last;
 657       Notes.Increment_Last;
 658
 659       --  Initialize global variables recording cumulative options in all
 660       --  ALI files that are read for a given processing run in gnatbind.
 661
 662       Dynamic_Elaboration_Checks_Specified   := False;
 663       Locking_Policy_Specified               := ' ';
 664       No_Normalize_Scalars_Specified         := False;
 665       No_Object_Specified                    := False;
 666       No_Component_Reordering_Specified      := False;
 667       GNATprove_Mode_Specified               := False;
 668       Normalize_Scalars_Specified            := False;
 669       Partition_Elaboration_Policy_Specified := ' ';
 670       Queuing_Policy_Specified               := ' ';
 671       SSO_Default_Specified                  := False;
 672       Task_Dispatching_Policy_Specified      := ' ';
 673       Unreserve_All_Interrupts_Specified     := False;
 674       Zero_Cost_Exceptions_Specified         := False;
 675    end Initialize_ALI;
 676
 677    ---------------------------------------
 678    -- Invocation_Construct_Kind_To_Code --
 679    ---------------------------------------
 680
 681    function Invocation_Construct_Kind_To_Code
 682      (Kind : Invocation_Construct_Kind) return Character
 683    is
 684    begin
 685       return Invocation_Construct_Codes (Kind);
 686    end Invocation_Construct_Kind_To_Code;
 687
 688    -------------------------------
 689    -- Invocation_Graph_Encoding --
 690    -------------------------------
 691
 692    function Invocation_Graph_Encoding return Invocation_Graph_Encoding_Kind is
 693    begin
 694       return Compile_Time_Invocation_Graph_Encoding;
 695    end Invocation_Graph_Encoding;
 696
 697    --------------------------------------------
 698    -- Invocation_Graph_Encoding_Kind_To_Code --
 699    --------------------------------------------
 700
 701    function Invocation_Graph_Encoding_Kind_To_Code
 702      (Kind : Invocation_Graph_Encoding_Kind) return Character
 703    is
 704    begin
 705       return Invocation_Graph_Encoding_Codes (Kind);
 706    end Invocation_Graph_Encoding_Kind_To_Code;
 707
 708    ----------------------------------------
 709    -- Invocation_Graph_Line_Kind_To_Code --
 710    ----------------------------------------
 711
 712    function Invocation_Graph_Line_Kind_To_Code
 713      (Kind : Invocation_Graph_Line_Kind) return Character
 714    is
 715    begin
 716       return Invocation_Graph_Line_Codes (Kind);
 717    end Invocation_Graph_Line_Kind_To_Code;
 718
 719    -----------------------------
 720    -- Invocation_Kind_To_Code --
 721    -----------------------------
 722
 723    function Invocation_Kind_To_Code
 724      (Kind : Invocation_Kind) return Character
 725    is
 726    begin
 727       return Invocation_Codes (Kind);
 728    end Invocation_Kind_To_Code;
 729
 730    -----------------------------
 731    -- Invocation_Signature_Of --
 732    -----------------------------
 733
 734    function Invocation_Signature_Of
 735      (Column    : Nat;
 736       Line      : Nat;
 737       Locations : Name_Id;
 738       Name      : Name_Id;
 739       Scope     : Name_Id) return Invocation_Signature_Id
 740    is
 741       IS_Rec : constant Invocation_Signature_Record :=
 742                  (Column    => Column,
 743                   Line      => Line,
 744                   Locations => Locations,
 745                   Name      => Name,
 746                   Scope     => Scope);
 747       IS_Id  : Invocation_Signature_Id;
 748
 749    begin
 750       IS_Id := Sig_Map.Get (Sig_To_Sig_Map, IS_Rec);
 751
 752       --  The invocation signature lacks an id. This indicates that it
 753       --  is encountered for the first time during the construction of
 754       --  the graph.
 755
 756       if not Present (IS_Id) then
 757          Invocation_Signatures.Append (IS_Rec);
 758          IS_Id := Invocation_Signatures.Last;
 759
 760          --  Map the invocation signature record to its corresponding id
 761
 762          Sig_Map.Put (Sig_To_Sig_Map, IS_Rec, IS_Id);
 763       end if;
 764
 765       return IS_Id;
 766    end Invocation_Signature_Of;
 767
 768    -------------
 769    -- Invoker --
 770    -------------
 771
 772    function Invoker
 773      (IR_Id : Invocation_Relation_Id) return Invocation_Signature_Id
 774    is
 775    begin
 776       pragma Assert (Present (IR_Id));
 777       return Invocation_Relations.Table (IR_Id).Invoker;
 778    end Invoker;
 779
 780    ----------
 781    -- Kind --
 782    ----------
 783
 784    function Kind
 785      (IC_Id : Invocation_Construct_Id) return Invocation_Construct_Kind
 786    is
 787    begin
 788       pragma Assert (Present (IC_Id));
 789       return Invocation_Constructs.Table (IC_Id).Kind;
 790    end Kind;
 791
 792    ----------
 793    -- Kind --
 794    ----------
 795
 796    function Kind (IR_Id : Invocation_Relation_Id) return Invocation_Kind is
 797    begin
 798       pragma Assert (Present (IR_Id));
 799       return Invocation_Relations.Table (IR_Id).Kind;
 800    end Kind;
 801
 802    ----------
 803    -- Line --
 804    ----------
 805
 806    function Line (IS_Id : Invocation_Signature_Id) return Nat is
 807    begin
 808       pragma Assert (Present (IS_Id));
 809       return Invocation_Signatures.Table (IS_Id).Line;
 810    end Line;
 811
 812    ---------------
 813    -- Locations --
 814    ---------------
 815
 816    function Locations (IS_Id : Invocation_Signature_Id) return Name_Id is
 817    begin
 818       pragma Assert (Present (IS_Id));
 819       return Invocation_Signatures.Table (IS_Id).Locations;
 820    end Locations;
 821
 822    ----------
 823    -- Name --
 824    ----------
 825
 826    function Name (IS_Id : Invocation_Signature_Id) return Name_Id is
 827    begin
 828       pragma Assert (Present (IS_Id));
 829       return Invocation_Signatures.Table (IS_Id).Name;
 830    end Name;
 831
 832    -------------
 833    -- Present --
 834    -------------
 835
 836    function Present (IC_Id : Invocation_Construct_Id) return Boolean is
 837    begin
 838       return IC_Id /= No_Invocation_Construct;
 839    end Present;
 840
 841    -------------
 842    -- Present --
 843    -------------
 844
 845    function Present (IR_Id : Invocation_Relation_Id) return Boolean is
 846    begin
 847       return IR_Id /= No_Invocation_Relation;
 848    end Present;
 849
 850    -------------
 851    -- Present --
 852    -------------
 853
 854    function Present (IS_Id : Invocation_Signature_Id) return Boolean is
 855    begin
 856       return IS_Id /= No_Invocation_Signature;
 857    end Present;
 858
 859    -------------
 860    -- Present --
 861    -------------
 862
 863    function Present (Dep : Sdep_Id) return Boolean is
 864    begin
 865       return Dep /= No_Sdep_Id;
 866    end Present;
 867
 868    -------------
 869    -- Present --
 870    -------------
 871
 872    function Present (U_Id : Unit_Id) return Boolean is
 873    begin
 874       return U_Id /= No_Unit_Id;
 875    end Present;
 876
 877    -------------
 878    -- Present --
 879    -------------
 880
 881    function Present (W_Id : With_Id) return Boolean is
 882    begin
 883       return W_Id /= No_With_Id;
 884    end Present;
 885
 886    --------------
 887    -- Scan_ALI --
 888    --------------
 889
 890    function Scan_ALI
 891      (F                : File_Name_Type;
 892       T                : Text_Buffer_Ptr;
 893       Err              : Boolean;
 894       Ignore_Lines     : String  := "X";
 895       Ignore_Errors    : Boolean := False;
 896       Directly_Scanned : Boolean := False) return ALI_Id
 897    is
 898       P         : Text_Ptr            := T'First;
 899       Line      : Logical_Line_Number := 1;
 900       Id        : ALI_Id;
 901       C         : Character;
 902       NS_Found  : Boolean;
 903       First_Arg : Arg_Id;
 904
 905       Ignore : array (Character range 'A' .. 'Z') of Boolean :=
 906                  (others => False);
 907       --  Ignore (X) is set to True if lines starting with X are to
 908       --  be ignored by Scan_ALI and skipped, and False if the lines
 909       --  are to be read and processed.
 910
 911       Bad_ALI_Format : exception;
 912       --  Exception raised by Fatal_Error if Err is True
 913
 914       function At_Eol return Boolean;
 915       --  Test if at end of line
 916
 917       function At_End_Of_Field return Boolean;
 918       --  Test if at end of line, or if at blank or horizontal tab
 919
 920       procedure Check_At_End_Of_Field;
 921       --  Check if we are at end of field, fatal error if not
 922
 923       procedure Checkc (C : Character);
 924       --  Check next character is C. If so bump past it, if not fatal error
 925
 926       procedure Check_Unknown_Line;
 927       --  If Ignore_Errors mode, then checks C to make sure that it is not
 928       --  an unknown ALI line type characters, and if so, skips lines
 929       --  until the first character of the line is one of these characters,
 930       --  at which point it does a Getc to put that character in C. The
 931       --  call has no effect if C is already an appropriate character.
 932       --  If not in Ignore_Errors mode, a fatal error is signalled if the
 933       --  line is unknown. Note that if C is an EOL on entry, the line is
 934       --  skipped (it is assumed that blank lines are never significant).
 935       --  If C is EOF on entry, the call has no effect (it is assumed that
 936       --  the caller will properly handle this case).
 937
 938       procedure Fatal_Error;
 939       --  Generate fatal error message for badly formatted ALI file if
 940       --  Err is false, or raise Bad_ALI_Format if Err is True.
 941
 942       procedure Fatal_Error_Ignore;
 943       pragma Inline (Fatal_Error_Ignore);
 944       --  In Ignore_Errors mode, has no effect, otherwise same as Fatal_Error
 945
 946       function Getc return Character;
 947       --  Get next character, bumping P past the character obtained
 948
 949       function Get_File_Name
 950         (Lower         : Boolean := False;
 951          May_Be_Quoted : Boolean := False) return File_Name_Type;
 952       --  Skip blanks, then scan out a file name (name is left in Name_Buffer
 953       --  with length in Name_Len, as well as returning a File_Name_Type value.
 954       --  If May_Be_Quoted is True and the first non blank character is '"',
 955       --  then remove starting and ending quotes and undoubled internal quotes.
 956       --  If lower is false, the case is unchanged, if Lower is True then the
 957       --  result is forced to all lower case for systems where file names are
 958       --  not case sensitive. This ensures that gnatbind works correctly
 959       --  regardless of the case of the file name on all systems. The scan
 960       --  is terminated by a end of line, space or horizontal tab. Any other
 961       --  special characters are included in the returned name.
 962
 963       function Get_Name
 964         (Ignore_Special : Boolean := False;
 965          May_Be_Quoted  : Boolean := False) return Name_Id;
 966       --  Skip blanks, then scan out a name (name is left in Name_Buffer with
 967       --  length in Name_Len, as well as being returned in Name_Id form).
 968       --  If Lower is set to True then the Name_Buffer will be converted to
 969       --  all lower case, for systems where file names are not case sensitive.
 970       --  This ensures that gnatbind works correctly regardless of the case
 971       --  of the file name on all systems.
 972       --
 973       --  The scan is terminated by the normal end of field condition
 974       --  (EOL, space, horizontal tab). Furthermore, the termination condition
 975       --  depends on the setting of Ignore_Special:
 976       --
 977       --    If Ignore_Special is False (normal case), the scan is terminated by
 978       --    a typeref bracket or an equal sign except for the special case of
 979       --    an operator name starting with a double quote that is terminated
 980       --    by another double quote.
 981       --
 982       --    If May_Be_Quoted is True and the first non blank character is '"'
 983       --    the name is 'unquoted'. In this case Ignore_Special is ignored and
 984       --    assumed to be True.
 985       --
 986       --  This function handles wide characters properly.
 987
 988       function Get_Nat return Nat;
 989       --  Skip blanks, then scan out an unsigned integer value in Nat range
 990       --  raises ALI_Reading_Error if the encoutered type is not natural.
 991
 992       function Get_Stamp return Time_Stamp_Type;
 993       --  Skip blanks, then scan out a time stamp
 994
 995       function Get_Unit_Name return Unit_Name_Type;
 996       --  Skip blanks, then scan out a file name (name is left in Name_Buffer
 997       --  with length in Name_Len, as well as returning a Unit_Name_Type value.
 998       --  The case is unchanged and terminated by a normal end of field.
 999
1000       function Nextc return Character;
1001       --  Return current character without modifying pointer P
1002
1003       procedure Scan_Invocation_Graph_Line;
1004       --  Parse a single line that encodes a piece of the invocation graph
1005
1006       procedure Skip_Eol;
1007       --  Skip past spaces, then skip past end of line (fatal error if not
1008       --  at end of line). Also skips past any following blank lines.
1009
1010       procedure Skip_Line;
1011       --  Skip rest of current line and any following blank lines
1012
1013       procedure Skip_Space;
1014       --  Skip past white space (blanks or horizontal tab)
1015
1016       procedure Skipc;
1017       --  Skip past next character, does not affect value in C. This call
1018       --  is like calling Getc and ignoring the returned result.
1019
1020       ---------------------
1021       -- At_End_Of_Field --
1022       ---------------------
1023
1024       function At_End_Of_Field return Boolean is
1025       begin
1026          return Nextc <= ' ';
1027       end At_End_Of_Field;
1028
1029       ------------
1030       -- At_Eol --
1031       ------------
1032
1033       function At_Eol return Boolean is
1034       begin
1035          return Nextc = EOF or else Nextc = CR or else Nextc = LF;
1036       end At_Eol;
1037
1038       ---------------------------
1039       -- Check_At_End_Of_Field --
1040       ---------------------------
1041
1042       procedure Check_At_End_Of_Field is
1043       begin
1044          if not At_End_Of_Field then
1045             if Ignore_Errors then
1046                while Nextc > ' ' loop
1047                   P := P + 1;
1048                end loop;
1049             else
1050                Fatal_Error;
1051             end if;
1052          end if;
1053       end Check_At_End_Of_Field;
1054
1055       ------------------------
1056       -- Check_Unknown_Line --
1057       ------------------------
1058
1059       procedure Check_Unknown_Line is
1060       begin
1061          while C not in 'A' .. 'Z'
1062            or else not Known_ALI_Lines (C)
1063          loop
1064             if C = CR or else C = LF then
1065                Skip_Line;
1066                C := Nextc;
1067
1068             elsif C = EOF then
1069                return;
1070
1071             elsif Ignore_Errors then
1072                Skip_Line;
1073                C := Getc;
1074
1075             else
1076                Fatal_Error;
1077             end if;
1078          end loop;
1079       end Check_Unknown_Line;
1080
1081       ------------
1082       -- Checkc --
1083       ------------
1084
1085       procedure Checkc (C : Character) is
1086       begin
1087          if Nextc = C then
1088             P := P + 1;
1089          elsif Ignore_Errors then
1090             P := P + 1;
1091          else
1092             Fatal_Error;
1093          end if;
1094       end Checkc;
1095
1096       -----------------
1097       -- Fatal_Error --
1098       -----------------
1099
1100       procedure Fatal_Error is
1101          Ptr1 : Text_Ptr;
1102          Ptr2 : Text_Ptr;
1103          Col  : Int;
1104
1105          procedure Wchar (C : Character);
1106          --  Write a single character, replacing horizontal tab by spaces
1107
1108          procedure Wchar (C : Character) is
1109          begin
1110             if C = HT then
1111                loop
1112                   Wchar (' ');
1113                   exit when Col mod 8 = 0;
1114                end loop;
1115
1116             else
1117                Write_Char (C);
1118                Col := Col + 1;
1119             end if;
1120          end Wchar;
1121
1122       --  Start of processing for Fatal_Error
1123
1124       begin
1125          if Err then
1126             raise Bad_ALI_Format;
1127          end if;
1128
1129          Set_Standard_Error;
1130          Write_Str ("fatal error: file ");
1131          Write_Name (F);
1132          Write_Str (" is incorrectly formatted");
1133          Write_Eol;
1134
1135          Write_Str ("make sure you are using consistent versions " &
1136
1137          --  Split the following line so that it can easily be transformed for
1138          --  other back-ends where the compiler might have a different name.
1139
1140                     "of gcc/gnatbind");
1141
1142          Write_Eol;
1143
1144          --  Find start of line
1145
1146          Ptr1 := P;
1147          while Ptr1 > T'First
1148            and then T (Ptr1 - 1) /= CR
1149            and then T (Ptr1 - 1) /= LF
1150          loop
1151             Ptr1 := Ptr1 - 1;
1152          end loop;
1153
1154          Write_Int (Int (Line));
1155          Write_Str (". ");
1156
1157          if Line < 100 then
1158             Write_Char (' ');
1159          end if;
1160
1161          if Line < 10 then
1162             Write_Char (' ');
1163          end if;
1164
1165          Col := 0;
1166          Ptr2 := Ptr1;
1167
1168          while Ptr2 < T'Last
1169            and then T (Ptr2) /= CR
1170            and then T (Ptr2) /= LF
1171          loop
1172             Wchar (T (Ptr2));
1173             Ptr2 := Ptr2 + 1;
1174          end loop;
1175
1176          Write_Eol;
1177
1178          Write_Str ("     ");
1179          Col := 0;
1180
1181          while Ptr1 < P loop
1182             if T (Ptr1) = HT then
1183                Wchar (HT);
1184             else
1185                Wchar (' ');
1186             end if;
1187
1188             Ptr1 := Ptr1 + 1;
1189          end loop;
1190
1191          Wchar ('|');
1192          Write_Eol;
1193
1194          Exit_Program (E_Fatal);
1195       end Fatal_Error;
1196
1197       ------------------------
1198       -- Fatal_Error_Ignore --
1199       ------------------------
1200
1201       procedure Fatal_Error_Ignore is
1202       begin
1203          if not Ignore_Errors then
1204             Fatal_Error;
1205          end if;
1206       end Fatal_Error_Ignore;
1207
1208       -------------------
1209       -- Get_File_Name --
1210       -------------------
1211
1212       function Get_File_Name
1213         (Lower         : Boolean := False;
1214          May_Be_Quoted : Boolean := False) return File_Name_Type
1215       is
1216          F : Name_Id;
1217
1218       begin
1219          F := Get_Name (Ignore_Special => True,
1220                         May_Be_Quoted  => May_Be_Quoted);
1221
1222          --  Convert file name to all lower case if file names are not case
1223          --  sensitive. This ensures that we handle names in the canonical
1224          --  lower case format, regardless of the actual case.
1225
1226          if Lower and not File_Names_Case_Sensitive then
1227             Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
1228             return Name_Find;
1229          else
1230             return File_Name_Type (F);
1231          end if;
1232       end Get_File_Name;
1233
1234       --------------
1235       -- Get_Name --
1236       --------------
1237
1238       function Get_Name
1239         (Ignore_Special : Boolean := False;
1240          May_Be_Quoted  : Boolean := False) return Name_Id
1241       is
1242          Char : Character;
1243
1244       begin
1245          Name_Len := 0;
1246          Skip_Space;
1247
1248          if At_Eol then
1249             if Ignore_Errors then
1250                return Error_Name;
1251             else
1252                Fatal_Error;
1253             end if;
1254          end if;
1255
1256          Char := Getc;
1257
1258          --  Deal with quoted characters
1259
1260          if May_Be_Quoted and then Char = '"' then
1261             loop
1262                if At_Eol then
1263                   if Ignore_Errors then
1264                      return Error_Name;
1265                   else
1266                      Fatal_Error;
1267                   end if;
1268                end if;
1269
1270                Char := Getc;
1271
1272                if Char = '"' then
1273                   if At_Eol then
1274                      exit;
1275
1276                   else
1277                      Char := Getc;
1278
1279                      if Char /= '"' then
1280                         P := P - 1;
1281                         exit;
1282                      end if;
1283                   end if;
1284                end if;
1285
1286                Add_Char_To_Name_Buffer (Char);
1287             end loop;
1288
1289          --  Other than case of quoted character
1290
1291          else
1292             P := P - 1;
1293             loop
1294                Add_Char_To_Name_Buffer (Getc);
1295
1296                exit when At_End_Of_Field;
1297
1298                if not Ignore_Special then
1299                   if Name_Buffer (1) = '"' then
1300                      exit when Name_Len > 1
1301                                and then Name_Buffer (Name_Len) = '"';
1302
1303                   else
1304                      --  Terminate on parens or angle brackets or equal sign
1305
1306                      exit when Nextc = '(' or else Nextc = ')'
1307                        or else Nextc = '{' or else Nextc = '}'
1308                        or else Nextc = '<' or else Nextc = '>'
1309                        or else Nextc = '=';
1310
1311                      --  Terminate on comma
1312
1313                      exit when Nextc = ',';
1314
1315                      --  Terminate if left bracket not part of wide char
1316                      --  sequence.
1317
1318                      exit when Nextc = '[' and then T (P + 1) /= '"';
1319
1320                      --  Terminate if right bracket not part of wide char
1321                      --  sequence.
1322
1323                      exit when Nextc = ']' and then T (P - 1) /= '"';
1324                   end if;
1325                end if;
1326             end loop;
1327          end if;
1328
1329          return Name_Find;
1330       end Get_Name;
1331
1332       -------------------
1333       -- Get_Unit_Name --
1334       -------------------
1335
1336       function Get_Unit_Name return Unit_Name_Type is
1337       begin
1338          return Unit_Name_Type (Get_Name);
1339       end Get_Unit_Name;
1340
1341       -------------
1342       -- Get_Nat --
1343       -------------
1344
1345       function Get_Nat return Nat is
1346          V : Nat;
1347
1348       begin
1349          Skip_Space;
1350
1351          --  Check if we are on a number. In the case of bad ALI files, this
1352          --  may not be true.
1353
1354          if not (Nextc in '0' .. '9') then
1355             Fatal_Error;
1356          end if;
1357
1358          V := 0;
1359          loop
1360             V := V * 10 + (Character'Pos (Getc) - Character'Pos ('0'));
1361
1362             exit when At_End_Of_Field;
1363             exit when Nextc < '0' or else Nextc > '9';
1364          end loop;
1365
1366          return V;
1367       end Get_Nat;
1368
1369       ---------------
1370       -- Get_Stamp --
1371       ---------------
1372
1373       function Get_Stamp return Time_Stamp_Type is
1374          T     : Time_Stamp_Type;
1375          Start : Integer;
1376
1377       begin
1378          Skip_Space;
1379
1380          if At_Eol then
1381             if Ignore_Errors then
1382                return Dummy_Time_Stamp;
1383             else
1384                Fatal_Error;
1385             end if;
1386          end if;
1387
1388          --  Following reads old style time stamp missing first two digits
1389
1390          if Nextc in '7' .. '9' then
1391             T (1) := '1';
1392             T (2) := '9';
1393             Start := 3;
1394
1395          --  Normal case of full year in time stamp
1396
1397          else
1398             Start := 1;
1399          end if;
1400
1401          for J in Start .. T'Last loop
1402             T (J) := Getc;
1403          end loop;
1404
1405          return T;
1406       end Get_Stamp;
1407
1408       ----------
1409       -- Getc --
1410       ----------
1411
1412       function Getc return Character is
1413       begin
1414          if P = T'Last then
1415             return EOF;
1416          else
1417             P := P + 1;
1418             return T (P - 1);
1419          end if;
1420       end Getc;
1421
1422       -----------
1423       -- Nextc --
1424       -----------
1425
1426       function Nextc return Character is
1427       begin
1428          return T (P);
1429       end Nextc;
1430
1431       --------------------------------
1432       -- Scan_Invocation_Graph_Line --
1433       --------------------------------
1434
1435       procedure Scan_Invocation_Graph_Line is
1436          procedure Scan_Invocation_Construct_Line;
1437          pragma Inline (Scan_Invocation_Construct_Line);
1438          --  Parse an invocation construct line and construct the corresponding
1439          --  construct. The following data structures are updated:
1440          --
1441          --    * Invocation_Constructs
1442          --    * Units
1443
1444          procedure Scan_Invocation_Graph_Attributes_Line;
1445          pragma Inline (Scan_Invocation_Graph_Attributes_Line);
1446          --  Parse an invocation-graph attributes line. The following data
1447          --  structures are updated:
1448          --
1449          --    * Units
1450
1451          procedure Scan_Invocation_Relation_Line;
1452          pragma Inline (Scan_Invocation_Relation_Line);
1453          --  Parse an invocation relation line and construct the corresponding
1454          --  relation. The following data structures are updated:
1455          --
1456          --    * Invocation_Relations
1457          --    * Units
1458
1459          function Scan_Invocation_Signature return Invocation_Signature_Id;
1460          pragma Inline (Scan_Invocation_Signature);
1461          --  Parse a single invocation signature while populating the following
1462          --  data structures:
1463          --
1464          --    * Invocation_Signatures
1465          --    * Sig_To_Sig_Map
1466
1467          ------------------------------------
1468          -- Scan_Invocation_Construct_Line --
1469          ------------------------------------
1470
1471          procedure Scan_Invocation_Construct_Line is
1472             Body_Placement : Declaration_Placement_Kind;
1473             Kind           : Invocation_Construct_Kind;
1474             Signature      : Invocation_Signature_Id;
1475             Spec_Placement : Declaration_Placement_Kind;
1476
1477          begin
1478             --  construct-kind
1479
1480             Kind := Code_To_Invocation_Construct_Kind (Getc);
1481             Checkc (' ');
1482             Skip_Space;
1483
1484             --  construct-spec-placement
1485
1486             Spec_Placement := Code_To_Declaration_Placement_Kind (Getc);
1487             Checkc (' ');
1488             Skip_Space;
1489
1490             --  construct-body-placement
1491
1492             Body_Placement := Code_To_Declaration_Placement_Kind (Getc);
1493             Checkc (' ');
1494             Skip_Space;
1495
1496             --  construct-signature
1497
1498             Signature := Scan_Invocation_Signature;
1499             Skip_Eol;
1500
1501             Add_Invocation_Construct
1502               (Body_Placement => Body_Placement,
1503                Kind           => Kind,
1504                Signature      => Signature,
1505                Spec_Placement => Spec_Placement);
1506          end Scan_Invocation_Construct_Line;
1507
1508          -------------------------------------------
1509          -- Scan_Invocation_Graph_Attributes_Line --
1510          -------------------------------------------
1511
1512          procedure Scan_Invocation_Graph_Attributes_Line is
1513          begin
1514             --  encoding-kind
1515
1516             Set_Invocation_Graph_Encoding
1517               (Code_To_Invocation_Graph_Encoding_Kind (Getc));
1518             Skip_Eol;
1519          end Scan_Invocation_Graph_Attributes_Line;
1520
1521          -----------------------------------
1522          -- Scan_Invocation_Relation_Line --
1523          -----------------------------------
1524
1525          procedure Scan_Invocation_Relation_Line is
1526             Extra   : Name_Id;
1527             Invoker : Invocation_Signature_Id;
1528             Kind    : Invocation_Kind;
1529             Target  : Invocation_Signature_Id;
1530
1531          begin
1532             --  relation-kind
1533
1534             Kind := Code_To_Invocation_Kind (Getc);
1535             Checkc (' ');
1536             Skip_Space;
1537
1538             --  (extra-name | "none")
1539
1540             Extra := Get_Name;
1541
1542             if Extra = Name_None then
1543                Extra := No_Name;
1544             end if;
1545
1546             Checkc (' ');
1547             Skip_Space;
1548
1549             --  invoker-signature
1550
1551             Invoker := Scan_Invocation_Signature;
1552             Checkc (' ');
1553             Skip_Space;
1554
1555             --  target-signature
1556
1557             Target := Scan_Invocation_Signature;
1558             Skip_Eol;
1559
1560             Add_Invocation_Relation
1561               (Extra   => Extra,
1562                Invoker => Invoker,
1563                Kind    => Kind,
1564                Target  => Target);
1565          end Scan_Invocation_Relation_Line;
1566
1567          -------------------------------
1568          -- Scan_Invocation_Signature --
1569          -------------------------------
1570
1571          function Scan_Invocation_Signature return Invocation_Signature_Id is
1572             Column    : Nat;
1573             Line      : Nat;
1574             Locations : Name_Id;
1575             Name      : Name_Id;
1576             Scope     : Name_Id;
1577
1578          begin
1579             --  [
1580
1581             Checkc ('[');
1582
1583             --  name
1584
1585             Name := Get_Name;
1586             Checkc (' ');
1587             Skip_Space;
1588
1589             --  scope
1590
1591             Scope := Get_Name;
1592             Checkc (' ');
1593             Skip_Space;
1594
1595             --  line
1596
1597             Line := Get_Nat;
1598             Checkc (' ');
1599             Skip_Space;
1600
1601             --  column
1602
1603             Column := Get_Nat;
1604             Checkc (' ');
1605             Skip_Space;
1606
1607             --  (locations | "none")
1608
1609             Locations := Get_Name;
1610
1611             if Locations = Name_None then
1612                Locations := No_Name;
1613             end if;
1614
1615             --  ]
1616
1617             Checkc (']');
1618
1619             --  Create an invocation signature from the scanned attributes
1620
1621             return
1622               Invocation_Signature_Of
1623                 (Column    => Column,
1624                  Line      => Line,
1625                  Locations => Locations,
1626                  Name      => Name,
1627                  Scope     => Scope);
1628          end Scan_Invocation_Signature;
1629
1630          --  Local variables
1631
1632          Line : Invocation_Graph_Line_Kind;
1633
1634       --  Start of processing for Scan_Invocation_Graph_Line
1635
1636       begin
1637          if Ignore ('G') then
1638             return;
1639          end if;
1640
1641          Checkc (' ');
1642          Skip_Space;
1643
1644          --  line-kind
1645
1646          Line := Code_To_Invocation_Graph_Line_Kind (Getc);
1647          Checkc (' ');
1648          Skip_Space;
1649
1650          --  line-attributes
1651
1652          case Line is
1653             when Invocation_Construct_Line =>
1654                Scan_Invocation_Construct_Line;
1655
1656             when Invocation_Graph_Attributes_Line =>
1657                Scan_Invocation_Graph_Attributes_Line;
1658
1659             when Invocation_Relation_Line =>
1660                Scan_Invocation_Relation_Line;
1661          end case;
1662       end Scan_Invocation_Graph_Line;
1663
1664       --------------
1665       -- Skip_Eol --
1666       --------------
1667
1668       procedure Skip_Eol is
1669       begin
1670          Skip_Space;
1671
1672          if not At_Eol then
1673             if Ignore_Errors then
1674                while not At_Eol loop
1675                   P := P + 1;
1676                end loop;
1677             else
1678                Fatal_Error;
1679             end if;
1680          end if;
1681
1682          --  Loop to skip past blank lines (first time through skips this EOL)
1683
1684          while Nextc < ' ' and then Nextc /= EOF loop
1685             if Nextc = LF then
1686                Line := Line + 1;
1687             end if;
1688
1689             P := P + 1;
1690          end loop;
1691       end Skip_Eol;
1692
1693       ---------------
1694       -- Skip_Line --
1695       ---------------
1696
1697       procedure Skip_Line is
1698       begin
1699          while not At_Eol loop
1700             P := P + 1;
1701          end loop;
1702
1703          Skip_Eol;
1704       end Skip_Line;
1705
1706       ----------------
1707       -- Skip_Space --
1708       ----------------
1709
1710       procedure Skip_Space is
1711       begin
1712          while Nextc = ' ' or else Nextc = HT loop
1713             P := P + 1;
1714          end loop;
1715       end Skip_Space;
1716
1717       -----------
1718       -- Skipc --
1719       -----------
1720
1721       procedure Skipc is
1722       begin
1723          if P /= T'Last then
1724             P := P + 1;
1725          end if;
1726       end Skipc;
1727
1728    --  Start of processing for Scan_ALI
1729
1730    begin
1731       First_Sdep_Entry := Sdep.Last + 1;
1732
1733       for J in Ignore_Lines'Range loop
1734          pragma Assert (Ignore_Lines (J) /= 'U');
1735          Ignore (Ignore_Lines (J)) := True;
1736       end loop;
1737
1738       --  Setup ALI Table entry with appropriate defaults
1739
1740       ALIs.Increment_Last;
1741       Id := ALIs.Last;
1742       Set_Name_Table_Int (F, Int (Id));
1743
1744       ALIs.Table (Id) := (
1745         Afile                        => F,
1746         Compile_Errors               => False,
1747         First_CUDA_Kernel            => CUDA_Kernels.Last + 1,
1748         First_Interrupt_State        => Interrupt_States.Last + 1,
1749         First_Sdep                   => No_Sdep_Id,
1750         First_Specific_Dispatching   => Specific_Dispatching.Last + 1,
1751         First_Unit                   => No_Unit_Id,
1752         GNATprove_Mode               => False,
1753         Invocation_Graph_Encoding    => No_Encoding,
1754         Last_CUDA_Kernel             => CUDA_Kernels.Last,
1755         Last_Interrupt_State         => Interrupt_States.Last,
1756         Last_Sdep                    => No_Sdep_Id,
1757         Last_Specific_Dispatching    => Specific_Dispatching.Last,
1758         Last_Unit                    => No_Unit_Id,
1759         Locking_Policy               => ' ',
1760         Main_Priority                => -1,
1761         Main_CPU                     => -1,
1762         Main_Program                 => None,
1763         No_Component_Reordering      => False,
1764         No_Object                    => False,
1765         Normalize_Scalars            => False,
1766         Ofile_Full_Name              => Full_Object_File_Name,
1767         Partition_Elaboration_Policy => ' ',
1768         Queuing_Policy               => ' ',
1769         Restrictions                 => No_Restrictions,
1770         SAL_Interface                => False,
1771         Sfile                        => No_File,
1772         SSO_Default                  => ' ',
1773         Task_Dispatching_Policy      => ' ',
1774         Time_Slice_Value             => -1,
1775         WC_Encoding                  => 'b',
1776         Unit_Exception_Table         => False,
1777         Ver                          => (others => ' '),
1778         Ver_Len                      => 0,
1779         Zero_Cost_Exceptions         => False);
1780
1781       --  Now we acquire the input lines from the ALI file. Note that the
1782       --  convention in the following code is that as we enter each section,
1783       --  C is set to contain the first character of the following line.
1784
1785       C := Getc;
1786       Check_Unknown_Line;
1787
1788       --  Acquire library version
1789
1790       if C /= 'V' then
1791
1792          --  The V line missing really indicates trouble, most likely it
1793          --  means we don't have an ALI file at all, so here we give a
1794          --  fatal error even if we are in Ignore_Errors mode.
1795
1796          Fatal_Error;
1797
1798       elsif Ignore ('V') then
1799          Skip_Line;
1800
1801       else
1802          Checkc (' ');
1803          Skip_Space;
1804          Checkc ('"');
1805
1806          for J in 1 .. Ver_Len_Max loop
1807             C := Getc;
1808             exit when C = '"';
1809             ALIs.Table (Id).Ver (J) := C;
1810             ALIs.Table (Id).Ver_Len := J;
1811          end loop;
1812
1813          Skip_Eol;
1814       end if;
1815
1816       C := Getc;
1817       Check_Unknown_Line;
1818
1819       --  Acquire main program line if present
1820
1821       if C = 'M' then
1822          if Ignore ('M') then
1823             Skip_Line;
1824
1825          else
1826             Checkc (' ');
1827             Skip_Space;
1828
1829             C := Getc;
1830
1831             if C = 'F' then
1832                ALIs.Table (Id).Main_Program := Func;
1833             elsif C = 'P' then
1834                ALIs.Table (Id).Main_Program := Proc;
1835             else
1836                P := P - 1;
1837                Fatal_Error;
1838             end if;
1839
1840             Skip_Space;
1841
1842             if not At_Eol then
1843                if Nextc < 'A' then
1844                   ALIs.Table (Id).Main_Priority := Get_Nat;
1845                end if;
1846
1847                Skip_Space;
1848
1849                if Nextc = 'T' then
1850                   P := P + 1;
1851                   Checkc ('=');
1852                   ALIs.Table (Id).Time_Slice_Value := Get_Nat;
1853                end if;
1854
1855                Skip_Space;
1856
1857                if Nextc = 'C' then
1858                   P := P + 1;
1859                   Checkc ('=');
1860                   ALIs.Table (Id).Main_CPU := Get_Nat;
1861                end if;
1862
1863                Skip_Space;
1864
1865                Checkc ('W');
1866                Checkc ('=');
1867                ALIs.Table (Id).WC_Encoding := Getc;
1868             end if;
1869
1870             Skip_Eol;
1871          end if;
1872
1873          C := Getc;
1874       end if;
1875
1876       --  Acquire argument lines
1877
1878       First_Arg := Args.Last + 1;
1879
1880       A_Loop : loop
1881          Check_Unknown_Line;
1882          exit A_Loop when C /= 'A';
1883
1884          if Ignore ('A') then
1885             Skip_Line;
1886
1887          else
1888             Checkc (' ');
1889
1890             --  Scan out argument
1891
1892             Name_Len := 0;
1893             while not At_Eol loop
1894                Add_Char_To_Name_Buffer (Getc);
1895             end loop;
1896
1897             --  If -fstack-check, record that it occurred. Note that an
1898             --  additional string parameter can be specified, in the form of
1899             --  -fstack-check={no|generic|specific}. "no" means no checking,
1900             --  "generic" means force the use of old-style checking, and
1901             --  "specific" means use the best checking method.
1902
1903             if Name_Len >= 13
1904               and then Name_Buffer (1 .. 13) = "-fstack-check"
1905               and then Name_Buffer (1 .. Name_Len) /= "-fstack-check=no"
1906             then
1907                Stack_Check_Switch_Set := True;
1908             end if;
1909
1910             --  Store the argument
1911
1912             Args.Increment_Last;
1913             Args.Table (Args.Last) := new String'(Name_Buffer (1 .. Name_Len));
1914
1915             Skip_Eol;
1916          end if;
1917
1918          C := Getc;
1919       end loop A_Loop;
1920
1921       --  Acquire 'K' lines if present
1922
1923       Check_Unknown_Line;
1924
1925       while C = 'K' loop
1926          if Ignore ('K') then
1927             Skip_Line;
1928
1929          else
1930             Skip_Space;
1931             CUDA_Kernels.Append ((Kernel_Name => Get_Name));
1932             ALIs.Table (Id).Last_CUDA_Kernel := CUDA_Kernels.Last;
1933             Skip_Eol;
1934          end if;
1935
1936          C := Getc;
1937       end loop;
1938
1939       --  Acquire P line
1940
1941       Check_Unknown_Line;
1942
1943       while C /= 'P' loop
1944          if Ignore_Errors then
1945             if C = EOF then
1946                Fatal_Error;
1947             else
1948                Skip_Line;
1949                C := Nextc;
1950             end if;
1951          else
1952             Fatal_Error;
1953          end if;
1954       end loop;
1955
1956       if Ignore ('P') then
1957          Skip_Line;
1958
1959       --  Process P line
1960
1961       else
1962          NS_Found := False;
1963
1964          while not At_Eol loop
1965             Checkc (' ');
1966             Skip_Space;
1967             C := Getc;
1968
1969             --  Processing for CE
1970
1971             if C = 'C' then
1972                Checkc ('E');
1973                ALIs.Table (Id).Compile_Errors := True;
1974
1975             --  Processing for DB
1976
1977             elsif C = 'D' then
1978                Checkc ('B');
1979                Detect_Blocking := True;
1980
1981             --  Processing for Ex
1982
1983             elsif C = 'E' then
1984                Partition_Elaboration_Policy_Specified := Getc;
1985                ALIs.Table (Id).Partition_Elaboration_Policy :=
1986                  Partition_Elaboration_Policy_Specified;
1987
1988             --  Processing for FX
1989
1990             elsif C = 'F' then
1991                C := Getc;
1992
1993                --  Old front-end exceptions marker, ignore
1994
1995                if C = 'X' then
1996                   null;
1997                else
1998                   Fatal_Error_Ignore;
1999                end if;
2000
2001             --  Processing for GP
2002
2003             elsif C = 'G' then
2004                Checkc ('P');
2005                GNATprove_Mode_Specified := True;
2006                ALIs.Table (Id).GNATprove_Mode := True;
2007
2008             --  Processing for Lx
2009
2010             elsif C = 'L' then
2011                Locking_Policy_Specified := Getc;
2012                ALIs.Table (Id).Locking_Policy := Locking_Policy_Specified;
2013
2014             --  Processing for flags starting with N
2015
2016             elsif C = 'N' then
2017                C := Getc;
2018
2019                --  Processing for NC
2020
2021                if C = 'C' then
2022                   ALIs.Table (Id).No_Component_Reordering := True;
2023                   No_Component_Reordering_Specified := True;
2024
2025                --  Processing for NO
2026
2027                elsif C = 'O' then
2028                   ALIs.Table (Id).No_Object := True;
2029                   No_Object_Specified := True;
2030
2031                --  Processing for NR
2032
2033                elsif C = 'R' then
2034                   No_Run_Time_Mode           := True;
2035                   Configurable_Run_Time_Mode := True;
2036
2037                --  Processing for NS
2038
2039                elsif C = 'S' then
2040                   ALIs.Table (Id).Normalize_Scalars := True;
2041                   Normalize_Scalars_Specified := True;
2042                   NS_Found := True;
2043
2044                --  Invalid switch starting with N
2045
2046                else
2047                   Fatal_Error_Ignore;
2048                end if;
2049
2050             --  Processing for OH/OL
2051
2052             elsif C = 'O' then
2053                C := Getc;
2054
2055                if C = 'L' or else C = 'H' then
2056                   ALIs.Table (Id).SSO_Default := C;
2057                   SSO_Default_Specified := True;
2058
2059                else
2060                   Fatal_Error_Ignore;
2061                end if;
2062
2063             --  Processing for Qx
2064
2065             elsif C = 'Q' then
2066                Queuing_Policy_Specified := Getc;
2067                ALIs.Table (Id).Queuing_Policy := Queuing_Policy_Specified;
2068
2069             --  Processing for flags starting with S
2070
2071             elsif C = 'S' then
2072                C := Getc;
2073
2074                --  Processing for SL
2075
2076                if C = 'L' then
2077                   ALIs.Table (Id).SAL_Interface := True;
2078
2079                --  Processing for SS
2080
2081                elsif C = 'S' then
2082                   --  Special case: a-tags/i-c* by themselves should not set
2083                   --  Sec_Stack_Used, only if other code uses the secondary
2084                   --  stack should we set this flag. This ensures that we do
2085                   --  not bring the secondary stack unnecessarily when using
2086                   --  one of these packages and not actually using the
2087                   --  secondary stack.
2088
2089                   declare
2090                      File : constant String := Get_Name_String (F);
2091                   begin
2092                      if File /= "a-tags.ali"
2093                        and then File /= "i-c.ali"
2094                        and then File /= "i-cstrin.ali"
2095                        and then File /= "i-cpoint.ali"
2096                      then
2097                         Opt.Sec_Stack_Used := True;
2098                      end if;
2099                   end;
2100
2101                --  Invalid switch starting with S
2102
2103                else
2104                   Fatal_Error_Ignore;
2105                end if;
2106
2107             --  Processing for Tx
2108
2109             elsif C = 'T' then
2110                Task_Dispatching_Policy_Specified := Getc;
2111                ALIs.Table (Id).Task_Dispatching_Policy :=
2112                  Task_Dispatching_Policy_Specified;
2113
2114             --  Processing for switch starting with U
2115
2116             elsif C = 'U' then
2117                C := Getc;
2118
2119                --  Processing for UA
2120
2121                if C  = 'A' then
2122                   Unreserve_All_Interrupts_Specified := True;
2123
2124                --  Processing for UX
2125
2126                elsif C = 'X' then
2127                   ALIs.Table (Id).Unit_Exception_Table := True;
2128
2129                --  Invalid switches starting with U
2130
2131                else
2132                   Fatal_Error_Ignore;
2133                end if;
2134
2135             --  Processing for ZX
2136
2137             elsif C = 'Z' then
2138                C := Getc;
2139
2140                if C = 'X' then
2141                   ALIs.Table (Id).Zero_Cost_Exceptions := True;
2142                   Zero_Cost_Exceptions_Specified := True;
2143                else
2144                   Fatal_Error_Ignore;
2145                end if;
2146
2147             --  Invalid parameter
2148
2149             else
2150                C := Getc;
2151                Fatal_Error_Ignore;
2152             end if;
2153          end loop;
2154
2155          if not NS_Found then
2156             No_Normalize_Scalars_Specified := True;
2157          end if;
2158
2159          Skip_Eol;
2160       end if;
2161
2162       C := Getc;
2163       Check_Unknown_Line;
2164
2165       --  Loop to skip to first restrictions line
2166
2167       while C /= 'R' loop
2168          if Ignore_Errors then
2169             if C = EOF then
2170                Fatal_Error;
2171             else
2172                Skip_Line;
2173                C := Nextc;
2174             end if;
2175          else
2176             Fatal_Error;
2177          end if;
2178       end loop;
2179
2180       --  Ignore all 'R' lines if that is required
2181
2182       if Ignore ('R') then
2183          while C = 'R' loop
2184             Skip_Line;
2185             C := Getc;
2186          end loop;
2187
2188       --  Here we process the restrictions lines (other than unit name cases)
2189
2190       else
2191          Scan_Restrictions : declare
2192             Save_R : constant Restrictions_Info := Cumulative_Restrictions;
2193             --  Save cumulative restrictions in case we have a fatal error
2194
2195             Bad_R_Line : exception;
2196             --  Signal bad restrictions line (raised on unexpected character)
2197
2198             Typ : Character;
2199             R   : Restriction_Id;
2200             N   : Natural;
2201
2202          begin
2203             --  Named restriction case
2204
2205             if Nextc = 'N' then
2206                Skip_Line;
2207                C := Getc;
2208
2209                --  Loop through RR and RV lines
2210
2211                while C = 'R' and then Nextc /= ' ' loop
2212                   Typ := Getc;
2213                   Checkc (' ');
2214
2215                   --  Acquire restriction name
2216
2217                   Name_Len := 0;
2218                   while not At_Eol and then Nextc /= '=' loop
2219                      Name_Len := Name_Len + 1;
2220                      Name_Buffer (Name_Len) := Getc;
2221                   end loop;
2222
2223                   --  Now search list of restrictions to find match
2224
2225                   declare
2226                      RN : String renames Name_Buffer (1 .. Name_Len);
2227
2228                   begin
2229                      R := Restriction_Id'First;
2230                      while R /= Not_A_Restriction_Id loop
2231                         if Restriction_Id'Image (R) = RN then
2232                            goto R_Found;
2233                         end if;
2234
2235                         R := Restriction_Id'Succ (R);
2236                      end loop;
2237
2238                      --  We don't recognize the restriction. This might be
2239                      --  thought of as an error, and it really is, but we
2240                      --  want to allow building with inconsistent versions
2241                      --  of the binder and ali files (see comments at the
2242                      --  start of package System.Rident), so we just ignore
2243                      --  this situation.
2244
2245                      goto Done_With_Restriction_Line;
2246                   end;
2247
2248                   <<R_Found>>
2249
2250                   case R is
2251
2252                      --  Boolean restriction case
2253
2254                      when All_Boolean_Restrictions =>
2255                         case Typ is
2256                            when 'V' =>
2257                               ALIs.Table (Id).Restrictions.Violated (R) :=
2258                                 True;
2259                               Cumulative_Restrictions.Violated (R) := True;
2260
2261                            when 'R' =>
2262                               ALIs.Table (Id).Restrictions.Set (R) := True;
2263                               Cumulative_Restrictions.Set (R) := True;
2264
2265                            when others =>
2266                               raise Bad_R_Line;
2267                         end case;
2268
2269                      --  Parameter restriction case
2270
2271                      when All_Parameter_Restrictions =>
2272                         if At_Eol or else Nextc /= '=' then
2273                            raise Bad_R_Line;
2274                         else
2275                            Skipc;
2276                         end if;
2277
2278                         N := Natural (Get_Nat);
2279
2280                         case Typ is
2281
2282                            --  Restriction set
2283
2284                            when 'R' =>
2285                               ALIs.Table (Id).Restrictions.Set (R) := True;
2286                               ALIs.Table (Id).Restrictions.Value (R) := N;
2287
2288                               if Cumulative_Restrictions.Set (R) then
2289                                  Cumulative_Restrictions.Value (R) :=
2290                                    Integer'Min
2291                                      (Cumulative_Restrictions.Value (R), N);
2292                               else
2293                                  Cumulative_Restrictions.Set (R) := True;
2294                                  Cumulative_Restrictions.Value (R) := N;
2295                               end if;
2296
2297                            --  Restriction violated
2298
2299                            when 'V' =>
2300                               ALIs.Table (Id).Restrictions.Violated (R) :=
2301                                 True;
2302                               Cumulative_Restrictions.Violated (R) := True;
2303                               ALIs.Table (Id).Restrictions.Count (R) := N;
2304
2305                               --  Checked Max_Parameter case
2306
2307                               if R in Checked_Max_Parameter_Restrictions then
2308                                  Cumulative_Restrictions.Count (R) :=
2309                                    Integer'Max
2310                                      (Cumulative_Restrictions.Count (R), N);
2311
2312                               --  Other checked parameter cases
2313
2314                               else
2315                                  declare
2316                                     pragma Unsuppress (Overflow_Check);
2317
2318                                  begin
2319                                     Cumulative_Restrictions.Count (R) :=
2320                                       Cumulative_Restrictions.Count (R) + N;
2321
2322                                  exception
2323                                     when Constraint_Error =>
2324
2325                                        --  A constraint error comes from the
2326                                        --  addition. We reset to the maximum
2327                                        --  and indicate that the real value
2328                                        --  is now unknown.
2329
2330                                        Cumulative_Restrictions.Value (R) :=
2331                                          Integer'Last;
2332                                        Cumulative_Restrictions.Unknown (R) :=
2333                                          True;
2334                                  end;
2335                               end if;
2336
2337                               --  Deal with + case
2338
2339                               if Nextc = '+' then
2340                                  Skipc;
2341                                  ALIs.Table (Id).Restrictions.Unknown (R) :=
2342                                    True;
2343                                  Cumulative_Restrictions.Unknown (R) := True;
2344                               end if;
2345
2346                            --  Other than 'R' or 'V'
2347
2348                            when others =>
2349                               raise Bad_R_Line;
2350                         end case;
2351
2352                         if not At_Eol then
2353                            raise Bad_R_Line;
2354                         end if;
2355
2356                      --  Bizarre error case NOT_A_RESTRICTION
2357
2358                      when Not_A_Restriction_Id =>
2359                         raise Bad_R_Line;
2360                   end case;
2361
2362                   if not At_Eol then
2363                      raise Bad_R_Line;
2364                   end if;
2365
2366                <<Done_With_Restriction_Line>>
2367                   Skip_Line;
2368                   C := Getc;
2369                end loop;
2370
2371             --  Positional restriction case
2372
2373             else
2374                Checkc (' ');
2375                Skip_Space;
2376
2377                --  Acquire information for boolean restrictions
2378
2379                for R in All_Boolean_Restrictions loop
2380                   C := Getc;
2381
2382                   case C is
2383                      when 'v' =>
2384                         ALIs.Table (Id).Restrictions.Violated (R) := True;
2385                         Cumulative_Restrictions.Violated (R) := True;
2386
2387                      when 'r' =>
2388                         ALIs.Table (Id).Restrictions.Set (R) := True;
2389                         Cumulative_Restrictions.Set (R) := True;
2390
2391                      when 'n' =>
2392                         null;
2393
2394                      when others =>
2395                         raise Bad_R_Line;
2396                   end case;
2397                end loop;
2398
2399                --  Acquire information for parameter restrictions
2400
2401                for RP in All_Parameter_Restrictions loop
2402                   case Getc is
2403                      when 'n' =>
2404                         null;
2405
2406                      when 'r' =>
2407                         ALIs.Table (Id).Restrictions.Set (RP) := True;
2408
2409                         declare
2410                            N : constant Integer := Integer (Get_Nat);
2411                         begin
2412                            ALIs.Table (Id).Restrictions.Value (RP) := N;
2413
2414                            if Cumulative_Restrictions.Set (RP) then
2415                               Cumulative_Restrictions.Value (RP) :=
2416                                 Integer'Min
2417                                   (Cumulative_Restrictions.Value (RP), N);
2418                            else
2419                               Cumulative_Restrictions.Set (RP) := True;
2420                               Cumulative_Restrictions.Value (RP) := N;
2421                            end if;
2422                         end;
2423
2424                      when others =>
2425                         raise Bad_R_Line;
2426                   end case;
2427
2428                   --  Acquire restrictions violations information
2429
2430                   case Getc is
2431
2432                   when 'n' =>
2433                      null;
2434
2435                   when 'v' =>
2436                      ALIs.Table (Id).Restrictions.Violated (RP) := True;
2437                      Cumulative_Restrictions.Violated (RP) := True;
2438
2439                      declare
2440                         N : constant Integer := Integer (Get_Nat);
2441
2442                      begin
2443                         ALIs.Table (Id).Restrictions.Count (RP) := N;
2444
2445                         if RP in Checked_Max_Parameter_Restrictions then
2446                            Cumulative_Restrictions.Count (RP) :=
2447                              Integer'Max
2448                                (Cumulative_Restrictions.Count (RP), N);
2449
2450                         else
2451                            declare
2452                               pragma Unsuppress (Overflow_Check);
2453
2454                            begin
2455                               Cumulative_Restrictions.Count (RP) :=
2456                                 Cumulative_Restrictions.Count (RP) + N;
2457
2458                            exception
2459                               when Constraint_Error =>
2460
2461                                  --  A constraint error comes from the add. We
2462                                  --  reset to the maximum and indicate that the
2463                                  --  real value is now unknown.
2464
2465                                  Cumulative_Restrictions.Value (RP) :=
2466                                    Integer'Last;
2467                                  Cumulative_Restrictions.Unknown (RP) := True;
2468                            end;
2469                         end if;
2470
2471                         if Nextc = '+' then
2472                            Skipc;
2473                            ALIs.Table (Id).Restrictions.Unknown (RP) := True;
2474                            Cumulative_Restrictions.Unknown (RP) := True;
2475                         end if;
2476                      end;
2477
2478                   when others =>
2479                      raise Bad_R_Line;
2480                   end case;
2481                end loop;
2482
2483                if not At_Eol then
2484                   raise Bad_R_Line;
2485                else
2486                   Skip_Line;
2487                   C := Getc;
2488                end if;
2489             end if;
2490
2491          --  Here if error during scanning of restrictions line
2492
2493          exception
2494             when Bad_R_Line =>
2495
2496                --  In Ignore_Errors mode, undo any changes to restrictions
2497                --  from this unit, and continue on, skipping remaining R
2498                --  lines for this unit.
2499
2500                if Ignore_Errors then
2501                   Cumulative_Restrictions := Save_R;
2502                   ALIs.Table (Id).Restrictions := No_Restrictions;
2503
2504                   loop
2505                      Skip_Eol;
2506                      C := Getc;
2507                      exit when C /= 'R';
2508                   end loop;
2509
2510                --  In normal mode, this is a fatal error
2511
2512                else
2513                   Fatal_Error;
2514                end if;
2515          end Scan_Restrictions;
2516       end if;
2517
2518       --  Acquire additional restrictions (No_Dependence) lines if present
2519
2520       while C = 'R' loop
2521          if Ignore ('R') then
2522             Skip_Line;
2523          else
2524             Skip_Space;
2525             No_Deps.Append ((Id, Get_Name));
2526             Skip_Eol;
2527          end if;
2528
2529          C := Getc;
2530       end loop;
2531
2532       --  Acquire 'I' lines if present
2533
2534       Check_Unknown_Line;
2535
2536       while C = 'I' loop
2537          if Ignore ('I') then
2538             Skip_Line;
2539
2540          else
2541             declare
2542                Int_Num : Nat;
2543                I_State : Character;
2544                Line_No : Nat;
2545
2546             begin
2547                Int_Num := Get_Nat;
2548                Skip_Space;
2549                I_State := Getc;
2550                Line_No := Get_Nat;
2551
2552                Interrupt_States.Append (
2553                  (Interrupt_Id    => Int_Num,
2554                   Interrupt_State => I_State,
2555                   IS_Pragma_Line  => Line_No));
2556
2557                ALIs.Table (Id).Last_Interrupt_State := Interrupt_States.Last;
2558                Skip_Eol;
2559             end;
2560          end if;
2561
2562          C := Getc;
2563       end loop;
2564
2565       --  Acquire 'S' lines if present
2566
2567       Check_Unknown_Line;
2568
2569       while C = 'S' loop
2570          if Ignore ('S') then
2571             Skip_Line;
2572
2573          else
2574             declare
2575                Policy     : Character;
2576                First_Prio : Nat;
2577                Last_Prio  : Nat;
2578                Line_No    : Nat;
2579
2580             begin
2581                Checkc (' ');
2582                Skip_Space;
2583
2584                Policy := Getc;
2585                Skip_Space;
2586                First_Prio := Get_Nat;
2587                Last_Prio := Get_Nat;
2588                Line_No := Get_Nat;
2589
2590                Specific_Dispatching.Append (
2591                  (Dispatching_Policy => Policy,
2592                   First_Priority     => First_Prio,
2593                   Last_Priority      => Last_Prio,
2594                   PSD_Pragma_Line    => Line_No));
2595
2596                ALIs.Table (Id).Last_Specific_Dispatching :=
2597                  Specific_Dispatching.Last;
2598
2599                Skip_Eol;
2600             end;
2601          end if;
2602
2603          C := Getc;
2604       end loop;
2605
2606       --  Loop to acquire unit entries
2607
2608       U_Loop : loop
2609          Check_Unknown_Line;
2610          exit U_Loop when C /= 'U';
2611
2612          --  Note: as per spec, we never ignore U lines
2613
2614          Checkc (' ');
2615          Skip_Space;
2616          Units.Increment_Last;
2617
2618          if ALIs.Table (Id).First_Unit = No_Unit_Id then
2619             ALIs.Table (Id).First_Unit := Units.Last;
2620          end if;
2621
2622          declare
2623             UL : Unit_Record renames Units.Table (Units.Last);
2624
2625          begin
2626             UL.Uname                      := Get_Unit_Name;
2627             UL.Predefined                 := Is_Predefined_Unit;
2628             UL.Internal                   := Is_Internal_Unit;
2629             UL.My_ALI                     := Id;
2630             UL.Sfile                      := Get_File_Name (Lower => True);
2631             UL.Pure                       := False;
2632             UL.Preelab                    := False;
2633             UL.No_Elab                    := False;
2634             UL.Shared_Passive             := False;
2635             UL.RCI                        := False;
2636             UL.Remote_Types               := False;
2637             UL.Serious_Errors             := False;
2638             UL.Has_RACW                   := False;
2639             UL.Init_Scalars               := False;
2640             UL.Is_Generic                 := False;
2641             UL.Icasing                    := Mixed_Case;
2642             UL.Kcasing                    := All_Lower_Case;
2643             UL.Dynamic_Elab               := False;
2644             UL.Elaborate_Body             := False;
2645             UL.Set_Elab_Entity            := False;
2646             UL.Version                    := "00000000";
2647             UL.First_With                 := Withs.Last + 1;
2648             UL.First_Arg                  := First_Arg;
2649             UL.First_Invocation_Construct := Invocation_Constructs.Last + 1;
2650             UL.Last_Invocation_Construct  := No_Invocation_Construct;
2651             UL.First_Invocation_Relation  := Invocation_Relations.Last + 1;
2652             UL.Last_Invocation_Relation   := No_Invocation_Relation;
2653             UL.Elab_Position              := 0;
2654             UL.SAL_Interface              := ALIs.Table (Id).SAL_Interface;
2655             UL.Directly_Scanned           := Directly_Scanned;
2656             UL.Body_Needed_For_SAL        := False;
2657             UL.Elaborate_Body_Desirable   := False;
2658             UL.Optimize_Alignment         := 'O';
2659             UL.Has_Finalizer              := False;
2660             UL.Primary_Stack_Count        := 0;
2661             UL.Sec_Stack_Count            := 0;
2662
2663             if Debug_Flag_U then
2664                Write_Str (" ----> reading unit ");
2665                Write_Int (Int (Units.Last));
2666                Write_Str ("  ");
2667                Write_Unit_Name (UL.Uname);
2668                Write_Str (" from file ");
2669                Write_Name (UL.Sfile);
2670                Write_Eol;
2671             end if;
2672          end;
2673
2674          --  Check for duplicated unit in different files
2675
2676          declare
2677             Info : constant Int := Get_Name_Table_Int
2678                                      (Units.Table (Units.Last).Uname);
2679          begin
2680             if Info /= 0
2681               and then Units.Table (Units.Last).Sfile /=
2682                        Units.Table (Unit_Id (Info)).Sfile
2683             then
2684                --  If Err is set then ignore duplicate unit name. This is the
2685                --  case of a call from gnatmake, where the situation can arise
2686                --  from substitution of source files. In such situations, the
2687                --  processing in gnatmake will always result in any required
2688                --  recompilations in any case, and if we consider this to be
2689                --  an error we get strange cases (for example when a generic
2690                --  instantiation is replaced by a normal package) where we
2691                --  read the old ali file, decide to recompile, and then decide
2692                --  that the old and new ali files are incompatible.
2693
2694                if Err then
2695                   null;
2696
2697                --  If Err is not set, then this is a fatal error. This is
2698                --  the case of being called from the binder, where we must
2699                --  definitely diagnose this as an error.
2700
2701                else
2702                   Set_Standard_Error;
2703                   Write_Str ("error: duplicate unit name: ");
2704                   Write_Eol;
2705
2706                   Write_Str ("error: unit """);
2707                   Write_Unit_Name (Units.Table (Units.Last).Uname);
2708                   Write_Str (""" found in file """);
2709                   Write_Name_Decoded (Units.Table (Units.Last).Sfile);
2710                   Write_Char ('"');
2711                   Write_Eol;
2712
2713                   Write_Str ("error: unit """);
2714                   Write_Unit_Name (Units.Table (Unit_Id (Info)).Uname);
2715                   Write_Str (""" found in file """);
2716                   Write_Name_Decoded (Units.Table (Unit_Id (Info)).Sfile);
2717                   Write_Char ('"');
2718                   Write_Eol;
2719
2720                   Exit_Program (E_Fatal);
2721                end if;
2722             end if;
2723          end;
2724
2725          Set_Name_Table_Int
2726            (Units.Table (Units.Last).Uname, Int (Units.Last));
2727
2728          --  Scan out possible version and other parameters
2729
2730          loop
2731             Skip_Space;
2732             exit when At_Eol;
2733             C := Getc;
2734
2735             --  Version field
2736
2737             if C in '0' .. '9' or else C in 'a' .. 'f' then
2738                Units.Table (Units.Last).Version (1) := C;
2739
2740                for J in 2 .. 8 loop
2741                   C := Getc;
2742                   Units.Table (Units.Last).Version (J) := C;
2743                end loop;
2744
2745             --  BD/BN parameters
2746
2747             elsif C = 'B' then
2748                C := Getc;
2749
2750                if C = 'D' then
2751                   Check_At_End_Of_Field;
2752                   Units.Table (Units.Last).Elaborate_Body_Desirable := True;
2753
2754                elsif C = 'N' then
2755                   Check_At_End_Of_Field;
2756                   Units.Table (Units.Last).Body_Needed_For_SAL := True;
2757
2758                else
2759                   Fatal_Error_Ignore;
2760                end if;
2761
2762             --  DE parameter (Dynamic elaboration checks)
2763
2764             elsif C = 'D' then
2765                C := Getc;
2766
2767                if C = 'E' then
2768                   Check_At_End_Of_Field;
2769                   Units.Table (Units.Last).Dynamic_Elab := True;
2770                   Dynamic_Elaboration_Checks_Specified := True;
2771                else
2772                   Fatal_Error_Ignore;
2773                end if;
2774
2775             --  EB/EE parameters
2776
2777             elsif C = 'E' then
2778                C := Getc;
2779
2780                if C = 'B' then
2781                   Units.Table (Units.Last).Elaborate_Body := True;
2782                elsif C = 'E' then
2783                   Units.Table (Units.Last).Set_Elab_Entity := True;
2784                else
2785                   Fatal_Error_Ignore;
2786                end if;
2787
2788                Check_At_End_Of_Field;
2789
2790             --  GE parameter (generic)
2791
2792             elsif C = 'G' then
2793                C := Getc;
2794
2795                if C = 'E' then
2796                   Check_At_End_Of_Field;
2797                   Units.Table (Units.Last).Is_Generic := True;
2798                else
2799                   Fatal_Error_Ignore;
2800                end if;
2801
2802             --  IL/IS/IU parameters
2803
2804             elsif C = 'I' then
2805                C := Getc;
2806
2807                if C = 'L' then
2808                   Units.Table (Units.Last).Icasing := All_Lower_Case;
2809                elsif C = 'S' then
2810                   Units.Table (Units.Last).Init_Scalars := True;
2811                   Initialize_Scalars_Used := True;
2812                elsif C = 'U' then
2813                   Units.Table (Units.Last).Icasing := All_Upper_Case;
2814                else
2815                   Fatal_Error_Ignore;
2816                end if;
2817
2818                Check_At_End_Of_Field;
2819
2820             --  KM/KU parameters
2821
2822             elsif C = 'K' then
2823                C := Getc;
2824
2825                if C = 'M' then
2826                   Units.Table (Units.Last).Kcasing := Mixed_Case;
2827                elsif C = 'U' then
2828                   Units.Table (Units.Last).Kcasing := All_Upper_Case;
2829                else
2830                   Fatal_Error_Ignore;
2831                end if;
2832
2833                Check_At_End_Of_Field;
2834
2835             --  NE parameter
2836
2837             elsif C = 'N' then
2838                C := Getc;
2839
2840                if C = 'E' then
2841                   Units.Table (Units.Last).No_Elab := True;
2842                   Check_At_End_Of_Field;
2843                else
2844                   Fatal_Error_Ignore;
2845                end if;
2846
2847             --  PF/PR/PU/PK parameters
2848
2849             elsif C = 'P' then
2850                C := Getc;
2851
2852                if C = 'F' then
2853                   Units.Table (Units.Last).Has_Finalizer := True;
2854                elsif C = 'R' then
2855                   Units.Table (Units.Last).Preelab := True;
2856                elsif C = 'U' then
2857                   Units.Table (Units.Last).Pure := True;
2858                elsif C = 'K' then
2859                   Units.Table (Units.Last).Unit_Kind := 'p';
2860                else
2861                   Fatal_Error_Ignore;
2862                end if;
2863
2864                Check_At_End_Of_Field;
2865
2866             --  OL/OO/OS/OT parameters
2867
2868             elsif C = 'O' then
2869                C := Getc;
2870
2871                if C = 'L' or else C = 'O' or else C = 'S' or else C = 'T' then
2872                   Units.Table (Units.Last).Optimize_Alignment := C;
2873                else
2874                   Fatal_Error_Ignore;
2875                end if;
2876
2877                Check_At_End_Of_Field;
2878
2879             --  RC/RT parameters
2880
2881             elsif C = 'R' then
2882                C := Getc;
2883
2884                if C = 'C' then
2885                   Units.Table (Units.Last).RCI := True;
2886                elsif C = 'T' then
2887                   Units.Table (Units.Last).Remote_Types := True;
2888                elsif C = 'A' then
2889                   Units.Table (Units.Last).Has_RACW := True;
2890                else
2891                   Fatal_Error_Ignore;
2892                end if;
2893
2894                Check_At_End_Of_Field;
2895
2896             --  SE/SP/SU parameters
2897
2898             elsif C = 'S' then
2899                C := Getc;
2900
2901                if C = 'E' then
2902                   Units.Table (Units.Last).Serious_Errors := True;
2903                elsif C = 'P' then
2904                   Units.Table (Units.Last).Shared_Passive := True;
2905                elsif C = 'U' then
2906                   Units.Table (Units.Last).Unit_Kind := 's';
2907                else
2908                   Fatal_Error_Ignore;
2909                end if;
2910
2911                Check_At_End_Of_Field;
2912
2913             else
2914                C := Getc;
2915                Fatal_Error_Ignore;
2916             end if;
2917          end loop;
2918
2919          Skip_Eol;
2920
2921          C := Getc;
2922
2923          --  Scan out With lines for this unit
2924
2925          With_Loop : loop
2926             Check_Unknown_Line;
2927             exit With_Loop when C /= 'W' and then C /= 'Y' and then C /= 'Z';
2928
2929             if Ignore ('W') then
2930                Skip_Line;
2931
2932             else
2933                Checkc (' ');
2934                Skip_Space;
2935                Withs.Increment_Last;
2936                Withs.Table (Withs.Last).Uname              := Get_Unit_Name;
2937                Withs.Table (Withs.Last).Elaborate          := False;
2938                Withs.Table (Withs.Last).Elaborate_All      := False;
2939                Withs.Table (Withs.Last).Elab_Desirable     := False;
2940                Withs.Table (Withs.Last).Elab_All_Desirable := False;
2941                Withs.Table (Withs.Last).SAL_Interface      := False;
2942                Withs.Table (Withs.Last).Limited_With       := (C = 'Y');
2943                Withs.Table (Withs.Last).Implicit_With      := (C = 'Z');
2944
2945                --  Generic case with no object file available
2946
2947                if At_Eol then
2948                   Withs.Table (Withs.Last).Sfile := No_File;
2949                   Withs.Table (Withs.Last).Afile := No_File;
2950
2951                --  Normal case
2952
2953                else
2954                   Withs.Table (Withs.Last).Sfile := Get_File_Name
2955                                                       (Lower => True);
2956                   Withs.Table (Withs.Last).Afile := Get_File_Name
2957                                                       (Lower => True);
2958
2959                   --  Scan out possible E, EA, ED, and AD parameters
2960
2961                   while not At_Eol loop
2962                      Skip_Space;
2963
2964                      if Nextc = 'A' then
2965                         P := P + 1;
2966                         Checkc ('D');
2967                         Check_At_End_Of_Field;
2968
2969                         --  Store AD indication unless ignore required
2970
2971                         Withs.Table (Withs.Last).Elab_All_Desirable := True;
2972
2973                      elsif Nextc = 'E' then
2974                         P := P + 1;
2975
2976                         if At_End_Of_Field then
2977                            Withs.Table (Withs.Last).Elaborate := True;
2978
2979                         elsif Nextc = 'A' then
2980                            P := P + 1;
2981                            Check_At_End_Of_Field;
2982                            Withs.Table (Withs.Last).Elaborate_All := True;
2983
2984                         else
2985                            Checkc ('D');
2986                            Check_At_End_Of_Field;
2987
2988                            --  Store ED indication
2989
2990                            Withs.Table (Withs.Last).Elab_Desirable := True;
2991                         end if;
2992
2993                      else
2994                         Fatal_Error;
2995                      end if;
2996                   end loop;
2997                end if;
2998
2999                Skip_Eol;
3000             end if;
3001
3002             C := Getc;
3003          end loop With_Loop;
3004
3005          Units.Table (Units.Last).Last_With := Withs.Last;
3006          Units.Table (Units.Last).Last_Arg  := Args.Last;
3007
3008          --  Scan out task stack information for the unit if present
3009
3010          Check_Unknown_Line;
3011
3012          if C = 'T' then
3013             if Ignore ('T') then
3014                Skip_Line;
3015
3016             else
3017                Checkc (' ');
3018                Skip_Space;
3019
3020                Units.Table (Units.Last).Primary_Stack_Count := Get_Nat;
3021                Skip_Space;
3022                Units.Table (Units.Last).Sec_Stack_Count := Get_Nat;
3023                Skip_Space;
3024                Skip_Eol;
3025             end if;
3026
3027             C := Getc;
3028          end if;
3029
3030          --  If there are linker options lines present, scan them
3031
3032          Name_Len := 0;
3033
3034          Linker_Options_Loop : loop
3035             Check_Unknown_Line;
3036             exit Linker_Options_Loop when C /= 'L';
3037
3038             if Ignore ('L') then
3039                Skip_Line;
3040
3041             else
3042                Checkc (' ');
3043                Skip_Space;
3044                Checkc ('"');
3045
3046                loop
3047                   C := Getc;
3048
3049                   if C < Character'Val (16#20#)
3050                     or else C > Character'Val (16#7E#)
3051                   then
3052                      Fatal_Error_Ignore;
3053
3054                   elsif C = '{' then
3055                      C := Character'Val (0);
3056
3057                      declare
3058                         V : Natural;
3059
3060                      begin
3061                         V := 0;
3062                         for J in 1 .. 2 loop
3063                            C := Getc;
3064
3065                            if C in '0' .. '9' then
3066                               V := V * 16 +
3067                                      Character'Pos (C) -
3068                                        Character'Pos ('0');
3069
3070                            elsif C in 'A' .. 'F' then
3071                               V := V * 16 +
3072                                      Character'Pos (C) -
3073                                        Character'Pos ('A') +
3074                                          10;
3075
3076                            else
3077                               Fatal_Error_Ignore;
3078                            end if;
3079                         end loop;
3080
3081                         Checkc ('}');
3082                         Add_Char_To_Name_Buffer (Character'Val (V));
3083                      end;
3084
3085                   else
3086                      if C = '"' then
3087                         exit when Nextc /= '"';
3088                         C := Getc;
3089                      end if;
3090
3091                      Add_Char_To_Name_Buffer (C);
3092                   end if;
3093                end loop;
3094
3095                Add_Char_To_Name_Buffer (NUL);
3096                Skip_Eol;
3097             end if;
3098
3099             C := Getc;
3100          end loop Linker_Options_Loop;
3101
3102          --  Store the linker options entry if one was found
3103
3104          if Name_Len /= 0 then
3105             Linker_Options.Increment_Last;
3106
3107             Linker_Options.Table (Linker_Options.Last).Name :=
3108               Name_Enter;
3109
3110             Linker_Options.Table (Linker_Options.Last).Unit :=
3111               Units.Last;
3112
3113             Linker_Options.Table (Linker_Options.Last).Internal_File :=
3114               Is_Internal_File_Name (F);
3115          end if;
3116
3117          --  If there are notes present, scan them
3118
3119          Notes_Loop : loop
3120             Check_Unknown_Line;
3121             exit Notes_Loop when C /= 'N';
3122
3123             if Ignore ('N') then
3124                Skip_Line;
3125
3126             else
3127                Checkc (' ');
3128
3129                Notes.Increment_Last;
3130                Notes.Table (Notes.Last).Pragma_Type := Getc;
3131                Notes.Table (Notes.Last).Pragma_Line := Get_Nat;
3132                Checkc (':');
3133                Notes.Table (Notes.Last).Pragma_Col  := Get_Nat;
3134
3135                if not At_Eol and then Nextc = ':' then
3136                   Checkc (':');
3137                   Notes.Table (Notes.Last).Pragma_Source_File :=
3138                     Get_File_Name (Lower => True);
3139                else
3140                   Notes.Table (Notes.Last).Pragma_Source_File :=
3141                     Units.Table (Units.Last).Sfile;
3142                end if;
3143
3144                if At_Eol then
3145                   Notes.Table (Notes.Last).Pragma_Args := No_Name;
3146
3147                else
3148                   --  Note: can't use Get_Name here as the remainder of the
3149                   --  line is unstructured text whose syntax depends on the
3150                   --  particular pragma used.
3151
3152                   Checkc (' ');
3153
3154                   Name_Len := 0;
3155                   while not At_Eol loop
3156                      Add_Char_To_Name_Buffer (Getc);
3157                   end loop;
3158                end if;
3159
3160                Skip_Eol;
3161             end if;
3162
3163             C := Getc;
3164          end loop Notes_Loop;
3165       end loop U_Loop;
3166
3167       --  End loop through units for one ALI file
3168
3169       ALIs.Table (Id).Last_Unit := Units.Last;
3170       ALIs.Table (Id).Sfile := Units.Table (ALIs.Table (Id).First_Unit).Sfile;
3171
3172       --  Set types of the units (there can be at most 2 of them)
3173
3174       if ALIs.Table (Id).First_Unit /= ALIs.Table (Id).Last_Unit then
3175          Units.Table (ALIs.Table (Id).First_Unit).Utype := Is_Body;
3176          Units.Table (ALIs.Table (Id).Last_Unit).Utype  := Is_Spec;
3177
3178       else
3179          --  Deal with body only and spec only cases, note that the reason we
3180          --  do our own checking of the name (rather than using Is_Body_Name)
3181          --  is that Uname drags in far too much compiler junk.
3182
3183          Get_Name_String (Units.Table (Units.Last).Uname);
3184
3185          if Name_Buffer (Name_Len) = 'b' then
3186             Units.Table (Units.Last).Utype := Is_Body_Only;
3187          else
3188             Units.Table (Units.Last).Utype := Is_Spec_Only;
3189          end if;
3190       end if;
3191
3192       --  Scan out external version references and put in hash table
3193
3194       E_Loop : loop
3195          Check_Unknown_Line;
3196          exit E_Loop when C /= 'E';
3197
3198          if Ignore ('E') then
3199             Skip_Line;
3200
3201          else
3202             Checkc (' ');
3203             Skip_Space;
3204
3205             Name_Len := 0;
3206             Name_Len := 0;
3207             loop
3208                C := Getc;
3209
3210                if C < ' ' then
3211                   Fatal_Error;
3212                end if;
3213
3214                exit when At_End_Of_Field;
3215                Add_Char_To_Name_Buffer (C);
3216             end loop;
3217
3218             Version_Ref.Set (new String'(Name_Buffer (1 .. Name_Len)), True);
3219             Skip_Eol;
3220          end if;
3221
3222          C := Getc;
3223       end loop E_Loop;
3224
3225       --  Scan out source dependency lines for this ALI file
3226
3227       ALIs.Table (Id).First_Sdep := Sdep.Last + 1;
3228
3229       D_Loop : loop
3230          Check_Unknown_Line;
3231          exit D_Loop when C /= 'D';
3232
3233          if Ignore ('D') then
3234             Skip_Line;
3235
3236          else
3237             Checkc (' ');
3238             Skip_Space;
3239             Sdep.Increment_Last;
3240
3241             --  The file/path name may be quoted
3242
3243             Sdep.Table (Sdep.Last).Sfile :=
3244               Get_File_Name (Lower => True, May_Be_Quoted => True);
3245
3246             Sdep.Table (Sdep.Last).Stamp := Get_Stamp;
3247             Sdep.Table (Sdep.Last).Dummy_Entry :=
3248               (Sdep.Table (Sdep.Last).Stamp = Dummy_Time_Stamp);
3249
3250             --  Acquire checksum value
3251
3252             Skip_Space;
3253
3254             declare
3255                Ctr : Natural;
3256                Chk : Word;
3257
3258             begin
3259                Ctr := 0;
3260                Chk := 0;
3261
3262                loop
3263                   exit when At_Eol or else Ctr = 8;
3264
3265                   if Nextc in '0' .. '9' then
3266                      Chk := Chk * 16 +
3267                               Character'Pos (Nextc) - Character'Pos ('0');
3268
3269                   elsif Nextc in 'a' .. 'f' then
3270                      Chk := Chk * 16 +
3271                               Character'Pos (Nextc) - Character'Pos ('a') + 10;
3272
3273                   else
3274                      exit;
3275                   end if;
3276
3277                   Ctr := Ctr + 1;
3278                   P := P + 1;
3279                end loop;
3280
3281                if Ctr = 8 and then At_End_Of_Field then
3282                   Sdep.Table (Sdep.Last).Checksum := Chk;
3283                else
3284                   Fatal_Error;
3285                end if;
3286             end;
3287
3288             --  Acquire (sub)unit and reference file name entries
3289
3290             Sdep.Table (Sdep.Last).Subunit_Name := No_Name;
3291             Sdep.Table (Sdep.Last).Unit_Name    := No_Name;
3292             Sdep.Table (Sdep.Last).Rfile        :=
3293               Sdep.Table (Sdep.Last).Sfile;
3294             Sdep.Table (Sdep.Last).Start_Line   := 1;
3295
3296             if not At_Eol then
3297                Skip_Space;
3298
3299                --  Here for (sub)unit name
3300
3301                if Nextc not in '0' .. '9' then
3302                   Name_Len := 0;
3303                   while not At_End_Of_Field loop
3304                      Add_Char_To_Name_Buffer (Getc);
3305                   end loop;
3306
3307                   --  Set the (sub)unit name. Note that we use Name_Find rather
3308                   --  than Name_Enter here as the subunit name may already
3309                   --  have been put in the name table by the Project Manager.
3310
3311                   if Name_Len <= 2
3312                     or else Name_Buffer (Name_Len - 1) /= '%'
3313                   then
3314                      Sdep.Table (Sdep.Last).Subunit_Name := Name_Find;
3315                   else
3316                      Name_Len := Name_Len - 2;
3317                      Sdep.Table (Sdep.Last).Unit_Name := Name_Find;
3318                   end if;
3319
3320                   Skip_Space;
3321                end if;
3322
3323                --  Here for reference file name entry
3324
3325                if Nextc in '0' .. '9' then
3326                   Sdep.Table (Sdep.Last).Start_Line := Get_Nat;
3327                   Checkc (':');
3328
3329                   Name_Len := 0;
3330
3331                   while not At_End_Of_Field loop
3332                      Add_Char_To_Name_Buffer (Getc);
3333                   end loop;
3334
3335                   Sdep.Table (Sdep.Last).Rfile := Name_Enter;
3336                end if;
3337             end if;
3338
3339             Skip_Eol;
3340          end if;
3341
3342          C := Getc;
3343       end loop D_Loop;
3344
3345       ALIs.Table (Id).Last_Sdep := Sdep.Last;
3346
3347       --  Loop through invocation-graph lines
3348
3349       G_Loop : loop
3350          Check_Unknown_Line;
3351          exit G_Loop when C /= 'G';
3352
3353          Scan_Invocation_Graph_Line;
3354
3355          C := Getc;
3356       end loop G_Loop;
3357
3358       --  We must at this stage be at an Xref line or the end of file
3359
3360       if C = EOF then
3361          return Id;
3362       end if;
3363
3364       Check_Unknown_Line;
3365
3366       if C /= 'X' then
3367          Fatal_Error;
3368       end if;
3369
3370       --  This ALI parser does not care about Xref lines.
3371
3372       return Id;
3373
3374    exception
3375       when Bad_ALI_Format =>
3376          return No_ALI_Id;
3377    end Scan_ALI;
3378
3379    --------------
3380    -- IS_Scope --
3381    --------------
3382
3383    function IS_Scope (IS_Id : Invocation_Signature_Id) return Name_Id is
3384    begin
3385       pragma Assert (Present (IS_Id));
3386       return Invocation_Signatures.Table (IS_Id).Scope;
3387    end IS_Scope;
3388
3389    ---------
3390    -- SEq --
3391    ---------
3392
3393    function SEq (F1, F2 : String_Ptr) return Boolean is
3394    begin
3395       return F1.all = F2.all;
3396    end SEq;
3397
3398    -----------------------------------
3399    -- Set_Invocation_Graph_Encoding --
3400    -----------------------------------
3401
3402    procedure Set_Invocation_Graph_Encoding
3403      (Kind         : Invocation_Graph_Encoding_Kind;
3404       Update_Units : Boolean := True)
3405    is
3406    begin
3407       Compile_Time_Invocation_Graph_Encoding := Kind;
3408
3409       --  Update the invocation-graph encoding of the current unit only when
3410       --  requested by the caller.
3411
3412       if Update_Units then
3413          declare
3414             Curr_Unit : Unit_Record renames Units.Table (Units.Last);
3415             Curr_ALI  : ALIs_Record renames ALIs.Table  (Curr_Unit.My_ALI);
3416
3417          begin
3418             Curr_ALI.Invocation_Graph_Encoding := Kind;
3419          end;
3420       end if;
3421    end Set_Invocation_Graph_Encoding;
3422
3423    -----------
3424    -- SHash --
3425    -----------
3426
3427    function SHash (S : String_Ptr) return Vindex is
3428       H : Word;
3429
3430    begin
3431       H := 0;
3432       for J in S.all'Range loop
3433          H := H * 2 + Character'Pos (S (J));
3434       end loop;
3435
3436       return Vindex (Vindex'First + Vindex (H mod Vindex'Range_Length));
3437    end SHash;
3438
3439    ---------------
3440    -- Signature --
3441    ---------------
3442
3443    function Signature
3444      (IC_Id : Invocation_Construct_Id) return Invocation_Signature_Id
3445    is
3446    begin
3447       pragma Assert (Present (IC_Id));
3448       return Invocation_Constructs.Table (IC_Id).Signature;
3449    end Signature;
3450
3451    --------------------
3452    -- Spec_Placement --
3453    --------------------
3454
3455    function Spec_Placement
3456      (IC_Id : Invocation_Construct_Id) return Declaration_Placement_Kind
3457    is
3458    begin
3459       pragma Assert (Present (IC_Id));
3460       return Invocation_Constructs.Table (IC_Id).Spec_Placement;
3461    end Spec_Placement;
3462
3463    ------------
3464    -- Target --
3465    ------------
3466
3467    function Target
3468      (IR_Id : Invocation_Relation_Id) return Invocation_Signature_Id
3469    is
3470    begin
3471       pragma Assert (Present (IR_Id));
3472       return Invocation_Relations.Table (IR_Id).Target;
3473    end Target;
3474
3475 end ALI;