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-2019, 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
  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          --  -minimal
 478
 479          elsif Argv (2 .. Argv'Last) = "minimal" then
 480             if not Is_Cross_Compiler then
 481                Write_Line
 482                  ("gnatbind: -minimal not expected to be used on native " &
 483                   "platforms");
 484             end if;
 485
 486             Opt.Minimal_Binder := True;
 487
 488          --  -Mname
 489
 490          elsif Argv'Length >= 3 and then Argv (2) = 'M' then
 491             if not Is_Cross_Compiler then
 492                Write_Line
 493                  ("gnatbind: -M not expected to be used on native platforms");
 494             end if;
 495
 496             Opt.Bind_Alternate_Main_Name := True;
 497             Opt.Alternate_Main_Name := new String'(Argv (3 .. Argv'Last));
 498
 499          --  All other options are single character and are handled by
 500          --  Scan_Binder_Switches.
 501
 502          else
 503             Scan_Binder_Switches (Argv);
 504          end if;
 505
 506       --  Not a switch, so must be a file name (if non-empty)
 507
 508       elsif Argv'Length /= 0 then
 509          if Argv'Length > 4
 510            and then Argv (Argv'Last - 3 .. Argv'Last) = ".ali"
 511          then
 512             Add_File (Argv);
 513          else
 514             Add_File (Argv & ".ali");
 515          end if;
 516       end if;
 517    end Scan_Bind_Arg;
 518
 519    ----------------------------
 520    -- Generic_Scan_Bind_Args --
 521    ----------------------------
 522
 523    procedure Generic_Scan_Bind_Args is
 524       Next_Arg : Positive := 1;
 525
 526    begin
 527       while Next_Arg < Arg_Count loop
 528          declare
 529             Next_Argv : String (1 .. Len_Arg (Next_Arg));
 530
 531          begin
 532             Fill_Arg (Next_Argv'Address, Next_Arg);
 533
 534             if Next_Argv'Length > 0 then
 535                if Next_Argv (1) = '@' then
 536                   if Next_Argv'Length > 1 then
 537                      declare
 538                         Arguments : constant Argument_List :=
 539                           System.Response_File.Arguments_From
 540                             (Response_File_Name        =>
 541                                Next_Argv (2 .. Next_Argv'Last),
 542                              Recursive                 => True,
 543                              Ignore_Non_Existing_Files => True);
 544                      begin
 545                         for J in Arguments'Range loop
 546                            Action (Arguments (J).all);
 547                         end loop;
 548                      end;
 549                   end if;
 550
 551                else
 552                   Action (Next_Argv);
 553                end if;
 554             end if;
 555          end;
 556
 557          Next_Arg := Next_Arg + 1;
 558       end loop;
 559    end Generic_Scan_Bind_Args;
 560
 561    ---------------
 562    -- Write_Arg --
 563    ---------------
 564
 565    procedure Write_Arg (S : String) is
 566    begin
 567       Write_Str (" " & S);
 568    end Write_Arg;
 569
 570    procedure Check_Version_And_Help is
 571      new Check_Version_And_Help_G (Bindusg.Display);
 572
 573    procedure Put_Bind_Args  is new Generic_Scan_Bind_Args (Write_Arg);
 574    procedure Scan_Bind_Args is new Generic_Scan_Bind_Args (Scan_Bind_Arg);
 575
 576 --  Start of processing for Gnatbind
 577
 578 begin
 579    --  Set default for Shared_Libgnat option
 580
 581    declare
 582       Shared_Libgnat_Default : Character;
 583       pragma Import
 584         (C, Shared_Libgnat_Default, "__gnat_shared_libgnat_default");
 585
 586       SHARED : constant Character := 'H';
 587       STATIC : constant Character := 'T';
 588
 589    begin
 590       pragma Assert
 591         (Shared_Libgnat_Default = SHARED
 592           or else
 593          Shared_Libgnat_Default = STATIC);
 594       Shared_Libgnat := (Shared_Libgnat_Default = SHARED);
 595    end;
 596
 597    --  Carry out package initializations. These are initializations which
 598    --  might logically be performed at elaboration time, and we decide to be
 599    --  consistent. Like elaboration, the order in which these calls are made
 600    --  is in some cases important.
 601
 602    Csets.Initialize;
 603    Snames.Initialize;
 604
 605    --  Scan the switches and arguments. Note that Snames must already be
 606    --  initialized (for processing of the -V switch).
 607
 608    --  First, scan to detect --version and/or --help
 609
 610    Check_Version_And_Help ("GNATBIND", "1992");
 611
 612    --  We need to Scan_Bind_Args first, to set Verbose_Mode, so we know whether
 613    --  to Put_Bind_Args.
 614
 615    Scan_Bind_Args;
 616
 617    if Verbose_Mode then
 618       declare
 619          Command_Name : String (1 .. Len_Arg (0));
 620       begin
 621          Fill_Arg (Command_Name'Address, 0);
 622          Write_Str (Command_Name);
 623       end;
 624
 625       Put_Bind_Args;
 626       Write_Eol;
 627    end if;
 628
 629    if Use_Pragma_Linker_Constructor then
 630       if Bind_Main_Program then
 631          Fail ("switch -a must be used in conjunction with -n or -Lxxx");
 632
 633       elsif not Gnatbind_Supports_Auto_Init then
 634          Fail ("automatic initialisation of elaboration not supported on this "
 635                & "platform");
 636       end if;
 637    end if;
 638
 639    --  Test for trailing -o switch
 640
 641    if Opt.Output_File_Name_Present and then not Output_File_Name_Seen then
 642       Fail ("output file name missing after -o");
 643    end if;
 644
 645    --  Output usage if requested
 646
 647    if Usage_Requested then
 648       Bindusg.Display;
 649    end if;
 650
 651    --  Check that the binder file specified has extension .adb
 652
 653    if Opt.Output_File_Name_Present and then Output_File_Name_Seen then
 654       Check_Extensions : declare
 655          Length : constant Natural := Output_File_Name'Length;
 656          Last   : constant Natural := Output_File_Name'Last;
 657
 658       begin
 659          if Length <= 4
 660            or else Output_File_Name (Last - 3 .. Last) /= ".adb"
 661          then
 662             Fail ("output file name should have .adb extension");
 663          end if;
 664       end Check_Extensions;
 665    end if;
 666
 667    Osint.Add_Default_Search_Dirs;
 668
 669    --  Acquire target parameters
 670
 671    Targparm.Get_Target_Parameters;
 672
 673    --  Initialize Cumulative_Restrictions with the restrictions on the target
 674    --  scanned from the system.ads file. Then as we read ALI files, we will
 675    --  accumulate additional restrictions specified in other files.
 676
 677    Cumulative_Restrictions := Targparm.Restrictions_On_Target;
 678
 679    --  Acquire configurable run-time mode
 680
 681    if Configurable_Run_Time_On_Target then
 682       Configurable_Run_Time_Mode := True;
 683    end if;
 684
 685    --  Output copyright notice if in verbose mode
 686
 687    if Verbose_Mode then
 688       Write_Eol;
 689       Display_Version ("GNATBIND", "1995");
 690    end if;
 691
 692    --  Output usage information if no arguments
 693
 694    if not More_Lib_Files then
 695       if Arg_Count = 0 then
 696          Bindusg.Display;
 697       else
 698          Write_Line ("try ""gnatbind --help"" for more information.");
 699       end if;
 700
 701       Exit_Program (E_Fatal);
 702    end if;
 703
 704    --  If a mapping file was specified, initialize the file mapping
 705
 706    if Mapping_File /= null then
 707       Fmap.Initialize (Mapping_File.all);
 708    end if;
 709
 710    --  The block here is to catch the Unrecoverable_Error exception in the
 711    --  case where we exceed the maximum number of permissible errors or some
 712    --  other unrecoverable error occurs.
 713
 714    begin
 715       --  Initialize binder packages
 716
 717       Initialize_Binderr;
 718       Initialize_ALI;
 719       Initialize_ALI_Source;
 720
 721       if Verbose_Mode then
 722          Write_Eol;
 723       end if;
 724
 725       --  Input ALI files
 726
 727       while More_Lib_Files loop
 728          Main_Lib_File := Next_Main_Lib_File;
 729
 730          if First_Main_Lib_File = No_File then
 731             First_Main_Lib_File := Main_Lib_File;
 732          end if;
 733
 734          if Verbose_Mode then
 735             if Check_Only then
 736                Write_Str ("Checking: ");
 737             else
 738                Write_Str ("Binding: ");
 739             end if;
 740
 741             Write_Name (Main_Lib_File);
 742             Write_Eol;
 743          end if;
 744
 745          Text := Read_Library_Info (Main_Lib_File, True);
 746
 747          declare
 748             Id : ALI_Id;
 749             pragma Warnings (Off, Id);
 750
 751          begin
 752             Id := Scan_ALI
 753                     (F                => Main_Lib_File,
 754                      T                => Text,
 755                      Ignore_ED        => False,
 756                      Err              => False,
 757                      Ignore_Errors    => Debug_Flag_I,
 758                      Directly_Scanned => True);
 759          end;
 760
 761          Free (Text);
 762       end loop;
 763
 764       --  No_Run_Time mode
 765
 766       if No_Run_Time_Mode then
 767
 768          --  Set standard configuration parameters
 769
 770          Suppress_Standard_Library_On_Target := True;
 771          Configurable_Run_Time_Mode          := True;
 772       end if;
 773
 774       --  For main ALI files, even if they are interfaces, we get their
 775       --  dependencies. To be sure, we reset the Interface flag for all main
 776       --  ALI files.
 777
 778       for Index in ALIs.First .. ALIs.Last loop
 779          ALIs.Table (Index).SAL_Interface := False;
 780       end loop;
 781
 782       --  Add System.Standard_Library to list to ensure that these files are
 783       --  included in the bind, even if not directly referenced from Ada code
 784       --  This is suppressed if the appropriate targparm switch is set. Be sure
 785       --  in any case that System is in the closure, as it may contain linker
 786       --  options. Note that it will be automatically added if s-stalib is
 787       --  added.
 788
 789       if not Suppress_Standard_Library_On_Target then
 790          Add_Artificial_ALI_File ("s-stalib.ali");
 791       else
 792          Add_Artificial_ALI_File ("system.ali");
 793       end if;
 794
 795       --  Load ALIs for all dependent units
 796
 797       for Index in ALIs.First .. ALIs.Last loop
 798          Read_Withed_ALIs (Index);
 799       end loop;
 800
 801       --  Quit if some file needs compiling
 802
 803       if No_Object_Specified then
 804          Error_Msg ("no object specified");
 805          raise Unrecoverable_Error;
 806       end if;
 807
 808       --  Quit with message if we had a GNATprove file
 809
 810       if GNATprove_Mode_Specified then
 811          Error_Msg ("one or more files compiled in GNATprove mode");
 812          raise Unrecoverable_Error;
 813       end if;
 814
 815       --  Output list of ALI files in closure
 816
 817       if Output_ALI_List then
 818          if ALI_List_Filename /= null then
 819             Set_List_File (ALI_List_Filename.all);
 820          end if;
 821
 822          for Index in ALIs.First .. ALIs.Last loop
 823             declare
 824                Full_Afile : constant File_Name_Type :=
 825                               Find_File (ALIs.Table (Index).Afile, Library);
 826             begin
 827                Write_Name (Full_Afile);
 828                Write_Eol;
 829             end;
 830          end loop;
 831
 832          if ALI_List_Filename /= null then
 833             Close_List_File;
 834          end if;
 835       end if;
 836
 837       --  Build source file table from the ALI files we have read in
 838
 839       Set_Source_Table;
 840
 841       --  If there is main program to bind, set Main_Lib_File to the first
 842       --  library file, and the name from which to derive the binder generate
 843       --  file to the first ALI file.
 844
 845       if Bind_Main_Program then
 846          Main_Lib_File := First_Main_Lib_File;
 847          Set_Current_File_Name_Index (To => 1);
 848       end if;
 849
 850       --  Check that main library file is a suitable main program
 851
 852       if Bind_Main_Program
 853         and then ALIs.Table (ALIs.First).Main_Program = None
 854         and then not No_Main_Subprogram
 855       then
 856          Get_Name_String
 857            (Units.Table (ALIs.Table (ALIs.First).First_Unit).Uname);
 858
 859          declare
 860             Unit_Name : String := Name_Buffer (1 .. Name_Len - 2);
 861          begin
 862             To_Mixed (Unit_Name);
 863             Get_Name_String (ALIs.Table (ALIs.First).Sfile);
 864             Add_Str_To_Name_Buffer (":1: ");
 865             Add_Str_To_Name_Buffer (Unit_Name);
 866             Add_Str_To_Name_Buffer (" cannot be used as a main program");
 867             Write_Line (Name_Buffer (1 .. Name_Len));
 868             Errors_Detected := Errors_Detected + 1;
 869          end;
 870       end if;
 871
 872       --  Perform consistency and correctness checks. Disable these in CodePeer
 873       --  mode where we want to be more flexible.
 874
 875       if not CodePeer_Mode then
 876          Check_Duplicated_Subunits;
 877          Check_Versions;
 878          Check_Consistency;
 879          Check_Configuration_Consistency;
 880       end if;
 881
 882       --  List restrictions that could be applied to this partition
 883
 884       if List_Restrictions then
 885          List_Applicable_Restrictions;
 886       end if;
 887
 888       --  Complete bind if no errors
 889
 890       if Errors_Detected = 0 then
 891          declare
 892             use Unit_Id_Tables;
 893             Elab_Order : Unit_Id_Table;
 894
 895          begin
 896             Find_Elaboration_Order (Elab_Order, First_Main_Lib_File);
 897
 898             if Errors_Detected = 0 and then not Check_Only then
 899                Gen_Output_File
 900                  (Output_File_Name.all,
 901                   Elab_Order => Elab_Order.Table (First .. Last (Elab_Order)));
 902             end if;
 903          end;
 904       end if;
 905
 906       Total_Errors   := Total_Errors   + Errors_Detected;
 907       Total_Warnings := Total_Warnings + Warnings_Detected;
 908
 909    exception
 910       when Unrecoverable_Error =>
 911          Total_Errors   := Total_Errors   + Errors_Detected;
 912          Total_Warnings := Total_Warnings + Warnings_Detected;
 913    end;
 914
 915    --  All done. Set the proper exit status.
 916
 917    Finalize_Binderr;
 918    Namet.Finalize;
 919
 920    if Total_Errors > 0 then
 921       Exit_Program (E_Errors);
 922
 923    elsif Total_Warnings > 0 then
 924       Exit_Program (E_Warnings);
 925
 926    else
 927       --  Do not call Exit_Program (E_Success), so that finalization occurs
 928       --  normally.
 929
 930       null;
 931    end if;
 932 end Gnatbind;