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