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