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 Write_Info_Str (" EE"); 458 end if; 459 460 if Has_No_Elaboration_Code (Unode) then 461 Write_Info_Str (" NE"); 462 end if; 463 464 Write_Info_Str (" O"); 465 Write_Info_Char (OA_Setting (Unit_Num)); 466 467 if Ekind_In (Uent, E_Package, E_Package_Body) 468 and then Present (Finalizer (Uent)) 469 then 470 Write_Info_Str (" PF"); 471 end if; 472 473 if Is_Preelaborated (Uent) then 474 Write_Info_Str (" PR"); 475 end if; 476 477 if Is_Pure (Uent) then 478 Write_Info_Str (" PU"); 479 end if; 480 481 if Has_RACW (Unit_Num) then 482 Write_Info_Str (" RA"); 483 end if; 484 485 if Is_Remote_Call_Interface (Uent) then 486 Write_Info_Str (" RC"); 487 end if; 488 489 if Is_Remote_Types (Uent) then 490 Write_Info_Str (" RT"); 491 end if; 492 493 if Serious_Errors_Detected /= 0 then 494 Write_Info_Str (" SE"); 495 end if; 496 497 if Is_Shared_Passive (Uent) then 498 Write_Info_Str (" SP"); 499 end if; 500 501 if Ukind = N_Subprogram_Declaration 502 or else Ukind = N_Subprogram_Body 503 then 504 Write_Info_Str (" SU"); 505 506 elsif Ukind = N_Package_Declaration 507 or else 508 Ukind = N_Package_Body 509 then 510 -- If this is a wrapper package for a subprogram instantiation, 511 -- the user view is the subprogram. Note that in this case the 512 -- ali file contains both the spec and body of the instance. 513 514 if Is_Wrapper_Package (Uent) then 515 Write_Info_Str (" SU"); 516 else 517 Write_Info_Str (" PK"); 518 end if; 519 520 elsif Ukind = N_Generic_Package_Declaration then 521 Write_Info_Str (" PK"); 522 523 end if; 524 525 if Ukind in N_Generic_Declaration 526 or else 527 (Present (Library_Unit (Unode)) 528 and then 529 Nkind (Unit (Library_Unit (Unode))) in N_Generic_Declaration) 530 then 531 Write_Info_Str (" GE"); 532 end if; 533 534 if not Is_Internal_File_Name (Unit_File_Name (Unit_Num), True) then 535 case Identifier_Casing (Source_Index (Unit_Num)) is 536 when All_Lower_Case => Write_Info_Str (" IL"); 537 when All_Upper_Case => Write_Info_Str (" IU"); 538 when others => null; 539 end case; 540 541 case Keyword_Casing (Source_Index (Unit_Num)) is 542 when Mixed_Case => Write_Info_Str (" KM"); 543 when All_Upper_Case => Write_Info_Str (" KU"); 544 when others => null; 545 end case; 546 end if; 547 548 if Initialize_Scalars or else Invalid_Value_Used then 549 Write_Info_Str (" IS"); 550 end if; 551 552 Write_Info_EOL; 553 554 -- Generate with lines, first those that are directly with'ed 555 556 for J in With_Flags'Range loop 557 With_Flags (J) := False; 558 Elab_Flags (J) := False; 559 Elab_All_Flags (J) := False; 560 Elab_Des_Flags (J) := False; 561 Elab_All_Des_Flags (J) := False; 562 Implicit_With (J) := Unknown; 563 end loop; 564 565 Collect_Withs (Unode); 566 567 -- For a body, we must also check for any subunits which belong to 568 -- it and which have context clauses of their own, since these 569 -- with'ed units are part of its own elaboration dependencies. 570 571 if Nkind (Unit (Unode)) in N_Unit_Body then 572 for S in Units.First .. Last_Unit loop 573 574 -- We are only interested in subunits. For preproc. data and 575 -- def. files, Cunit is Empty, so we need to test that first. 576 577 if Cunit (S) /= Empty 578 and then Nkind (Unit (Cunit (S))) = N_Subunit 579 then 580 Pnode := Library_Unit (Cunit (S)); 581 582 -- In gnatc mode, the errors in the subunits will not have 583 -- been recorded, but the analysis of the subunit may have 584 -- failed. There is no information to add to ALI file in 585 -- this case. 586 587 if No (Pnode) then 588 exit; 589 end if; 590 591 -- Find ultimate parent of the subunit 592 593 while Nkind (Unit (Pnode)) = N_Subunit loop 594 Pnode := Library_Unit (Pnode); 595 end loop; 596 597 -- See if it belongs to current unit, and if so, include 598 -- its with_clauses. 599 600 if Pnode = Unode then 601 Collect_Withs (Cunit (S)); 602 end if; 603 end if; 604 end loop; 605 end if; 606 607 Write_With_Lines; 608 609 -- Generate the linker option lines 610 611 for J in 1 .. Linker_Option_Lines.Last loop 612 613 -- Pragma Linker_Options is not allowed in predefined generic 614 -- units. This is because they won't be read, due to the fact that 615 -- with lines for generic units lack the file name and lib name 616 -- parameters (see Lib_Writ spec for an explanation). 617 618 if Is_Generic_Unit (Cunit_Entity (Main_Unit)) 619 and then 620 Is_Predefined_File_Name (Unit_File_Name (Current_Sem_Unit)) 621 and then Linker_Option_Lines.Table (J).Unit = Unit_Num 622 then 623 Set_Standard_Error; 624 Write_Line 625 ("linker options not allowed in predefined generic unit"); 626 raise Unrecoverable_Error; 627 end if; 628 629 -- Output one linker option line 630 631 declare 632 S : Linker_Option_Entry renames Linker_Option_Lines.Table (J); 633 begin 634 if S.Unit = Unit_Num then 635 Write_Info_Initiate ('L'); 636 Write_Info_Char (' '); 637 Write_Info_Slit (S.Option); 638 Write_Info_EOL; 639 end if; 640 end; 641 end loop; 642 643 -- Output notes 644 645 for J in 1 .. Notes.Last loop 646 declare 647 N : constant Node_Id := Notes.Table (J); 648 L : constant Source_Ptr := Sloc (N); 649 U : constant Unit_Number_Type := 650 Unit (Get_Source_File_Index (L)); 651 C : Character; 652 653 Note_Unit : Unit_Number_Type; 654 -- The unit in whose U section this note must be emitted: 655 -- notes for subunits are emitted along with the main unit; 656 -- all other notes are emitted as part of the enclosing 657 -- compilation unit. 658 659 begin 660 if U /= No_Unit and then Nkind (Unit (Cunit (U))) = N_Subunit 661 then 662 Note_Unit := Main_Unit; 663 else 664 Note_Unit := U; 665 end if; 666 667 if Note_Unit = Unit_Num then 668 Write_Info_Initiate ('N'); 669 Write_Info_Char (' '); 670 671 case Chars (Pragma_Identifier (N)) is 672 when Name_Annotate => 673 C := 'A'; 674 when Name_Comment => 675 C := 'C'; 676 when Name_Ident => 677 C := 'I'; 678 when Name_Title => 679 C := 'T'; 680 when Name_Subtitle => 681 C := 'S'; 682 when others => 683 raise Program_Error; 684 end case; 685 686 Write_Info_Char (C); 687 Write_Info_Int (Int (Get_Logical_Line_Number (L))); 688 Write_Info_Char (':'); 689 Write_Info_Int (Int (Get_Column_Number (L))); 690 691 -- Indicate source file of annotation if different from 692 -- compilation unit source file (case of annotation coming 693 -- from a separate). 694 695 if Get_Source_File_Index (L) /= Source_Index (Unit_Num) then 696 Write_Info_Char (':'); 697 Write_Info_Name (File_Name (Get_Source_File_Index (L))); 698 end if; 699 700 declare 701 A : Node_Id; 702 703 begin 704 A := First (Pragma_Argument_Associations (N)); 705 while Present (A) loop 706 Write_Info_Char (' '); 707 708 if Chars (A) /= No_Name then 709 Write_Info_Name (Chars (A)); 710 Write_Info_Char (':'); 711 end if; 712 713 declare 714 Expr : constant Node_Id := Expression (A); 715 716 begin 717 if Nkind (Expr) = N_Identifier then 718 Write_Info_Name (Chars (Expr)); 719 720 elsif Nkind (Expr) = N_Integer_Literal 721 and then Is_OK_Static_Expression (Expr) 722 then 723 Write_Info_Uint (Intval (Expr)); 724 725 elsif Nkind (Expr) = N_String_Literal 726 and then Is_OK_Static_Expression (Expr) 727 then 728 Write_Info_Slit (Strval (Expr)); 729 730 else 731 Write_Info_Str ("<expr>"); 732 end if; 733 end; 734 735 Next (A); 736 end loop; 737 end; 738 739 Write_Info_EOL; 740 end if; 741 end; 742 end loop; 743 end Write_Unit_Information; 744 745 ---------------------- 746 -- Write_With_Lines -- 747 ---------------------- 748 749 procedure Write_With_Lines is 750 With_Table : Unit_Ref_Table (1 .. Pos (Last_Unit - Units.First + 1)); 751 Num_Withs : Int := 0; 752 Unum : Unit_Number_Type; 753 Cunit : Node_Id; 754 Uname : Unit_Name_Type; 755 Fname : File_Name_Type; 756 Pname : constant Unit_Name_Type := 757 Get_Parent_Spec_Name (Unit_Name (Main_Unit)); 758 Body_Fname : File_Name_Type; 759 Body_Index : Nat; 760 761 procedure Write_With_File_Names 762 (Nam : in out File_Name_Type; 763 Idx : Nat); 764 -- Write source file name Nam and ALI file name for unit index Idx. 765 -- Possibly change Nam to lowercase (generating a new file name). 766 767 -------------------------- 768 -- Write_With_File_Name -- 769 -------------------------- 770 771 procedure Write_With_File_Names 772 (Nam : in out File_Name_Type; 773 Idx : Nat) 774 is 775 begin 776 if not File_Names_Case_Sensitive then 777 Get_Name_String (Nam); 778 To_Lower (Name_Buffer (1 .. Name_Len)); 779 Nam := Name_Find; 780 end if; 781 782 Write_Info_Name (Nam); 783 Write_Info_Tab (49); 784 Write_Info_Name (Lib_File_Name (Nam, Idx)); 785 end Write_With_File_Names; 786 787 -- Start of processing for Write_With_Lines 788 789 begin 790 -- Loop to build the with table. A with on the main unit itself 791 -- is ignored (AARM 10.2(14a)). Such a with-clause can occur if 792 -- the main unit is a subprogram with no spec, and a subunit of 793 -- it unnecessarily withs the parent. 794 795 for J in Units.First + 1 .. Last_Unit loop 796 797 -- Add element to with table if it is with'ed or if it is the 798 -- parent spec of the main unit (case of main unit is a child 799 -- unit). The latter with is not needed for semantic purposes, 800 -- but is required by the binder for elaboration purposes. For 801 -- preprocessing data and definition files, there is no Unit_Name, 802 -- check for that first. 803 804 if Unit_Name (J) /= No_Unit_Name 805 and then (With_Flags (J) or else Unit_Name (J) = Pname) 806 then 807 Num_Withs := Num_Withs + 1; 808 With_Table (Num_Withs) := J; 809 end if; 810 end loop; 811 812 -- Sort and output the table 813 814 Sort (With_Table (1 .. Num_Withs)); 815 816 for J in 1 .. Num_Withs loop 817 Unum := With_Table (J); 818 Cunit := Units.Table (Unum).Cunit; 819 Uname := Units.Table (Unum).Unit_Name; 820 Fname := Units.Table (Unum).Unit_File_Name; 821 822 if Implicit_With (Unum) = Yes then 823 Write_Info_Initiate ('Z'); 824 825 elsif Ekind (Cunit_Entity (Unum)) = E_Package 826 and then From_Limited_With (Cunit_Entity (Unum)) 827 then 828 Write_Info_Initiate ('Y'); 829 830 else 831 Write_Info_Initiate ('W'); 832 end if; 833 834 Write_Info_Char (' '); 835 Write_Info_Name (Uname); 836 837 -- Now we need to figure out the names of the files that contain 838 -- the with'ed unit. These will usually be the files for the body, 839 -- except in the case of a package that has no body. Note that we 840 -- have a specific exemption here for predefined library generics 841 -- (see comments for Generic_May_Lack_ALI). We do not generate 842 -- dependency upon the ALI file for such units. Older compilers 843 -- used to not support generating code (and ALI) for generics, and 844 -- we want to avoid having different processing (namely, different 845 -- lists of files to be compiled) for different stages of the 846 -- bootstrap. 847 848 if not ((Nkind (Unit (Cunit)) in N_Generic_Declaration 849 or else 850 Nkind (Unit (Cunit)) in N_Generic_Renaming_Declaration) 851 and then Generic_May_Lack_ALI (Fname)) 852 853 -- In SPARK mode, always generate the dependencies on ALI 854 -- files, which are required to compute frame conditions 855 -- of subprograms. 856 857 or else GNATprove_Mode 858 then 859 Write_Info_Tab (25); 860 861 if Is_Spec_Name (Uname) then 862 Body_Fname := 863 Get_File_Name 864 (Get_Body_Name (Uname), 865 Subunit => False, May_Fail => True); 866 867 Body_Index := 868 Get_Unit_Index 869 (Get_Body_Name (Uname)); 870 871 if Body_Fname = No_File then 872 Body_Fname := Get_File_Name (Uname, Subunit => False); 873 Body_Index := Get_Unit_Index (Uname); 874 end if; 875 876 else 877 Body_Fname := Get_File_Name (Uname, Subunit => False); 878 Body_Index := Get_Unit_Index (Uname); 879 end if; 880 881 -- A package is considered to have a body if it requires 882 -- a body or if a body is present in Ada 83 mode. 883 884 if Body_Required (Cunit) 885 or else (Ada_Version = Ada_83 886 and then Full_Source_Name (Body_Fname) /= No_File) 887 then 888 Write_With_File_Names (Body_Fname, Body_Index); 889 else 890 Write_With_File_Names (Fname, Munit_Index (Unum)); 891 end if; 892 893 if Ekind (Cunit_Entity (Unum)) = E_Package 894 and then From_Limited_With (Cunit_Entity (Unum)) 895 then 896 null; 897 else 898 if Elab_Flags (Unum) then 899 Write_Info_Str (" E"); 900 end if; 901 902 if Elab_All_Flags (Unum) then 903 Write_Info_Str (" EA"); 904 end if; 905 906 if Elab_Des_Flags (Unum) then 907 Write_Info_Str (" ED"); 908 end if; 909 910 if Elab_All_Des_Flags (Unum) then 911 Write_Info_Str (" AD"); 912 end if; 913 end if; 914 end if; 915 916 Write_Info_EOL; 917 end loop; 918 919 -- Finally generate the special lines for cases of Restriction_Set 920 -- with No_Dependence and no restriction present. 921 922 declare 923 Unam : Unit_Name_Type; 924 925 begin 926 for J in Restriction_Set_Dependences.First .. 927 Restriction_Set_Dependences.Last 928 loop 929 Unam := Restriction_Set_Dependences.Table (J); 930 931 -- Don't need an entry if already in the unit table 932 933 for U in 0 .. Last_Unit loop 934 if Unit_Name (U) = Unam then 935 goto Continue; 936 end if; 937 end loop; 938 939 -- Otherwise generate the entry 940 941 Write_Info_Initiate ('W'); 942 Write_Info_Char (' '); 943 Write_Info_Name (Unam); 944 Write_Info_EOL; 945 946 <<Continue>> 947 null; 948 end loop; 949 end; 950 end Write_With_Lines; 951 952 -- Start of processing for Write_ALI 953 954 begin 955 -- We never write an ALI file if the original operating mode was 956 -- syntax-only (-gnats switch used in compiler invocation line) 957 958 if Original_Operating_Mode = Check_Syntax 959 or flag_compare_debug /= 0 960 then 961 return; 962 end if; 963 964 -- Generation of ALI files may be disabled, e.g. for formal verification 965 -- back-end. 966 967 if Disable_ALI_File then 968 return; 969 end if; 970 971 -- Build sorted source dependency table. We do this right away, because 972 -- it is referenced by Up_To_Date_ALI_File_Exists. 973 974 for Unum in Units.First .. Last_Unit loop 975 if Cunit_Entity (Unum) = Empty 976 or else not From_Limited_With (Cunit_Entity (Unum)) 977 then 978 Num_Sdep := Num_Sdep + 1; 979 Sdep_Table (Num_Sdep) := Unum; 980 end if; 981 end loop; 982 983 -- Sort the table so that the D lines are in order 984 985 Lib.Sort (Sdep_Table (1 .. Num_Sdep)); 986 987 -- If we are not generating code, and there is an up to date ALI file 988 -- file accessible, read it, and acquire the compilation arguments from 989 -- this file. In GNATprove mode, always generate the ALI file, which 990 -- contains a special section for formal verification. 991 992 if Operating_Mode /= Generate_Code and then not GNATprove_Mode then 993 if Up_To_Date_ALI_File_Exists then 994 Update_Tables_From_ALI_File; 995 return; 996 end if; 997 end if; 998 999 -- Otherwise acquire compilation arguments and prepare to write 1000 -- out a new ali file. 1001 1002 Create_Output_Library_Info; 1003 1004 -- Output version line 1005 1006 Write_Info_Initiate ('V'); 1007 Write_Info_Str (" """); 1008 Write_Info_Str (Verbose_Library_Version); 1009 Write_Info_Char ('"'); 1010 1011 Write_Info_EOL; 1012 1013 -- Output main program line if this is acceptable main program 1014 1015 Output_Main_Program_Line : declare 1016 U : Node_Id := Unit (Units.Table (Main_Unit).Cunit); 1017 S : Node_Id; 1018 1019 procedure M_Parameters; 1020 -- Output parameters for main program line 1021 1022 ------------------ 1023 -- M_Parameters -- 1024 ------------------ 1025 1026 procedure M_Parameters is 1027 begin 1028 if Main_Priority (Main_Unit) /= Default_Main_Priority then 1029 Write_Info_Char (' '); 1030 Write_Info_Nat (Main_Priority (Main_Unit)); 1031 end if; 1032 1033 if Opt.Time_Slice_Set then 1034 Write_Info_Str (" T="); 1035 Write_Info_Nat (Opt.Time_Slice_Value); 1036 end if; 1037 1038 if Main_CPU (Main_Unit) /= Default_Main_CPU then 1039 Write_Info_Str (" C="); 1040 Write_Info_Nat (Main_CPU (Main_Unit)); 1041 end if; 1042 1043 Write_Info_Str (" W="); 1044 Write_Info_Char 1045 (WC_Encoding_Letters (Wide_Character_Encoding_Method)); 1046 1047 Write_Info_EOL; 1048 end M_Parameters; 1049 1050 -- Start of processing for Output_Main_Program_Line 1051 1052 begin 1053 if Nkind (U) = N_Subprogram_Body 1054 or else 1055 (Nkind (U) = N_Package_Body 1056 and then 1057 Nkind (Original_Node (U)) in N_Subprogram_Instantiation) 1058 then 1059 -- If the unit is a subprogram instance, the entity for the 1060 -- subprogram is the alias of the visible entity, which is the 1061 -- related instance of the wrapper package. We retrieve the 1062 -- subprogram declaration of the desired entity. 1063 1064 if Nkind (U) = N_Package_Body then 1065 U := Parent (Parent ( 1066 Alias (Related_Instance (Defining_Unit_Name 1067 (Specification (Unit (Library_Unit (Parent (U))))))))); 1068 end if; 1069 1070 S := Specification (U); 1071 1072 -- A generic subprogram is never a main program 1073 1074 if Nkind (U) = N_Subprogram_Body 1075 and then Present (Corresponding_Spec (U)) 1076 and then 1077 Ekind_In (Corresponding_Spec (U), E_Generic_Procedure, 1078 E_Generic_Function) 1079 then 1080 null; 1081 1082 elsif No (Parameter_Specifications (S)) then 1083 if Nkind (S) = N_Procedure_Specification then 1084 Write_Info_Initiate ('M'); 1085 Write_Info_Str (" P"); 1086 M_Parameters; 1087 1088 else 1089 declare 1090 Nam : Node_Id := Defining_Unit_Name (S); 1091 1092 begin 1093 -- If it is a child unit, get its simple name 1094 1095 if Nkind (Nam) = N_Defining_Program_Unit_Name then 1096 Nam := Defining_Identifier (Nam); 1097 end if; 1098 1099 if Is_Integer_Type (Etype (Nam)) then 1100 Write_Info_Initiate ('M'); 1101 Write_Info_Str (" F"); 1102 M_Parameters; 1103 end if; 1104 end; 1105 end if; 1106 end if; 1107 end if; 1108 end Output_Main_Program_Line; 1109 1110 -- Write command argument ('A') lines 1111 1112 for A in 1 .. Compilation_Switches.Last loop 1113 Write_Info_Initiate ('A'); 1114 Write_Info_Char (' '); 1115 Write_Info_Str (Compilation_Switches.Table (A).all); 1116 Write_Info_Terminate; 1117 end loop; 1118 1119 -- Output parameters ('P') line 1120 1121 Write_Info_Initiate ('P'); 1122 1123 if Compilation_Errors then 1124 Write_Info_Str (" CE"); 1125 end if; 1126 1127 if Opt.Detect_Blocking then 1128 Write_Info_Str (" DB"); 1129 end if; 1130 1131 if Tasking_Used 1132 and then not Is_Predefined_File_Name (Unit_File_Name (Main_Unit)) 1133 then 1134 if Locking_Policy /= ' ' then 1135 Write_Info_Str (" L"); 1136 Write_Info_Char (Locking_Policy); 1137 end if; 1138 1139 if Queuing_Policy /= ' ' then 1140 Write_Info_Str (" Q"); 1141 Write_Info_Char (Queuing_Policy); 1142 end if; 1143 1144 if Task_Dispatching_Policy /= ' ' then 1145 Write_Info_Str (" T"); 1146 Write_Info_Char (Task_Dispatching_Policy); 1147 Write_Info_Char (' '); 1148 end if; 1149 end if; 1150 1151 if GNATprove_Mode then 1152 Write_Info_Str (" GP"); 1153 end if; 1154 1155 if Partition_Elaboration_Policy /= ' ' then 1156 Write_Info_Str (" E"); 1157 Write_Info_Char (Partition_Elaboration_Policy); 1158 end if; 1159 1160 if not Object then 1161 Write_Info_Str (" NO"); 1162 end if; 1163 1164 if No_Run_Time_Mode then 1165 Write_Info_Str (" NR"); 1166 end if; 1167 1168 if Normalize_Scalars then 1169 Write_Info_Str (" NS"); 1170 end if; 1171 1172 if Default_SSO_Config /= ' ' then 1173 Write_Info_Str (" O"); 1174 Write_Info_Char (Default_SSO_Config); 1175 end if; 1176 1177 if Sec_Stack_Used then 1178 Write_Info_Str (" SS"); 1179 end if; 1180 1181 if Unreserve_All_Interrupts then 1182 Write_Info_Str (" UA"); 1183 end if; 1184 1185 if Front_End_Exceptions then 1186 Write_Info_Str (" FX"); 1187 end if; 1188 1189 if ZCX_Exceptions then 1190 Write_Info_Str (" ZX"); 1191 end if; 1192 1193 Write_Info_EOL; 1194 1195 -- Before outputting the restrictions line, update the setting of 1196 -- the No_Elaboration_Code flag. Violations of this restriction 1197 -- cannot be detected until after the backend has been called since 1198 -- it is the backend that sets this flag. We have to check all units 1199 -- for which we have generated code 1200 1201 for Unit in Units.First .. Last_Unit loop 1202 if Units.Table (Unit).Generate_Code or else Unit = Main_Unit then 1203 if not Has_No_Elaboration_Code (Cunit (Unit)) then 1204 Main_Restrictions.Violated (No_Elaboration_Code) := True; 1205 end if; 1206 end if; 1207 end loop; 1208 1209 -- Positional case (only if debug flag -gnatd.R is set) 1210 1211 if Debug_Flag_Dot_RR then 1212 1213 -- Output first restrictions line 1214 1215 Write_Info_Initiate ('R'); 1216 Write_Info_Char (' '); 1217 1218 -- First the information for the boolean restrictions 1219 1220 for R in All_Boolean_Restrictions loop 1221 if Main_Restrictions.Set (R) 1222 and then not Restriction_Warnings (R) 1223 then 1224 Write_Info_Char ('r'); 1225 elsif Main_Restrictions.Violated (R) then 1226 Write_Info_Char ('v'); 1227 else 1228 Write_Info_Char ('n'); 1229 end if; 1230 end loop; 1231 1232 -- And now the information for the parameter restrictions 1233 1234 for RP in All_Parameter_Restrictions loop 1235 if Main_Restrictions.Set (RP) 1236 and then not Restriction_Warnings (RP) 1237 then 1238 Write_Info_Char ('r'); 1239 Write_Info_Nat (Nat (Main_Restrictions.Value (RP))); 1240 else 1241 Write_Info_Char ('n'); 1242 end if; 1243 1244 if not Main_Restrictions.Violated (RP) 1245 or else RP not in Checked_Parameter_Restrictions 1246 then 1247 Write_Info_Char ('n'); 1248 else 1249 Write_Info_Char ('v'); 1250 Write_Info_Nat (Nat (Main_Restrictions.Count (RP))); 1251 1252 if Main_Restrictions.Unknown (RP) then 1253 Write_Info_Char ('+'); 1254 end if; 1255 end if; 1256 end loop; 1257 1258 Write_Info_EOL; 1259 1260 -- Named case (if debug flag -gnatd.R is not set) 1261 1262 else 1263 declare 1264 C : Character; 1265 1266 begin 1267 -- Write RN header line with preceding blank line 1268 1269 Write_Info_EOL; 1270 Write_Info_Initiate ('R'); 1271 Write_Info_Char ('N'); 1272 Write_Info_EOL; 1273 1274 -- First the lines for the boolean restrictions 1275 1276 for R in All_Boolean_Restrictions loop 1277 if Main_Restrictions.Set (R) 1278 and then not Restriction_Warnings (R) 1279 then 1280 C := 'R'; 1281 elsif Main_Restrictions.Violated (R) then 1282 C := 'V'; 1283 else 1284 goto Continue; 1285 end if; 1286 1287 Write_Info_Initiate ('R'); 1288 Write_Info_Char (C); 1289 Write_Info_Char (' '); 1290 Write_Info_Str (All_Boolean_Restrictions'Image (R)); 1291 Write_Info_EOL; 1292 1293 <<Continue>> 1294 null; 1295 end loop; 1296 end; 1297 1298 -- And now the lines for the parameter restrictions 1299 1300 for RP in All_Parameter_Restrictions loop 1301 if Main_Restrictions.Set (RP) 1302 and then not Restriction_Warnings (RP) 1303 then 1304 Write_Info_Initiate ('R'); 1305 Write_Info_Str ("R "); 1306 Write_Info_Str (All_Parameter_Restrictions'Image (RP)); 1307 Write_Info_Char ('='); 1308 Write_Info_Nat (Nat (Main_Restrictions.Value (RP))); 1309 Write_Info_EOL; 1310 end if; 1311 1312 if not Main_Restrictions.Violated (RP) 1313 or else RP not in Checked_Parameter_Restrictions 1314 then 1315 null; 1316 else 1317 Write_Info_Initiate ('R'); 1318 Write_Info_Str ("V "); 1319 Write_Info_Str (All_Parameter_Restrictions'Image (RP)); 1320 Write_Info_Char ('='); 1321 Write_Info_Nat (Nat (Main_Restrictions.Count (RP))); 1322 1323 if Main_Restrictions.Unknown (RP) then 1324 Write_Info_Char ('+'); 1325 end if; 1326 1327 Write_Info_EOL; 1328 end if; 1329 end loop; 1330 end if; 1331 1332 -- Output R lines for No_Dependence entries 1333 1334 for J in No_Dependences.First .. No_Dependences.Last loop 1335 if In_Extended_Main_Source_Unit (No_Dependences.Table (J).Unit) 1336 and then not No_Dependences.Table (J).Warn 1337 then 1338 Write_Info_Initiate ('R'); 1339 Write_Info_Char (' '); 1340 Write_Unit_Name (No_Dependences.Table (J).Unit); 1341 Write_Info_EOL; 1342 end if; 1343 end loop; 1344 1345 -- Output interrupt state lines 1346 1347 for J in Interrupt_States.First .. Interrupt_States.Last loop 1348 Write_Info_Initiate ('I'); 1349 Write_Info_Char (' '); 1350 Write_Info_Nat (Interrupt_States.Table (J).Interrupt_Number); 1351 Write_Info_Char (' '); 1352 Write_Info_Char (Interrupt_States.Table (J).Interrupt_State); 1353 Write_Info_Char (' '); 1354 Write_Info_Nat 1355 (Nat (Get_Logical_Line_Number 1356 (Interrupt_States.Table (J).Pragma_Loc))); 1357 Write_Info_EOL; 1358 end loop; 1359 1360 -- Output priority specific dispatching lines 1361 1362 for J in Specific_Dispatching.First .. Specific_Dispatching.Last loop 1363 Write_Info_Initiate ('S'); 1364 Write_Info_Char (' '); 1365 Write_Info_Char (Specific_Dispatching.Table (J).Dispatching_Policy); 1366 Write_Info_Char (' '); 1367 Write_Info_Nat (Specific_Dispatching.Table (J).First_Priority); 1368 Write_Info_Char (' '); 1369 Write_Info_Nat (Specific_Dispatching.Table (J).Last_Priority); 1370 Write_Info_Char (' '); 1371 Write_Info_Nat 1372 (Nat (Get_Logical_Line_Number 1373 (Specific_Dispatching.Table (J).Pragma_Loc))); 1374 Write_Info_EOL; 1375 end loop; 1376 1377 -- Loop through file table to output information for all units for which 1378 -- we have generated code, as marked by the Generate_Code flag. 1379 1380 for Unit in Units.First .. Last_Unit loop 1381 if Units.Table (Unit).Generate_Code 1382 or else Unit = Main_Unit 1383 then 1384 Write_Info_EOL; -- blank line 1385 Write_Unit_Information (Unit); 1386 end if; 1387 end loop; 1388 1389 Write_Info_EOL; -- blank line 1390 1391 -- Output external version reference lines 1392 1393 for J in 1 .. Version_Ref.Last loop 1394 Write_Info_Initiate ('E'); 1395 Write_Info_Char (' '); 1396 1397 for K in 1 .. String_Length (Version_Ref.Table (J)) loop 1398 Write_Info_Char_Code (Get_String_Char (Version_Ref.Table (J), K)); 1399 end loop; 1400 1401 Write_Info_EOL; 1402 end loop; 1403 1404 -- Prepare to output the source dependency lines 1405 1406 declare 1407 Unum : Unit_Number_Type; 1408 -- Number of unit being output 1409 1410 Sind : Source_File_Index; 1411 -- Index of corresponding source file 1412 1413 Fname : File_Name_Type; 1414 1415 begin 1416 for J in 1 .. Num_Sdep loop 1417 Unum := Sdep_Table (J); 1418 Units.Table (Unum).Dependency_Num := J; 1419 Sind := Units.Table (Unum).Source_Index; 1420 1421 Write_Info_Initiate ('D'); 1422 Write_Info_Char (' '); 1423 1424 -- Normal case of a unit entry with a source index 1425 1426 if Sind /= No_Source_File then 1427 Fname := File_Name (Sind); 1428 1429 -- Ensure that on platforms where the file names are not case 1430 -- sensitive, the recorded file name is in lower case. 1431 1432 if not File_Names_Case_Sensitive then 1433 Get_Name_String (Fname); 1434 To_Lower (Name_Buffer (1 .. Name_Len)); 1435 Fname := Name_Find; 1436 end if; 1437 1438 Write_Info_Name_May_Be_Quoted (Fname); 1439 Write_Info_Tab (25); 1440 Write_Info_Str (String (Time_Stamp (Sind))); 1441 Write_Info_Char (' '); 1442 Write_Info_Str (Get_Hex_String (Source_Checksum (Sind))); 1443 1444 -- If subunit, add unit name, omitting the %b at the end 1445 1446 if Present (Cunit (Unum)) then 1447 Get_Decoded_Name_String (Unit_Name (Unum)); 1448 Write_Info_Char (' '); 1449 1450 if Nkind (Unit (Cunit (Unum))) = N_Subunit then 1451 Write_Info_Str (Name_Buffer (1 .. Name_Len - 2)); 1452 else 1453 Write_Info_Str (Name_Buffer (1 .. Name_Len)); 1454 end if; 1455 end if; 1456 1457 -- If Source_Reference pragma used, output information 1458 1459 if Num_SRef_Pragmas (Sind) > 0 then 1460 Write_Info_Char (' '); 1461 1462 if Num_SRef_Pragmas (Sind) = 1 then 1463 Write_Info_Nat (Int (First_Mapped_Line (Sind))); 1464 else 1465 Write_Info_Nat (0); 1466 end if; 1467 1468 Write_Info_Char (':'); 1469 Write_Info_Name (Reference_Name (Sind)); 1470 end if; 1471 1472 -- Case where there is no source index (happens for missing 1473 -- files). In this case we write a dummy time stamp. 1474 1475 else 1476 Write_Info_Name (Unit_File_Name (Unum)); 1477 Write_Info_Tab (25); 1478 Write_Info_Str (String (Dummy_Time_Stamp)); 1479 Write_Info_Char (' '); 1480 Write_Info_Str (Get_Hex_String (0)); 1481 end if; 1482 1483 Write_Info_EOL; 1484 end loop; 1485 end; 1486 1487 -- Output cross-references 1488 1489 if Opt.Xref_Active then 1490 Output_References; 1491 end if; 1492 1493 -- Output SCO information if present 1494 1495 if Generate_SCO then 1496 SCO_Record_Filtered; 1497 SCO_Output; 1498 end if; 1499 1500 -- Output SPARK cross-reference information if needed 1501 1502 if Opt.Xref_Active and then GNATprove_Mode then 1503 SPARK_Specific.Collect_SPARK_Xrefs (Sdep_Table => Sdep_Table, 1504 Num_Sdep => Num_Sdep); 1505 SPARK_Specific.Output_SPARK_Xrefs; 1506 end if; 1507 1508 -- Output final blank line and we are done. This final blank line is 1509 -- probably junk, but we don't feel like making an incompatible change. 1510 1511 Write_Info_Terminate; 1512 Close_Output_Library_Info; 1513 end Write_ALI; 1514 1515 --------------------- 1516 -- Write_Unit_Name -- 1517 --------------------- 1518 1519 procedure Write_Unit_Name (N : Node_Id) is 1520 begin 1521 if Nkind (N) = N_Identifier then 1522 Write_Info_Name (Chars (N)); 1523 1524 else 1525 pragma Assert (Nkind (N) = N_Selected_Component); 1526 Write_Unit_Name (Prefix (N)); 1527 Write_Info_Char ('.'); 1528 Write_Unit_Name (Selector_Name (N)); 1529 end if; 1530 end Write_Unit_Name; 1531 1532end Lib.Writ; 1533