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