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