gcc/ada/gnatbind.adb

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