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