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