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-2015, Free Software Foundation, Inc.         --
  10 --                                                                          --
  11 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  12 -- terms of the  GNU General Public License as published  by the Free Soft- --
  13 -- ware  Foundation;  either version 3,  or (at your option) any later ver- --
  14 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  15 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  16 -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  17 -- for  more details.  You should have  received  a copy of the GNU General --
  18 -- Public License  distributed with GNAT; see file COPYING3.  If not, go to --
  19 -- http://www.gnu.org/licenses for a complete copy of the license.          --
  20 --                                                                          --
  21 -- GNAT was originally developed  by the GNAT team at  New York University. --
  22 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  23 --                                                                          --
  24 ------------------------------------------------------------------------------
  25
  26 with ALI;      use ALI;
  27 with ALI.Util; use ALI.Util;
  28 with Bcheck;   use Bcheck;
  29 with Binde;    use Binde;
  30 with Binderr;  use Binderr;
  31 with Bindgen;  use Bindgen;
  32 with Bindusg;
  33 with Butil;    use Butil;
  34 with Casing;   use Casing;
  35 with Csets;
  36 with Debug;    use Debug;
  37 with Fmap;
  38 with Fname;    use Fname;
  39 with Namet;    use Namet;
  40 with Opt;      use Opt;
  41 with Osint;    use Osint;
  42 with Osint.B;  use Osint.B;
  43 with Output;   use Output;
  44 with Rident;   use Rident;
  45 with Snames;
  46 with Switch;   use Switch;
  47 with Switch.B; use Switch.B;
  48 with Table;
  49 with Targparm; use Targparm;
  50 with Types;    use Types;
  51
  52 with System.Case_Util; use System.Case_Util;
  53 with System.OS_Lib;    use System.OS_Lib;
  54
  55 with Ada.Command_Line.Response_File; use Ada.Command_Line;
  56
  57 procedure Gnatbind is
  58
  59    Total_Errors : Nat := 0;
  60    --  Counts total errors in all files
  61
  62    Total_Warnings : Nat := 0;
  63    --  Total warnings in all files
  64
  65    Main_Lib_File : File_Name_Type;
  66    --  Current main library file
  67
  68    First_Main_Lib_File : File_Name_Type := No_File;
  69    --  The first library file, that should be a main subprogram if neither -n
  70    --  nor -z are used.
  71
  72    Std_Lib_File : File_Name_Type;
  73    --  Standard library
  74
  75    Text     : Text_Buffer_Ptr;
  76
  77    Output_File_Name_Seen : Boolean := False;
  78    Output_File_Name      : String_Ptr := new String'("");
  79
  80    Mapping_File : String_Ptr := null;
  81
  82    package Closure_Sources is new Table.Table
  83      (Table_Component_Type => File_Name_Type,
  84       Table_Index_Type     => Natural,
  85       Table_Low_Bound      => 1,
  86       Table_Initial        => 10,
  87       Table_Increment      => 100,
  88       Table_Name           => "Gnatbind.Closure_Sources");
  89    --  Table to record the sources in the closure, to avoid duplications. Used
  90    --  only with switch -R.
  91
  92    function Gnatbind_Supports_Auto_Init return Boolean;
  93    --  Indicates if automatic initialization of elaboration procedure
  94    --  through the constructor mechanism is possible on the platform.
  95
  96    procedure List_Applicable_Restrictions;
  97    --  List restrictions that apply to this partition if option taken
  98
  99    procedure Scan_Bind_Arg (Argv : String);
 100    --  Scan and process binder specific arguments. Argv is a single argument.
 101    --  All the one character arguments are still handled by Switch. This
 102    --  routine handles -aO -aI and -I-. The lower bound of Argv must be 1.
 103
 104    generic
 105       with procedure Action (Argv : String);
 106    procedure Generic_Scan_Bind_Args;
 107    --  Iterate through the args calling Action on each one, taking care of
 108    --  response files.
 109
 110    procedure Write_Arg (S : String);
 111    --  Passed to Generic_Scan_Bind_Args to print args
 112
 113    function Is_Cross_Compiler return Boolean;
 114    --  Returns True iff this is a cross-compiler
 115
 116    ---------------------------------
 117    -- Gnatbind_Supports_Auto_Init --
 118    ---------------------------------
 119
 120    function Gnatbind_Supports_Auto_Init return Boolean is
 121       function gnat_binder_supports_auto_init return Integer;
 122       pragma Import (C, gnat_binder_supports_auto_init,
 123                      "__gnat_binder_supports_auto_init");
 124    begin
 125       return gnat_binder_supports_auto_init /= 0;
 126    end Gnatbind_Supports_Auto_Init;
 127
 128    -----------------------
 129    -- Is_Cross_Compiler --
 130    -----------------------
 131
 132    function Is_Cross_Compiler return Boolean is
 133       Cross_Compiler : Integer;
 134       pragma Import (C, Cross_Compiler, "__gnat_is_cross_compiler");
 135    begin
 136       return Cross_Compiler = 1;
 137    end Is_Cross_Compiler;
 138
 139    ----------------------------------
 140    -- List_Applicable_Restrictions --
 141    ----------------------------------
 142
 143    procedure List_Applicable_Restrictions is
 144
 145       --  Define those restrictions that should be output if the gnatbind
 146       --  -r switch is used. Not all restrictions are output for the reasons
 147       --  given below in the list, and this array is used to test whether
 148       --  the corresponding pragma should be listed. True means that it
 149       --  should not be listed.
 150
 151       No_Restriction_List : constant array (All_Restrictions) of Boolean :=
 152         (No_Standard_Allocators_After_Elaboration => True,
 153          --  This involves run-time conditions not checkable at compile time
 154
 155          No_Anonymous_Allocators         => True,
 156          --  Premature, since we have not implemented this yet
 157
 158          No_Exception_Propagation        => True,
 159          --  Modifies code resulting in different exception semantics
 160
 161          No_Exceptions                   => True,
 162          --  Has unexpected Suppress (All_Checks) effect
 163
 164          No_Implicit_Conditionals        => True,
 165          --  This could modify and pessimize generated code
 166
 167          No_Implicit_Dynamic_Code        => True,
 168          --  This could modify and pessimize generated code
 169
 170          No_Implicit_Loops               => True,
 171          --  This could modify and pessimize generated code
 172
 173          No_Recursion                    => True,
 174          --  Not checkable at compile time
 175
 176          No_Reentrancy                   => True,
 177          --  Not checkable at compile time
 178
 179          Max_Entry_Queue_Length           => True,
 180          --  Not checkable at compile time
 181
 182          Max_Storage_At_Blocking         => True,
 183          --  Not checkable at compile time
 184
 185          --  The following three should not be partition-wide, so the
 186          --  following tests are junk to be removed eventually ???
 187
 188          No_Specification_Of_Aspect      => True,
 189          --  Requires a parameter value, not a count
 190
 191          No_Use_Of_Attribute             => True,
 192          --  Requires a parameter value, not a count
 193
 194          No_Use_Of_Pragma                => True,
 195          --  Requires a parameter value, not a count
 196
 197          others                          => False);
 198
 199       Additional_Restrictions_Listed : Boolean := False;
 200       --  Set True if we have listed header for restrictions
 201
 202       function Restriction_Could_Be_Set (R : Restriction_Id) return Boolean;
 203       --  Returns True if the given restriction can be listed as an additional
 204       --  restriction that could be set.
 205
 206       ------------------------------
 207       -- Restriction_Could_Be_Set --
 208       ------------------------------
 209
 210       function Restriction_Could_Be_Set (R : Restriction_Id) return Boolean is
 211          CR : Restrictions_Info renames Cumulative_Restrictions;
 212
 213       begin
 214          case R is
 215
 216             --  Boolean restriction
 217
 218             when All_Boolean_Restrictions =>
 219
 220                --  The condition for listing a boolean restriction as an
 221                --  additional restriction that could be set is that it is
 222                --  not violated by any unit, and not already set.
 223
 224                return CR.Violated (R) = False and then CR.Set (R) = False;
 225
 226             --  Parameter restriction
 227
 228             when All_Parameter_Restrictions =>
 229
 230                --  If the restriction is violated and the level of violation is
 231                --  unknown, the restriction can definitely not be listed.
 232
 233                if CR.Violated (R) and then CR.Unknown (R) then
 234                   return False;
 235
 236                --  We can list the restriction if it is not set
 237
 238                elsif not CR.Set (R) then
 239                   return True;
 240
 241                --  We can list the restriction if is set to a greater value
 242                --  than the maximum value known for the violation.
 243
 244                else
 245                   return CR.Value (R) > CR.Count (R);
 246                end if;
 247
 248             --  No other values for R possible
 249
 250             when others =>
 251                raise Program_Error;
 252
 253          end case;
 254       end Restriction_Could_Be_Set;
 255
 256    --  Start of processing for List_Applicable_Restrictions
 257
 258    begin
 259       --  Loop through restrictions
 260
 261       for R in All_Restrictions loop
 262          if not No_Restriction_List (R)
 263             and then Restriction_Could_Be_Set (R)
 264          then
 265             if not Additional_Restrictions_Listed then
 266                Write_Eol;
 267                Write_Line
 268                  ("The following additional restrictions may be" &
 269                   " applied to this partition:");
 270                Additional_Restrictions_Listed := True;
 271             end if;
 272
 273             Write_Str ("pragma Restrictions (");
 274
 275             declare
 276                S : constant String := Restriction_Id'Image (R);
 277             begin
 278                Name_Len := S'Length;
 279                Name_Buffer (1 .. Name_Len) := S;
 280             end;
 281
 282             Set_Casing (Mixed_Case);
 283             Write_Str (Name_Buffer (1 .. Name_Len));
 284
 285             if R in All_Parameter_Restrictions then
 286                Write_Str (" => ");
 287                Write_Int (Int (Cumulative_Restrictions.Count (R)));
 288             end if;
 289
 290             Write_Str (");");
 291             Write_Eol;
 292          end if;
 293       end loop;
 294    end List_Applicable_Restrictions;
 295
 296    -------------------
 297    -- Scan_Bind_Arg --
 298    -------------------
 299
 300    procedure Scan_Bind_Arg (Argv : String) is
 301       pragma Assert (Argv'First = 1);
 302
 303    begin
 304       --  Now scan arguments that are specific to the binder and are not
 305       --  handled by the common circuitry in Switch.
 306
 307       if Opt.Output_File_Name_Present
 308         and then not Output_File_Name_Seen
 309       then
 310          Output_File_Name_Seen := True;
 311
 312          if Argv'Length = 0
 313            or else (Argv'Length >= 1 and then Argv (1) = '-')
 314          then
 315             Fail ("output File_Name missing after -o");
 316
 317          else
 318             Output_File_Name := new String'(Argv);
 319          end if;
 320
 321       elsif Argv'Length >= 2 and then Argv (1) = '-' then
 322
 323          --  -I-
 324
 325          if Argv (2 .. Argv'Last) = "I-" then
 326             Opt.Look_In_Primary_Dir := False;
 327
 328          --  -Idir
 329
 330          elsif Argv (2) = 'I' then
 331             Add_Src_Search_Dir (Argv (3 .. Argv'Last));
 332             Add_Lib_Search_Dir (Argv (3 .. Argv'Last));
 333
 334          --  -Ldir
 335
 336          elsif Argv (2) = 'L' then
 337             if Argv'Length >= 3 then
 338
 339                Opt.Bind_For_Library := True;
 340                Opt.Ada_Init_Name :=
 341                  new String'(Argv (3 .. Argv'Last) & Opt.Ada_Init_Suffix);
 342                Opt.Ada_Final_Name :=
 343                  new String'(Argv (3 .. Argv'Last) & Opt.Ada_Final_Suffix);
 344                Opt.Ada_Main_Name :=
 345                  new String'(Argv (3 .. Argv'Last) & Opt.Ada_Main_Name_Suffix);
 346
 347                --  This option (-Lxxx) implies -n
 348
 349                Opt.Bind_Main_Program := False;
 350
 351             else
 352                Fail
 353                  ("Prefix of initialization and finalization " &
 354                   "procedure names missing in -L");
 355             end if;
 356
 357          --  -Sin -Slo -Shi -Sxx -Sev
 358
 359          elsif Argv'Length = 4
 360            and then Argv (2) = 'S'
 361          then
 362             declare
 363                C1 : Character := Argv (3);
 364                C2 : Character := Argv (4);
 365
 366             begin
 367                --  Fold to upper case
 368
 369                if C1 in 'a' .. 'z' then
 370                   C1 := Character'Val (Character'Pos (C1) - 32);
 371                end if;
 372
 373                if C2 in 'a' .. 'z' then
 374                   C2 := Character'Val (Character'Pos (C2) - 32);
 375                end if;
 376
 377                --  Test valid option and set mode accordingly
 378
 379                if C1 = 'E' and then C2 = 'V' then
 380                   null;
 381
 382                elsif C1 = 'I' and then C2 = 'N' then
 383                   null;
 384
 385                elsif C1 = 'L' and then C2 = 'O' then
 386                   null;
 387
 388                elsif C1 = 'H' and then C2 = 'I' then
 389                   null;
 390
 391                elsif (C1 in '0' .. '9' or else C1 in 'A' .. 'F')
 392                        and then
 393                      (C2 in '0' .. '9' or else C2 in 'A' .. 'F')
 394                then
 395                   null;
 396
 397                --  Invalid -S switch, let Switch give error, set default of IN
 398
 399                else
 400                   Scan_Binder_Switches (Argv);
 401                   C1 := 'I';
 402                   C2 := 'N';
 403                end if;
 404
 405                Initialize_Scalars_Mode1 := C1;
 406                Initialize_Scalars_Mode2 := C2;
 407             end;
 408
 409          --  -aIdir
 410
 411          elsif Argv'Length >= 3
 412            and then Argv (2 .. 3) = "aI"
 413          then
 414             Add_Src_Search_Dir (Argv (4 .. Argv'Last));
 415
 416          --  -aOdir
 417
 418          elsif Argv'Length >= 3
 419            and then Argv (2 .. 3) = "aO"
 420          then
 421             Add_Lib_Search_Dir (Argv (4 .. Argv'Last));
 422
 423          --  -nostdlib
 424
 425          elsif Argv (2 .. Argv'Last) = "nostdlib" then
 426             Opt.No_Stdlib := True;
 427
 428          --  -nostdinc
 429
 430          elsif Argv (2 .. Argv'Last) = "nostdinc" then
 431             Opt.No_Stdinc := True;
 432
 433          --  -static
 434
 435          elsif Argv (2 .. Argv'Last) = "static" then
 436             Opt.Shared_Libgnat := False;
 437
 438          --  -shared
 439
 440          elsif Argv (2 .. Argv'Last) = "shared" then
 441             Opt.Shared_Libgnat := True;
 442
 443          --  -F=mapping_file
 444
 445          elsif Argv'Length >= 4 and then Argv (2 .. 3) = "F=" then
 446             if Mapping_File /= null then
 447                Fail ("cannot specify several mapping files");
 448             end if;
 449
 450             Mapping_File := new String'(Argv (4 .. Argv'Last));
 451
 452          --  -Mname
 453
 454          elsif Argv'Length >= 3 and then Argv (2) = 'M' then
 455             if not Is_Cross_Compiler then
 456                Write_Line
 457                  ("gnatbind: -M not expected to be used on native platforms");
 458             end if;
 459
 460             Opt.Bind_Alternate_Main_Name := True;
 461             Opt.Alternate_Main_Name := new String'(Argv (3 .. Argv'Last));
 462
 463          --  All other options are single character and are handled by
 464          --  Scan_Binder_Switches.
 465
 466          else
 467             Scan_Binder_Switches (Argv);
 468          end if;
 469
 470       --  Not a switch, so must be a file name (if non-empty)
 471
 472       elsif Argv'Length /= 0 then
 473          if Argv'Length > 4
 474            and then Argv (Argv'Last - 3 .. Argv'Last) = ".ali"
 475          then
 476             Add_File (Argv);
 477          else
 478             Add_File (Argv & ".ali");
 479          end if;
 480       end if;
 481    end Scan_Bind_Arg;
 482
 483    ----------------------------
 484    -- Generic_Scan_Bind_Args --
 485    ----------------------------
 486
 487    procedure Generic_Scan_Bind_Args is
 488       Next_Arg : Positive := 1;
 489
 490    begin
 491       --  Use low level argument routines to avoid dragging in secondary stack
 492
 493       while Next_Arg < Arg_Count loop
 494          declare
 495             Next_Argv : String (1 .. Len_Arg (Next_Arg));
 496
 497          begin
 498             Fill_Arg (Next_Argv'Address, Next_Arg);
 499
 500             if Next_Argv'Length > 0 then
 501                if Next_Argv (1) = '@' then
 502                   if Next_Argv'Length > 1 then
 503                      declare
 504                         Arguments : constant Argument_List :=
 505                                       Response_File.Arguments_From
 506                                         (Response_File_Name        =>
 507                                            Next_Argv (2 .. Next_Argv'Last),
 508                                          Recursive                 => True,
 509                                          Ignore_Non_Existing_Files => True);
 510                      begin
 511                         for J in Arguments'Range loop
 512                            Action (Arguments (J).all);
 513                         end loop;
 514                      end;
 515                   end if;
 516
 517                else
 518                   Action (Next_Argv);
 519                end if;
 520             end if;
 521          end;
 522
 523          Next_Arg := Next_Arg + 1;
 524       end loop;
 525    end Generic_Scan_Bind_Args;
 526
 527    ---------------
 528    -- Write_Arg --
 529    ---------------
 530
 531    procedure Write_Arg (S : String) is
 532    begin
 533       Write_Str (" " & S);
 534    end Write_Arg;
 535
 536    procedure Scan_Bind_Args is new Generic_Scan_Bind_Args (Scan_Bind_Arg);
 537    procedure Put_Bind_Args is new Generic_Scan_Bind_Args (Write_Arg);
 538
 539    procedure Check_Version_And_Help is
 540      new Check_Version_And_Help_G (Bindusg.Display);
 541
 542 --  Start of processing for Gnatbind
 543
 544 begin
 545    --  Set default for Shared_Libgnat option
 546
 547    declare
 548       Shared_Libgnat_Default : Character;
 549       pragma Import
 550         (C, Shared_Libgnat_Default, "__gnat_shared_libgnat_default");
 551
 552       SHARED : constant Character := 'H';
 553       STATIC : constant Character := 'T';
 554
 555    begin
 556       pragma Assert
 557         (Shared_Libgnat_Default = SHARED
 558          or else
 559         Shared_Libgnat_Default = STATIC);
 560       Shared_Libgnat := (Shared_Libgnat_Default = SHARED);
 561    end;
 562
 563    --  Carry out package initializations. These are initializations which
 564    --  might logically be performed at elaboration time, and we decide to be
 565    --  consistent. Like elaboration, the order in which these calls are made
 566    --  is in some cases important.
 567
 568    Csets.Initialize;
 569    Snames.Initialize;
 570
 571    --  Scan the switches and arguments. Note that Snames must already be
 572    --  initialized (for processing of the -V switch).
 573
 574    --  First, scan to detect --version and/or --help
 575
 576    Check_Version_And_Help ("GNATBIND", "1992");
 577
 578    --  We need to Scan_Bind_Args first, to set Verbose_Mode, so we know whether
 579    --  to Put_Bind_Args.
 580
 581    Scan_Bind_Args;
 582
 583    if Verbose_Mode then
 584       Write_Str (Command_Name);
 585       Put_Bind_Args;
 586       Write_Eol;
 587    end if;
 588
 589    if Use_Pragma_Linker_Constructor then
 590       if Bind_Main_Program then
 591          Fail ("switch -a must be used in conjunction with -n or -Lxxx");
 592
 593       elsif not Gnatbind_Supports_Auto_Init then
 594          Fail ("automatic initialisation of elaboration " &
 595                "not supported on this platform");
 596       end if;
 597    end if;
 598
 599    --  Test for trailing -o switch
 600
 601    if Opt.Output_File_Name_Present and then not Output_File_Name_Seen then
 602       Fail ("output file name missing after -o");
 603    end if;
 604
 605    --  Output usage if requested
 606
 607    if Usage_Requested then
 608       Bindusg.Display;
 609    end if;
 610
 611    --  Check that the binder file specified has extension .adb
 612
 613    if Opt.Output_File_Name_Present and then Output_File_Name_Seen then
 614       Check_Extensions : declare
 615          Length : constant Natural := Output_File_Name'Length;
 616          Last   : constant Natural := Output_File_Name'Last;
 617       begin
 618          if Length <= 4
 619            or else Output_File_Name (Last - 3 .. Last) /= ".adb"
 620          then
 621             Fail ("output file name should have .adb extension");
 622          end if;
 623       end Check_Extensions;
 624    end if;
 625
 626    Osint.Add_Default_Search_Dirs;
 627
 628    --  Acquire target parameters
 629
 630    Targparm.Get_Target_Parameters;
 631
 632    --  Initialize Cumulative_Restrictions with the restrictions on the target
 633    --  scanned from the system.ads file. Then as we read ALI files, we will
 634    --  accumulate additional restrictions specified in other files.
 635
 636    Cumulative_Restrictions := Targparm.Restrictions_On_Target;
 637
 638    --  Acquire configurable run-time mode
 639
 640    if Configurable_Run_Time_On_Target then
 641       Configurable_Run_Time_Mode := True;
 642    end if;
 643
 644    --  Output copyright notice if in verbose mode
 645
 646    if Verbose_Mode then
 647       Write_Eol;
 648       Display_Version ("GNATBIND", "1995");
 649    end if;
 650
 651    --  Output usage information if no arguments
 652
 653    if not More_Lib_Files then
 654       if Argument_Count = 0 then
 655          Bindusg.Display;
 656       else
 657          Write_Line ("try ""gnatbind --help"" for more information.");
 658       end if;
 659
 660       Exit_Program (E_Fatal);
 661    end if;
 662
 663    --  If a mapping file was specified, initialize the file mapping
 664
 665    if Mapping_File /= null then
 666       Fmap.Initialize (Mapping_File.all);
 667    end if;
 668
 669    --  The block here is to catch the Unrecoverable_Error exception in the
 670    --  case where we exceed the maximum number of permissible errors or some
 671    --  other unrecoverable error occurs.
 672
 673    begin
 674       --  Initialize binder packages
 675
 676       Initialize_Binderr;
 677       Initialize_ALI;
 678       Initialize_ALI_Source;
 679
 680       if Verbose_Mode then
 681          Write_Eol;
 682       end if;
 683
 684       --  Input ALI files
 685
 686       while More_Lib_Files loop
 687          Main_Lib_File := Next_Main_Lib_File;
 688
 689          if First_Main_Lib_File = No_File then
 690             First_Main_Lib_File := Main_Lib_File;
 691          end if;
 692
 693          if Verbose_Mode then
 694             if Check_Only then
 695                Write_Str ("Checking: ");
 696             else
 697                Write_Str ("Binding: ");
 698             end if;
 699
 700             Write_Name (Main_Lib_File);
 701             Write_Eol;
 702          end if;
 703
 704          Text := Read_Library_Info (Main_Lib_File, True);
 705
 706          declare
 707             Id : ALI_Id;
 708             pragma Warnings (Off, Id);
 709
 710          begin
 711             Id := Scan_ALI
 712                     (F                => Main_Lib_File,
 713                      T                => Text,
 714                      Ignore_ED        => False,
 715                      Err              => False,
 716                      Ignore_Errors    => Debug_Flag_I,
 717                      Directly_Scanned => True);
 718          end;
 719
 720          Free (Text);
 721       end loop;
 722
 723       --  No_Run_Time mode
 724
 725       if No_Run_Time_Mode then
 726
 727          --  Set standard configuration parameters
 728
 729          Suppress_Standard_Library_On_Target := True;
 730          Configurable_Run_Time_Mode          := True;
 731       end if;
 732
 733       --  For main ALI files, even if they are interfaces, we get their
 734       --  dependencies. To be sure, we reset the Interface flag for all main
 735       --  ALI files.
 736
 737       for Index in ALIs.First .. ALIs.Last loop
 738          ALIs.Table (Index).SAL_Interface := False;
 739       end loop;
 740
 741       --  Add System.Standard_Library to list to ensure that these files are
 742       --  included in the bind, even if not directly referenced from Ada code
 743       --  This is suppressed if the appropriate targparm switch is set.
 744
 745       if not Suppress_Standard_Library_On_Target then
 746          Name_Buffer (1 .. 12) := "s-stalib.ali";
 747          Name_Len := 12;
 748          Std_Lib_File := Name_Find;
 749          Text := Read_Library_Info (Std_Lib_File, True);
 750
 751          declare
 752             Id : ALI_Id;
 753             pragma Warnings (Off, Id);
 754
 755          begin
 756             Id :=
 757               Scan_ALI
 758                 (F             => Std_Lib_File,
 759                  T             => Text,
 760                  Ignore_ED     => False,
 761                  Err           => False,
 762                  Ignore_Errors => Debug_Flag_I);
 763          end;
 764
 765          Free (Text);
 766       end if;
 767
 768       --  Load ALIs for all dependent units
 769
 770       for Index in ALIs.First .. ALIs.Last loop
 771          Read_Withed_ALIs (Index);
 772       end loop;
 773
 774       --  Quit if some file needs compiling
 775
 776       if No_Object_Specified then
 777          raise Unrecoverable_Error;
 778       end if;
 779
 780       --  Quit with message if we had a GNATprove file
 781
 782       if GNATprove_Mode_Specified then
 783          Error_Msg ("one or more files compiled in GNATprove mode");
 784          raise Unrecoverable_Error;
 785       end if;
 786
 787       --  Output list of ALI files in closure
 788
 789       if Output_ALI_List then
 790          if ALI_List_Filename /= null then
 791             Set_List_File (ALI_List_Filename.all);
 792          end if;
 793
 794          for Index in ALIs.First .. ALIs.Last loop
 795             declare
 796                Full_Afile : constant File_Name_Type :=
 797                               Find_File (ALIs.Table (Index).Afile, Library);
 798             begin
 799                Write_Name (Full_Afile);
 800                Write_Eol;
 801             end;
 802          end loop;
 803
 804          if ALI_List_Filename /= null then
 805             Close_List_File;
 806          end if;
 807       end if;
 808
 809       --  Build source file table from the ALI files we have read in
 810
 811       Set_Source_Table;
 812
 813       --  If there is main program to bind, set Main_Lib_File to the first
 814       --  library file, and the name from which to derive the binder generate
 815       --  file to the first ALI file.
 816
 817       if Bind_Main_Program then
 818          Main_Lib_File := First_Main_Lib_File;
 819          Set_Current_File_Name_Index (To => 1);
 820       end if;
 821
 822       --  Check that main library file is a suitable main program
 823
 824       if Bind_Main_Program
 825         and then ALIs.Table (ALIs.First).Main_Program = None
 826         and then not No_Main_Subprogram
 827       then
 828          Get_Name_String
 829            (Units.Table (ALIs.Table (ALIs.First).First_Unit).Uname);
 830
 831          declare
 832             Unit_Name : String := Name_Buffer (1 .. Name_Len - 2);
 833          begin
 834             To_Mixed (Unit_Name);
 835             Get_Name_String (ALIs.Table (ALIs.First).Sfile);
 836             Add_Str_To_Name_Buffer (":1: ");
 837             Add_Str_To_Name_Buffer (Unit_Name);
 838             Add_Str_To_Name_Buffer (" cannot be used as a main program");
 839             Write_Line (Name_Buffer (1 .. Name_Len));
 840             Errors_Detected := Errors_Detected + 1;
 841          end;
 842       end if;
 843
 844       --  Perform consistency and correctness checks
 845
 846       Check_Duplicated_Subunits;
 847       Check_Versions;
 848       Check_Consistency;
 849       Check_Configuration_Consistency;
 850
 851       --  List restrictions that could be applied to this partition
 852
 853       if List_Restrictions then
 854          List_Applicable_Restrictions;
 855       end if;
 856
 857       --  Complete bind if no errors
 858
 859       if Errors_Detected = 0 then
 860          Find_Elab_Order;
 861
 862          if Errors_Detected = 0 then
 863             --  Display elaboration order if -l was specified
 864
 865             if Elab_Order_Output then
 866                if not Zero_Formatting then
 867                   Write_Eol;
 868                   Write_Str ("ELABORATION ORDER");
 869                   Write_Eol;
 870                end if;
 871
 872                for J in Elab_Order.First .. Elab_Order.Last loop
 873                   if not Units.Table (Elab_Order.Table (J)).SAL_Interface then
 874                      if not Zero_Formatting then
 875                         Write_Str ("   ");
 876                      end if;
 877
 878                      Write_Unit_Name
 879                        (Units.Table (Elab_Order.Table (J)).Uname);
 880                      Write_Eol;
 881                   end if;
 882                end loop;
 883
 884                if not Zero_Formatting then
 885                   Write_Eol;
 886                end if;
 887             end if;
 888
 889             if not Check_Only then
 890                Gen_Output_File (Output_File_Name.all);
 891             end if;
 892
 893             --  Display list of sources in the closure (except predefined
 894             --  sources) if -R was used.
 895
 896             if List_Closure then
 897                List_Closure_Display : declare
 898                   Source : File_Name_Type;
 899
 900                   function Put_In_Sources (S : File_Name_Type) return Boolean;
 901                   --  Check if S is already in table Sources and put in Sources
 902                   --  if it is not. Return False if the source is already in
 903                   --  Sources, and True if it is added.
 904
 905                   --------------------
 906                   -- Put_In_Sources --
 907                   --------------------
 908
 909                   function Put_In_Sources
 910                     (S : File_Name_Type) return Boolean
 911                   is
 912                   begin
 913                      for J in 1 .. Closure_Sources.Last loop
 914                         if Closure_Sources.Table (J) = S then
 915                            return False;
 916                         end if;
 917                      end loop;
 918
 919                      Closure_Sources.Append (S);
 920                      return True;
 921                   end Put_In_Sources;
 922
 923                --  Start of processing for List_Closure_Display
 924
 925                begin
 926                   Closure_Sources.Init;
 927
 928                   if not Zero_Formatting then
 929                      Write_Eol;
 930                      Write_Str ("REFERENCED SOURCES");
 931                      Write_Eol;
 932                   end if;
 933
 934                   for J in reverse Elab_Order.First .. Elab_Order.Last loop
 935                      Source := Units.Table (Elab_Order.Table (J)).Sfile;
 936
 937                      --  Do not include same source more than once
 938
 939                      if Put_In_Sources (Source)
 940
 941                        --  Do not include run-time units unless -Ra switch set
 942
 943                        and then (List_Closure_All
 944                                   or else not Is_Internal_File_Name (Source))
 945                      then
 946                         if not Zero_Formatting then
 947                            Write_Str ("   ");
 948                         end if;
 949
 950                         Write_Str (Get_Name_String (Source));
 951                         Write_Eol;
 952                      end if;
 953                   end loop;
 954
 955                   --  Subunits do not appear in the elaboration table because
 956                   --  they are subsumed by their parent units, but we need to
 957                   --  list them for other tools. For now they are listed after
 958                   --  other files, rather than right after their parent, since
 959                   --  there is no easy link between the elaboration table and
 960                   --  the ALIs table ??? As subunits may appear repeatedly in
 961                   --  the list, if the parent unit appears in the context of
 962                   --  several units in the closure, duplicates are suppressed.
 963
 964                   for J in Sdep.First .. Sdep.Last loop
 965                      Source := Sdep.Table (J).Sfile;
 966
 967                      if Sdep.Table (J).Subunit_Name /= No_Name
 968                        and then Put_In_Sources (Source)
 969                        and then not Is_Internal_File_Name (Source)
 970                      then
 971                         if not Zero_Formatting then
 972                            Write_Str ("   ");
 973                         end if;
 974
 975                         Write_Str (Get_Name_String (Source));
 976                         Write_Eol;
 977                      end if;
 978                   end loop;
 979
 980                   if not Zero_Formatting then
 981                      Write_Eol;
 982                   end if;
 983                end List_Closure_Display;
 984             end if;
 985          end if;
 986       end if;
 987
 988       Total_Errors := Total_Errors + Errors_Detected;
 989       Total_Warnings := Total_Warnings + Warnings_Detected;
 990
 991    exception
 992       when Unrecoverable_Error =>
 993          Total_Errors := Total_Errors + Errors_Detected;
 994          Total_Warnings := Total_Warnings + Warnings_Detected;
 995    end;
 996
 997    --  All done. Set proper exit status
 998
 999    Finalize_Binderr;
1000    Namet.Finalize;
1001
1002    if Total_Errors > 0 then
1003       Exit_Program (E_Errors);
1004
1005    elsif Total_Warnings > 0 then
1006       Exit_Program (E_Warnings);
1007
1008    else
1009       --  Do not call Exit_Program (E_Success), so that finalization occurs
1010       --  normally.
1011
1012       null;
1013    end if;
1014 end Gnatbind;