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