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