1------------------------------------------------------------------------------ 2-- -- 3-- GNAT COMPILER COMPONENTS -- 4-- -- 5-- G N A T B I N D -- 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 ALI.Util; use ALI.Util; 28with Bcheck; use Bcheck; 29with Binde; use Binde; 30with Binderr; use Binderr; 31with Bindgen; use Bindgen; 32with Bindusg; 33with Butil; use Butil; 34with Casing; use Casing; 35with Csets; 36with Debug; use Debug; 37with Fmap; 38with Fname; use Fname; 39with Namet; use Namet; 40with Opt; use Opt; 41with Osint; use Osint; 42with Osint.B; use Osint.B; 43with Output; use Output; 44with Rident; use Rident; 45with Snames; 46with Switch; use Switch; 47with Switch.B; use Switch.B; 48with Table; 49with Targparm; use Targparm; 50with Types; use Types; 51 52with System.Case_Util; use System.Case_Util; 53with System.OS_Lib; use System.OS_Lib; 54 55with Ada.Command_Line.Response_File; use Ada.Command_Line; 56 57procedure Gnatbind is 58 59 Total_Errors : Nat := 0; 60 -- Counts total errors in all files 61 62 Total_Warnings : Nat := 0; 63 -- Total warnings in all files 64 65 Main_Lib_File : File_Name_Type; 66 -- Current main library file 67 68 First_Main_Lib_File : File_Name_Type := No_File; 69 -- The first library file, that should be a main subprogram if neither -n 70 -- nor -z are used. 71 72 Std_Lib_File : File_Name_Type; 73 -- Standard library 74 75 Text : Text_Buffer_Ptr; 76 Next_Arg : Positive; 77 78 Output_File_Name_Seen : Boolean := False; 79 Output_File_Name : String_Ptr := new String'(""); 80 81 L_Switch_Seen : Boolean := False; 82 83 Mapping_File : String_Ptr := null; 84 85 package Closure_Sources is new Table.Table 86 (Table_Component_Type => File_Name_Type, 87 Table_Index_Type => Natural, 88 Table_Low_Bound => 1, 89 Table_Initial => 10, 90 Table_Increment => 100, 91 Table_Name => "Gnatbind.Closure_Sources"); 92 -- Table to record the sources in the closure, to avoid duplications. Used 93 -- only with switch -R. 94 95 function Gnatbind_Supports_Auto_Init return Boolean; 96 -- Indicates if automatic initialization of elaboration procedure 97 -- through the constructor mechanism is possible on the platform. 98 99 procedure List_Applicable_Restrictions; 100 -- List restrictions that apply to this partition if option taken 101 102 procedure Scan_Bind_Arg (Argv : String); 103 -- Scan and process binder specific arguments. Argv is a single argument. 104 -- All the one character arguments are still handled by Switch. This 105 -- routine handles -aO -aI and -I-. The lower bound of Argv must be 1. 106 107 function Is_Cross_Compiler return Boolean; 108 -- Returns True iff this is a cross-compiler 109 110 --------------------------------- 111 -- Gnatbind_Supports_Auto_Init -- 112 --------------------------------- 113 114 function Gnatbind_Supports_Auto_Init return Boolean is 115 function gnat_binder_supports_auto_init return Integer; 116 pragma Import (C, gnat_binder_supports_auto_init, 117 "__gnat_binder_supports_auto_init"); 118 begin 119 return gnat_binder_supports_auto_init /= 0; 120 end Gnatbind_Supports_Auto_Init; 121 122 ----------------------- 123 -- Is_Cross_Compiler -- 124 ----------------------- 125 126 function Is_Cross_Compiler return Boolean is 127 Cross_Compiler : Integer; 128 pragma Import (C, Cross_Compiler, "__gnat_is_cross_compiler"); 129 begin 130 return Cross_Compiler = 1; 131 end Is_Cross_Compiler; 132 133 ---------------------------------- 134 -- List_Applicable_Restrictions -- 135 ---------------------------------- 136 137 procedure List_Applicable_Restrictions is 138 139 -- Define those restrictions that should be output if the gnatbind 140 -- -r switch is used. Not all restrictions are output for the reasons 141 -- given below in the list, and this array is used to test whether 142 -- the corresponding pragma should be listed. True means that it 143 -- should not be listed. 144 145 No_Restriction_List : constant array (All_Restrictions) of Boolean := 146 (No_Allocators_After_Elaboration => True, 147 -- This involves run-time conditions not checkable at compile time 148 149 No_Anonymous_Allocators => True, 150 -- Premature, since we have not implemented this yet 151 152 No_Exception_Propagation => True, 153 -- Modifies code resulting in different exception semantics 154 155 No_Exceptions => True, 156 -- Has unexpected Suppress (All_Checks) effect 157 158 No_Implicit_Conditionals => True, 159 -- This could modify and pessimize generated code 160 161 No_Implicit_Dynamic_Code => True, 162 -- This could modify and pessimize generated code 163 164 No_Implicit_Loops => True, 165 -- This could modify and pessimize generated code 166 167 No_Recursion => True, 168 -- Not checkable at compile time 169 170 No_Reentrancy => True, 171 -- Not checkable at compile time 172 173 Max_Entry_Queue_Length => True, 174 -- Not checkable at compile time 175 176 Max_Storage_At_Blocking => True, 177 -- Not checkable at compile time 178 179 others => False); 180 181 Additional_Restrictions_Listed : Boolean := False; 182 -- Set True if we have listed header for restrictions 183 184 function Restriction_Could_Be_Set (R : Restriction_Id) return Boolean; 185 -- Returns True if the given restriction can be listed as an additional 186 -- restriction that could be set. 187 188 ------------------------------ 189 -- Restriction_Could_Be_Set -- 190 ------------------------------ 191 192 function Restriction_Could_Be_Set (R : Restriction_Id) return Boolean is 193 CR : Restrictions_Info renames Cumulative_Restrictions; 194 195 begin 196 case R is 197 198 -- Boolean restriction 199 200 when All_Boolean_Restrictions => 201 202 -- The condition for listing a boolean restriction as an 203 -- additional restriction that could be set is that it is 204 -- not violated by any unit, and not already set. 205 206 return CR.Violated (R) = False and then CR.Set (R) = False; 207 208 -- Parameter restriction 209 210 when All_Parameter_Restrictions => 211 212 -- If the restriction is violated and the level of violation is 213 -- unknown, the restriction can definitely not be listed. 214 215 if CR.Violated (R) and then CR.Unknown (R) then 216 return False; 217 218 -- We can list the restriction if it is not set 219 220 elsif not CR.Set (R) then 221 return True; 222 223 -- We can list the restriction if is set to a greater value 224 -- than the maximum value known for the violation. 225 226 else 227 return CR.Value (R) > CR.Count (R); 228 end if; 229 230 -- No other values for R possible 231 232 when others => 233 raise Program_Error; 234 235 end case; 236 end Restriction_Could_Be_Set; 237 238 -- Start of processing for List_Applicable_Restrictions 239 240 begin 241 -- Loop through restrictions 242 243 for R in All_Restrictions loop 244 if not No_Restriction_List (R) 245 and then Restriction_Could_Be_Set (R) 246 then 247 if not Additional_Restrictions_Listed then 248 Write_Eol; 249 Write_Line 250 ("The following additional restrictions may be" & 251 " applied to this partition:"); 252 Additional_Restrictions_Listed := True; 253 end if; 254 255 Write_Str ("pragma Restrictions ("); 256 257 declare 258 S : constant String := Restriction_Id'Image (R); 259 begin 260 Name_Len := S'Length; 261 Name_Buffer (1 .. Name_Len) := S; 262 end; 263 264 Set_Casing (Mixed_Case); 265 Write_Str (Name_Buffer (1 .. Name_Len)); 266 267 if R in All_Parameter_Restrictions then 268 Write_Str (" => "); 269 Write_Int (Int (Cumulative_Restrictions.Count (R))); 270 end if; 271 272 Write_Str (");"); 273 Write_Eol; 274 end if; 275 end loop; 276 end List_Applicable_Restrictions; 277 278 ------------------- 279 -- Scan_Bind_Arg -- 280 ------------------- 281 282 procedure Scan_Bind_Arg (Argv : String) is 283 pragma Assert (Argv'First = 1); 284 285 begin 286 -- Now scan arguments that are specific to the binder and are not 287 -- handled by the common circuitry in Switch. 288 289 if Opt.Output_File_Name_Present 290 and then not Output_File_Name_Seen 291 then 292 Output_File_Name_Seen := True; 293 294 if Argv'Length = 0 295 or else (Argv'Length >= 1 and then Argv (1) = '-') 296 then 297 Fail ("output File_Name missing after -o"); 298 299 else 300 Output_File_Name := new String'(Argv); 301 end if; 302 303 elsif Argv'Length >= 2 and then Argv (1) = '-' then 304 305 -- -I- 306 307 if Argv (2 .. Argv'Last) = "I-" then 308 Opt.Look_In_Primary_Dir := False; 309 310 -- -Idir 311 312 elsif Argv (2) = 'I' then 313 Add_Src_Search_Dir (Argv (3 .. Argv'Last)); 314 Add_Lib_Search_Dir (Argv (3 .. Argv'Last)); 315 316 -- -Ldir 317 318 elsif Argv (2) = 'L' then 319 if Argv'Length >= 3 then 320 321 -- Remember that the -L switch was specified, so that if this 322 -- is on OpenVMS, the export names are put in uppercase. 323 -- This is not known before the target parameters are read. 324 325 L_Switch_Seen := True; 326 327 Opt.Bind_For_Library := True; 328 Opt.Ada_Init_Name := 329 new String'(Argv (3 .. Argv'Last) & Opt.Ada_Init_Suffix); 330 Opt.Ada_Final_Name := 331 new String'(Argv (3 .. Argv'Last) & Opt.Ada_Final_Suffix); 332 Opt.Ada_Main_Name := 333 new String'(Argv (3 .. Argv'Last) & Opt.Ada_Main_Name_Suffix); 334 335 -- This option (-Lxxx) implies -n 336 337 Opt.Bind_Main_Program := False; 338 339 else 340 Fail 341 ("Prefix of initialization and finalization " & 342 "procedure names missing in -L"); 343 end if; 344 345 -- -Sin -Slo -Shi -Sxx -Sev 346 347 elsif Argv'Length = 4 348 and then Argv (2) = 'S' 349 then 350 declare 351 C1 : Character := Argv (3); 352 C2 : Character := Argv (4); 353 354 begin 355 -- Fold to upper case 356 357 if C1 in 'a' .. 'z' then 358 C1 := Character'Val (Character'Pos (C1) - 32); 359 end if; 360 361 if C2 in 'a' .. 'z' then 362 C2 := Character'Val (Character'Pos (C2) - 32); 363 end if; 364 365 -- Test valid option and set mode accordingly 366 367 if C1 = 'E' and then C2 = 'V' then 368 null; 369 370 elsif C1 = 'I' and then C2 = 'N' then 371 null; 372 373 elsif C1 = 'L' and then C2 = 'O' then 374 null; 375 376 elsif C1 = 'H' and then C2 = 'I' then 377 null; 378 379 elsif (C1 in '0' .. '9' or else C1 in 'A' .. 'F') 380 and then 381 (C2 in '0' .. '9' or else C2 in 'A' .. 'F') 382 then 383 null; 384 385 -- Invalid -S switch, let Switch give error, set default of IN 386 387 else 388 Scan_Binder_Switches (Argv); 389 C1 := 'I'; 390 C2 := 'N'; 391 end if; 392 393 Initialize_Scalars_Mode1 := C1; 394 Initialize_Scalars_Mode2 := C2; 395 end; 396 397 -- -aIdir 398 399 elsif Argv'Length >= 3 400 and then Argv (2 .. 3) = "aI" 401 then 402 Add_Src_Search_Dir (Argv (4 .. Argv'Last)); 403 404 -- -aOdir 405 406 elsif Argv'Length >= 3 407 and then Argv (2 .. 3) = "aO" 408 then 409 Add_Lib_Search_Dir (Argv (4 .. Argv'Last)); 410 411 -- -nostdlib 412 413 elsif Argv (2 .. Argv'Last) = "nostdlib" then 414 Opt.No_Stdlib := True; 415 416 -- -nostdinc 417 418 elsif Argv (2 .. Argv'Last) = "nostdinc" then 419 Opt.No_Stdinc := True; 420 421 -- -static 422 423 elsif Argv (2 .. Argv'Last) = "static" then 424 Opt.Shared_Libgnat := False; 425 426 -- -shared 427 428 elsif Argv (2 .. Argv'Last) = "shared" then 429 Opt.Shared_Libgnat := True; 430 431 -- -F=mapping_file 432 433 elsif Argv'Length >= 4 and then Argv (2 .. 3) = "F=" then 434 if Mapping_File /= null then 435 Fail ("cannot specify several mapping files"); 436 end if; 437 438 Mapping_File := new String'(Argv (4 .. Argv'Last)); 439 440 -- -Mname 441 442 elsif Argv'Length >= 3 and then Argv (2) = 'M' then 443 if not Is_Cross_Compiler then 444 Write_Line 445 ("gnatbind: -M not expected to be used on native platforms"); 446 end if; 447 448 Opt.Bind_Alternate_Main_Name := True; 449 Opt.Alternate_Main_Name := new String'(Argv (3 .. Argv'Last)); 450 451 -- All other options are single character and are handled by 452 -- Scan_Binder_Switches. 453 454 else 455 Scan_Binder_Switches (Argv); 456 end if; 457 458 -- Not a switch, so must be a file name (if non-empty) 459 460 elsif Argv'Length /= 0 then 461 if Argv'Length > 4 462 and then Argv (Argv'Last - 3 .. Argv'Last) = ".ali" 463 then 464 Add_File (Argv); 465 else 466 Add_File (Argv & ".ali"); 467 end if; 468 end if; 469 end Scan_Bind_Arg; 470 471 procedure Check_Version_And_Help is 472 new Check_Version_And_Help_G (Bindusg.Display); 473 474-- Start of processing for Gnatbind 475 476begin 477 -- Set default for Shared_Libgnat option 478 479 declare 480 Shared_Libgnat_Default : Character; 481 pragma Import 482 (C, Shared_Libgnat_Default, "__gnat_shared_libgnat_default"); 483 484 SHARED : constant Character := 'H'; 485 STATIC : constant Character := 'T'; 486 487 begin 488 pragma Assert 489 (Shared_Libgnat_Default = SHARED 490 or else 491 Shared_Libgnat_Default = STATIC); 492 Shared_Libgnat := (Shared_Libgnat_Default = SHARED); 493 end; 494 495 -- Scan the switches and arguments 496 497 -- First, scan to detect --version and/or --help 498 499 Check_Version_And_Help ("GNATBIND", "1995"); 500 501 -- Use low level argument routines to avoid dragging in the secondary stack 502 503 Next_Arg := 1; 504 Scan_Args : while Next_Arg < Arg_Count loop 505 declare 506 Next_Argv : String (1 .. Len_Arg (Next_Arg)); 507 begin 508 Fill_Arg (Next_Argv'Address, Next_Arg); 509 510 if Next_Argv'Length > 0 then 511 if Next_Argv (1) = '@' then 512 if Next_Argv'Length > 1 then 513 declare 514 Arguments : constant Argument_List := 515 Response_File.Arguments_From 516 (Response_File_Name => 517 Next_Argv (2 .. Next_Argv'Last), 518 Recursive => True, 519 Ignore_Non_Existing_Files => True); 520 begin 521 for J in Arguments'Range loop 522 Scan_Bind_Arg (Arguments (J).all); 523 end loop; 524 end; 525 end if; 526 527 else 528 Scan_Bind_Arg (Next_Argv); 529 end if; 530 end if; 531 end; 532 533 Next_Arg := Next_Arg + 1; 534 end loop Scan_Args; 535 536 if Use_Pragma_Linker_Constructor then 537 if Bind_Main_Program then 538 Fail ("switch -a must be used in conjunction with -n or -Lxxx"); 539 540 elsif not Gnatbind_Supports_Auto_Init then 541 Fail ("automatic initialisation of elaboration " & 542 "not supported on this platform"); 543 end if; 544 end if; 545 546 -- Test for trailing -o switch 547 548 if Opt.Output_File_Name_Present and then not Output_File_Name_Seen then 549 Fail ("output file name missing after -o"); 550 end if; 551 552 -- Output usage if requested 553 554 if Usage_Requested then 555 Bindusg.Display; 556 end if; 557 558 -- Check that the binder file specified has extension .adb 559 560 if Opt.Output_File_Name_Present and then Output_File_Name_Seen then 561 Check_Extensions : declare 562 Length : constant Natural := Output_File_Name'Length; 563 Last : constant Natural := Output_File_Name'Last; 564 begin 565 if Length <= 4 566 or else Output_File_Name (Last - 3 .. Last) /= ".adb" 567 then 568 Fail ("output file name should have .adb extension"); 569 end if; 570 end Check_Extensions; 571 end if; 572 573 Osint.Add_Default_Search_Dirs; 574 575 -- Carry out package initializations. These are initializations which 576 -- might logically be performed at elaboration time, and we decide to be 577 -- consistent. Like elaboration, the order in which these calls are made 578 -- is in some cases important. 579 580 Csets.Initialize; 581 Snames.Initialize; 582 583 -- Acquire target parameters 584 585 Targparm.Get_Target_Parameters; 586 587 -- Initialize Cumulative_Restrictions with the restrictions on the target 588 -- scanned from the system.ads file. Then as we read ALI files, we will 589 -- accumulate additional restrictions specified in other files. 590 591 Cumulative_Restrictions := Targparm.Restrictions_On_Target; 592 593 -- On OpenVMS, when -L is used, all external names used in pragmas Export 594 -- are in upper case. The reason is that on OpenVMS, the macro-assembler 595 -- MACASM-32, used to build Stand-Alone Libraries, only understands 596 -- uppercase. 597 598 if L_Switch_Seen and then OpenVMS_On_Target then 599 To_Upper (Opt.Ada_Init_Name.all); 600 To_Upper (Opt.Ada_Final_Name.all); 601 To_Upper (Opt.Ada_Main_Name.all); 602 end if; 603 604 -- Acquire configurable run-time mode 605 606 if Configurable_Run_Time_On_Target then 607 Configurable_Run_Time_Mode := True; 608 end if; 609 610 -- Output copyright notice if in verbose mode 611 612 if Verbose_Mode then 613 Write_Eol; 614 Display_Version ("GNATBIND", "1995"); 615 end if; 616 617 -- Output usage information if no files 618 619 if not More_Lib_Files then 620 Bindusg.Display; 621 Exit_Program (E_Fatal); 622 end if; 623 624 -- If a mapping file was specified, initialize the file mapping 625 626 if Mapping_File /= null then 627 Fmap.Initialize (Mapping_File.all); 628 end if; 629 630 -- The block here is to catch the Unrecoverable_Error exception in the 631 -- case where we exceed the maximum number of permissible errors or some 632 -- other unrecoverable error occurs. 633 634 begin 635 -- Initialize binder packages 636 637 Initialize_Binderr; 638 Initialize_ALI; 639 Initialize_ALI_Source; 640 641 if Verbose_Mode then 642 Write_Eol; 643 end if; 644 645 -- Input ALI files 646 647 while More_Lib_Files loop 648 Main_Lib_File := Next_Main_Lib_File; 649 650 if First_Main_Lib_File = No_File then 651 First_Main_Lib_File := Main_Lib_File; 652 end if; 653 654 if Verbose_Mode then 655 if Check_Only then 656 Write_Str ("Checking: "); 657 else 658 Write_Str ("Binding: "); 659 end if; 660 661 Write_Name (Main_Lib_File); 662 Write_Eol; 663 end if; 664 665 Text := Read_Library_Info (Main_Lib_File, True); 666 667 declare 668 Id : ALI_Id; 669 pragma Warnings (Off, Id); 670 671 begin 672 Id := Scan_ALI 673 (F => Main_Lib_File, 674 T => Text, 675 Ignore_ED => False, 676 Err => False, 677 Ignore_Errors => Debug_Flag_I, 678 Directly_Scanned => True); 679 end; 680 681 Free (Text); 682 end loop; 683 684 -- No_Run_Time mode 685 686 if No_Run_Time_Mode then 687 688 -- Set standard configuration parameters 689 690 Suppress_Standard_Library_On_Target := True; 691 Configurable_Run_Time_Mode := True; 692 end if; 693 694 -- For main ALI files, even if they are interfaces, we get their 695 -- dependencies. To be sure, we reset the Interface flag for all main 696 -- ALI files. 697 698 for Index in ALIs.First .. ALIs.Last loop 699 ALIs.Table (Index).SAL_Interface := False; 700 end loop; 701 702 -- Add System.Standard_Library to list to ensure that these files are 703 -- included in the bind, even if not directly referenced from Ada code 704 -- This is suppressed if the appropriate targparm switch is set. 705 706 if not Suppress_Standard_Library_On_Target then 707 Name_Buffer (1 .. 12) := "s-stalib.ali"; 708 Name_Len := 12; 709 Std_Lib_File := Name_Find; 710 Text := Read_Library_Info (Std_Lib_File, True); 711 712 declare 713 Id : ALI_Id; 714 pragma Warnings (Off, Id); 715 716 begin 717 Id := 718 Scan_ALI 719 (F => Std_Lib_File, 720 T => Text, 721 Ignore_ED => False, 722 Err => False, 723 Ignore_Errors => Debug_Flag_I); 724 end; 725 726 Free (Text); 727 end if; 728 729 -- Load ALIs for all dependent units 730 731 for Index in ALIs.First .. ALIs.Last loop 732 Read_Withed_ALIs (Index); 733 end loop; 734 735 -- Quit if some file needs compiling 736 737 if No_Object_Specified then 738 raise Unrecoverable_Error; 739 end if; 740 741 -- Output list of ALI files in closure 742 743 if Output_ALI_List then 744 if ALI_List_Filename /= null then 745 Set_List_File (ALI_List_Filename.all); 746 end if; 747 748 for Index in ALIs.First .. ALIs.Last loop 749 declare 750 Full_Afile : constant File_Name_Type := 751 Find_File (ALIs.Table (Index).Afile, Library); 752 begin 753 Write_Name (Full_Afile); 754 Write_Eol; 755 end; 756 end loop; 757 758 if ALI_List_Filename /= null then 759 Close_List_File; 760 end if; 761 end if; 762 763 -- Build source file table from the ALI files we have read in 764 765 Set_Source_Table; 766 767 -- If there is main program to bind, set Main_Lib_File to the first 768 -- library file, and the name from which to derive the binder generate 769 -- file to the first ALI file. 770 771 if Bind_Main_Program then 772 Main_Lib_File := First_Main_Lib_File; 773 Set_Current_File_Name_Index (To => 1); 774 end if; 775 776 -- Check that main library file is a suitable main program 777 778 if Bind_Main_Program 779 and then ALIs.Table (ALIs.First).Main_Program = None 780 and then not No_Main_Subprogram 781 then 782 Get_Name_String 783 (Units.Table (ALIs.Table (ALIs.First).First_Unit).Uname); 784 785 declare 786 Unit_Name : String := Name_Buffer (1 .. Name_Len - 2); 787 begin 788 To_Mixed (Unit_Name); 789 Get_Name_String (ALIs.Table (ALIs.First).Sfile); 790 Add_Str_To_Name_Buffer (":1: "); 791 Add_Str_To_Name_Buffer (Unit_Name); 792 Add_Str_To_Name_Buffer (" cannot be used as a main program"); 793 Write_Line (Name_Buffer (1 .. Name_Len)); 794 Errors_Detected := Errors_Detected + 1; 795 end; 796 end if; 797 798 -- Perform consistency and correctness checks 799 800 Check_Duplicated_Subunits; 801 Check_Versions; 802 Check_Consistency; 803 Check_Configuration_Consistency; 804 805 -- List restrictions that could be applied to this partition 806 807 if List_Restrictions then 808 List_Applicable_Restrictions; 809 end if; 810 811 -- Complete bind if no errors 812 813 if Errors_Detected = 0 then 814 Find_Elab_Order; 815 816 if Errors_Detected = 0 then 817 -- Display elaboration order if -l was specified 818 819 if Elab_Order_Output then 820 if not Zero_Formatting then 821 Write_Eol; 822 Write_Str ("ELABORATION ORDER"); 823 Write_Eol; 824 end if; 825 826 for J in Elab_Order.First .. Elab_Order.Last loop 827 if not Units.Table (Elab_Order.Table (J)).SAL_Interface then 828 if not Zero_Formatting then 829 Write_Str (" "); 830 end if; 831 832 Write_Unit_Name 833 (Units.Table (Elab_Order.Table (J)).Uname); 834 Write_Eol; 835 end if; 836 end loop; 837 838 if not Zero_Formatting then 839 Write_Eol; 840 end if; 841 end if; 842 843 if not Check_Only then 844 Gen_Output_File (Output_File_Name.all); 845 end if; 846 847 -- Display list of sources in the closure (except predefined 848 -- sources) if -R was used. 849 850 if List_Closure then 851 List_Closure_Display : declare 852 Source : File_Name_Type; 853 854 function Put_In_Sources (S : File_Name_Type) return Boolean; 855 -- Check if S is already in table Sources and put in Sources 856 -- if it is not. Return False if the source is already in 857 -- Sources, and True if it is added. 858 859 -------------------- 860 -- Put_In_Sources -- 861 -------------------- 862 863 function Put_In_Sources 864 (S : File_Name_Type) return Boolean is 865 begin 866 for J in 1 .. Closure_Sources.Last loop 867 if Closure_Sources.Table (J) = S then 868 return False; 869 end if; 870 end loop; 871 872 Closure_Sources.Append (S); 873 return True; 874 end Put_In_Sources; 875 876 -- Start of processing for List_Closure_Display 877 878 begin 879 Closure_Sources.Init; 880 881 if not Zero_Formatting then 882 Write_Eol; 883 Write_Str ("REFERENCED SOURCES"); 884 Write_Eol; 885 end if; 886 887 for J in reverse Elab_Order.First .. Elab_Order.Last loop 888 Source := Units.Table (Elab_Order.Table (J)).Sfile; 889 890 -- Do not include the sources of the runtime and do not 891 -- include the same source several times. 892 893 if Put_In_Sources (Source) 894 and then not Is_Internal_File_Name (Source) 895 then 896 if not Zero_Formatting then 897 Write_Str (" "); 898 end if; 899 900 Write_Str (Get_Name_String (Source)); 901 Write_Eol; 902 end if; 903 end loop; 904 905 -- Subunits do not appear in the elaboration table because 906 -- they are subsumed by their parent units, but we need to 907 -- list them for other tools. For now they are listed after 908 -- other files, rather than right after their parent, since 909 -- there is no easy link between the elaboration table and 910 -- the ALIs table ??? As subunits may appear repeatedly in 911 -- the list, if the parent unit appears in the context of 912 -- several units in the closure, duplicates are suppressed. 913 914 for J in Sdep.First .. Sdep.Last loop 915 Source := Sdep.Table (J).Sfile; 916 917 if Sdep.Table (J).Subunit_Name /= No_Name 918 and then Put_In_Sources (Source) 919 and then not Is_Internal_File_Name (Source) 920 then 921 if not Zero_Formatting then 922 Write_Str (" "); 923 end if; 924 925 Write_Str (Get_Name_String (Source)); 926 Write_Eol; 927 end if; 928 end loop; 929 930 if not Zero_Formatting then 931 Write_Eol; 932 end if; 933 end List_Closure_Display; 934 end if; 935 end if; 936 end if; 937 938 Total_Errors := Total_Errors + Errors_Detected; 939 Total_Warnings := Total_Warnings + Warnings_Detected; 940 941 exception 942 when Unrecoverable_Error => 943 Total_Errors := Total_Errors + Errors_Detected; 944 Total_Warnings := Total_Warnings + Warnings_Detected; 945 end; 946 947 -- All done. Set proper exit status 948 949 Finalize_Binderr; 950 Namet.Finalize; 951 952 if Total_Errors > 0 then 953 Exit_Program (E_Errors); 954 955 elsif Total_Warnings > 0 then 956 Exit_Program (E_Warnings); 957 958 else 959 -- Do not call Exit_Program (E_Success), so that finalization occurs 960 -- normally. 961 962 null; 963 end if; 964end Gnatbind; 965