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-2020, 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 26with Binderr; use Binderr; 27with Butil; use Butil; 28with Debug; use Debug; 29with Fname; use Fname; 30with Opt; use Opt; 31with Output; use Output; 32 33with Bindo.Units; 34use Bindo.Units; 35 36with GNAT; use GNAT; 37with GNAT.Graphs; use GNAT.Graphs; 38with GNAT.Sets; use GNAT.Sets; 39 40package 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 1693 -- in 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 1778end Bindo.Writers; 1779