1------------------------------------------------------------------------------ 2-- -- 3-- GNAT COMPILER COMPONENTS -- 4-- -- 5-- L I B . W R I T -- 6-- -- 7-- B o d y -- 8-- -- 9-- Copyright (C) 1992-2015, 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 ALI; use ALI; 27with Atree; use Atree; 28with Casing; use Casing; 29with Debug; use Debug; 30with Einfo; use Einfo; 31with Errout; use Errout; 32with Fname; use Fname; 33with Fname.UF; use Fname.UF; 34with Lib.Util; use Lib.Util; 35with Lib.Xref; use Lib.Xref; 36with Nlists; use Nlists; 37with Gnatvsn; use Gnatvsn; 38with Opt; use Opt; 39with Osint; use Osint; 40with Osint.C; use Osint.C; 41with Output; use Output; 42with Par; 43with Par_SCO; use Par_SCO; 44with Restrict; use Restrict; 45with Rident; use Rident; 46with Scn; use Scn; 47with Sem_Eval; use Sem_Eval; 48with Sinfo; use Sinfo; 49with Sinput; use Sinput; 50with Snames; use Snames; 51with Stringt; use Stringt; 52with Tbuild; use Tbuild; 53with Uname; use Uname; 54 55with System.Case_Util; use System.Case_Util; 56with System.WCh_Con; use System.WCh_Con; 57 58package body Lib.Writ is 59 60 ----------------------- 61 -- Local Subprograms -- 62 ----------------------- 63 64 procedure Write_Unit_Name (N : Node_Id); 65 -- Used to write out the unit name for R (pragma Restriction) lines 66 -- for uses of Restriction (No_Dependence => unit-name). 67 68 ---------------------------------- 69 -- Add_Preprocessing_Dependency -- 70 ---------------------------------- 71 72 procedure Add_Preprocessing_Dependency (S : Source_File_Index) is 73 begin 74 Units.Increment_Last; 75 Units.Table (Units.Last) := 76 (Unit_File_Name => File_Name (S), 77 Unit_Name => No_Unit_Name, 78 Expected_Unit => No_Unit_Name, 79 Source_Index => S, 80 Cunit => Empty, 81 Cunit_Entity => Empty, 82 Dependency_Num => 0, 83 Dynamic_Elab => False, 84 Fatal_Error => None, 85 Generate_Code => False, 86 Has_RACW => False, 87 Filler => False, 88 Ident_String => Empty, 89 Loading => False, 90 Main_Priority => -1, 91 Main_CPU => -1, 92 Munit_Index => 0, 93 No_Elab_Code_All => False, 94 Serial_Number => 0, 95 Version => 0, 96 Error_Location => No_Location, 97 OA_Setting => 'O', 98 SPARK_Mode_Pragma => Empty); 99 end Add_Preprocessing_Dependency; 100 101 ------------------------------ 102 -- Ensure_System_Dependency -- 103 ------------------------------ 104 105 procedure Ensure_System_Dependency is 106 System_Uname : Unit_Name_Type; 107 -- Unit name for system spec if needed for dummy entry 108 109 System_Fname : File_Name_Type; 110 -- File name for system spec if needed for dummy entry 111 112 begin 113 -- Nothing to do if we already compiled System 114 115 for Unum in Units.First .. Last_Unit loop 116 if Units.Table (Unum).Source_Index = System_Source_File_Index then 117 return; 118 end if; 119 end loop; 120 121 -- If no entry for system.ads in the units table, then add a entry 122 -- to the units table for system.ads, which will be referenced when 123 -- the ali file is generated. We need this because every unit depends 124 -- on system as a result of Targparm scanning the system.ads file to 125 -- determine the target dependent parameters for the compilation. 126 127 Name_Len := 6; 128 Name_Buffer (1 .. 6) := "system"; 129 System_Uname := Name_To_Unit_Name (Name_Enter); 130 System_Fname := File_Name (System_Source_File_Index); 131 132 Units.Increment_Last; 133 Units.Table (Units.Last) := ( 134 Unit_File_Name => System_Fname, 135 Unit_Name => System_Uname, 136 Expected_Unit => System_Uname, 137 Source_Index => System_Source_File_Index, 138 Cunit => Empty, 139 Cunit_Entity => Empty, 140 Dependency_Num => 0, 141 Dynamic_Elab => False, 142 Fatal_Error => None, 143 Generate_Code => False, 144 Has_RACW => False, 145 Filler => False, 146 Ident_String => Empty, 147 Loading => False, 148 Main_Priority => -1, 149 Main_CPU => -1, 150 Munit_Index => 0, 151 No_Elab_Code_All => False, 152 Serial_Number => 0, 153 Version => 0, 154 Error_Location => No_Location, 155 OA_Setting => 'O', 156 SPARK_Mode_Pragma => Empty); 157 158 -- Parse system.ads so that the checksum is set right 159 -- Style checks are not applied. 160 161 declare 162 Save_Mindex : constant Nat := Multiple_Unit_Index; 163 Save_Style : constant Boolean := Style_Check; 164 begin 165 Multiple_Unit_Index := 0; 166 Style_Check := False; 167 Initialize_Scanner (Units.Last, System_Source_File_Index); 168 Discard_List (Par (Configuration_Pragmas => False)); 169 Style_Check := Save_Style; 170 Multiple_Unit_Index := Save_Mindex; 171 end; 172 end Ensure_System_Dependency; 173 174 --------------- 175 -- Write_ALI -- 176 --------------- 177 178 procedure Write_ALI (Object : Boolean) is 179 180 ---------------- 181 -- Local Data -- 182 ---------------- 183 184 Last_Unit : constant Unit_Number_Type := Units.Last; 185 -- Record unit number of last unit. We capture this in case we 186 -- have to add a dummy entry to the unit table for package System. 187 188 With_Flags : array (Units.First .. Last_Unit) of Boolean; 189 -- Array of flags to show which units are with'ed 190 191 Elab_Flags : array (Units.First .. Last_Unit) of Boolean; 192 -- Array of flags to show which units have pragma Elaborate set 193 194 Elab_All_Flags : array (Units.First .. Last_Unit) of Boolean; 195 -- Array of flags to show which units have pragma Elaborate All set 196 197 Elab_Des_Flags : array (Units.First .. Last_Unit) of Boolean; 198 -- Array of flags to show which units have Elaborate_Desirable set 199 200 Elab_All_Des_Flags : array (Units.First .. Last_Unit) of Boolean; 201 -- Array of flags to show which units have Elaborate_All_Desirable set 202 203 type Yes_No is (Unknown, Yes, No); 204 Implicit_With : array (Units.First .. Last_Unit) of Yes_No; 205 -- Indicates if an implicit with has been given for the unit. Yes if 206 -- certainly present, no if certainly absent, unkonwn if not known. 207 208 Sdep_Table : Unit_Ref_Table (1 .. Pos (Last_Unit - Units.First + 2)); 209 -- Sorted table of source dependencies. One extra entry in case we 210 -- have to add a dummy entry for System. 211 212 Num_Sdep : Nat := 0; 213 -- Number of active entries in Sdep_Table 214 215 flag_compare_debug : Int; 216 pragma Import (C, flag_compare_debug); 217 -- Import from toplev.c 218 219 ----------------------- 220 -- Local Subprograms -- 221 ----------------------- 222 223 procedure Collect_Withs (Cunit : Node_Id); 224 -- Collect with lines for entries in the context clause of the 225 -- given compilation unit, Cunit. 226 227 procedure Update_Tables_From_ALI_File; 228 -- Given an up to date ALI file (see Up_To_Date_ALI_file_Exists 229 -- function), update tables from the ALI information, including 230 -- specifically the Compilation_Switches table. 231 232 function Up_To_Date_ALI_File_Exists return Boolean; 233 -- If there exists an ALI file that is up to date, then this function 234 -- initializes the tables in the ALI spec to contain information on 235 -- this file (using Scan_ALI) and returns True. If no file exists, 236 -- or the file is not up to date, then False is returned. 237 238 procedure Write_Unit_Information (Unit_Num : Unit_Number_Type); 239 -- Write out the library information for one unit for which code is 240 -- generated (includes unit line and with lines). 241 242 procedure Write_With_Lines; 243 -- Write out with lines collected by calls to Collect_Withs 244 245 ------------------- 246 -- Collect_Withs -- 247 ------------------- 248 249 procedure Collect_Withs (Cunit : Node_Id) is 250 Item : Node_Id; 251 Unum : Unit_Number_Type; 252 253 begin 254 Item := First (Context_Items (Cunit)); 255 while Present (Item) loop 256 257 -- Process with clause 258 259 -- Ada 2005 (AI-50217): limited with_clauses do not create 260 -- dependencies, but must be recorded as components of the 261 -- partition, in case there is no regular with_clause for 262 -- the unit anywhere else. 263 264 if Nkind (Item) = N_With_Clause then 265 Unum := Get_Cunit_Unit_Number (Library_Unit (Item)); 266 With_Flags (Unum) := True; 267 268 if not Limited_Present (Item) then 269 if Elaborate_Present (Item) then 270 Elab_Flags (Unum) := True; 271 end if; 272 273 if Elaborate_All_Present (Item) then 274 Elab_All_Flags (Unum) := True; 275 end if; 276 277 if Elaborate_All_Desirable (Item) then 278 Elab_All_Des_Flags (Unum) := True; 279 end if; 280 281 if Elaborate_Desirable (Item) then 282 Elab_Des_Flags (Unum) := True; 283 end if; 284 285 else 286 Set_From_Limited_With (Cunit_Entity (Unum)); 287 end if; 288 289 if Implicit_With (Unum) /= Yes then 290 if Implicit_With_From_Instantiation (Item) then 291 Implicit_With (Unum) := Yes; 292 else 293 Implicit_With (Unum) := No; 294 end if; 295 end if; 296 end if; 297 298 Next (Item); 299 end loop; 300 end Collect_Withs; 301 302 -------------------------------- 303 -- Up_To_Date_ALI_File_Exists -- 304 -------------------------------- 305 306 function Up_To_Date_ALI_File_Exists return Boolean is 307 Name : File_Name_Type; 308 Text : Text_Buffer_Ptr; 309 Id : Sdep_Id; 310 Sind : Source_File_Index; 311 312 begin 313 Opt.Check_Object_Consistency := True; 314 Read_Library_Info (Name, Text); 315 316 -- Return if we could not find an ALI file 317 318 if Text = null then 319 return False; 320 end if; 321 322 -- Return if ALI file has bad format 323 324 Initialize_ALI; 325 326 if Scan_ALI (Name, Text, False, Err => True) = No_ALI_Id then 327 return False; 328 end if; 329 330 -- If we have an OK ALI file, check if it is up to date 331 -- Note that we assume that the ALI read has all the entries 332 -- we have in our table, plus some additional ones (that can 333 -- come from expansion). 334 335 Id := First_Sdep_Entry; 336 for J in 1 .. Num_Sdep loop 337 Sind := Units.Table (Sdep_Table (J)).Source_Index; 338 339 while Sdep.Table (Id).Sfile /= File_Name (Sind) loop 340 if Id = Sdep.Last then 341 return False; 342 else 343 Id := Id + 1; 344 end if; 345 end loop; 346 347 if Sdep.Table (Id).Stamp /= Time_Stamp (Sind) then 348 return False; 349 end if; 350 end loop; 351 352 return True; 353 end Up_To_Date_ALI_File_Exists; 354 355 --------------------------------- 356 -- Update_Tables_From_ALI_File -- 357 --------------------------------- 358 359 procedure Update_Tables_From_ALI_File is 360 begin 361 -- Build Compilation_Switches table 362 363 Compilation_Switches.Init; 364 365 for J in First_Arg_Entry .. Args.Last loop 366 Compilation_Switches.Increment_Last; 367 Compilation_Switches.Table (Compilation_Switches.Last) := 368 Args.Table (J); 369 end loop; 370 end Update_Tables_From_ALI_File; 371 372 ---------------------------- 373 -- Write_Unit_Information -- 374 ---------------------------- 375 376 procedure Write_Unit_Information (Unit_Num : Unit_Number_Type) is 377 Unode : constant Node_Id := Cunit (Unit_Num); 378 Ukind : constant Node_Kind := Nkind (Unit (Unode)); 379 Uent : constant Entity_Id := Cunit_Entity (Unit_Num); 380 Pnode : Node_Id; 381 382 begin 383 Write_Info_Initiate ('U'); 384 Write_Info_Char (' '); 385 Write_Info_Name (Unit_Name (Unit_Num)); 386 Write_Info_Tab (25); 387 Write_Info_Name (Unit_File_Name (Unit_Num)); 388 389 Write_Info_Tab (49); 390 Write_Info_Str (Version_Get (Unit_Num)); 391 392 -- Add BD parameter if Elaborate_Body pragma desirable 393 394 if Ekind (Uent) = E_Package 395 and then Elaborate_Body_Desirable (Uent) 396 then 397 Write_Info_Str (" BD"); 398 end if; 399 400 -- Add BN parameter if body needed for SAL 401 402 if (Is_Subprogram (Uent) 403 or else Ekind (Uent) = E_Package 404 or else Is_Generic_Unit (Uent)) 405 and then Body_Needed_For_SAL (Uent) 406 then 407 Write_Info_Str (" BN"); 408 end if; 409 410 if Dynamic_Elab (Unit_Num) then 411 Write_Info_Str (" DE"); 412 end if; 413 414 -- Set the Elaborate_Body indication if either an explicit pragma 415 -- was present, or if this is an instantiation. 416 417 if Has_Pragma_Elaborate_Body (Uent) 418 or else (Ukind = N_Package_Declaration 419 and then Is_Generic_Instance (Uent) 420 and then Present (Corresponding_Body (Unit (Unode)))) 421 then 422 Write_Info_Str (" EB"); 423 end if; 424 425 -- Now see if we should tell the binder that an elaboration entity 426 -- is present, which must be set to true during elaboration. 427 -- We generate the indication if the following condition is met: 428 429 -- If this is a spec ... 430 431 if (Is_Subprogram (Uent) 432 or else Ekind (Uent) = E_Package 433 or else Is_Generic_Unit (Uent)) 434 435 -- and an elaboration entity was declared ... 436 437 and then Present (Elaboration_Entity (Uent)) 438 439 -- and either the elaboration flag is required ... 440 441 and then (Elaboration_Entity_Required (Uent) 442 443 -- or this unit has elaboration code ... 444 445 or else not Has_No_Elaboration_Code (Unode) 446 447 -- or this unit has a separate body and this 448 -- body has elaboration code. 449 450 or else 451 (Ekind (Uent) = E_Package 452 and then Present (Body_Entity (Uent)) 453 and then 454 not Has_No_Elaboration_Code 455 (Parent (Declaration_Node (Body_Entity (Uent)))))) 456 then 457 if Convention (Uent) = Convention_CIL then 458 459 -- Special case for generic CIL packages which never have 460 -- elaboration code 461 462 Write_Info_Str (" NE"); 463 464 else 465 Write_Info_Str (" EE"); 466 end if; 467 end if; 468 469 if Has_No_Elaboration_Code (Unode) then 470 Write_Info_Str (" NE"); 471 end if; 472 473 Write_Info_Str (" O"); 474 Write_Info_Char (OA_Setting (Unit_Num)); 475 476 if Ekind_In (Uent, E_Package, E_Package_Body) 477 and then Present (Finalizer (Uent)) 478 then 479 Write_Info_Str (" PF"); 480 end if; 481 482 if Is_Preelaborated (Uent) then 483 Write_Info_Str (" PR"); 484 end if; 485 486 if Is_Pure (Uent) then 487 Write_Info_Str (" PU"); 488 end if; 489 490 if Has_RACW (Unit_Num) then 491 Write_Info_Str (" RA"); 492 end if; 493 494 if Is_Remote_Call_Interface (Uent) then 495 Write_Info_Str (" RC"); 496 end if; 497 498 if Is_Remote_Types (Uent) then 499 Write_Info_Str (" RT"); 500 end if; 501 502 if Serious_Errors_Detected /= 0 then 503 Write_Info_Str (" SE"); 504 end if; 505 506 if Is_Shared_Passive (Uent) then 507 Write_Info_Str (" SP"); 508 end if; 509 510 if Ukind = N_Subprogram_Declaration 511 or else Ukind = N_Subprogram_Body 512 then 513 Write_Info_Str (" SU"); 514 515 elsif Ukind = N_Package_Declaration 516 or else 517 Ukind = N_Package_Body 518 then 519 -- If this is a wrapper package for a subprogram instantiation, 520 -- the user view is the subprogram. Note that in this case the 521 -- ali file contains both the spec and body of the instance. 522 523 if Is_Wrapper_Package (Uent) then 524 Write_Info_Str (" SU"); 525 else 526 Write_Info_Str (" PK"); 527 end if; 528 529 elsif Ukind = N_Generic_Package_Declaration then 530 Write_Info_Str (" PK"); 531 532 end if; 533 534 if Ukind in N_Generic_Declaration 535 or else 536 (Present (Library_Unit (Unode)) 537 and then 538 Nkind (Unit (Library_Unit (Unode))) in N_Generic_Declaration) 539 then 540 Write_Info_Str (" GE"); 541 end if; 542 543 if not Is_Internal_File_Name (Unit_File_Name (Unit_Num), True) then 544 case Identifier_Casing (Source_Index (Unit_Num)) is 545 when All_Lower_Case => Write_Info_Str (" IL"); 546 when All_Upper_Case => Write_Info_Str (" IU"); 547 when others => null; 548 end case; 549 550 case Keyword_Casing (Source_Index (Unit_Num)) is 551 when Mixed_Case => Write_Info_Str (" KM"); 552 when All_Upper_Case => Write_Info_Str (" KU"); 553 when others => null; 554 end case; 555 end if; 556 557 if Initialize_Scalars or else Invalid_Value_Used then 558 Write_Info_Str (" IS"); 559 end if; 560 561 Write_Info_EOL; 562 563 -- Generate with lines, first those that are directly with'ed 564 565 for J in With_Flags'Range loop 566 With_Flags (J) := False; 567 Elab_Flags (J) := False; 568 Elab_All_Flags (J) := False; 569 Elab_Des_Flags (J) := False; 570 Elab_All_Des_Flags (J) := False; 571 Implicit_With (J) := Unknown; 572 end loop; 573 574 Collect_Withs (Unode); 575 576 -- For a body, we must also check for any subunits which belong to 577 -- it and which have context clauses of their own, since these 578 -- with'ed units are part of its own elaboration dependencies. 579 580 if Nkind (Unit (Unode)) in N_Unit_Body then 581 for S in Units.First .. Last_Unit loop 582 583 -- We are only interested in subunits. For preproc. data and 584 -- def. files, Cunit is Empty, so we need to test that first. 585 586 if Cunit (S) /= Empty 587 and then Nkind (Unit (Cunit (S))) = N_Subunit 588 then 589 Pnode := Library_Unit (Cunit (S)); 590 591 -- In gnatc mode, the errors in the subunits will not have 592 -- been recorded, but the analysis of the subunit may have 593 -- failed. There is no information to add to ALI file in 594 -- this case. 595 596 if No (Pnode) then 597 exit; 598 end if; 599 600 -- Find ultimate parent of the subunit 601 602 while Nkind (Unit (Pnode)) = N_Subunit loop 603 Pnode := Library_Unit (Pnode); 604 end loop; 605 606 -- See if it belongs to current unit, and if so, include 607 -- its with_clauses. 608 609 if Pnode = Unode then 610 Collect_Withs (Cunit (S)); 611 end if; 612 end if; 613 end loop; 614 end if; 615 616 Write_With_Lines; 617 618 -- Generate the linker option lines 619 620 for J in 1 .. Linker_Option_Lines.Last loop 621 622 -- Pragma Linker_Options is not allowed in predefined generic 623 -- units. This is because they won't be read, due to the fact that 624 -- with lines for generic units lack the file name and lib name 625 -- parameters (see Lib_Writ spec for an explanation). 626 627 if Is_Generic_Unit (Cunit_Entity (Main_Unit)) 628 and then 629 Is_Predefined_File_Name (Unit_File_Name (Current_Sem_Unit)) 630 and then Linker_Option_Lines.Table (J).Unit = Unit_Num 631 then 632 Set_Standard_Error; 633 Write_Line 634 ("linker options not allowed in predefined generic unit"); 635 raise Unrecoverable_Error; 636 end if; 637 638 -- Output one linker option line 639 640 declare 641 S : Linker_Option_Entry renames Linker_Option_Lines.Table (J); 642 begin 643 if S.Unit = Unit_Num then 644 Write_Info_Initiate ('L'); 645 Write_Info_Char (' '); 646 Write_Info_Slit (S.Option); 647 Write_Info_EOL; 648 end if; 649 end; 650 end loop; 651 652 -- Output notes 653 654 for J in 1 .. Notes.Last loop 655 declare 656 N : constant Node_Id := Notes.Table (J); 657 L : constant Source_Ptr := Sloc (N); 658 U : constant Unit_Number_Type := 659 Unit (Get_Source_File_Index (L)); 660 C : Character; 661 662 Note_Unit : Unit_Number_Type; 663 -- The unit in whose U section this note must be emitted: 664 -- notes for subunits are emitted along with the main unit; 665 -- all other notes are emitted as part of the enclosing 666 -- compilation unit. 667 668 begin 669 if U /= No_Unit and then Nkind (Unit (Cunit (U))) = N_Subunit 670 then 671 Note_Unit := Main_Unit; 672 else 673 Note_Unit := U; 674 end if; 675 676 if Note_Unit = Unit_Num then 677 Write_Info_Initiate ('N'); 678 Write_Info_Char (' '); 679 680 case Chars (Pragma_Identifier (N)) is 681 when Name_Annotate => 682 C := 'A'; 683 when Name_Comment => 684 C := 'C'; 685 when Name_Ident => 686 C := 'I'; 687 when Name_Title => 688 C := 'T'; 689 when Name_Subtitle => 690 C := 'S'; 691 when others => 692 raise Program_Error; 693 end case; 694 695 Write_Info_Char (C); 696 Write_Info_Int (Int (Get_Logical_Line_Number (L))); 697 Write_Info_Char (':'); 698 Write_Info_Int (Int (Get_Column_Number (L))); 699 700 -- Indicate source file of annotation if different from 701 -- compilation unit source file (case of annotation coming 702 -- from a separate). 703 704 if Get_Source_File_Index (L) /= Source_Index (Unit_Num) then 705 Write_Info_Char (':'); 706 Write_Info_Name (File_Name (Get_Source_File_Index (L))); 707 end if; 708 709 declare 710 A : Node_Id; 711 712 begin 713 A := First (Pragma_Argument_Associations (N)); 714 while Present (A) loop 715 Write_Info_Char (' '); 716 717 if Chars (A) /= No_Name then 718 Write_Info_Name (Chars (A)); 719 Write_Info_Char (':'); 720 end if; 721 722 declare 723 Expr : constant Node_Id := Expression (A); 724 725 begin 726 if Nkind (Expr) = N_Identifier then 727 Write_Info_Name (Chars (Expr)); 728 729 elsif Nkind (Expr) = N_Integer_Literal 730 and then Is_OK_Static_Expression (Expr) 731 then 732 Write_Info_Uint (Intval (Expr)); 733 734 elsif Nkind (Expr) = N_String_Literal 735 and then Is_OK_Static_Expression (Expr) 736 then 737 Write_Info_Slit (Strval (Expr)); 738 739 else 740 Write_Info_Str ("<expr>"); 741 end if; 742 end; 743 744 Next (A); 745 end loop; 746 end; 747 748 Write_Info_EOL; 749 end if; 750 end; 751 end loop; 752 end Write_Unit_Information; 753 754 ---------------------- 755 -- Write_With_Lines -- 756 ---------------------- 757 758 procedure Write_With_Lines is 759 With_Table : Unit_Ref_Table (1 .. Pos (Last_Unit - Units.First + 1)); 760 Num_Withs : Int := 0; 761 Unum : Unit_Number_Type; 762 Cunit : Node_Id; 763 Uname : Unit_Name_Type; 764 Fname : File_Name_Type; 765 Pname : constant Unit_Name_Type := 766 Get_Parent_Spec_Name (Unit_Name (Main_Unit)); 767 Body_Fname : File_Name_Type; 768 Body_Index : Nat; 769 770 procedure Write_With_File_Names 771 (Nam : in out File_Name_Type; 772 Idx : Nat); 773 -- Write source file name Nam and ALI file name for unit index Idx. 774 -- Possibly change Nam to lowercase (generating a new file name). 775 776 -------------------------- 777 -- Write_With_File_Name -- 778 -------------------------- 779 780 procedure Write_With_File_Names 781 (Nam : in out File_Name_Type; 782 Idx : Nat) 783 is 784 begin 785 if not File_Names_Case_Sensitive then 786 Get_Name_String (Nam); 787 To_Lower (Name_Buffer (1 .. Name_Len)); 788 Nam := Name_Find; 789 end if; 790 791 Write_Info_Name (Nam); 792 Write_Info_Tab (49); 793 Write_Info_Name (Lib_File_Name (Nam, Idx)); 794 end Write_With_File_Names; 795 796 -- Start of processing for Write_With_Lines 797 798 begin 799 -- Loop to build the with table. A with on the main unit itself 800 -- is ignored (AARM 10.2(14a)). Such a with-clause can occur if 801 -- the main unit is a subprogram with no spec, and a subunit of 802 -- it unnecessarily withs the parent. 803 804 for J in Units.First + 1 .. Last_Unit loop 805 806 -- Add element to with table if it is with'ed or if it is the 807 -- parent spec of the main unit (case of main unit is a child 808 -- unit). The latter with is not needed for semantic purposes, 809 -- but is required by the binder for elaboration purposes. For 810 -- preprocessing data and definition files, there is no Unit_Name, 811 -- check for that first. 812 813 if Unit_Name (J) /= No_Unit_Name 814 and then (With_Flags (J) or else Unit_Name (J) = Pname) 815 then 816 Num_Withs := Num_Withs + 1; 817 With_Table (Num_Withs) := J; 818 end if; 819 end loop; 820 821 -- Sort and output the table 822 823 Sort (With_Table (1 .. Num_Withs)); 824 825 for J in 1 .. Num_Withs loop 826 Unum := With_Table (J); 827 Cunit := Units.Table (Unum).Cunit; 828 Uname := Units.Table (Unum).Unit_Name; 829 Fname := Units.Table (Unum).Unit_File_Name; 830 831 if Implicit_With (Unum) = Yes then 832 Write_Info_Initiate ('Z'); 833 834 elsif Ekind (Cunit_Entity (Unum)) = E_Package 835 and then From_Limited_With (Cunit_Entity (Unum)) 836 then 837 Write_Info_Initiate ('Y'); 838 839 else 840 Write_Info_Initiate ('W'); 841 end if; 842 843 Write_Info_Char (' '); 844 Write_Info_Name (Uname); 845 846 -- Now we need to figure out the names of the files that contain 847 -- the with'ed unit. These will usually be the files for the body, 848 -- except in the case of a package that has no body. Note that we 849 -- have a specific exemption here for predefined library generics 850 -- (see comments for Generic_May_Lack_ALI). We do not generate 851 -- dependency upon the ALI file for such units. Older compilers 852 -- used to not support generating code (and ALI) for generics, and 853 -- we want to avoid having different processing (namely, different 854 -- lists of files to be compiled) for different stages of the 855 -- bootstrap. 856 857 if not ((Nkind (Unit (Cunit)) in N_Generic_Declaration 858 or else 859 Nkind (Unit (Cunit)) in N_Generic_Renaming_Declaration) 860 and then Generic_May_Lack_ALI (Fname)) 861 862 -- In SPARK mode, always generate the dependencies on ALI 863 -- files, which are required to compute frame conditions 864 -- of subprograms. 865 866 or else GNATprove_Mode 867 then 868 Write_Info_Tab (25); 869 870 if Is_Spec_Name (Uname) then 871 Body_Fname := 872 Get_File_Name 873 (Get_Body_Name (Uname), 874 Subunit => False, May_Fail => True); 875 876 Body_Index := 877 Get_Unit_Index 878 (Get_Body_Name (Uname)); 879 880 if Body_Fname = No_File then 881 Body_Fname := Get_File_Name (Uname, Subunit => False); 882 Body_Index := Get_Unit_Index (Uname); 883 end if; 884 885 else 886 Body_Fname := Get_File_Name (Uname, Subunit => False); 887 Body_Index := Get_Unit_Index (Uname); 888 end if; 889 890 -- A package is considered to have a body if it requires 891 -- a body or if a body is present in Ada 83 mode. 892 893 if Body_Required (Cunit) 894 or else (Ada_Version = Ada_83 895 and then Full_Source_Name (Body_Fname) /= No_File) 896 then 897 Write_With_File_Names (Body_Fname, Body_Index); 898 else 899 Write_With_File_Names (Fname, Munit_Index (Unum)); 900 end if; 901 902 if Ekind (Cunit_Entity (Unum)) = E_Package 903 and then From_Limited_With (Cunit_Entity (Unum)) 904 then 905 null; 906 else 907 if Elab_Flags (Unum) then 908 Write_Info_Str (" E"); 909 end if; 910 911 if Elab_All_Flags (Unum) then 912 Write_Info_Str (" EA"); 913 end if; 914 915 if Elab_Des_Flags (Unum) then 916 Write_Info_Str (" ED"); 917 end if; 918 919 if Elab_All_Des_Flags (Unum) then 920 Write_Info_Str (" AD"); 921 end if; 922 end if; 923 end if; 924 925 Write_Info_EOL; 926 end loop; 927 928 -- Finally generate the special lines for cases of Restriction_Set 929 -- with No_Dependence and no restriction present. 930 931 declare 932 Unam : Unit_Name_Type; 933 934 begin 935 for J in Restriction_Set_Dependences.First .. 936 Restriction_Set_Dependences.Last 937 loop 938 Unam := Restriction_Set_Dependences.Table (J); 939 940 -- Don't need an entry if already in the unit table 941 942 for U in 0 .. Last_Unit loop 943 if Unit_Name (U) = Unam then 944 goto Continue; 945 end if; 946 end loop; 947 948 -- Otherwise generate the entry 949 950 Write_Info_Initiate ('W'); 951 Write_Info_Char (' '); 952 Write_Info_Name (Unam); 953 Write_Info_EOL; 954 955 <<Continue>> 956 null; 957 end loop; 958 end; 959 end Write_With_Lines; 960 961 -- Start of processing for Write_ALI 962 963 begin 964 -- We never write an ALI file if the original operating mode was 965 -- syntax-only (-gnats switch used in compiler invocation line) 966 967 if Original_Operating_Mode = Check_Syntax 968 or flag_compare_debug /= 0 969 then 970 return; 971 end if; 972 973 -- Generation of ALI files may be disabled, e.g. for formal verification 974 -- back-end. 975 976 if Disable_ALI_File then 977 return; 978 end if; 979 980 -- Build sorted source dependency table. We do this right away, because 981 -- it is referenced by Up_To_Date_ALI_File_Exists. 982 983 for Unum in Units.First .. Last_Unit loop 984 if Cunit_Entity (Unum) = Empty 985 or else not From_Limited_With (Cunit_Entity (Unum)) 986 then 987 Num_Sdep := Num_Sdep + 1; 988 Sdep_Table (Num_Sdep) := Unum; 989 end if; 990 end loop; 991 992 -- Sort the table so that the D lines are in order 993 994 Lib.Sort (Sdep_Table (1 .. Num_Sdep)); 995 996 -- If we are not generating code, and there is an up to date ALI file 997 -- file accessible, read it, and acquire the compilation arguments from 998 -- this file. In GNATprove mode, always generate the ALI file, which 999 -- contains a special section for formal verification. 1000 1001 if Operating_Mode /= Generate_Code and then not GNATprove_Mode then 1002 if Up_To_Date_ALI_File_Exists then 1003 Update_Tables_From_ALI_File; 1004 return; 1005 end if; 1006 end if; 1007 1008 -- Otherwise acquire compilation arguments and prepare to write 1009 -- out a new ali file. 1010 1011 Create_Output_Library_Info; 1012 1013 -- Output version line 1014 1015 Write_Info_Initiate ('V'); 1016 Write_Info_Str (" """); 1017 Write_Info_Str (Verbose_Library_Version); 1018 Write_Info_Char ('"'); 1019 1020 Write_Info_EOL; 1021 1022 -- Output main program line if this is acceptable main program 1023 1024 Output_Main_Program_Line : declare 1025 U : Node_Id := Unit (Units.Table (Main_Unit).Cunit); 1026 S : Node_Id; 1027 1028 procedure M_Parameters; 1029 -- Output parameters for main program line 1030 1031 ------------------ 1032 -- M_Parameters -- 1033 ------------------ 1034 1035 procedure M_Parameters is 1036 begin 1037 if Main_Priority (Main_Unit) /= Default_Main_Priority then 1038 Write_Info_Char (' '); 1039 Write_Info_Nat (Main_Priority (Main_Unit)); 1040 end if; 1041 1042 if Opt.Time_Slice_Set then 1043 Write_Info_Str (" T="); 1044 Write_Info_Nat (Opt.Time_Slice_Value); 1045 end if; 1046 1047 if Main_CPU (Main_Unit) /= Default_Main_CPU then 1048 Write_Info_Str (" C="); 1049 Write_Info_Nat (Main_CPU (Main_Unit)); 1050 end if; 1051 1052 Write_Info_Str (" W="); 1053 Write_Info_Char 1054 (WC_Encoding_Letters (Wide_Character_Encoding_Method)); 1055 1056 Write_Info_EOL; 1057 end M_Parameters; 1058 1059 -- Start of processing for Output_Main_Program_Line 1060 1061 begin 1062 if Nkind (U) = N_Subprogram_Body 1063 or else 1064 (Nkind (U) = N_Package_Body 1065 and then 1066 Nkind (Original_Node (U)) in N_Subprogram_Instantiation) 1067 then 1068 -- If the unit is a subprogram instance, the entity for the 1069 -- subprogram is the alias of the visible entity, which is the 1070 -- related instance of the wrapper package. We retrieve the 1071 -- subprogram declaration of the desired entity. 1072 1073 if Nkind (U) = N_Package_Body then 1074 U := Parent (Parent ( 1075 Alias (Related_Instance (Defining_Unit_Name 1076 (Specification (Unit (Library_Unit (Parent (U))))))))); 1077 end if; 1078 1079 S := Specification (U); 1080 1081 -- A generic subprogram is never a main program 1082 1083 if Nkind (U) = N_Subprogram_Body 1084 and then Present (Corresponding_Spec (U)) 1085 and then 1086 Ekind_In (Corresponding_Spec (U), E_Generic_Procedure, 1087 E_Generic_Function) 1088 then 1089 null; 1090 1091 elsif No (Parameter_Specifications (S)) then 1092 if Nkind (S) = N_Procedure_Specification then 1093 Write_Info_Initiate ('M'); 1094 Write_Info_Str (" P"); 1095 M_Parameters; 1096 1097 else 1098 declare 1099 Nam : Node_Id := Defining_Unit_Name (S); 1100 1101 begin 1102 -- If it is a child unit, get its simple name 1103 1104 if Nkind (Nam) = N_Defining_Program_Unit_Name then 1105 Nam := Defining_Identifier (Nam); 1106 end if; 1107 1108 if Is_Integer_Type (Etype (Nam)) then 1109 Write_Info_Initiate ('M'); 1110 Write_Info_Str (" F"); 1111 M_Parameters; 1112 end if; 1113 end; 1114 end if; 1115 end if; 1116 end if; 1117 end Output_Main_Program_Line; 1118 1119 -- Write command argument ('A') lines 1120 1121 for A in 1 .. Compilation_Switches.Last loop 1122 Write_Info_Initiate ('A'); 1123 Write_Info_Char (' '); 1124 Write_Info_Str (Compilation_Switches.Table (A).all); 1125 Write_Info_Terminate; 1126 end loop; 1127 1128 -- Output parameters ('P') line 1129 1130 Write_Info_Initiate ('P'); 1131 1132 if Compilation_Errors then 1133 Write_Info_Str (" CE"); 1134 end if; 1135 1136 if Opt.Detect_Blocking then 1137 Write_Info_Str (" DB"); 1138 end if; 1139 1140 if Tasking_Used 1141 and then not Is_Predefined_File_Name (Unit_File_Name (Main_Unit)) 1142 then 1143 if Locking_Policy /= ' ' then 1144 Write_Info_Str (" L"); 1145 Write_Info_Char (Locking_Policy); 1146 end if; 1147 1148 if Queuing_Policy /= ' ' then 1149 Write_Info_Str (" Q"); 1150 Write_Info_Char (Queuing_Policy); 1151 end if; 1152 1153 if Task_Dispatching_Policy /= ' ' then 1154 Write_Info_Str (" T"); 1155 Write_Info_Char (Task_Dispatching_Policy); 1156 Write_Info_Char (' '); 1157 end if; 1158 end if; 1159 1160 if GNATprove_Mode then 1161 Write_Info_Str (" GP"); 1162 end if; 1163 1164 if Partition_Elaboration_Policy /= ' ' then 1165 Write_Info_Str (" E"); 1166 Write_Info_Char (Partition_Elaboration_Policy); 1167 end if; 1168 1169 if not Object then 1170 Write_Info_Str (" NO"); 1171 end if; 1172 1173 if No_Run_Time_Mode then 1174 Write_Info_Str (" NR"); 1175 end if; 1176 1177 if Normalize_Scalars then 1178 Write_Info_Str (" NS"); 1179 end if; 1180 1181 if Default_SSO_Config /= ' ' then 1182 Write_Info_Str (" O"); 1183 Write_Info_Char (Default_SSO_Config); 1184 end if; 1185 1186 if Sec_Stack_Used then 1187 Write_Info_Str (" SS"); 1188 end if; 1189 1190 if Unreserve_All_Interrupts then 1191 Write_Info_Str (" UA"); 1192 end if; 1193 1194 if Exception_Mechanism = Back_End_Exceptions then 1195 Write_Info_Str (" ZX"); 1196 end if; 1197 1198 Write_Info_EOL; 1199 1200 -- Before outputting the restrictions line, update the setting of 1201 -- the No_Elaboration_Code flag. Violations of this restriction 1202 -- cannot be detected until after the backend has been called since 1203 -- it is the backend that sets this flag. We have to check all units 1204 -- for which we have generated code 1205 1206 for Unit in Units.First .. Last_Unit loop 1207 if Units.Table (Unit).Generate_Code or else Unit = Main_Unit then 1208 if not Has_No_Elaboration_Code (Cunit (Unit)) then 1209 Main_Restrictions.Violated (No_Elaboration_Code) := True; 1210 end if; 1211 end if; 1212 end loop; 1213 1214 -- Positional case (only if debug flag -gnatd.R is set) 1215 1216 if Debug_Flag_Dot_RR then 1217 1218 -- Output first restrictions line 1219 1220 Write_Info_Initiate ('R'); 1221 Write_Info_Char (' '); 1222 1223 -- First the information for the boolean restrictions 1224 1225 for R in All_Boolean_Restrictions loop 1226 if Main_Restrictions.Set (R) 1227 and then not Restriction_Warnings (R) 1228 then 1229 Write_Info_Char ('r'); 1230 elsif Main_Restrictions.Violated (R) then 1231 Write_Info_Char ('v'); 1232 else 1233 Write_Info_Char ('n'); 1234 end if; 1235 end loop; 1236 1237 -- And now the information for the parameter restrictions 1238 1239 for RP in All_Parameter_Restrictions loop 1240 if Main_Restrictions.Set (RP) 1241 and then not Restriction_Warnings (RP) 1242 then 1243 Write_Info_Char ('r'); 1244 Write_Info_Nat (Nat (Main_Restrictions.Value (RP))); 1245 else 1246 Write_Info_Char ('n'); 1247 end if; 1248 1249 if not Main_Restrictions.Violated (RP) 1250 or else RP not in Checked_Parameter_Restrictions 1251 then 1252 Write_Info_Char ('n'); 1253 else 1254 Write_Info_Char ('v'); 1255 Write_Info_Nat (Nat (Main_Restrictions.Count (RP))); 1256 1257 if Main_Restrictions.Unknown (RP) then 1258 Write_Info_Char ('+'); 1259 end if; 1260 end if; 1261 end loop; 1262 1263 Write_Info_EOL; 1264 1265 -- Named case (if debug flag -gnatd.R is not set) 1266 1267 else 1268 declare 1269 C : Character; 1270 1271 begin 1272 -- Write RN header line with preceding blank line 1273 1274 Write_Info_EOL; 1275 Write_Info_Initiate ('R'); 1276 Write_Info_Char ('N'); 1277 Write_Info_EOL; 1278 1279 -- First the lines for the boolean restrictions 1280 1281 for R in All_Boolean_Restrictions loop 1282 if Main_Restrictions.Set (R) 1283 and then not Restriction_Warnings (R) 1284 then 1285 C := 'R'; 1286 elsif Main_Restrictions.Violated (R) then 1287 C := 'V'; 1288 else 1289 goto Continue; 1290 end if; 1291 1292 Write_Info_Initiate ('R'); 1293 Write_Info_Char (C); 1294 Write_Info_Char (' '); 1295 Write_Info_Str (All_Boolean_Restrictions'Image (R)); 1296 Write_Info_EOL; 1297 1298 <<Continue>> 1299 null; 1300 end loop; 1301 end; 1302 1303 -- And now the lines for the parameter restrictions 1304 1305 for RP in All_Parameter_Restrictions loop 1306 if Main_Restrictions.Set (RP) 1307 and then not Restriction_Warnings (RP) 1308 then 1309 Write_Info_Initiate ('R'); 1310 Write_Info_Str ("R "); 1311 Write_Info_Str (All_Parameter_Restrictions'Image (RP)); 1312 Write_Info_Char ('='); 1313 Write_Info_Nat (Nat (Main_Restrictions.Value (RP))); 1314 Write_Info_EOL; 1315 end if; 1316 1317 if not Main_Restrictions.Violated (RP) 1318 or else RP not in Checked_Parameter_Restrictions 1319 then 1320 null; 1321 else 1322 Write_Info_Initiate ('R'); 1323 Write_Info_Str ("V "); 1324 Write_Info_Str (All_Parameter_Restrictions'Image (RP)); 1325 Write_Info_Char ('='); 1326 Write_Info_Nat (Nat (Main_Restrictions.Count (RP))); 1327 1328 if Main_Restrictions.Unknown (RP) then 1329 Write_Info_Char ('+'); 1330 end if; 1331 1332 Write_Info_EOL; 1333 end if; 1334 end loop; 1335 end if; 1336 1337 -- Output R lines for No_Dependence entries 1338 1339 for J in No_Dependences.First .. No_Dependences.Last loop 1340 if In_Extended_Main_Source_Unit (No_Dependences.Table (J).Unit) 1341 and then not No_Dependences.Table (J).Warn 1342 then 1343 Write_Info_Initiate ('R'); 1344 Write_Info_Char (' '); 1345 Write_Unit_Name (No_Dependences.Table (J).Unit); 1346 Write_Info_EOL; 1347 end if; 1348 end loop; 1349 1350 -- Output interrupt state lines 1351 1352 for J in Interrupt_States.First .. Interrupt_States.Last loop 1353 Write_Info_Initiate ('I'); 1354 Write_Info_Char (' '); 1355 Write_Info_Nat (Interrupt_States.Table (J).Interrupt_Number); 1356 Write_Info_Char (' '); 1357 Write_Info_Char (Interrupt_States.Table (J).Interrupt_State); 1358 Write_Info_Char (' '); 1359 Write_Info_Nat 1360 (Nat (Get_Logical_Line_Number 1361 (Interrupt_States.Table (J).Pragma_Loc))); 1362 Write_Info_EOL; 1363 end loop; 1364 1365 -- Output priority specific dispatching lines 1366 1367 for J in Specific_Dispatching.First .. Specific_Dispatching.Last loop 1368 Write_Info_Initiate ('S'); 1369 Write_Info_Char (' '); 1370 Write_Info_Char (Specific_Dispatching.Table (J).Dispatching_Policy); 1371 Write_Info_Char (' '); 1372 Write_Info_Nat (Specific_Dispatching.Table (J).First_Priority); 1373 Write_Info_Char (' '); 1374 Write_Info_Nat (Specific_Dispatching.Table (J).Last_Priority); 1375 Write_Info_Char (' '); 1376 Write_Info_Nat 1377 (Nat (Get_Logical_Line_Number 1378 (Specific_Dispatching.Table (J).Pragma_Loc))); 1379 Write_Info_EOL; 1380 end loop; 1381 1382 -- Loop through file table to output information for all units for which 1383 -- we have generated code, as marked by the Generate_Code flag. 1384 1385 for Unit in Units.First .. Last_Unit loop 1386 if Units.Table (Unit).Generate_Code 1387 or else Unit = Main_Unit 1388 then 1389 Write_Info_EOL; -- blank line 1390 Write_Unit_Information (Unit); 1391 end if; 1392 end loop; 1393 1394 Write_Info_EOL; -- blank line 1395 1396 -- Output external version reference lines 1397 1398 for J in 1 .. Version_Ref.Last loop 1399 Write_Info_Initiate ('E'); 1400 Write_Info_Char (' '); 1401 1402 for K in 1 .. String_Length (Version_Ref.Table (J)) loop 1403 Write_Info_Char_Code (Get_String_Char (Version_Ref.Table (J), K)); 1404 end loop; 1405 1406 Write_Info_EOL; 1407 end loop; 1408 1409 -- Prepare to output the source dependency lines 1410 1411 declare 1412 Unum : Unit_Number_Type; 1413 -- Number of unit being output 1414 1415 Sind : Source_File_Index; 1416 -- Index of corresponding source file 1417 1418 Fname : File_Name_Type; 1419 1420 begin 1421 for J in 1 .. Num_Sdep loop 1422 Unum := Sdep_Table (J); 1423 Units.Table (Unum).Dependency_Num := J; 1424 Sind := Units.Table (Unum).Source_Index; 1425 1426 Write_Info_Initiate ('D'); 1427 Write_Info_Char (' '); 1428 1429 -- Normal case of a unit entry with a source index 1430 1431 if Sind /= No_Source_File then 1432 Fname := File_Name (Sind); 1433 1434 -- Ensure that on platforms where the file names are not case 1435 -- sensitive, the recorded file name is in lower case. 1436 1437 if not File_Names_Case_Sensitive then 1438 Get_Name_String (Fname); 1439 To_Lower (Name_Buffer (1 .. Name_Len)); 1440 Fname := Name_Find; 1441 end if; 1442 1443 Write_Info_Name_May_Be_Quoted (Fname); 1444 Write_Info_Tab (25); 1445 Write_Info_Str (String (Time_Stamp (Sind))); 1446 Write_Info_Char (' '); 1447 Write_Info_Str (Get_Hex_String (Source_Checksum (Sind))); 1448 1449 -- If subunit, add unit name, omitting the %b at the end 1450 1451 if Present (Cunit (Unum)) then 1452 Get_Decoded_Name_String (Unit_Name (Unum)); 1453 Write_Info_Char (' '); 1454 1455 if Nkind (Unit (Cunit (Unum))) = N_Subunit then 1456 Write_Info_Str (Name_Buffer (1 .. Name_Len - 2)); 1457 else 1458 Write_Info_Str (Name_Buffer (1 .. Name_Len)); 1459 end if; 1460 end if; 1461 1462 -- If Source_Reference pragma used, output information 1463 1464 if Num_SRef_Pragmas (Sind) > 0 then 1465 Write_Info_Char (' '); 1466 1467 if Num_SRef_Pragmas (Sind) = 1 then 1468 Write_Info_Nat (Int (First_Mapped_Line (Sind))); 1469 else 1470 Write_Info_Nat (0); 1471 end if; 1472 1473 Write_Info_Char (':'); 1474 Write_Info_Name (Reference_Name (Sind)); 1475 end if; 1476 1477 -- Case where there is no source index (happens for missing 1478 -- files). In this case we write a dummy time stamp. 1479 1480 else 1481 Write_Info_Name (Unit_File_Name (Unum)); 1482 Write_Info_Tab (25); 1483 Write_Info_Str (String (Dummy_Time_Stamp)); 1484 Write_Info_Char (' '); 1485 Write_Info_Str (Get_Hex_String (0)); 1486 end if; 1487 1488 Write_Info_EOL; 1489 end loop; 1490 end; 1491 1492 -- Output cross-references 1493 1494 if Opt.Xref_Active then 1495 Output_References; 1496 end if; 1497 1498 -- Output SCO information if present 1499 1500 if Generate_SCO then 1501 SCO_Record_Filtered; 1502 SCO_Output; 1503 end if; 1504 1505 -- Output SPARK cross-reference information if needed 1506 1507 if Opt.Xref_Active and then GNATprove_Mode then 1508 SPARK_Specific.Collect_SPARK_Xrefs (Sdep_Table => Sdep_Table, 1509 Num_Sdep => Num_Sdep); 1510 SPARK_Specific.Output_SPARK_Xrefs; 1511 end if; 1512 1513 -- Output final blank line and we are done. This final blank line is 1514 -- probably junk, but we don't feel like making an incompatible change. 1515 1516 Write_Info_Terminate; 1517 Close_Output_Library_Info; 1518 end Write_ALI; 1519 1520 --------------------- 1521 -- Write_Unit_Name -- 1522 --------------------- 1523 1524 procedure Write_Unit_Name (N : Node_Id) is 1525 begin 1526 if Nkind (N) = N_Identifier then 1527 Write_Info_Name (Chars (N)); 1528 1529 else 1530 pragma Assert (Nkind (N) = N_Selected_Component); 1531 Write_Unit_Name (Prefix (N)); 1532 Write_Info_Char ('.'); 1533 Write_Unit_Name (Selector_Name (N)); 1534 end if; 1535 end Write_Unit_Name; 1536 1537end Lib.Writ; 1538