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