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, 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 (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       begin
 931          pragma Assert (Present (G));
 932          pragma Assert (Present (Vertex));
 933
 934          Write_Str  ("invocation graph vertex (IGV_Id_");
 935          Write_Int  (Int (Vertex));
 936          Write_Str  (") name = ");
 937          Write_Name (Name (G, Vertex));
 938          Write_Eol;
 939
 940          Write_Str ("  Body_Vertex (LGV_Id_");
 941          Write_Int (Int (Body_Vertex (G, Vertex)));
 942          Write_Str (")");
 943          Write_Eol;
 944
 945          Write_Str ("  Construct (IC_Id_");
 946          Write_Int (Int (Construct (G, Vertex)));
 947          Write_Str (")");
 948          Write_Eol;
 949
 950          Write_Str ("  Spec_Vertex (LGV_Id_");
 951          Write_Int (Int (Spec_Vertex (G, Vertex)));
 952          Write_Str (")");
 953          Write_Eol;
 954
 955          Write_Invocation_Graph_Edges (G, Vertex);
 956       end Write_Invocation_Graph_Vertex;
 957
 958       -------------------------------------
 959       -- Write_Invocation_Graph_Vertices --
 960       -------------------------------------
 961
 962       procedure Write_Invocation_Graph_Vertices (G : Invocation_Graph) is
 963          Iter   : Invocation_Graphs.All_Vertex_Iterator;
 964          Vertex : Invocation_Graph_Vertex_Id;
 965
 966       begin
 967          pragma Assert (Present (G));
 968
 969          Iter := Iterate_All_Vertices (G);
 970          while Has_Next (Iter) loop
 971             Next (Iter, Vertex);
 972
 973             Write_Invocation_Graph_Vertex (G, Vertex);
 974          end loop;
 975       end Write_Invocation_Graph_Vertices;
 976
 977       ----------------------
 978       -- Write_Statistics --
 979       ----------------------
 980
 981       procedure Write_Statistics (G : Invocation_Graph) is
 982       begin
 983          pragma Assert (Present (G));
 984
 985          Write_Str ("Edges   : ");
 986          Write_Num (Int (Number_Of_Edges (G)));
 987          Write_Eol;
 988
 989          Write_Str ("Roots   : ");
 990          Write_Num (Int (Number_Of_Elaboration_Roots (G)));
 991          Write_Eol;
 992
 993          Write_Str ("Vertices: ");
 994          Write_Num (Int (Number_Of_Vertices (G)));
 995          Write_Eol;
 996          Write_Eol;
 997
 998          for Kind in Invocation_Kind'Range loop
 999             Write_Str ("  ");
1000             Write_Num (Int (Invocation_Graph_Edge_Count (G, Kind)));
1001             Write_Str (" - ");
1002             Write_Str (Kind'Img);
1003             Write_Eol;
1004          end loop;
1005
1006          Write_Eol;
1007       end Write_Statistics;
1008    end Invocation_Graph_Writers;
1009
1010    ---------------------------
1011    -- Library_Graph_Writers --
1012    ---------------------------
1013
1014    package body Library_Graph_Writers is
1015
1016       -----------------------
1017       -- Local subprograms --
1018       -----------------------
1019
1020       procedure Write_Component
1021         (G    : Library_Graph;
1022          Comp : Component_Id);
1023       pragma Inline (Write_Component);
1024       --  Write component Comp of library graph G to standard output
1025
1026       procedure Write_Component_Vertices
1027         (G    : Library_Graph;
1028          Comp : Component_Id);
1029       pragma Inline (Write_Component_Vertices);
1030       --  Write all vertices of component Comp of library graph G to standard
1031       --  output.
1032
1033       procedure Write_Components (G : Library_Graph);
1034       pragma Inline (Write_Component);
1035       --  Write all components of library graph G to standard output
1036
1037       procedure Write_Edges_To_Successors
1038         (G      : Library_Graph;
1039          Vertex : Library_Graph_Vertex_Id);
1040       pragma Inline (Write_Edges_To_Successors);
1041       --  Write all edges to successors of predecessor Vertex of library graph
1042       --  G to standard output.
1043
1044       procedure Write_Library_Graph_Edge
1045         (G    : Library_Graph;
1046          Edge : Library_Graph_Edge_Id);
1047       pragma Inline (Write_Library_Graph_Edge);
1048       --  Write edge Edge of library graph G to standard output
1049
1050       procedure Write_Library_Graph_Vertex
1051         (G      : Library_Graph;
1052          Vertex : Library_Graph_Vertex_Id);
1053       pragma Inline (Write_Library_Graph_Vertex);
1054       --  Write vertex Vertex of library graph G to standard output
1055
1056       procedure Write_Library_Graph_Vertices (G : Library_Graph);
1057       pragma Inline (Write_Library_Graph_Vertices);
1058       --  Write all vertices of library graph G to standard output
1059
1060       procedure Write_Statistics (G : Library_Graph);
1061       pragma Inline (Write_Statistics);
1062       --  Write the statistical information of library graph G to standard
1063       --  output.
1064
1065       -----------
1066       -- Debug --
1067       -----------
1068
1069       procedure pc
1070         (G    : Library_Graph;
1071          Comp : Component_Id) renames Write_Component;
1072       pragma Unreferenced (pc);
1073
1074       procedure plge
1075         (G    : Library_Graph;
1076          Edge : Library_Graph_Edge_Id) renames Write_Library_Graph_Edge;
1077       pragma Unreferenced (plge);
1078
1079       procedure plgv
1080         (G      : Library_Graph;
1081          Vertex : Library_Graph_Vertex_Id) renames Write_Library_Graph_Vertex;
1082       pragma Unreferenced (plgv);
1083
1084       ---------------------
1085       -- Write_Component --
1086       ---------------------
1087
1088       procedure Write_Component
1089         (G    : Library_Graph;
1090          Comp : Component_Id)
1091       is
1092       begin
1093          pragma Assert (Present (G));
1094          pragma Assert (Present (Comp));
1095
1096          Write_Str ("component (Comp_");
1097          Write_Int (Int (Comp));
1098          Write_Str (")");
1099          Write_Eol;
1100
1101          Write_Str ("  Pending_Strong_Predecessors = ");
1102          Write_Int (Int (Pending_Strong_Predecessors (G, Comp)));
1103          Write_Eol;
1104
1105          Write_Str ("  Pending_Weak_Predecessors   = ");
1106          Write_Int (Int (Pending_Weak_Predecessors (G, Comp)));
1107          Write_Eol;
1108
1109          Write_Component_Vertices (G, Comp);
1110
1111          Write_Eol;
1112       end Write_Component;
1113
1114       ------------------------------
1115       -- Write_Component_Vertices --
1116       ------------------------------
1117
1118       procedure Write_Component_Vertices
1119         (G    : Library_Graph;
1120          Comp : Component_Id)
1121       is
1122          pragma Assert (Present (G));
1123          pragma Assert (Present (Comp));
1124
1125          Num_Of_Vertices : constant Natural :=
1126                              Number_Of_Component_Vertices (G, Comp);
1127
1128          Iter   : Component_Vertex_Iterator;
1129          Vertex : Library_Graph_Vertex_Id;
1130
1131       begin
1132          Write_Str ("  Vertices: ");
1133          Write_Int (Int (Num_Of_Vertices));
1134          Write_Eol;
1135
1136          if Num_Of_Vertices > 0 then
1137             Iter := Iterate_Component_Vertices (G, Comp);
1138             while Has_Next (Iter) loop
1139                Next (Iter, Vertex);
1140
1141                Write_Str  ("    library graph vertex (LGV_Id_");
1142                Write_Int  (Int (Vertex));
1143                Write_Str  (") name = ");
1144                Write_Name (Name (G, Vertex));
1145                Write_Eol;
1146             end loop;
1147          else
1148             Write_Eol;
1149          end if;
1150       end Write_Component_Vertices;
1151
1152       ----------------------
1153       -- Write_Components --
1154       ----------------------
1155
1156       procedure Write_Components (G : Library_Graph) is
1157          pragma Assert (Present (G));
1158
1159          Num_Of_Comps : constant Natural := Number_Of_Components (G);
1160
1161          Comp : Component_Id;
1162          Iter : Component_Iterator;
1163
1164       begin
1165          --  Nothing to do when switch -d_L (output library item graph) is not
1166          --  in effect.
1167
1168          if not Debug_Flag_Underscore_LL then
1169             return;
1170          end if;
1171
1172          Write_Str ("Library Graph components");
1173          Write_Eol;
1174          Write_Eol;
1175
1176          if Num_Of_Comps > 0 then
1177             Write_Str ("Components: ");
1178             Write_Num (Int (Num_Of_Comps));
1179             Write_Eol;
1180
1181             Iter := Iterate_Components (G);
1182             while Has_Next (Iter) loop
1183                Next (Iter, Comp);
1184
1185                Write_Component (G, Comp);
1186             end loop;
1187          else
1188             Write_Eol;
1189          end if;
1190
1191          Write_Str ("Library Graph components end");
1192          Write_Eol;
1193
1194          Write_Eol;
1195       end Write_Components;
1196
1197       -------------------------------
1198       -- Write_Edges_To_Successors --
1199       -------------------------------
1200
1201       procedure Write_Edges_To_Successors
1202         (G      : Library_Graph;
1203          Vertex : Library_Graph_Vertex_Id)
1204       is
1205          pragma Assert (Present (G));
1206          pragma Assert (Present (Vertex));
1207
1208          Num_Of_Edges : constant Natural :=
1209                           Number_Of_Edges_To_Successors (G, Vertex);
1210
1211          Edge : Library_Graph_Edge_Id;
1212          Iter : Edges_To_Successors_Iterator;
1213
1214       begin
1215          Write_Str ("  Edges to successors: ");
1216          Write_Int (Int (Num_Of_Edges));
1217          Write_Eol;
1218
1219          if Num_Of_Edges > 0 then
1220             Iter := Iterate_Edges_To_Successors (G, Vertex);
1221             while Has_Next (Iter) loop
1222                Next (Iter, Edge);
1223
1224                Write_Library_Graph_Edge (G, Edge);
1225             end loop;
1226          else
1227             Write_Eol;
1228          end if;
1229       end Write_Edges_To_Successors;
1230
1231       -------------------------
1232       -- Write_Library_Graph --
1233       -------------------------
1234
1235       procedure Write_Library_Graph (G : Library_Graph) is
1236       begin
1237          pragma Assert (Present (G));
1238
1239          --  Nothing to do when switch -d_L (output library item graph) is not
1240          --  in effect.
1241
1242          if not Debug_Flag_Underscore_LL then
1243             return;
1244          end if;
1245
1246          Write_Str ("Library Graph");
1247          Write_Eol;
1248          Write_Eol;
1249
1250          Write_Statistics (G);
1251          Write_Library_Graph_Vertices (G);
1252          Write_Components (G);
1253
1254          Write_Str ("Library Graph end");
1255          Write_Eol;
1256
1257          Write_Eol;
1258       end Write_Library_Graph;
1259
1260       ------------------------------
1261       -- Write_Library_Graph_Edge --
1262       ------------------------------
1263
1264       procedure Write_Library_Graph_Edge
1265         (G    : Library_Graph;
1266          Edge : Library_Graph_Edge_Id)
1267       is
1268          pragma Assert (Present (G));
1269          pragma Assert (Present (Edge));
1270
1271          Pred : constant Library_Graph_Vertex_Id := Predecessor (G, Edge);
1272          Succ : constant Library_Graph_Vertex_Id := Successor   (G, Edge);
1273
1274       begin
1275          Write_Str ("    library graph edge (LGE_Id_");
1276          Write_Int (Int (Edge));
1277          Write_Str (")");
1278          Write_Eol;
1279
1280          Write_Str ("      Kind = ");
1281          Write_Str (Kind (G, Edge)'Img);
1282          Write_Eol;
1283
1284          Write_Str  ("      Predecessor (LGV_Id_");
1285          Write_Int  (Int (Pred));
1286          Write_Str  (") name = ");
1287          Write_Name (Name (G, Pred));
1288          Write_Eol;
1289
1290          Write_Str  ("      Successor   (LGV_Id_");
1291          Write_Int  (Int (Succ));
1292          Write_Str  (") name = ");
1293          Write_Name (Name (G, Succ));
1294          Write_Eol;
1295
1296          Write_Eol;
1297       end Write_Library_Graph_Edge;
1298
1299       --------------------------------
1300       -- Write_Library_Graph_Vertex --
1301       --------------------------------
1302
1303       procedure Write_Library_Graph_Vertex
1304         (G      : Library_Graph;
1305          Vertex : Library_Graph_Vertex_Id)
1306       is
1307          pragma Assert (Present (G));
1308          pragma Assert (Present (Vertex));
1309
1310          Item : constant Library_Graph_Vertex_Id :=
1311                   Corresponding_Item (G, Vertex);
1312          U_Id : constant Unit_Id := Unit (G, Vertex);
1313
1314       begin
1315          Write_Str  ("library graph vertex (LGV_Id_");
1316          Write_Int  (Int (Vertex));
1317          Write_Str  (") name = ");
1318          Write_Name (Name (G, Vertex));
1319          Write_Eol;
1320
1321          if Present (Item) then
1322             Write_Str  ("  Corresponding_Item (LGV_Id_");
1323             Write_Int  (Int (Item));
1324             Write_Str  (") name = ");
1325             Write_Name (Name (G, Item));
1326          else
1327             Write_Str ("  Corresponding_Item = none");
1328          end if;
1329
1330          Write_Eol;
1331          Write_Str ("  In_Elaboration_Order = ");
1332
1333          if In_Elaboration_Order (G, Vertex) then
1334             Write_Str ("True");
1335          else
1336             Write_Str ("False");
1337          end if;
1338
1339          Write_Eol;
1340          Write_Str ("  Pending_Strong_Predecessors = ");
1341          Write_Int (Int (Pending_Strong_Predecessors (G, Vertex)));
1342          Write_Eol;
1343
1344          Write_Str ("  Pending_Weak_Predecessors   = ");
1345          Write_Int (Int (Pending_Weak_Predecessors (G, Vertex)));
1346          Write_Eol;
1347
1348          Write_Str ("  Component (Comp_Id_");
1349          Write_Int (Int (Component (G, Vertex)));
1350          Write_Str (")");
1351          Write_Eol;
1352
1353          Write_Str  ("  Unit (U_Id_");
1354          Write_Int  (Int (U_Id));
1355          Write_Str  (") name = ");
1356          Write_Name (Name (U_Id));
1357          Write_Eol;
1358
1359          Write_Edges_To_Successors (G, Vertex);
1360       end Write_Library_Graph_Vertex;
1361
1362       ----------------------------------
1363       -- Write_Library_Graph_Vertices --
1364       ----------------------------------
1365
1366       procedure Write_Library_Graph_Vertices (G : Library_Graph) is
1367          Iter   : Library_Graphs.All_Vertex_Iterator;
1368          Vertex : Library_Graph_Vertex_Id;
1369
1370       begin
1371          pragma Assert (Present (G));
1372
1373          Iter := Iterate_All_Vertices (G);
1374          while Has_Next (Iter) loop
1375             Next (Iter, Vertex);
1376
1377             Write_Library_Graph_Vertex (G, Vertex);
1378          end loop;
1379       end Write_Library_Graph_Vertices;
1380
1381       ----------------------
1382       -- Write_Statistics --
1383       ----------------------
1384
1385       procedure Write_Statistics (G : Library_Graph) is
1386       begin
1387          Write_Str ("Components: ");
1388          Write_Num (Int (Number_Of_Components (G)));
1389          Write_Eol;
1390
1391          Write_Str ("Edges     : ");
1392          Write_Num (Int (Number_Of_Edges (G)));
1393          Write_Eol;
1394
1395          Write_Str ("Vertices  : ");
1396          Write_Num (Int (Number_Of_Vertices (G)));
1397          Write_Eol;
1398          Write_Eol;
1399
1400          for Kind in Library_Graph_Edge_Kind'Range loop
1401             Write_Str ("  ");
1402             Write_Num (Int (Library_Graph_Edge_Count (G, Kind)));
1403             Write_Str (" - ");
1404             Write_Str (Kind'Img);
1405             Write_Eol;
1406          end loop;
1407
1408          Write_Eol;
1409       end Write_Statistics;
1410    end Library_Graph_Writers;
1411
1412    -------------------
1413    -- Phase_Writers --
1414    -------------------
1415
1416    package body Phase_Writers is
1417
1418       subtype Phase_Message is String (1 .. 32);
1419
1420       --  The following table contains the phase-specific messages for phase
1421       --  completion.
1422
1423       End_Messages : constant array (Elaboration_Phase) of Phase_Message :=
1424         (Component_Discovery           => "components discovered.          ",
1425          Cycle_Diagnostics             => "cycle diagnosed.                ",
1426          Cycle_Discovery               => "cycles discovered.              ",
1427          Cycle_Validation              => "cycles validated.               ",
1428          Elaboration_Order_Validation  => "elaboration order validated.    ",
1429          Invocation_Graph_Construction => "invocation graph constructed.   ",
1430          Invocation_Graph_Validation   => "invocation graph validated.     ",
1431          Library_Graph_Augmentation    => "library graph augmented.        ",
1432          Library_Graph_Construction    => "library graph constructed.      ",
1433          Library_Graph_Elaboration     => "library graph elaborated.       ",
1434          Library_Graph_Validation      => "library graph validated.        ",
1435          Unit_Collection               => "units collected.                ",
1436          Unit_Elaboration              => "units elaborated.               ");
1437
1438       --  The following table contains the phase-specific messages for phase
1439       --  commencement.
1440
1441       Start_Messages : constant array (Elaboration_Phase) of Phase_Message :=
1442         (Component_Discovery           => "discovering components...       ",
1443          Cycle_Diagnostics             => "diagnosing cycle...             ",
1444          Cycle_Discovery               => "discovering cycles...           ",
1445          Cycle_Validation              => "validating cycles...            ",
1446          Elaboration_Order_Validation  => "validating elaboration order... ",
1447          Invocation_Graph_Construction => "constructing invocation graph...",
1448          Invocation_Graph_Validation   => "validating invocation graph...  ",
1449          Library_Graph_Augmentation    => "augmenting library graph...     ",
1450          Library_Graph_Construction    => "constructing library graph...   ",
1451          Library_Graph_Elaboration     => "elaborating library graph...    ",
1452          Library_Graph_Validation      => "validating library graph...     ",
1453          Unit_Collection               => "collecting units...             ",
1454          Unit_Elaboration              => "elaborating units...            ");
1455
1456       -----------------------
1457       -- Local subprograms --
1458       -----------------------
1459
1460       procedure Write_Phase_Message (Msg : Phase_Message);
1461       pragma Inline (Write_Phase_Message);
1462       --  Write elaboration phase-related message Msg to standard output
1463
1464       ---------------
1465       -- End_Phase --
1466       ---------------
1467
1468       procedure End_Phase (Phase : Elaboration_Phase) is
1469       begin
1470          Write_Phase_Message (End_Messages (Phase));
1471       end End_Phase;
1472
1473       -----------------
1474       -- Start_Phase --
1475       -----------------
1476
1477       procedure Start_Phase (Phase : Elaboration_Phase) is
1478       begin
1479          Write_Phase_Message (Start_Messages (Phase));
1480       end Start_Phase;
1481
1482       -------------------------
1483       -- Write_Phase_Message --
1484       -------------------------
1485
1486       procedure Write_Phase_Message (Msg : Phase_Message) is
1487       begin
1488          --  Nothing to do when switch -d_S (output elaboration order status)
1489          --  is not in effect.
1490
1491          if not Debug_Flag_Underscore_SS then
1492             return;
1493          end if;
1494
1495          Write_Str (Msg);
1496          Write_Eol;
1497       end Write_Phase_Message;
1498    end Phase_Writers;
1499
1500    --------------------------
1501    -- Unit_Closure_Writers --
1502    --------------------------
1503
1504    package body Unit_Closure_Writers is
1505       function Hash_File_Name (Nam : File_Name_Type) return Bucket_Range_Type;
1506       pragma Inline (Hash_File_Name);
1507       --  Obtain the hash value of key Nam
1508
1509       package File_Name_Tables is new Membership_Sets
1510         (Element_Type => File_Name_Type,
1511          "="          => "=",
1512          Hash         => Hash_File_Name);
1513       use File_Name_Tables;
1514
1515       -----------------------
1516       -- Local subprograms --
1517       -----------------------
1518
1519       procedure Write_File_Name (Nam : File_Name_Type);
1520       pragma Inline (Write_File_Name);
1521       --  Write file name Nam to standard output
1522
1523       procedure Write_Subunit_Closure
1524         (Dep : Sdep_Id;
1525          Set : Membership_Set);
1526       pragma Inline (Write_Subunit_Closure);
1527       --  Write the subunit which corresponds to dependency Dep to standard
1528       --  output if it does not appear in set Set.
1529
1530       procedure Write_Subunits_Closure (Set : Membership_Set);
1531       pragma Inline (Write_Subunits_Closure);
1532       --  Write all subunits to standard output if they do not appear in set
1533       --  Set.
1534
1535       procedure Write_Unit_Closure
1536         (U_Id : Unit_Id;
1537          Set  : Membership_Set);
1538       pragma Inline (Write_Unit_Closure);
1539       --  Write unit U_Id to standard output if it does not appear in set Set
1540
1541       procedure Write_Units_Closure
1542         (Order : Unit_Id_Table;
1543          Set   : Membership_Set);
1544       pragma Inline (Write_Units_Closure);
1545       --  Write all units of elaboration order Order to standard output if they
1546       --  do not appear in set Set.
1547
1548       --------------------
1549       -- Hash_File_Name --
1550       --------------------
1551
1552       function Hash_File_Name
1553         (Nam : File_Name_Type) return Bucket_Range_Type
1554       is
1555       begin
1556          pragma Assert (Present (Nam));
1557
1558          return Bucket_Range_Type (Nam);
1559       end Hash_File_Name;
1560
1561       ---------------------
1562       -- Write_File_Name --
1563       ---------------------
1564
1565       procedure Write_File_Name (Nam : File_Name_Type) is
1566          Use_Formatting : constant Boolean := not Zero_Formatting;
1567
1568       begin
1569          pragma Assert (Present (Nam));
1570
1571          if Use_Formatting then
1572             Write_Str ("   ");
1573          end if;
1574
1575          Write_Line (Get_Name_String (Nam));
1576       end Write_File_Name;
1577
1578       ---------------------------
1579       -- Write_Subunit_Closure --
1580       ---------------------------
1581
1582       procedure Write_Subunit_Closure
1583         (Dep : Sdep_Id;
1584          Set : Membership_Set)
1585       is
1586          pragma Assert (Present (Dep));
1587          pragma Assert (Present (Set));
1588
1589          Dep_Rec : Sdep_Record renames Sdep.Table (Dep);
1590          Source  : constant File_Name_Type := Dep_Rec.Sfile;
1591
1592          pragma Assert (Present (Source));
1593
1594       begin
1595          --  Nothing to do when the source file has already been written
1596
1597          if Contains (Set, Source) then
1598             return;
1599
1600          --  Nothing to do when the source file does not denote a non-internal
1601          --  subunit.
1602
1603          elsif not Present (Dep_Rec.Subunit_Name)
1604            or else Is_Internal_File_Name (Source)
1605          then
1606             return;
1607          end if;
1608
1609          --  Mark the subunit as written
1610
1611          Insert (Set, Source);
1612          Write_File_Name (Source);
1613       end Write_Subunit_Closure;
1614
1615       ----------------------------
1616       -- Write_Subunits_Closure --
1617       ----------------------------
1618
1619       procedure Write_Subunits_Closure (Set : Membership_Set) is
1620       begin
1621          pragma Assert (Present (Set));
1622
1623          for Dep in Sdep.First .. Sdep.Last loop
1624             Write_Subunit_Closure (Dep, Set);
1625          end loop;
1626       end Write_Subunits_Closure;
1627
1628       ------------------------
1629       -- Write_Unit_Closure --
1630       ------------------------
1631
1632       procedure Write_Unit_Closure (Order : Unit_Id_Table) is
1633          Use_Formatting : constant Boolean := not Zero_Formatting;
1634
1635          Set : Membership_Set;
1636
1637       begin
1638          --  Nothing to do when switch -R (list sources referenced in closure)
1639          --  is not in effect.
1640
1641          if not List_Closure then
1642             return;
1643          end if;
1644
1645          if Use_Formatting then
1646             Write_Eol;
1647             Write_Line ("REFERENCED SOURCES");
1648          end if;
1649
1650          --  Use a set to avoid writing duplicate units and subunits
1651
1652          Set := Create (Number_Of_Elaborable_Units);
1653
1654          Write_Units_Closure (Order, Set);
1655          Write_Subunits_Closure (Set);
1656
1657          Destroy (Set);
1658
1659          if Use_Formatting then
1660             Write_Eol;
1661          end if;
1662       end Write_Unit_Closure;
1663
1664       ------------------------
1665       -- Write_Unit_Closure --
1666       ------------------------
1667
1668       procedure Write_Unit_Closure
1669         (U_Id : Unit_Id;
1670          Set  : Membership_Set)
1671       is
1672          pragma Assert (Present (U_Id));
1673          pragma Assert (Present (Set));
1674
1675          U_Rec  : Unit_Record renames ALI.Units.Table (U_Id);
1676          Source : constant File_Name_Type := U_Rec.Sfile;
1677
1678          pragma Assert (Present (Source));
1679
1680       begin
1681          --  Nothing to do when the source file has already been written
1682
1683          if Contains (Set, Source) then
1684             return;
1685
1686          --  Nothing to do for internal source files unless switch -Ra (???) is
1687          --  in effect.
1688
1689          elsif Is_Internal_File_Name (Source)
1690            and then not List_Closure_All
1691          then
1692             return;
1693          end if;
1694
1695          --  Mark the source file as written
1696
1697          Insert (Set, Source);
1698          Write_File_Name (Source);
1699       end Write_Unit_Closure;
1700
1701       -------------------------
1702       -- Write_Units_Closure --
1703       -------------------------
1704
1705       procedure Write_Units_Closure
1706         (Order : Unit_Id_Table;
1707          Set   : Membership_Set)
1708       is
1709       begin
1710          pragma Assert (Present (Set));
1711
1712          for Index in reverse Unit_Id_Tables.First ..
1713                               Unit_Id_Tables.Last (Order)
1714          loop
1715             Write_Unit_Closure
1716               (U_Id => Order.Table (Index),
1717                Set  => Set);
1718          end loop;
1719       end Write_Units_Closure;
1720    end Unit_Closure_Writers;
1721
1722    ---------------
1723    -- Write_Num --
1724    ---------------
1725
1726    procedure Write_Num
1727      (Val        : Int;
1728       Val_Indent : Indentation_Level := Number_Column)
1729    is
1730       function Digits_Indentation return Indentation_Level;
1731       pragma Inline (Digits_Indentation);
1732       --  Determine the level of indentation the number requires in order to
1733       --  be right-justified by Val_Indent.
1734
1735       ------------------------
1736       -- Digits_Indentation --
1737       ------------------------
1738
1739       function Digits_Indentation return Indentation_Level is
1740          Indent : Indentation_Level;
1741          Num    : Int;
1742
1743       begin
1744          --  Treat zero as a single digit
1745
1746          if Val = 0 then
1747             Indent := 1;
1748
1749          else
1750             Indent := 0;
1751             Num    := Val;
1752
1753             --  Shrink the input value by dividing it until all of its digits
1754             --  are exhausted.
1755
1756             while Num /= 0 loop
1757                Indent := Indent + 1;
1758                Num    := Num / 10;
1759             end loop;
1760          end if;
1761
1762          return Val_Indent - Indent;
1763       end Digits_Indentation;
1764
1765    --  Start of processing for Write_Num
1766
1767    begin
1768       Indent_By (Digits_Indentation);
1769       Write_Int (Val);
1770    end Write_Num;
1771
1772 end Bindo.Writers;