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-2017, 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 with Osint;    use Osint;
  40 with Osint.B;  use Osint.B;
  41 with Output;   use Output;
  42 with Rident;   use Rident;
  43 with Snames;
  44 with Switch;   use Switch;
  45 with Switch.B; use Switch.B;
  46 with Targparm; use Targparm;
  47 with Types;    use Types;
  48
  49 with System.Case_Util; use System.Case_Util;
  50 with System.OS_Lib;    use System.OS_Lib;
  51
  52 with Ada.Command_Line.Response_File; use Ada.Command_Line;
  53
  54 procedure Gnatbind is
  55
  56    Total_Errors : Nat := 0;
  57    --  Counts total errors in all files
  58
  59    Total_Warnings : Nat := 0;
  60    --  Total warnings in all files
  61
  62    Main_Lib_File : File_Name_Type;
  63    --  Current main library file
  64
  65    First_Main_Lib_File : File_Name_Type := No_File;
  66    --  The first library file, that should be a main subprogram if neither -n
  67    --  nor -z are used.
  68
  69    Text : Text_Buffer_Ptr;
  70
  71    Output_File_Name_Seen : Boolean := False;
  72    Output_File_Name      : String_Ptr := new String'("");
  73
  74    Mapping_File : String_Ptr := null;
  75
  76    procedure Add_Artificial_ALI_File (Name : String);
  77    --  Artificially add ALI file Name in the closure
  78
  79    function Gnatbind_Supports_Auto_Init return Boolean;
  80    --  Indicates if automatic initialization of elaboration procedure through
  81    --  the constructor mechanism is possible on the platform.
  82
  83    function Is_Cross_Compiler return Boolean;
  84    --  Returns True iff this is a cross-compiler
  85
  86    procedure List_Applicable_Restrictions;
  87    --  List restrictions that apply to this partition if option taken
  88
  89    procedure Scan_Bind_Arg (Argv : String);
  90    --  Scan and process binder specific arguments. Argv is a single argument.
  91    --  All the one character arguments are still handled by Switch. This
  92    --  routine handles -aO -aI and -I-. The lower bound of Argv must be 1.
  93
  94    generic
  95       with procedure Action (Argv : String);
  96    procedure Generic_Scan_Bind_Args;
  97    --  Iterate through the args calling Action on each one, taking care of
  98    --  response files.
  99
 100    procedure Write_Arg (S : String);
 101    --  Passed to Generic_Scan_Bind_Args to print args
 102
 103    -----------------------------
 104    -- Add_Artificial_ALI_File --
 105    -----------------------------
 106
 107    procedure Add_Artificial_ALI_File (Name : String) is
 108       Id : ALI_Id;
 109       pragma Warnings (Off, Id);
 110
 111       Std_Lib_File : File_Name_Type;
 112       --  Standard library
 113
 114    begin
 115       Name_Len := Name'Length;
 116       Name_Buffer (1 .. Name_Len) := Name;
 117       Std_Lib_File := Name_Find;
 118       Text := Read_Library_Info (Std_Lib_File, True);
 119
 120       Id :=
 121         Scan_ALI
 122           (F             => Std_Lib_File,
 123            T             => Text,
 124            Ignore_ED     => False,
 125            Err           => False,
 126            Ignore_Errors => Debug_Flag_I);
 127
 128       Free (Text);
 129    end Add_Artificial_ALI_File;
 130
 131    ---------------------------------
 132    -- Gnatbind_Supports_Auto_Init --
 133    ---------------------------------
 134
 135    function Gnatbind_Supports_Auto_Init return Boolean is
 136       function gnat_binder_supports_auto_init return Integer;
 137       pragma Import (C, gnat_binder_supports_auto_init,
 138                      "__gnat_binder_supports_auto_init");
 139
 140    begin
 141       return gnat_binder_supports_auto_init /= 0;
 142    end Gnatbind_Supports_Auto_Init;
 143
 144    -----------------------
 145    -- Is_Cross_Compiler --
 146    -----------------------
 147
 148    function Is_Cross_Compiler return Boolean is
 149       Cross_Compiler : Integer;
 150       pragma Import (C, Cross_Compiler, "__gnat_is_cross_compiler");
 151
 152    begin
 153       return Cross_Compiler = 1;
 154    end Is_Cross_Compiler;
 155
 156    ----------------------------------
 157    -- List_Applicable_Restrictions --
 158    ----------------------------------
 159
 160    procedure List_Applicable_Restrictions is
 161
 162       --  Define those restrictions that should be output if the gnatbind
 163       --  -r switch is used. Not all restrictions are output for the reasons
 164       --  given below in the list, and this array is used to test whether
 165       --  the corresponding pragma should be listed. True means that it
 166       --  should not be listed.
 167
 168       No_Restriction_List : constant array (All_Restrictions) of Boolean :=
 169         (No_Standard_Allocators_After_Elaboration => True,
 170          --  This involves run-time conditions not checkable at compile time
 171
 172          No_Anonymous_Allocators         => True,
 173          --  Premature, since we have not implemented this yet
 174
 175          No_Exception_Propagation        => True,
 176          --  Modifies code resulting in different exception semantics
 177
 178          No_Exceptions                   => True,
 179          --  Has unexpected Suppress (All_Checks) effect
 180
 181          No_Implicit_Conditionals        => True,
 182          --  This could modify and pessimize generated code
 183
 184          No_Implicit_Dynamic_Code        => True,
 185          --  This could modify and pessimize generated code
 186
 187          No_Implicit_Loops               => True,
 188          --  This could modify and pessimize generated code
 189
 190          No_Recursion                    => True,
 191          --  Not checkable at compile time
 192
 193          No_Reentrancy                   => True,
 194          --  Not checkable at compile time
 195
 196          Max_Entry_Queue_Length           => True,
 197          --  Not checkable at compile time
 198
 199          Max_Storage_At_Blocking         => True,
 200          --  Not checkable at compile time
 201
 202          --  The following three should not be partition-wide, so the
 203          --  following tests are junk to be removed eventually ???
 204
 205          No_Specification_Of_Aspect      => True,
 206          --  Requires a parameter value, not a count
 207
 208          No_Use_Of_Attribute             => True,
 209          --  Requires a parameter value, not a count
 210
 211          No_Use_Of_Pragma                => True,
 212          --  Requires a parameter value, not a count
 213
 214          others                          => False);
 215
 216       Additional_Restrictions_Listed : Boolean := False;
 217       --  Set True if we have listed header for restrictions
 218
 219       function Restriction_Could_Be_Set (R : Restriction_Id) return Boolean;
 220       --  Returns True if the given restriction can be listed as an additional
 221       --  restriction that could be set.
 222
 223       ------------------------------
 224       -- Restriction_Could_Be_Set --
 225       ------------------------------
 226
 227       function Restriction_Could_Be_Set (R : Restriction_Id) return Boolean is
 228          CR : Restrictions_Info renames Cumulative_Restrictions;
 229
 230       begin
 231          case R is
 232
 233             --  Boolean restriction
 234
 235             when All_Boolean_Restrictions =>
 236
 237                --  The condition for listing a boolean restriction as an
 238                --  additional restriction that could be set is that it is
 239                --  not violated by any unit, and not already set.
 240
 241                return CR.Violated (R) = False and then CR.Set (R) = False;
 242
 243             --  Parameter restriction
 244
 245             when All_Parameter_Restrictions =>
 246
 247                --  If the restriction is violated and the level of violation is
 248                --  unknown, the restriction can definitely not be listed.
 249
 250                if CR.Violated (R) and then CR.Unknown (R) then
 251                   return False;
 252
 253                --  We can list the restriction if it is not set
 254
 255                elsif not CR.Set (R) then
 256                   return True;
 257
 258                --  We can list the restriction if is set to a greater value
 259                --  than the maximum value known for the violation.
 260
 261                else
 262                   return CR.Value (R) > CR.Count (R);
 263                end if;
 264
 265             --  No other values for R possible
 266
 267             when others =>
 268                raise Program_Error;
 269          end case;
 270       end Restriction_Could_Be_Set;
 271
 272    --  Start of processing for List_Applicable_Restrictions
 273
 274    begin
 275       --  Loop through restrictions
 276
 277       for R in All_Restrictions loop
 278          if not No_Restriction_List (R)
 279            and then Restriction_Could_Be_Set (R)
 280          then
 281             if not Additional_Restrictions_Listed then
 282                Write_Eol;
 283                Write_Line
 284                  ("The following additional restrictions may be applied to "
 285                   & "this partition:");
 286                Additional_Restrictions_Listed := True;
 287             end if;
 288
 289             Write_Str ("pragma Restrictions (");
 290
 291             declare
 292                S : constant String := Restriction_Id'Image (R);
 293
 294             begin
 295                Name_Len := S'Length;
 296                Name_Buffer (1 .. Name_Len) := S;
 297             end;
 298
 299             Set_Casing (Mixed_Case);
 300             Write_Str (Name_Buffer (1 .. Name_Len));
 301
 302             if R in All_Parameter_Restrictions then
 303                Write_Str (" => ");
 304                Write_Int (Int (Cumulative_Restrictions.Count (R)));
 305             end if;
 306
 307             Write_Str (");");
 308             Write_Eol;
 309          end if;
 310       end loop;
 311    end List_Applicable_Restrictions;
 312
 313    -------------------
 314    -- Scan_Bind_Arg --
 315    -------------------
 316
 317    procedure Scan_Bind_Arg (Argv : String) is
 318       pragma Assert (Argv'First = 1);
 319
 320    begin
 321       --  Now scan arguments that are specific to the binder and are not
 322       --  handled by the common circuitry in Switch.
 323
 324       if Opt.Output_File_Name_Present
 325         and then not Output_File_Name_Seen
 326       then
 327          Output_File_Name_Seen := True;
 328
 329          if Argv'Length = 0
 330            or else (Argv'Length >= 1 and then Argv (1) = '-')
 331          then
 332             Fail ("output File_Name missing after -o");
 333
 334          else
 335             Output_File_Name := new String'(Argv);
 336          end if;
 337
 338       elsif Argv'Length >= 2 and then Argv (1) = '-' then
 339
 340          --  -I-
 341
 342          if Argv (2 .. Argv'Last) = "I-" then
 343             Opt.Look_In_Primary_Dir := False;
 344
 345          --  -Idir
 346
 347          elsif Argv (2) = 'I' then
 348             Add_Src_Search_Dir (Argv (3 .. Argv'Last));
 349             Add_Lib_Search_Dir (Argv (3 .. Argv'Last));
 350
 351          --  -Ldir
 352
 353          elsif Argv (2) = 'L' then
 354             if Argv'Length >= 3 then
 355
 356                Opt.Bind_For_Library := True;
 357                Opt.Ada_Init_Name :=
 358                  new String'(Argv (3 .. Argv'Last) & Opt.Ada_Init_Suffix);
 359                Opt.Ada_Final_Name :=
 360                  new String'(Argv (3 .. Argv'Last) & Opt.Ada_Final_Suffix);
 361                Opt.Ada_Main_Name :=
 362                  new String'(Argv (3 .. Argv'Last) & Opt.Ada_Main_Name_Suffix);
 363
 364                --  This option (-Lxxx) implies -n
 365
 366                Opt.Bind_Main_Program := False;
 367
 368             else
 369                Fail
 370                  ("Prefix of initialization and finalization procedure names "
 371                   & "missing in -L");
 372             end if;
 373
 374          --  -Sin -Slo -Shi -Sxx -Sev
 375
 376          elsif Argv'Length = 4
 377            and then Argv (2) = 'S'
 378          then
 379             declare
 380                C1 : Character := Argv (3);
 381                C2 : Character := Argv (4);
 382
 383             begin
 384                --  Fold to upper case
 385
 386                if C1 in 'a' .. 'z' then
 387                   C1 := Character'Val (Character'Pos (C1) - 32);
 388                end if;
 389
 390                if C2 in 'a' .. 'z' then
 391                   C2 := Character'Val (Character'Pos (C2) - 32);
 392                end if;
 393
 394                --  Test valid option and set mode accordingly
 395
 396                if C1 = 'E' and then C2 = 'V' then
 397                   null;
 398
 399                elsif C1 = 'I' and then C2 = 'N' then
 400                   null;
 401
 402                elsif C1 = 'L' and then C2 = 'O' then
 403                   null;
 404
 405                elsif C1 = 'H' and then C2 = 'I' then
 406                   null;
 407
 408                elsif (C1 in '0' .. '9' or else C1 in 'A' .. 'F')
 409                        and then
 410                      (C2 in '0' .. '9' or else C2 in 'A' .. 'F')
 411                then
 412                   null;
 413
 414                --  Invalid -S switch, let Switch give error, set default of IN
 415
 416                else
 417                   Scan_Binder_Switches (Argv);
 418                   C1 := 'I';
 419                   C2 := 'N';
 420                end if;
 421
 422                Initialize_Scalars_Mode1 := C1;
 423                Initialize_Scalars_Mode2 := C2;
 424             end;
 425
 426          --  -aIdir
 427
 428          elsif Argv'Length >= 3
 429            and then Argv (2 .. 3) = "aI"
 430          then
 431             Add_Src_Search_Dir (Argv (4 .. Argv'Last));
 432
 433          --  -aOdir
 434
 435          elsif Argv'Length >= 3
 436            and then Argv (2 .. 3) = "aO"
 437          then
 438             Add_Lib_Search_Dir (Argv (4 .. Argv'Last));
 439
 440          --  -nostdlib
 441
 442          elsif Argv (2 .. Argv'Last) = "nostdlib" then
 443             Opt.No_Stdlib := True;
 444
 445          --  -nostdinc
 446
 447          elsif Argv (2 .. Argv'Last) = "nostdinc" then
 448             Opt.No_Stdinc := True;
 449
 450          --  -static
 451
 452          elsif Argv (2 .. Argv'Last) = "static" then
 453             Opt.Shared_Libgnat := False;
 454
 455          --  -shared
 456
 457          elsif Argv (2 .. Argv'Last) = "shared" then
 458             Opt.Shared_Libgnat := True;
 459
 460          --  -F=mapping_file
 461
 462          elsif Argv'Length >= 4 and then Argv (2 .. 3) = "F=" then
 463             if Mapping_File /= null then
 464                Fail ("cannot specify several mapping files");
 465             end if;
 466
 467             Mapping_File := new String'(Argv (4 .. Argv'Last));
 468
 469          --  -Mname
 470
 471          elsif Argv'Length >= 3 and then Argv (2) = 'M' then
 472             if not Is_Cross_Compiler then
 473                Write_Line
 474                  ("gnatbind: -M not expected to be used on native platforms");
 475             end if;
 476
 477             Opt.Bind_Alternate_Main_Name := True;
 478             Opt.Alternate_Main_Name := new String'(Argv (3 .. Argv'Last));
 479
 480          --  All other options are single character and are handled by
 481          --  Scan_Binder_Switches.
 482
 483          else
 484             Scan_Binder_Switches (Argv);
 485          end if;
 486
 487       --  Not a switch, so must be a file name (if non-empty)
 488
 489       elsif Argv'Length /= 0 then
 490          if Argv'Length > 4
 491            and then Argv (Argv'Last - 3 .. Argv'Last) = ".ali"
 492          then
 493             Add_File (Argv);
 494          else
 495             Add_File (Argv & ".ali");
 496          end if;
 497       end if;
 498    end Scan_Bind_Arg;
 499
 500    ----------------------------
 501    -- Generic_Scan_Bind_Args --
 502    ----------------------------
 503
 504    procedure Generic_Scan_Bind_Args is
 505       Next_Arg : Positive := 1;
 506
 507    begin
 508       --  Use low level argument routines to avoid dragging in secondary stack
 509
 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                                       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       Write_Str (Command_Name);
 602       Put_Bind_Args;
 603       Write_Eol;
 604    end if;
 605
 606    if Use_Pragma_Linker_Constructor then
 607       if Bind_Main_Program then
 608          Fail ("switch -a must be used in conjunction with -n or -Lxxx");
 609
 610       elsif not Gnatbind_Supports_Auto_Init then
 611          Fail ("automatic initialisation of elaboration not supported on this "
 612                & "platform");
 613       end if;
 614    end if;
 615
 616    --  Test for trailing -o switch
 617
 618    if Opt.Output_File_Name_Present and then not Output_File_Name_Seen then
 619       Fail ("output file name missing after -o");
 620    end if;
 621
 622    --  Output usage if requested
 623
 624    if Usage_Requested then
 625       Bindusg.Display;
 626    end if;
 627
 628    --  Check that the binder file specified has extension .adb
 629
 630    if Opt.Output_File_Name_Present and then Output_File_Name_Seen then
 631       Check_Extensions : declare
 632          Length : constant Natural := Output_File_Name'Length;
 633          Last   : constant Natural := Output_File_Name'Last;
 634
 635       begin
 636          if Length <= 4
 637            or else Output_File_Name (Last - 3 .. Last) /= ".adb"
 638          then
 639             Fail ("output file name should have .adb extension");
 640          end if;
 641       end Check_Extensions;
 642    end if;
 643
 644    Osint.Add_Default_Search_Dirs;
 645
 646    --  Acquire target parameters
 647
 648    Targparm.Get_Target_Parameters;
 649
 650    --  Initialize Cumulative_Restrictions with the restrictions on the target
 651    --  scanned from the system.ads file. Then as we read ALI files, we will
 652    --  accumulate additional restrictions specified in other files.
 653
 654    Cumulative_Restrictions := Targparm.Restrictions_On_Target;
 655
 656    --  Acquire configurable run-time mode
 657
 658    if Configurable_Run_Time_On_Target then
 659       Configurable_Run_Time_Mode := True;
 660    end if;
 661
 662    --  Output copyright notice if in verbose mode
 663
 664    if Verbose_Mode then
 665       Write_Eol;
 666       Display_Version ("GNATBIND", "1995");
 667    end if;
 668
 669    --  Output usage information if no arguments
 670
 671    if not More_Lib_Files then
 672       if Argument_Count = 0 then
 673          Bindusg.Display;
 674       else
 675          Write_Line ("try ""gnatbind --help"" for more information.");
 676       end if;
 677
 678       Exit_Program (E_Fatal);
 679    end if;
 680
 681    --  If a mapping file was specified, initialize the file mapping
 682
 683    if Mapping_File /= null then
 684       Fmap.Initialize (Mapping_File.all);
 685    end if;
 686
 687    --  The block here is to catch the Unrecoverable_Error exception in the
 688    --  case where we exceed the maximum number of permissible errors or some
 689    --  other unrecoverable error occurs.
 690
 691    begin
 692       --  Initialize binder packages
 693
 694       Initialize_Binderr;
 695       Initialize_ALI;
 696       Initialize_ALI_Source;
 697
 698       if Verbose_Mode then
 699          Write_Eol;
 700       end if;
 701
 702       --  Input ALI files
 703
 704       while More_Lib_Files loop
 705          Main_Lib_File := Next_Main_Lib_File;
 706
 707          if First_Main_Lib_File = No_File then
 708             First_Main_Lib_File := Main_Lib_File;
 709          end if;
 710
 711          if Verbose_Mode then
 712             if Check_Only then
 713                Write_Str ("Checking: ");
 714             else
 715                Write_Str ("Binding: ");
 716             end if;
 717
 718             Write_Name (Main_Lib_File);
 719             Write_Eol;
 720          end if;
 721
 722          Text := Read_Library_Info (Main_Lib_File, True);
 723
 724          declare
 725             Id : ALI_Id;
 726             pragma Warnings (Off, Id);
 727
 728          begin
 729             Id := Scan_ALI
 730                     (F                => Main_Lib_File,
 731                      T                => Text,
 732                      Ignore_ED        => False,
 733                      Err              => False,
 734                      Ignore_Errors    => Debug_Flag_I,
 735                      Directly_Scanned => True);
 736          end;
 737
 738          Free (Text);
 739       end loop;
 740
 741       --  No_Run_Time mode
 742
 743       if No_Run_Time_Mode then
 744
 745          --  Set standard configuration parameters
 746
 747          Suppress_Standard_Library_On_Target := True;
 748          Configurable_Run_Time_Mode          := True;
 749       end if;
 750
 751       --  For main ALI files, even if they are interfaces, we get their
 752       --  dependencies. To be sure, we reset the Interface flag for all main
 753       --  ALI files.
 754
 755       for Index in ALIs.First .. ALIs.Last loop
 756          ALIs.Table (Index).SAL_Interface := False;
 757       end loop;
 758
 759       --  Add System.Standard_Library to list to ensure that these files are
 760       --  included in the bind, even if not directly referenced from Ada code
 761       --  This is suppressed if the appropriate targparm switch is set. Be sure
 762       --  in any case that System is in the closure, as it may contain linker
 763       --  options. Note that it will be automatically added if s-stalib is
 764       --  added.
 765
 766       if not Suppress_Standard_Library_On_Target then
 767          Add_Artificial_ALI_File ("s-stalib.ali");
 768       else
 769          Add_Artificial_ALI_File ("system.ali");
 770       end if;
 771
 772       --  Load ALIs for all dependent units
 773
 774       for Index in ALIs.First .. ALIs.Last loop
 775          Read_Withed_ALIs (Index);
 776       end loop;
 777
 778       --  Quit if some file needs compiling
 779
 780       if No_Object_Specified then
 781          raise Unrecoverable_Error;
 782       end if;
 783
 784       --  Quit with message if we had a GNATprove file
 785
 786       if GNATprove_Mode_Specified then
 787          Error_Msg ("one or more files compiled in GNATprove mode");
 788          raise Unrecoverable_Error;
 789       end if;
 790
 791       --  Output list of ALI files in closure
 792
 793       if Output_ALI_List then
 794          if ALI_List_Filename /= null then
 795             Set_List_File (ALI_List_Filename.all);
 796          end if;
 797
 798          for Index in ALIs.First .. ALIs.Last loop
 799             declare
 800                Full_Afile : constant File_Name_Type :=
 801                               Find_File (ALIs.Table (Index).Afile, Library);
 802             begin
 803                Write_Name (Full_Afile);
 804                Write_Eol;
 805             end;
 806          end loop;
 807
 808          if ALI_List_Filename /= null then
 809             Close_List_File;
 810          end if;
 811       end if;
 812
 813       --  Build source file table from the ALI files we have read in
 814
 815       Set_Source_Table;
 816
 817       --  If there is main program to bind, set Main_Lib_File to the first
 818       --  library file, and the name from which to derive the binder generate
 819       --  file to the first ALI file.
 820
 821       if Bind_Main_Program then
 822          Main_Lib_File := First_Main_Lib_File;
 823          Set_Current_File_Name_Index (To => 1);
 824       end if;
 825
 826       --  Check that main library file is a suitable main program
 827
 828       if Bind_Main_Program
 829         and then ALIs.Table (ALIs.First).Main_Program = None
 830         and then not No_Main_Subprogram
 831       then
 832          Get_Name_String
 833            (Units.Table (ALIs.Table (ALIs.First).First_Unit).Uname);
 834
 835          declare
 836             Unit_Name : String := Name_Buffer (1 .. Name_Len - 2);
 837          begin
 838             To_Mixed (Unit_Name);
 839             Get_Name_String (ALIs.Table (ALIs.First).Sfile);
 840             Add_Str_To_Name_Buffer (":1: ");
 841             Add_Str_To_Name_Buffer (Unit_Name);
 842             Add_Str_To_Name_Buffer (" cannot be used as a main program");
 843             Write_Line (Name_Buffer (1 .. Name_Len));
 844             Errors_Detected := Errors_Detected + 1;
 845          end;
 846       end if;
 847
 848       --  Perform consistency and correctness checks. Disable these in CodePeer
 849       --  mode where we want to be more flexible.
 850
 851       if not CodePeer_Mode then
 852          Check_Duplicated_Subunits;
 853          Check_Versions;
 854          Check_Consistency;
 855          Check_Configuration_Consistency;
 856       end if;
 857
 858       --  List restrictions that could be applied to this partition
 859
 860       if List_Restrictions then
 861          List_Applicable_Restrictions;
 862       end if;
 863
 864       --  Complete bind if no errors
 865
 866       if Errors_Detected = 0 then
 867          declare
 868             Elab_Order : Unit_Id_Table;
 869             use Unit_Id_Tables;
 870
 871          begin
 872             Find_Elab_Order (Elab_Order, First_Main_Lib_File);
 873
 874             if Errors_Detected = 0 and then not Check_Only then
 875                Gen_Output_File
 876                  (Output_File_Name.all,
 877                   Elab_Order => Elab_Order.Table (First .. Last (Elab_Order)));
 878             end if;
 879          end;
 880       end if;
 881
 882       Total_Errors := Total_Errors + Errors_Detected;
 883       Total_Warnings := Total_Warnings + Warnings_Detected;
 884
 885    exception
 886       when Unrecoverable_Error =>
 887          Total_Errors := Total_Errors + Errors_Detected;
 888          Total_Warnings := Total_Warnings + Warnings_Detected;
 889    end;
 890
 891    --  All done. Set the proper exit status.
 892
 893    Finalize_Binderr;
 894    Namet.Finalize;
 895
 896    if Total_Errors > 0 then
 897       Exit_Program (E_Errors);
 898
 899    elsif Total_Warnings > 0 then
 900       Exit_Program (E_Warnings);
 901
 902    else
 903       --  Do not call Exit_Program (E_Success), so that finalization occurs
 904       --  normally.
 905
 906       null;
 907    end if;
 908 end Gnatbind;