gcc/ada/bindo-writers.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                        B I N D O . W R I T E R S                         --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --             Copyright (C) 2019-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 Binderr; use Binderr;
  27 with Butil;   use Butil;
  28 with Debug;   use Debug;
  29 with Fname;   use Fname;
  30 with Opt;     use Opt;
  31 with Output;  use Output;
  32
  33 with Bindo.Units;
  34 use  Bindo.Units;
  35
  36 with GNAT;        use GNAT;
  37 with GNAT.Graphs; use GNAT.Graphs;
  38 with GNAT.Sets;   use GNAT.Sets;
  39
  40 package body Bindo.Writers is
  41
  42    -----------------
  43    -- ALI_Writers --
  44    -----------------
  45
  46    package body ALI_Writers is
  47
  48       -----------------------
  49       -- Local subprograms --
  50       -----------------------
  51
  52       procedure Write_All_Units;
  53       pragma Inline (Write_All_Units);
  54       --  Write the common form of units to standard output
  55
  56       procedure Write_Invocation_Construct (IC_Id : Invocation_Construct_Id);
  57       pragma Inline (Write_Invocation_Construct);
  58       --  Write invocation construct IC_Id to standard output
  59
  60       procedure Write_Invocation_Relation (IR_Id : Invocation_Relation_Id);
  61       pragma Inline (Write_Invocation_Relation);
  62       --  Write invocation relation IR_Id to standard output
  63
  64       procedure Write_Invocation_Signature (IS_Id : Invocation_Signature_Id);
  65       pragma Inline (Write_Invocation_Signature);
  66       --  Write invocation signature IS_Id to standard output
  67
  68       procedure Write_Statistics;
  69       pragma Inline (Write_Statistics);
  70       --  Write the statistical information of units to standard output
  71
  72       procedure Write_Unit (U_Id : Unit_Id);
  73       pragma Inline (Write_Unit);
  74       --  Write the invocation constructs and relations of unit U_Id to
  75       --  standard output.
  76
  77       procedure Write_Unit_Common (U_Id : Unit_Id);
  78       pragma Inline (Write_Unit_Common);
  79       --  Write the common form of unit U_Id to standard output
  80
  81       -----------
  82       -- Debug --
  83       -----------
  84
  85       procedure pau renames Write_All_Units;
  86       pragma Unreferenced (pau);
  87
  88       procedure pu (U_Id : Unit_Id) renames Write_Unit_Common;
  89       pragma Unreferenced (pu);
  90
  91       ----------------------
  92       -- Write_ALI_Tables --
  93       ----------------------
  94
  95       procedure Write_ALI_Tables is
  96       begin
  97          --  Nothing to do when switch -d_A (output invocation tables) is not
  98          --  in effect.
  99
 100          if not Debug_Flag_Underscore_AA then
 101             return;
 102          end if;
 103
 104          Write_Str ("ALI Tables");
 105          Write_Eol;
 106          Write_Eol;
 107
 108          Write_Statistics;
 109          For_Each_Unit (Write_Unit'Access);
 110
 111          Write_Str ("ALI Tables end");
 112          Write_Eol;
 113          Write_Eol;
 114       end Write_ALI_Tables;
 115
 116       ---------------------
 117       -- Write_All_Units --
 118       ---------------------
 119
 120       procedure Write_All_Units is
 121       begin
 122          For_Each_Unit (Write_Unit_Common'Access);
 123       end Write_All_Units;
 124
 125       --------------------------------
 126       -- Write_Invocation_Construct --
 127       --------------------------------
 128
 129       procedure Write_Invocation_Construct (IC_Id : Invocation_Construct_Id) is
 130       begin
 131          pragma Assert (Present (IC_Id));
 132
 133          Write_Str ("  invocation construct (IC_Id_");
 134          Write_Int (Int (IC_Id));
 135          Write_Str (")");
 136          Write_Eol;
 137
 138          Write_Str ("    Body_Placement = ");
 139          Write_Str (Body_Placement (IC_Id)'Img);
 140          Write_Eol;
 141
 142          Write_Str ("    Kind = ");
 143          Write_Str (Kind (IC_Id)'Img);
 144          Write_Eol;
 145
 146          Write_Str ("    Spec_Placement = ");
 147          Write_Str (Spec_Placement (IC_Id)'Img);
 148          Write_Eol;
 149
 150          Write_Invocation_Signature (Signature (IC_Id));
 151          Write_Eol;
 152       end Write_Invocation_Construct;
 153
 154       -------------------------------
 155       -- Write_Invocation_Relation --
 156       -------------------------------
 157
 158       procedure Write_Invocation_Relation (IR_Id : Invocation_Relation_Id) is
 159       begin
 160          pragma Assert (Present (IR_Id));
 161
 162          Write_Str ("  invocation relation (IR_Id_");
 163          Write_Int (Int (IR_Id));
 164          Write_Str (")");
 165          Write_Eol;
 166
 167          if Present (Extra (IR_Id)) then
 168             Write_Str  ("    Extra = ");
 169             Write_Name (Extra (IR_Id));
 170          else
 171             Write_Str ("    Extra = none");
 172          end if;
 173
 174          Write_Eol;
 175          Write_Str ("    Invoker");
 176          Write_Eol;
 177
 178          Write_Invocation_Signature (Invoker (IR_Id));
 179
 180          Write_Str ("    Kind = ");
 181          Write_Str (Kind (IR_Id)'Img);
 182          Write_Eol;
 183
 184          Write_Str ("    Target");
 185          Write_Eol;
 186
 187          Write_Invocation_Signature (Target (IR_Id));
 188          Write_Eol;
 189       end Write_Invocation_Relation;
 190
 191       --------------------------------
 192       -- Write_Invocation_Signature --
 193       --------------------------------
 194
 195       procedure Write_Invocation_Signature (IS_Id : Invocation_Signature_Id) is
 196       begin
 197          pragma Assert (Present (IS_Id));
 198
 199          Write_Str ("    Signature (IS_Id_");
 200          Write_Int (Int (IS_Id));
 201          Write_Str (")");
 202          Write_Eol;
 203
 204          Write_Str ("      Column = ");
 205          Write_Int (Int (Column (IS_Id)));
 206          Write_Eol;
 207
 208          Write_Str ("      Line = ");
 209          Write_Int (Int (Line (IS_Id)));
 210          Write_Eol;
 211
 212          if Present (Locations (IS_Id)) then
 213             Write_Str  ("      Locations = ");
 214             Write_Name (Locations (IS_Id));
 215          else
 216             Write_Str ("      Locations = none");
 217          end if;
 218
 219          Write_Eol;
 220          Write_Str  ("      Name = ");
 221          Write_Name (Name (IS_Id));
 222          Write_Eol;
 223
 224          Write_Str  ("      Scope = ");
 225          Write_Name (IS_Scope (IS_Id));
 226          Write_Eol;
 227       end Write_Invocation_Signature;
 228
 229       ----------------------
 230       -- Write_Statistics --
 231       ----------------------
 232
 233       procedure Write_Statistics is
 234       begin
 235          Write_Str ("Units             : ");
 236          Write_Num (Int (Number_Of_Units));
 237          Write_Eol;
 238
 239          Write_Str ("Units to elaborate: ");
 240          Write_Num (Int (Number_Of_Elaborable_Units));
 241          Write_Eol;
 242          Write_Eol;
 243       end Write_Statistics;
 244
 245       ----------------
 246       -- Write_Unit --
 247       ----------------
 248
 249       procedure Write_Unit (U_Id : Unit_Id) is
 250          pragma Assert (Present (U_Id));
 251
 252          U_Rec : Unit_Record renames ALI.Units.Table (U_Id);
 253
 254       begin
 255          Write_Unit_Common (U_Id);
 256
 257          Write_Str ("  First_Invocation_Construct (IC_Id_");
 258          Write_Int (Int (U_Rec.First_Invocation_Construct));
 259          Write_Str (")");
 260          Write_Eol;
 261
 262          Write_Str ("  Last_Invocation_Construct  (IC_Id_");
 263          Write_Int (Int (U_Rec.Last_Invocation_Construct));
 264          Write_Str (")");
 265          Write_Eol;
 266
 267          Write_Str ("  First_Invocation_Relation  (IR_Id_");
 268          Write_Int (Int (U_Rec.First_Invocation_Relation));
 269          Write_Str (")");
 270          Write_Eol;
 271
 272          Write_Str ("  Last_Invocation_Relation   (IR_Id_");
 273          Write_Int (Int (U_Rec.Last_Invocation_Relation));
 274          Write_Str (")");
 275          Write_Eol;
 276
 277          Write_Str ("  Invocation_Graph_Encoding = ");
 278          Write_Str (Invocation_Graph_Encoding (U_Id)'Img);
 279          Write_Eol;
 280          Write_Eol;
 281
 282          For_Each_Invocation_Construct
 283            (U_Id      => U_Id,
 284             Processor => Write_Invocation_Construct'Access);
 285
 286          For_Each_Invocation_Relation
 287            (U_Id      => U_Id,
 288             Processor => Write_Invocation_Relation'Access);
 289       end Write_Unit;
 290
 291       -----------------------
 292       -- Write_Unit_Common --
 293       -----------------------
 294
 295       procedure Write_Unit_Common (U_Id : Unit_Id) is
 296          pragma Assert (Present (U_Id));
 297
 298          U_Rec : Unit_Record renames ALI.Units.Table (U_Id);
 299
 300       begin
 301          Write_Str  ("unit (U_Id_");
 302          Write_Int  (Int (U_Id));
 303          Write_Str  (") name = ");
 304          Write_Name (U_Rec.Uname);
 305          Write_Eol;
 306
 307          if U_Rec.SAL_Interface then
 308             Write_Str ("  SAL_Interface = True");
 309             Write_Eol;
 310          end if;
 311       end Write_Unit_Common;
 312    end ALI_Writers;
 313
 314    -------------------
 315    -- Cycle_Writers --
 316    -------------------
 317
 318    package body Cycle_Writers is
 319
 320       -----------------------
 321       -- Local subprograms --
 322       -----------------------
 323
 324       procedure Write_Cycle
 325         (G     : Library_Graph;
 326          Cycle : Library_Graph_Cycle_Id);
 327       pragma Inline (Write_Cycle);
 328       --  Write the path of cycle Cycle found in library graph G to standard
 329       --  output.
 330
 331       procedure Write_Cyclic_Edge
 332         (G    : Library_Graph;
 333          Edge : Library_Graph_Edge_Id);
 334       pragma Inline (Write_Cyclic_Edge);
 335       --  Write cyclic edge Edge of library graph G to standard
 336
 337       -----------
 338       -- Debug --
 339       -----------
 340
 341       procedure palgc (G : Library_Graph) renames Write_Cycles;
 342       pragma Unreferenced (palgc);
 343
 344       procedure plgc
 345         (G     : Library_Graph;
 346          Cycle : Library_Graph_Cycle_Id) renames Write_Cycle;
 347       pragma Unreferenced (plgc);
 348
 349       -----------------
 350       -- Write_Cycle --
 351       -----------------
 352
 353       procedure Write_Cycle
 354         (G     : Library_Graph;
 355          Cycle : Library_Graph_Cycle_Id)
 356       is
 357          Edge : Library_Graph_Edge_Id;
 358          Iter : Edges_Of_Cycle_Iterator;
 359
 360       begin
 361          pragma Assert (Present (G));
 362          pragma Assert (Present (Cycle));
 363
 364          --  Nothing to do when switch -d_P (output cycle paths) is not in
 365          --  effect.
 366
 367          if not Debug_Flag_Underscore_PP then
 368             return;
 369          end if;
 370
 371          Write_Str ("cycle (LGC_Id_");
 372          Write_Int (Int (Cycle));
 373          Write_Str (")");
 374          Write_Eol;
 375
 376          Iter := Iterate_Edges_Of_Cycle (G, Cycle);
 377          while Has_Next (Iter) loop
 378             Next (Iter, Edge);
 379
 380             Write_Cyclic_Edge (G, Edge);
 381          end loop;
 382
 383          Write_Eol;
 384       end Write_Cycle;
 385
 386       ------------------
 387       -- Write_Cycles --
 388       ------------------
 389
 390       procedure Write_Cycles (G : Library_Graph) is
 391          Cycle : Library_Graph_Cycle_Id;
 392          Iter  : All_Cycle_Iterator;
 393
 394       begin
 395          pragma Assert (Present (G));
 396
 397          Iter := Iterate_All_Cycles (G);
 398          while Has_Next (Iter) loop
 399             Next (Iter, Cycle);
 400
 401             Write_Cycle (G, Cycle);
 402          end loop;
 403       end Write_Cycles;
 404
 405       -----------------------
 406       -- Write_Cyclic_Edge --
 407       -----------------------
 408
 409       procedure Write_Cyclic_Edge
 410         (G    : Library_Graph;
 411          Edge : Library_Graph_Edge_Id)
 412       is
 413          pragma Assert (Present (G));
 414          pragma Assert (Present (Edge));
 415
 416          Pred : constant Library_Graph_Vertex_Id := Predecessor (G, Edge);
 417          Succ : constant Library_Graph_Vertex_Id := Successor   (G, Edge);
 418
 419       begin
 420          Indent_By (Nested_Indentation);
 421          Write_Name (Name (G, Succ));
 422          Write_Str  (" --> ");
 423          Write_Name (Name (G, Pred));
 424          Write_Str  ("   ");
 425
 426          if Is_Elaborate_All_Edge (G, Edge) then
 427             Write_Str ("Elaborate_All edge");
 428
 429          elsif Is_Elaborate_Body_Edge (G, Edge) then
 430             Write_Str ("Elaborate_Body edge");
 431
 432          elsif Is_Elaborate_Edge (G, Edge) then
 433             Write_Str ("Elaborate edge");
 434
 435          elsif Is_Forced_Edge (G, Edge) then
 436             Write_Str ("forced edge");
 437
 438          elsif Is_Invocation_Edge (G, Edge) then
 439             Write_Str ("invocation edge");
 440
 441          else
 442             pragma Assert (Is_With_Edge (G, Edge));
 443
 444             Write_Str ("with edge");
 445          end if;
 446
 447          Write_Eol;
 448       end Write_Cyclic_Edge;
 449    end Cycle_Writers;
 450
 451    ------------------------
 452    -- Dependency_Writers --
 453    ------------------------
 454
 455    package body Dependency_Writers is
 456
 457       -----------------------
 458       -- Local subprograms --
 459       -----------------------
 460
 461       procedure Write_Dependencies_Of_Vertex
 462         (G      : Library_Graph;
 463          Vertex : Library_Graph_Vertex_Id);
 464       pragma Inline (Write_Dependencies_Of_Vertex);
 465       --  Write the dependencies of vertex Vertex of library graph G to
 466       --  standard output.
 467
 468       procedure Write_Dependency_Edge
 469         (G    : Library_Graph;
 470          Edge : Library_Graph_Edge_Id);
 471       pragma Inline (Write_Dependency_Edge);
 472       --  Write the dependency described by edge Edge of library graph G to
 473       --  standard output.
 474
 475       ------------------------
 476       -- Write_Dependencies --
 477       ------------------------
 478
 479       procedure Write_Dependencies (G : Library_Graph) is
 480          Use_Formatting : constant Boolean := not Zero_Formatting;
 481
 482          Iter   : Library_Graphs.All_Vertex_Iterator;
 483          Vertex : Library_Graph_Vertex_Id;
 484
 485       begin
 486          pragma Assert (Present (G));
 487
 488          --  Nothing to do when switch -e (output complete list of elaboration
 489          --  order dependencies) is not in effect.
 490
 491          if not Elab_Dependency_Output then
 492             return;
 493          end if;
 494
 495          if Use_Formatting then
 496             Write_Eol;
 497             Write_Line ("ELABORATION ORDER DEPENDENCIES");
 498             Write_Eol;
 499          end if;
 500
 501          Info_Prefix_Suppress := True;
 502
 503          Iter := Iterate_All_Vertices (G);
 504          while Has_Next (Iter) loop
 505             Next (Iter, Vertex);
 506
 507             Write_Dependencies_Of_Vertex (G, Vertex);
 508          end loop;
 509
 510          Info_Prefix_Suppress := False;
 511
 512          if Use_Formatting then
 513             Write_Eol;
 514          end if;
 515       end Write_Dependencies;
 516
 517       ----------------------------------
 518       -- Write_Dependencies_Of_Vertex --
 519       ----------------------------------
 520
 521       procedure Write_Dependencies_Of_Vertex
 522         (G      : Library_Graph;
 523          Vertex : Library_Graph_Vertex_Id)
 524       is
 525          Edge : Library_Graph_Edge_Id;
 526          Iter : Edges_To_Successors_Iterator;
 527
 528       begin
 529          pragma Assert (Present (G));
 530          pragma Assert (Present (Vertex));
 531
 532          --  Nothing to do for internal and predefined units
 533
 534          if Is_Internal_Unit (G, Vertex)
 535            or else Is_Predefined_Unit (G, Vertex)
 536          then
 537             return;
 538          end if;
 539
 540          Iter := Iterate_Edges_To_Successors (G, Vertex);
 541          while Has_Next (Iter) loop
 542             Next (Iter, Edge);
 543
 544             Write_Dependency_Edge (G, Edge);
 545          end loop;
 546       end Write_Dependencies_Of_Vertex;
 547
 548       ---------------------------
 549       -- Write_Dependency_Edge --
 550       ---------------------------
 551
 552       procedure Write_Dependency_Edge
 553         (G    : Library_Graph;
 554          Edge : Library_Graph_Edge_Id)
 555       is
 556          pragma Assert (Present (G));
 557          pragma Assert (Present (Edge));
 558
 559          Pred : constant Library_Graph_Vertex_Id := Predecessor (G, Edge);
 560          Succ : constant Library_Graph_Vertex_Id := Successor   (G, Edge);
 561
 562       begin
 563          --  Nothing to do for internal and predefined units
 564
 565          if Is_Internal_Unit (G, Succ)
 566            or else Is_Predefined_Unit (G, Succ)
 567          then
 568             return;
 569          end if;
 570
 571          Error_Msg_Unit_1 := Name (G, Pred);
 572          Error_Msg_Unit_2 := Name (G, Succ);
 573          Error_Msg_Output
 574            (Msg  => "   unit $ must be elaborated before unit $",
 575             Info => True);
 576
 577          Error_Msg_Unit_1 := Name (G, Succ);
 578          Error_Msg_Unit_2 := Name (G, Pred);
 579
 580          if Is_Elaborate_All_Edge (G, Edge) then
 581             Error_Msg_Output
 582               (Msg  =>
 583                  "     reason: unit $ has with clause and pragma "
 584                  & "Elaborate_All for unit $",
 585                Info => True);
 586
 587          elsif Is_Elaborate_Body_Edge (G, Edge) then
 588             Error_Msg_Output
 589               (Msg  => "     reason: unit $ has with clause for unit $",
 590                Info => True);
 591
 592          elsif Is_Elaborate_Edge (G, Edge) then
 593             Error_Msg_Output
 594               (Msg  =>
 595                  "     reason: unit $ has with clause and pragma Elaborate "
 596                  & "for unit $",
 597                Info => True);
 598
 599          elsif Is_Forced_Edge (G, Edge) then
 600             Error_Msg_Output
 601               (Msg  =>
 602                  "     reason: unit $ has a dependency on unit $ forced by -f "
 603                  & "switch",
 604                Info => True);
 605
 606          elsif Is_Invocation_Edge (G, Edge) then
 607             Error_Msg_Output
 608               (Msg  =>
 609                  "     reason: unit $ invokes a construct of unit $ at "
 610                  & "elaboration time",
 611                Info => True);
 612
 613          elsif Is_Spec_Before_Body_Edge (G, Edge) then
 614             Error_Msg_Output
 615               (Msg  => "     reason: spec must be elaborated before body",
 616                Info => True);
 617
 618          else
 619             pragma Assert (Is_With_Edge (G, Edge));
 620
 621             Error_Msg_Output
 622               (Msg  => "     reason: unit $ has with clause for unit $",
 623                Info => True);
 624          end if;
 625       end Write_Dependency_Edge;
 626    end Dependency_Writers;
 627
 628    -------------------------------
 629    -- Elaboration_Order_Writers --
 630    -------------------------------
 631
 632    package body Elaboration_Order_Writers is
 633
 634       -----------------------
 635       -- Local subprograms --
 636       -----------------------
 637
 638       procedure Write_Unit (U_Id : Unit_Id);
 639       pragma Inline (Write_Unit);
 640       --  Write unit U_Id to standard output
 641
 642       procedure Write_Units (Order : Unit_Id_Table);
 643       pragma Inline (Write_Units);
 644       --  Write all units found in elaboration order Order to standard output
 645
 646       -----------------------------
 647       -- Write_Elaboration_Order --
 648       -----------------------------
 649
 650       procedure Write_Elaboration_Order (Order : Unit_Id_Table) is
 651          Use_Formatting : constant Boolean := not Zero_Formatting;
 652
 653       begin
 654          --  Nothing to do when switch -l (output chosen elaboration order) is
 655          --  not in effect.
 656
 657          if not Elab_Order_Output then
 658             return;
 659          end if;
 660
 661          if Use_Formatting then
 662             Write_Eol;
 663             Write_Str ("ELABORATION ORDER");
 664             Write_Eol;
 665          end if;
 666
 667          Write_Units (Order);
 668
 669          if Use_Formatting then
 670             Write_Eol;
 671          end if;
 672       end Write_Elaboration_Order;
 673
 674       ----------------
 675       -- Write_Unit --
 676       ----------------
 677
 678       procedure Write_Unit (U_Id : Unit_Id) is
 679          Use_Formatting : constant Boolean := not Zero_Formatting;
 680
 681       begin
 682          pragma Assert (Present (U_Id));
 683
 684          if Use_Formatting then
 685             Write_Str ("   ");
 686          end if;
 687
 688          Write_Unit_Name (Name (U_Id));
 689          Write_Eol;
 690       end Write_Unit;
 691
 692       -----------------
 693       -- Write_Units --
 694       -----------------
 695
 696       procedure Write_Units (Order : Unit_Id_Table) is
 697       begin
 698          for Index in Unit_Id_Tables.First .. Unit_Id_Tables.Last (Order) loop
 699             Write_Unit (Order.Table (Index));
 700          end loop;
 701       end Write_Units;
 702    end Elaboration_Order_Writers;
 703
 704    ---------------
 705    -- Indent_By --
 706    ---------------
 707
 708    procedure Indent_By (Indent : Indentation_Level) is
 709    begin
 710       for Count in 1 .. Indent loop
 711          Write_Char (' ');
 712       end loop;
 713    end Indent_By;
 714
 715    ------------------------------
 716    -- Invocation_Graph_Writers --
 717    ------------------------------
 718
 719    package body Invocation_Graph_Writers is
 720
 721       -----------------------
 722       -- Local subprograms --
 723       -----------------------
 724
 725       procedure Write_Elaboration_Root
 726         (G    : Invocation_Graph;
 727          Root : Invocation_Graph_Vertex_Id);
 728       pragma Inline (Write_Elaboration_Root);
 729       --  Write elaboration root Root of invocation graph G to standard output
 730
 731       procedure Write_Elaboration_Roots (G : Invocation_Graph);
 732       pragma Inline (Write_Elaboration_Roots);
 733       --  Write all elaboration roots of invocation graph G to standard output
 734
 735       procedure Write_Invocation_Graph_Edge
 736         (G    : Invocation_Graph;
 737          Edge : Invocation_Graph_Edge_Id);
 738       pragma Inline (Write_Invocation_Graph_Edge);
 739       --  Write edge Edge of invocation graph G to standard output
 740
 741       procedure Write_Invocation_Graph_Edges
 742         (G      : Invocation_Graph;
 743          Vertex : Invocation_Graph_Vertex_Id);
 744       pragma Inline (Write_Invocation_Graph_Edges);
 745       --  Write all edges to targets of vertex Vertex of invocation graph G to
 746       --  standard output.
 747
 748       procedure Write_Invocation_Graph_Vertex
 749         (G      : Invocation_Graph;
 750          Vertex : Invocation_Graph_Vertex_Id);
 751       pragma Inline (Write_Invocation_Graph_Vertex);
 752       --  Write vertex Vertex of invocation graph G to standard output
 753
 754       procedure Write_Invocation_Graph_Vertices (G : Invocation_Graph);
 755       pragma Inline (Write_Invocation_Graph_Vertices);
 756       --  Write all vertices of invocation graph G to standard output
 757
 758       procedure Write_Statistics (G : Invocation_Graph);
 759       pragma Inline (Write_Statistics);
 760       --  Write the statistical information of invocation graph G to standard
 761       --  output.
 762
 763       -----------
 764       -- Debug --
 765       -----------
 766
 767       procedure pige
 768         (G    : Invocation_Graph;
 769          Edge : Invocation_Graph_Edge_Id) renames Write_Invocation_Graph_Edge;
 770       pragma Unreferenced (pige);
 771
 772       procedure pigv
 773         (G      : Invocation_Graph;
 774          Vertex : Invocation_Graph_Vertex_Id)
 775          renames Write_Invocation_Graph_Vertex;
 776       pragma Unreferenced (pigv);
 777
 778       ----------------------------
 779       -- Write_Elaboration_Root --
 780       ----------------------------
 781
 782       procedure Write_Elaboration_Root
 783         (G    : Invocation_Graph;
 784          Root : Invocation_Graph_Vertex_Id)
 785       is
 786       begin
 787          pragma Assert (Present (G));
 788          pragma Assert (Present (Root));
 789
 790          Write_Str  ("elaboration root (IGV_Id_");
 791          Write_Int  (Int (Root));
 792          Write_Str  (") name = ");
 793          Write_Name (Name (G, Root));
 794          Write_Eol;
 795       end Write_Elaboration_Root;
 796
 797       -----------------------------
 798       -- Write_Elaboration_Roots --
 799       -----------------------------
 800
 801       procedure Write_Elaboration_Roots (G : Invocation_Graph) is
 802          pragma Assert (Present (G));
 803
 804          Num_Of_Roots : constant Natural := Number_Of_Elaboration_Roots (G);
 805
 806          Iter : Elaboration_Root_Iterator;
 807          Root : Invocation_Graph_Vertex_Id;
 808
 809       begin
 810          Write_Str ("Elaboration roots: ");
 811          Write_Int (Int (Num_Of_Roots));
 812          Write_Eol;
 813
 814          if Num_Of_Roots > 0 then
 815             Iter := Iterate_Elaboration_Roots (G);
 816             while Has_Next (Iter) loop
 817                Next (Iter, Root);
 818
 819                Write_Elaboration_Root (G, Root);
 820             end loop;
 821          else
 822             Write_Eol;
 823          end if;
 824       end Write_Elaboration_Roots;
 825
 826       ----------------------------
 827       -- Write_Invocation_Graph --
 828       ----------------------------
 829
 830       procedure Write_Invocation_Graph (G : Invocation_Graph) is
 831       begin
 832          pragma Assert (Present (G));
 833
 834          --  Nothing to do when switch -d_I (output invocation graph) is not in
 835          --  effect.
 836
 837          if not Debug_Flag_Underscore_II then
 838             return;
 839          end if;
 840
 841          Write_Str ("Invocation Graph");
 842          Write_Eol;
 843          Write_Eol;
 844
 845          Write_Statistics (G);
 846          Write_Invocation_Graph_Vertices (G);
 847          Write_Elaboration_Roots (G);
 848
 849          Write_Str ("Invocation Graph end");
 850          Write_Eol;
 851
 852          Write_Eol;
 853       end Write_Invocation_Graph;
 854
 855       ---------------------------------
 856       -- Write_Invocation_Graph_Edge --
 857       ---------------------------------
 858
 859       procedure Write_Invocation_Graph_Edge
 860         (G    : Invocation_Graph;
 861          Edge : Invocation_Graph_Edge_Id)
 862       is
 863          pragma Assert (Present (G));
 864          pragma Assert (Present (Edge));
 865
 866          Targ : constant Invocation_Graph_Vertex_Id := Target (G, Edge);
 867
 868       begin
 869          Write_Str ("    invocation graph edge (IGE_Id_");
 870          Write_Int (Int (Edge));
 871          Write_Str (")");
 872          Write_Eol;
 873
 874          Write_Str ("      Relation (IR_Id_");
 875          Write_Int (Int (Relation (G, Edge)));
 876          Write_Str (")");
 877          Write_Eol;
 878
 879          Write_Str ("      Target (IGV_Id_");
 880          Write_Int (Int (Targ));
 881          Write_Str (") name = ");
 882          Write_Name (Name (G, Targ));
 883          Write_Eol;
 884
 885          Write_Eol;
 886       end Write_Invocation_Graph_Edge;
 887
 888       ----------------------------------
 889       -- Write_Invocation_Graph_Edges --
 890       ----------------------------------
 891
 892       procedure Write_Invocation_Graph_Edges
 893         (G      : Invocation_Graph;
 894          Vertex : Invocation_Graph_Vertex_Id)
 895       is
 896          pragma Assert (Present (G));
 897          pragma Assert (Present (Vertex));
 898
 899          Num_Of_Edges : constant Natural :=
 900                           Number_Of_Edges_To_Targets (G, Vertex);
 901
 902          Edge : Invocation_Graph_Edge_Id;
 903          Iter : Invocation_Graphs.Edges_To_Targets_Iterator;
 904
 905       begin
 906          Write_Str ("  Edges to targets: ");
 907          Write_Int (Int (Num_Of_Edges));
 908          Write_Eol;
 909
 910          if Num_Of_Edges > 0 then
 911             Iter := Iterate_Edges_To_Targets (G, Vertex);
 912             while Has_Next (Iter) loop
 913                Next (Iter, Edge);
 914
 915                Write_Invocation_Graph_Edge (G, Edge);
 916             end loop;
 917          else
 918             Write_Eol;
 919          end if;
 920       end Write_Invocation_Graph_Edges;
 921
 922       -----------------------------------
 923       -- Write_Invocation_Graph_Vertex --
 924       -----------------------------------
 925
 926       procedure Write_Invocation_Graph_Vertex
 927         (G      : Invocation_Graph;
 928          Vertex : Invocation_Graph_Vertex_Id)
 929       is
 930          Lib_Graph : constant Library_Graph := Get_Lib_Graph (G);
 931
 932          B : constant Library_Graph_Vertex_Id := Body_Vertex (G, Vertex);
 933          S : constant Library_Graph_Vertex_Id := Spec_Vertex (G, Vertex);
 934       begin
 935          pragma Assert (Present (G));
 936          pragma Assert (Present (Vertex));
 937
 938          Write_Str  ("invocation graph vertex (IGV_Id_");
 939          Write_Int  (Int (Vertex));
 940          Write_Str  (") name = ");
 941          Write_Name (Name (G, Vertex));
 942          Write_Eol;
 943
 944          Write_Str ("  Body_Vertex (LGV_Id_");
 945          Write_Int (Int (B));
 946          Write_Str (") name = ");
 947          Write_Name (Name (Lib_Graph, B));
 948          Write_Eol;
 949
 950          Write_Str ("  Construct (IC_Id_");
 951          Write_Int (Int (Construct (G, Vertex)));
 952          Write_Str (")");
 953          Write_Eol;
 954
 955          Write_Str ("  Spec_Vertex (LGV_Id_");
 956          Write_Int (Int (S));
 957          Write_Str (") name = ");
 958          Write_Name (Name (Lib_Graph, S));
 959          Write_Eol;
 960
 961          Write_Invocation_Graph_Edges (G, Vertex);
 962       end Write_Invocation_Graph_Vertex;
 963
 964       -------------------------------------
 965       -- Write_Invocation_Graph_Vertices --
 966       -------------------------------------
 967
 968       procedure Write_Invocation_Graph_Vertices (G : Invocation_Graph) is
 969          Iter   : Invocation_Graphs.All_Vertex_Iterator;
 970          Vertex : Invocation_Graph_Vertex_Id;
 971
 972       begin
 973          pragma Assert (Present (G));
 974
 975          Iter := Iterate_All_Vertices (G);
 976          while Has_Next (Iter) loop
 977             Next (Iter, Vertex);
 978
 979             Write_Invocation_Graph_Vertex (G, Vertex);
 980          end loop;
 981       end Write_Invocation_Graph_Vertices;
 982
 983       ----------------------
 984       -- Write_Statistics --
 985       ----------------------
 986
 987       procedure Write_Statistics (G : Invocation_Graph) is
 988       begin
 989          pragma Assert (Present (G));
 990
 991          Write_Str ("Edges   : ");
 992          Write_Num (Int (Number_Of_Edges (G)));
 993          Write_Eol;
 994
 995          Write_Str ("Roots   : ");
 996          Write_Num (Int (Number_Of_Elaboration_Roots (G)));
 997          Write_Eol;
 998
 999          Write_Str ("Vertices: ");
1000          Write_Num (Int (Number_Of_Vertices (G)));
1001          Write_Eol;
1002          Write_Eol;
1003
1004          for Kind in Invocation_Kind'Range loop
1005             Write_Str ("  ");
1006             Write_Num (Int (Invocation_Graph_Edge_Count (G, Kind)));
1007             Write_Str (" - ");
1008             Write_Str (Kind'Img);
1009             Write_Eol;
1010          end loop;
1011
1012          Write_Eol;
1013       end Write_Statistics;
1014    end Invocation_Graph_Writers;
1015
1016    ---------------------------
1017    -- Library_Graph_Writers --
1018    ---------------------------
1019
1020    package body Library_Graph_Writers is
1021
1022       -----------------------
1023       -- Local subprograms --
1024       -----------------------
1025
1026       procedure Write_Component
1027         (G    : Library_Graph;
1028          Comp : Component_Id);
1029       pragma Inline (Write_Component);
1030       --  Write component Comp of library graph G to standard output
1031
1032       procedure Write_Component_Vertices
1033         (G    : Library_Graph;
1034          Comp : Component_Id);
1035       pragma Inline (Write_Component_Vertices);
1036       --  Write all vertices of component Comp of library graph G to standard
1037       --  output.
1038
1039       procedure Write_Components (G : Library_Graph);
1040       pragma Inline (Write_Components);
1041       --  Write all components of library graph G to standard output
1042
1043       procedure Write_Edges_To_Successors
1044         (G      : Library_Graph;
1045          Vertex : Library_Graph_Vertex_Id);
1046       pragma Inline (Write_Edges_To_Successors);
1047       --  Write all edges to successors of predecessor Vertex of library graph
1048       --  G to standard output.
1049
1050       procedure Write_Library_Graph_Edge
1051         (G    : Library_Graph;
1052          Edge : Library_Graph_Edge_Id);
1053       pragma Inline (Write_Library_Graph_Edge);
1054       --  Write edge Edge of library graph G to standard output
1055
1056       procedure Write_Library_Graph_Vertex
1057         (G      : Library_Graph;
1058          Vertex : Library_Graph_Vertex_Id);
1059       pragma Inline (Write_Library_Graph_Vertex);
1060       --  Write vertex Vertex of library graph G to standard output
1061
1062       procedure Write_Library_Graph_Vertices (G : Library_Graph);
1063       pragma Inline (Write_Library_Graph_Vertices);
1064       --  Write all vertices of library graph G to standard output
1065
1066       procedure Write_Statistics (G : Library_Graph);
1067       pragma Inline (Write_Statistics);
1068       --  Write the statistical information of library graph G to standard
1069       --  output.
1070
1071       -----------
1072       -- Debug --
1073       -----------
1074
1075       procedure pc
1076         (G    : Library_Graph;
1077          Comp : Component_Id) renames Write_Component;
1078       pragma Unreferenced (pc);
1079
1080       procedure plge
1081         (G    : Library_Graph;
1082          Edge : Library_Graph_Edge_Id) renames Write_Library_Graph_Edge;
1083       pragma Unreferenced (plge);
1084
1085       procedure plgv
1086         (G      : Library_Graph;
1087          Vertex : Library_Graph_Vertex_Id) renames Write_Library_Graph_Vertex;
1088       pragma Unreferenced (plgv);
1089
1090       ---------------------
1091       -- Write_Component --
1092       ---------------------
1093
1094       procedure Write_Component
1095         (G    : Library_Graph;
1096          Comp : Component_Id)
1097       is
1098       begin
1099          pragma Assert (Present (G));
1100          pragma Assert (Present (Comp));
1101
1102          Write_Str ("component (Comp_");
1103          Write_Int (Int (Comp));
1104          Write_Str (")");
1105          Write_Eol;
1106
1107          Write_Str ("  Pending_Strong_Predecessors = ");
1108          Write_Int (Int (Pending_Strong_Predecessors (G, Comp)));
1109          Write_Eol;
1110
1111          Write_Str ("  Pending_Weak_Predecessors   = ");
1112          Write_Int (Int (Pending_Weak_Predecessors (G, Comp)));
1113          Write_Eol;
1114
1115          Write_Component_Vertices (G, Comp);
1116
1117          Write_Eol;
1118       end Write_Component;
1119
1120       ------------------------------
1121       -- Write_Component_Vertices --
1122       ------------------------------
1123
1124       procedure Write_Component_Vertices
1125         (G    : Library_Graph;
1126          Comp : Component_Id)
1127       is
1128          pragma Assert (Present (G));
1129          pragma Assert (Present (Comp));
1130
1131          Num_Of_Vertices : constant Natural :=
1132                              Number_Of_Component_Vertices (G, Comp);
1133
1134          Iter   : Component_Vertex_Iterator;
1135          Vertex : Library_Graph_Vertex_Id;
1136
1137       begin
1138          Write_Str ("  Vertices: ");
1139          Write_Int (Int (Num_Of_Vertices));
1140          Write_Eol;
1141
1142          if Num_Of_Vertices > 0 then
1143             Iter := Iterate_Component_Vertices (G, Comp);
1144             while Has_Next (Iter) loop
1145                Next (Iter, Vertex);
1146
1147                Write_Str  ("    library graph vertex (LGV_Id_");
1148                Write_Int  (Int (Vertex));
1149                Write_Str  (") name = ");
1150                Write_Name (Name (G, Vertex));
1151                Write_Eol;
1152             end loop;
1153          else
1154             Write_Eol;
1155          end if;
1156       end Write_Component_Vertices;
1157
1158       ----------------------
1159       -- Write_Components --
1160       ----------------------
1161
1162       procedure Write_Components (G : Library_Graph) is
1163          pragma Assert (Present (G));
1164
1165          Num_Of_Comps : constant Natural := Number_Of_Components (G);
1166
1167          Comp : Component_Id;
1168          Iter : Component_Iterator;
1169
1170       begin
1171          --  Nothing to do when switch -d_L (output library item graph) is not
1172          --  in effect.
1173
1174          if not Debug_Flag_Underscore_LL then
1175             return;
1176          end if;
1177
1178          Write_Str ("Library Graph components");
1179          Write_Eol;
1180          Write_Eol;
1181
1182          if Num_Of_Comps > 0 then
1183             Write_Str ("Components: ");
1184             Write_Num (Int (Num_Of_Comps));
1185             Write_Eol;
1186
1187             Iter := Iterate_Components (G);
1188             while Has_Next (Iter) loop
1189                Next (Iter, Comp);
1190
1191                Write_Component (G, Comp);
1192             end loop;
1193          else
1194             Write_Eol;
1195          end if;
1196
1197          Write_Str ("Library Graph components end");
1198          Write_Eol;
1199
1200          Write_Eol;
1201       end Write_Components;
1202
1203       -------------------------------
1204       -- Write_Edges_To_Successors --
1205       -------------------------------
1206
1207       procedure Write_Edges_To_Successors
1208         (G      : Library_Graph;
1209          Vertex : Library_Graph_Vertex_Id)
1210       is
1211          pragma Assert (Present (G));
1212          pragma Assert (Present (Vertex));
1213
1214          Num_Of_Edges : constant Natural :=
1215                           Number_Of_Edges_To_Successors (G, Vertex);
1216
1217          Edge : Library_Graph_Edge_Id;
1218          Iter : Edges_To_Successors_Iterator;
1219
1220       begin
1221          Write_Str ("  Edges to successors: ");
1222          Write_Int (Int (Num_Of_Edges));
1223          Write_Eol;
1224
1225          if Num_Of_Edges > 0 then
1226             Iter := Iterate_Edges_To_Successors (G, Vertex);
1227             while Has_Next (Iter) loop
1228                Next (Iter, Edge);
1229
1230                Write_Library_Graph_Edge (G, Edge);
1231             end loop;
1232          else
1233             Write_Eol;
1234          end if;
1235       end Write_Edges_To_Successors;
1236
1237       -------------------------
1238       -- Write_Library_Graph --
1239       -------------------------
1240
1241       procedure Write_Library_Graph (G : Library_Graph) is
1242       begin
1243          pragma Assert (Present (G));
1244
1245          --  Nothing to do when switch -d_L (output library item graph) is not
1246          --  in effect.
1247
1248          if not Debug_Flag_Underscore_LL then
1249             return;
1250          end if;
1251
1252          Write_Str ("Library Graph");
1253          Write_Eol;
1254          Write_Eol;
1255
1256          Write_Statistics (G);
1257          Write_Library_Graph_Vertices (G);
1258          Write_Components (G);
1259
1260          Write_Str ("Library Graph end");
1261          Write_Eol;
1262
1263          Write_Eol;
1264       end Write_Library_Graph;
1265
1266       ------------------------------
1267       -- Write_Library_Graph_Edge --
1268       ------------------------------
1269
1270       procedure Write_Library_Graph_Edge
1271         (G    : Library_Graph;
1272          Edge : Library_Graph_Edge_Id)
1273       is
1274          pragma Assert (Present (G));
1275          pragma Assert (Present (Edge));
1276
1277          Pred : constant Library_Graph_Vertex_Id := Predecessor (G, Edge);
1278          Succ : constant Library_Graph_Vertex_Id := Successor   (G, Edge);
1279
1280       begin
1281          Write_Str ("    library graph edge (LGE_Id_");
1282          Write_Int (Int (Edge));
1283          Write_Str (")");
1284          Write_Eol;
1285
1286          Write_Str ("      Kind = ");
1287          Write_Str (Kind (G, Edge)'Img);
1288          Write_Eol;
1289
1290          Write_Str  ("      Predecessor (LGV_Id_");
1291          Write_Int  (Int (Pred));
1292          Write_Str  (") name = ");
1293          Write_Name (Name (G, Pred));
1294          Write_Eol;
1295
1296          Write_Str  ("      Successor   (LGV_Id_");
1297          Write_Int  (Int (Succ));
1298          Write_Str  (") name = ");
1299          Write_Name (Name (G, Succ));
1300          Write_Eol;
1301
1302          Write_Eol;
1303       end Write_Library_Graph_Edge;
1304
1305       --------------------------------
1306       -- Write_Library_Graph_Vertex --
1307       --------------------------------
1308
1309       procedure Write_Library_Graph_Vertex
1310         (G      : Library_Graph;
1311          Vertex : Library_Graph_Vertex_Id)
1312       is
1313          pragma Assert (Present (G));
1314          pragma Assert (Present (Vertex));
1315
1316          Item : constant Library_Graph_Vertex_Id :=
1317                   Corresponding_Item (G, Vertex);
1318          U_Id : constant Unit_Id := Unit (G, Vertex);
1319
1320       begin
1321          Write_Str  ("library graph vertex (LGV_Id_");
1322          Write_Int  (Int (Vertex));
1323          Write_Str  (") name = ");
1324          Write_Name (Name (G, Vertex));
1325          Write_Eol;
1326
1327          if Present (Item) then
1328             Write_Str  ("  Corresponding_Item (LGV_Id_");
1329             Write_Int  (Int (Item));
1330             Write_Str  (") name = ");
1331             Write_Name (Name (G, Item));
1332          else
1333             Write_Str ("  Corresponding_Item = none");
1334          end if;
1335
1336          Write_Eol;
1337          Write_Str ("  In_Elaboration_Order = ");
1338
1339          if In_Elaboration_Order (G, Vertex) then
1340             Write_Str ("True");
1341          else
1342             Write_Str ("False");
1343          end if;
1344
1345          Write_Eol;
1346          Write_Str ("  Pending_Strong_Predecessors = ");
1347          Write_Int (Int (Pending_Strong_Predecessors (G, Vertex)));
1348          Write_Eol;
1349
1350          Write_Str ("  Pending_Weak_Predecessors   = ");
1351          Write_Int (Int (Pending_Weak_Predecessors (G, Vertex)));
1352          Write_Eol;
1353
1354          Write_Str ("  Component (Comp_Id_");
1355          Write_Int (Int (Component (G, Vertex)));
1356          Write_Str (")");
1357          Write_Eol;
1358
1359          Write_Str  ("  Unit (U_Id_");
1360          Write_Int  (Int (U_Id));
1361          Write_Str  (") name = ");
1362          Write_Name (Name (U_Id));
1363          Write_Eol;
1364
1365          Write_Edges_To_Successors (G, Vertex);
1366       end Write_Library_Graph_Vertex;
1367
1368       ----------------------------------
1369       -- Write_Library_Graph_Vertices --
1370       ----------------------------------
1371
1372       procedure Write_Library_Graph_Vertices (G : Library_Graph) is
1373          Iter   : Library_Graphs.All_Vertex_Iterator;
1374          Vertex : Library_Graph_Vertex_Id;
1375
1376       begin
1377          pragma Assert (Present (G));
1378
1379          Iter := Iterate_All_Vertices (G);
1380          while Has_Next (Iter) loop
1381             Next (Iter, Vertex);
1382
1383             Write_Library_Graph_Vertex (G, Vertex);
1384          end loop;
1385       end Write_Library_Graph_Vertices;
1386
1387       ----------------------
1388       -- Write_Statistics --
1389       ----------------------
1390
1391       procedure Write_Statistics (G : Library_Graph) is
1392       begin
1393          Write_Str ("Components: ");
1394          Write_Num (Int (Number_Of_Components (G)));
1395          Write_Eol;
1396
1397          Write_Str ("Edges     : ");
1398          Write_Num (Int (Number_Of_Edges (G)));
1399          Write_Eol;
1400
1401          Write_Str ("Vertices  : ");
1402          Write_Num (Int (Number_Of_Vertices (G)));
1403          Write_Eol;
1404          Write_Eol;
1405
1406          for Kind in Library_Graph_Edge_Kind'Range loop
1407             Write_Str ("  ");
1408             Write_Num (Int (Library_Graph_Edge_Count (G, Kind)));
1409             Write_Str (" - ");
1410             Write_Str (Kind'Img);
1411             Write_Eol;
1412          end loop;
1413
1414          Write_Eol;
1415       end Write_Statistics;
1416    end Library_Graph_Writers;
1417
1418    -------------------
1419    -- Phase_Writers --
1420    -------------------
1421
1422    package body Phase_Writers is
1423
1424       subtype Phase_Message is String (1 .. 32);
1425
1426       --  The following table contains the phase-specific messages for phase
1427       --  completion.
1428
1429       End_Messages : constant array (Elaboration_Phase) of Phase_Message :=
1430         (Component_Discovery           => "components discovered.          ",
1431          Cycle_Diagnostics             => "cycle diagnosed.                ",
1432          Cycle_Discovery               => "cycles discovered.              ",
1433          Cycle_Validation              => "cycles validated.               ",
1434          Elaboration_Order_Validation  => "elaboration order validated.    ",
1435          Invocation_Graph_Construction => "invocation graph constructed.   ",
1436          Invocation_Graph_Validation   => "invocation graph validated.     ",
1437          Library_Graph_Augmentation    => "library graph augmented.        ",
1438          Library_Graph_Construction    => "library graph constructed.      ",
1439          Library_Graph_Elaboration     => "library graph elaborated.       ",
1440          Library_Graph_Validation      => "library graph validated.        ",
1441          Unit_Collection               => "units collected.                ",
1442          Unit_Elaboration              => "units elaborated.               ");
1443
1444       --  The following table contains the phase-specific messages for phase
1445       --  commencement.
1446
1447       Start_Messages : constant array (Elaboration_Phase) of Phase_Message :=
1448         (Component_Discovery           => "discovering components...       ",
1449          Cycle_Diagnostics             => "diagnosing cycle...             ",
1450          Cycle_Discovery               => "discovering cycles...           ",
1451          Cycle_Validation              => "validating cycles...            ",
1452          Elaboration_Order_Validation  => "validating elaboration order... ",
1453          Invocation_Graph_Construction => "constructing invocation graph...",
1454          Invocation_Graph_Validation   => "validating invocation graph...  ",
1455          Library_Graph_Augmentation    => "augmenting library graph...     ",
1456          Library_Graph_Construction    => "constructing library graph...   ",
1457          Library_Graph_Elaboration     => "elaborating library graph...    ",
1458          Library_Graph_Validation      => "validating library graph...     ",
1459          Unit_Collection               => "collecting units...             ",
1460          Unit_Elaboration              => "elaborating units...            ");
1461
1462       -----------------------
1463       -- Local subprograms --
1464       -----------------------
1465
1466       procedure Write_Phase_Message (Msg : Phase_Message);
1467       pragma Inline (Write_Phase_Message);
1468       --  Write elaboration phase-related message Msg to standard output
1469
1470       ---------------
1471       -- End_Phase --
1472       ---------------
1473
1474       procedure End_Phase (Phase : Elaboration_Phase) is
1475       begin
1476          Write_Phase_Message (End_Messages (Phase));
1477       end End_Phase;
1478
1479       -----------------
1480       -- Start_Phase --
1481       -----------------
1482
1483       procedure Start_Phase (Phase : Elaboration_Phase) is
1484       begin
1485          Write_Phase_Message (Start_Messages (Phase));
1486       end Start_Phase;
1487
1488       -------------------------
1489       -- Write_Phase_Message --
1490       -------------------------
1491
1492       procedure Write_Phase_Message (Msg : Phase_Message) is
1493       begin
1494          --  Nothing to do when switch -d_S (output elaboration order status)
1495          --  is not in effect.
1496
1497          if not Debug_Flag_Underscore_SS then
1498             return;
1499          end if;
1500
1501          Write_Str (Msg);
1502          Write_Eol;
1503       end Write_Phase_Message;
1504    end Phase_Writers;
1505
1506    --------------------------
1507    -- Unit_Closure_Writers --
1508    --------------------------
1509
1510    package body Unit_Closure_Writers is
1511       function Hash_File_Name (Nam : File_Name_Type) return Bucket_Range_Type;
1512       pragma Inline (Hash_File_Name);
1513       --  Obtain the hash value of key Nam
1514
1515       package File_Name_Tables is new Membership_Sets
1516         (Element_Type => File_Name_Type,
1517          "="          => "=",
1518          Hash         => Hash_File_Name);
1519       use File_Name_Tables;
1520
1521       -----------------------
1522       -- Local subprograms --
1523       -----------------------
1524
1525       procedure Write_File_Name (Nam : File_Name_Type);
1526       pragma Inline (Write_File_Name);
1527       --  Write file name Nam to standard output
1528
1529       procedure Write_Subunit_Closure
1530         (Dep : Sdep_Id;
1531          Set : Membership_Set);
1532       pragma Inline (Write_Subunit_Closure);
1533       --  Write the subunit which corresponds to dependency Dep to standard
1534       --  output if it does not appear in set Set.
1535
1536       procedure Write_Subunits_Closure (Set : Membership_Set);
1537       pragma Inline (Write_Subunits_Closure);
1538       --  Write all subunits to standard output if they do not appear in set
1539       --  Set.
1540
1541       procedure Write_Unit_Closure
1542         (U_Id : Unit_Id;
1543          Set  : Membership_Set);
1544       pragma Inline (Write_Unit_Closure);
1545       --  Write unit U_Id to standard output if it does not appear in set Set
1546
1547       procedure Write_Units_Closure
1548         (Order : Unit_Id_Table;
1549          Set   : Membership_Set);
1550       pragma Inline (Write_Units_Closure);
1551       --  Write all units of elaboration order Order to standard output if they
1552       --  do not appear in set Set.
1553
1554       --------------------
1555       -- Hash_File_Name --
1556       --------------------
1557
1558       function Hash_File_Name
1559         (Nam : File_Name_Type) return Bucket_Range_Type
1560       is
1561       begin
1562          pragma Assert (Present (Nam));
1563
1564          return Bucket_Range_Type (abs Nam);
1565       end Hash_File_Name;
1566
1567       ---------------------
1568       -- Write_File_Name --
1569       ---------------------
1570
1571       procedure Write_File_Name (Nam : File_Name_Type) is
1572          Use_Formatting : constant Boolean := not Zero_Formatting;
1573
1574       begin
1575          pragma Assert (Present (Nam));
1576
1577          if Use_Formatting then
1578             Write_Str ("   ");
1579          end if;
1580
1581          Write_Line (Get_Name_String (Nam));
1582       end Write_File_Name;
1583
1584       ---------------------------
1585       -- Write_Subunit_Closure --
1586       ---------------------------
1587
1588       procedure Write_Subunit_Closure
1589         (Dep : Sdep_Id;
1590          Set : Membership_Set)
1591       is
1592          pragma Assert (Present (Dep));
1593          pragma Assert (Present (Set));
1594
1595          Dep_Rec : Sdep_Record renames Sdep.Table (Dep);
1596          Source  : constant File_Name_Type := Dep_Rec.Sfile;
1597
1598          pragma Assert (Present (Source));
1599
1600       begin
1601          --  Nothing to do when the source file has already been written
1602
1603          if Contains (Set, Source) then
1604             return;
1605
1606          --  Nothing to do when the source file does not denote a non-internal
1607          --  subunit.
1608
1609          elsif not Present (Dep_Rec.Subunit_Name)
1610            or else Is_Internal_File_Name (Source)
1611          then
1612             return;
1613          end if;
1614
1615          --  Mark the subunit as written
1616
1617          Insert (Set, Source);
1618          Write_File_Name (Source);
1619       end Write_Subunit_Closure;
1620
1621       ----------------------------
1622       -- Write_Subunits_Closure --
1623       ----------------------------
1624
1625       procedure Write_Subunits_Closure (Set : Membership_Set) is
1626       begin
1627          pragma Assert (Present (Set));
1628
1629          for Dep in Sdep.First .. Sdep.Last loop
1630             Write_Subunit_Closure (Dep, Set);
1631          end loop;
1632       end Write_Subunits_Closure;
1633
1634       ------------------------
1635       -- Write_Unit_Closure --
1636       ------------------------
1637
1638       procedure Write_Unit_Closure (Order : Unit_Id_Table) is
1639          Use_Formatting : constant Boolean := not Zero_Formatting;
1640
1641          Set : Membership_Set;
1642
1643       begin
1644          --  Nothing to do when switch -R (list sources referenced in closure)
1645          --  is not in effect.
1646
1647          if not List_Closure then
1648             return;
1649          end if;
1650
1651          if Use_Formatting then
1652             Write_Eol;
1653             Write_Line ("REFERENCED SOURCES");
1654          end if;
1655
1656          --  Use a set to avoid writing duplicate units and subunits
1657
1658          Set := Create (Number_Of_Elaborable_Units);
1659
1660          Write_Units_Closure (Order, Set);
1661          Write_Subunits_Closure (Set);
1662
1663          Destroy (Set);
1664
1665          if Use_Formatting then
1666             Write_Eol;
1667          end if;
1668       end Write_Unit_Closure;
1669
1670       ------------------------
1671       -- Write_Unit_Closure --
1672       ------------------------
1673
1674       procedure Write_Unit_Closure
1675         (U_Id : Unit_Id;
1676          Set  : Membership_Set)
1677       is
1678          pragma Assert (Present (U_Id));
1679          pragma Assert (Present (Set));
1680
1681          U_Rec  : Unit_Record renames ALI.Units.Table (U_Id);
1682          Source : constant File_Name_Type := U_Rec.Sfile;
1683
1684          pragma Assert (Present (Source));
1685
1686       begin
1687          --  Nothing to do when the source file has already been written
1688
1689          if Contains (Set, Source) then
1690             return;
1691
1692          --  Nothing to do for internal source files unless switch -Ra is in
1693          --  effect.
1694
1695          elsif Is_Internal_File_Name (Source)
1696            and then not List_Closure_All
1697          then
1698             return;
1699          end if;
1700
1701          --  Mark the source file as written
1702
1703          Insert (Set, Source);
1704          Write_File_Name (Source);
1705       end Write_Unit_Closure;
1706
1707       -------------------------
1708       -- Write_Units_Closure --
1709       -------------------------
1710
1711       procedure Write_Units_Closure
1712         (Order : Unit_Id_Table;
1713          Set   : Membership_Set)
1714       is
1715       begin
1716          pragma Assert (Present (Set));
1717
1718          for Index in reverse Unit_Id_Tables.First ..
1719                               Unit_Id_Tables.Last (Order)
1720          loop
1721             Write_Unit_Closure
1722               (U_Id => Order.Table (Index),
1723                Set  => Set);
1724          end loop;
1725       end Write_Units_Closure;
1726    end Unit_Closure_Writers;
1727
1728    ---------------
1729    -- Write_Num --
1730    ---------------
1731
1732    procedure Write_Num
1733      (Val        : Int;
1734       Val_Indent : Indentation_Level := Number_Column)
1735    is
1736       function Digits_Indentation return Indentation_Level;
1737       pragma Inline (Digits_Indentation);
1738       --  Determine the level of indentation the number requires in order to
1739       --  be right-justified by Val_Indent.
1740
1741       ------------------------
1742       -- Digits_Indentation --
1743       ------------------------
1744
1745       function Digits_Indentation return Indentation_Level is
1746          Indent : Indentation_Level;
1747          Num    : Int;
1748
1749       begin
1750          --  Treat zero as a single digit
1751
1752          if Val = 0 then
1753             Indent := 1;
1754
1755          else
1756             Indent := 0;
1757             Num    := Val;
1758
1759             --  Shrink the input value by dividing it until all of its digits
1760             --  are exhausted.
1761
1762             while Num /= 0 loop
1763                Indent := Indent + 1;
1764                Num    := Num / 10;
1765             end loop;
1766          end if;
1767
1768          return Val_Indent - Indent;
1769       end Digits_Indentation;
1770
1771    --  Start of processing for Write_Num
1772
1773    begin
1774       Indent_By (Digits_Indentation);
1775       Write_Int (Val);
1776    end Write_Num;
1777
1778 end Bindo.Writers;