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-2007, 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 2,  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 COPYING.  If not, write --
  19 -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
  20 -- Boston, MA 02110-1301, USA.                                              --
  21 --                                                                          --
  22 -- GNAT was originally developed  by the GNAT team at  New York University. --
  23 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  24 --                                                                          --
  25 ------------------------------------------------------------------------------
  26
  27 with ALI;      use ALI;
  28 with ALI.Util; use ALI.Util;
  29 with Bcheck;   use Bcheck;
  30 with Binde;    use Binde;
  31 with Binderr;  use Binderr;
  32 with Bindgen;  use Bindgen;
  33 with Bindusg;
  34 with Butil;    use Butil;
  35 with Casing;   use Casing;
  36 with Csets;
  37 with Debug;    use Debug;
  38 with Fmap;
  39 with Fname;    use Fname;
  40 with Namet;    use Namet;
  41 with Opt;      use Opt;
  42 with Osint;    use Osint;
  43 with Osint.B;  use Osint.B;
  44 with Output;   use Output;
  45 with Rident;   use Rident;
  46 with Snames;
  47 with Switch;   use Switch;
  48 with Switch.B; use Switch.B;
  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    Std_Lib_File : File_Name_Type;
  69    --  Standard library
  70
  71    Text     : Text_Buffer_Ptr;
  72    Next_Arg : Positive;
  73
  74    Output_File_Name_Seen : Boolean := False;
  75    Output_File_Name      : String_Ptr := new String'("");
  76
  77    L_Switch_Seen : Boolean := False;
  78
  79    Mapping_File : String_Ptr := null;
  80
  81    function Gnatbind_Supports_Auto_Init return Boolean;
  82    --  Indicates if automatic initialization of elaboration procedure
  83    --  through the constructor mechanism is possible on the platform.
  84
  85    procedure List_Applicable_Restrictions;
  86    --  List restrictions that apply to this partition if option taken
  87
  88    procedure Scan_Bind_Arg (Argv : String);
  89    --  Scan and process binder specific arguments. Argv is a single argument.
  90    --  All the one character arguments are still handled by Switch. This
  91    --  routine handles -aO -aI and -I-. The lower bound of Argv must be 1.
  92
  93    function Is_Cross_Compiler return Boolean;
  94    --  Returns True iff this is a cross-compiler
  95
  96    ---------------------------------
  97    -- Gnatbind_Supports_Auto_Init --
  98    ---------------------------------
  99
 100    function Gnatbind_Supports_Auto_Init return Boolean is
 101       function gnat_binder_supports_auto_init return Integer;
 102       pragma Import (C, gnat_binder_supports_auto_init,
 103                      "__gnat_binder_supports_auto_init");
 104    begin
 105       return gnat_binder_supports_auto_init /= 0;
 106    end Gnatbind_Supports_Auto_Init;
 107
 108    -----------------------
 109    -- Is_Cross_Compiler --
 110    -----------------------
 111
 112    function Is_Cross_Compiler return Boolean is
 113       Cross_Compiler : Integer;
 114       pragma Import (C, Cross_Compiler, "__gnat_is_cross_compiler");
 115    begin
 116       return Cross_Compiler = 1;
 117    end Is_Cross_Compiler;
 118
 119    ----------------------------------
 120    -- List_Applicable_Restrictions --
 121    ----------------------------------
 122
 123    procedure List_Applicable_Restrictions is
 124
 125       --  Define those restrictions that should be output if the gnatbind
 126       --  -r switch is used. Not all restrictions are output for the reasons
 127       --  given below in the list, and this array is used to test whether
 128       --  the corresponding pragma should be listed. True means that it
 129       --  should not be listed.
 130
 131       No_Restriction_List : constant array (All_Restrictions) of Boolean :=
 132         (No_Exception_Propagation => True,
 133          --  Modifies code resulting in different exception semantics
 134
 135          No_Exceptions            => True,
 136          --  Has unexpected Suppress (All_Checks) effect
 137
 138          No_Implicit_Conditionals => True,
 139          --  This could modify and pessimize generated code
 140
 141          No_Implicit_Dynamic_Code => True,
 142          --  This could modify and pessimize generated code
 143
 144          No_Implicit_Loops        => True,
 145          --  This could modify and pessimize generated code
 146
 147          No_Recursion             => True,
 148          --  Not checkable at compile time
 149
 150          No_Reentrancy            => True,
 151          --  Not checkable at compile time
 152
 153          Max_Entry_Queue_Length    => True,
 154          --  Not checkable at compile time
 155
 156          Max_Storage_At_Blocking  => True,
 157          --  Not checkable at compile time
 158
 159          others => False);
 160
 161       Additional_Restrictions_Listed : Boolean := False;
 162       --  Set True if we have listed header for restrictions
 163
 164    begin
 165       --  Loop through restrictions
 166
 167       for R in All_Restrictions loop
 168          if not No_Restriction_List (R) then
 169
 170             --  We list a restriction if it is not violated, or if
 171             --  it is violated but the violation count is exactly known.
 172
 173             if Cumulative_Restrictions.Violated (R) = False
 174               or else (R in All_Parameter_Restrictions
 175                        and then
 176                          Cumulative_Restrictions.Unknown (R) = False)
 177             then
 178                if not Additional_Restrictions_Listed then
 179                   Write_Eol;
 180                   Write_Line
 181                     ("The following additional restrictions may be" &
 182                      " applied to this partition:");
 183                   Additional_Restrictions_Listed := True;
 184                end if;
 185
 186                Write_Str ("pragma Restrictions (");
 187
 188                declare
 189                   S : constant String := Restriction_Id'Image (R);
 190                begin
 191                   Name_Len := S'Length;
 192                   Name_Buffer (1 .. Name_Len) := S;
 193                end;
 194
 195                Set_Casing (Mixed_Case);
 196                Write_Str (Name_Buffer (1 .. Name_Len));
 197
 198                if R in All_Parameter_Restrictions then
 199                   Write_Str (" => ");
 200                   Write_Int (Int (Cumulative_Restrictions.Count (R)));
 201                end if;
 202
 203                Write_Str (");");
 204                Write_Eol;
 205             end if;
 206          end if;
 207       end loop;
 208    end List_Applicable_Restrictions;
 209
 210    -------------------
 211    -- Scan_Bind_Arg --
 212    -------------------
 213
 214    procedure Scan_Bind_Arg (Argv : String) is
 215       pragma Assert (Argv'First = 1);
 216
 217    begin
 218       --  Now scan arguments that are specific to the binder and are not
 219       --  handled by the common circuitry in Switch.
 220
 221       if Opt.Output_File_Name_Present
 222         and then not Output_File_Name_Seen
 223       then
 224          Output_File_Name_Seen := True;
 225
 226          if Argv'Length = 0
 227            or else (Argv'Length >= 1 and then Argv (1) = '-')
 228          then
 229             Fail ("output File_Name missing after -o");
 230
 231          else
 232             Output_File_Name := new String'(Argv);
 233          end if;
 234
 235       elsif Argv'Length >= 2 and then Argv (1) = '-' then
 236
 237          --  -I-
 238
 239          if Argv (2 .. Argv'Last) = "I-" then
 240             Opt.Look_In_Primary_Dir := False;
 241
 242          --  -Idir
 243
 244          elsif Argv (2) = 'I' then
 245             Add_Src_Search_Dir (Argv (3 .. Argv'Last));
 246             Add_Lib_Search_Dir (Argv (3 .. Argv'Last));
 247
 248          --  -Ldir
 249
 250          elsif Argv (2) = 'L' then
 251             if Argv'Length >= 3 then
 252
 253                --  Remember that the -L switch was specified, so that if this
 254                --  is on OpenVMS, the export names are put in uppercase.
 255                --  This is not known before the target parameters are read.
 256
 257                L_Switch_Seen := True;
 258
 259                Opt.Bind_For_Library := True;
 260                Opt.Ada_Init_Name :=
 261                  new String'(Argv (3 .. Argv'Last) & Opt.Ada_Init_Suffix);
 262                Opt.Ada_Final_Name :=
 263                  new String'(Argv (3 .. Argv'Last) & Opt.Ada_Final_Suffix);
 264                Opt.Ada_Main_Name :=
 265                  new String'(Argv (3 .. Argv'Last) & Opt.Ada_Main_Name_Suffix);
 266
 267                --  This option (-Lxxx) implies -n
 268
 269                Opt.Bind_Main_Program := False;
 270
 271             else
 272                Fail
 273                  ("Prefix of initialization and finalization " &
 274                   "procedure names missing in -L");
 275             end if;
 276
 277          --  -Sin -Slo -Shi -Sxx -Sev
 278
 279          elsif Argv'Length = 4
 280            and then Argv (2) = 'S'
 281          then
 282             declare
 283                C1 : Character := Argv (3);
 284                C2 : Character := Argv (4);
 285
 286             begin
 287                --  Fold to upper case
 288
 289                if C1 in 'a' .. 'z' then
 290                   C1 := Character'Val (Character'Pos (C1) - 32);
 291                end if;
 292
 293                if C2 in 'a' .. 'z' then
 294                   C2 := Character'Val (Character'Pos (C2) - 32);
 295                end if;
 296
 297                --  Test valid option and set mode accordingly
 298
 299                if C1 = 'E' and then C2 = 'V' then
 300                   null;
 301
 302                elsif C1 = 'I' and then C2 = 'N' then
 303                   null;
 304
 305                elsif C1 = 'L' and then C2 = 'O' then
 306                   null;
 307
 308                elsif C1 = 'H' and then C2 = 'I' then
 309                   null;
 310
 311                elsif (C1 in '0' .. '9' or else C1 in 'A' .. 'F')
 312                        and then
 313                      (C2 in '0' .. '9' or else C2 in 'A' .. 'F')
 314                then
 315                   null;
 316
 317                --  Invalid -S switch, let Switch give error, set defalut of IN
 318
 319                else
 320                   Scan_Binder_Switches (Argv);
 321                   C1 := 'I';
 322                   C2 := 'N';
 323                end if;
 324
 325                Initialize_Scalars_Mode1 := C1;
 326                Initialize_Scalars_Mode2 := C2;
 327             end;
 328
 329          --  -aIdir
 330
 331          elsif Argv'Length >= 3
 332            and then Argv (2 .. 3) = "aI"
 333          then
 334             Add_Src_Search_Dir (Argv (4 .. Argv'Last));
 335
 336          --  -aOdir
 337
 338          elsif Argv'Length >= 3
 339            and then Argv (2 .. 3) = "aO"
 340          then
 341             Add_Lib_Search_Dir (Argv (4 .. Argv'Last));
 342
 343          --  -nostdlib
 344
 345          elsif Argv (2 .. Argv'Last) = "nostdlib" then
 346             Opt.No_Stdlib := True;
 347
 348          --  -nostdinc
 349
 350          elsif Argv (2 .. Argv'Last) = "nostdinc" then
 351             Opt.No_Stdinc := True;
 352
 353          --  -static
 354
 355          elsif Argv (2 .. Argv'Last) = "static" then
 356             Opt.Shared_Libgnat := False;
 357
 358          --  -shared
 359
 360          elsif Argv (2 .. Argv'Last) = "shared" then
 361             Opt.Shared_Libgnat := True;
 362
 363          --  -F=mapping_file
 364
 365          elsif Argv'Length >= 4 and then Argv (2 .. 3) = "F=" then
 366             if Mapping_File /= null then
 367                Fail ("cannot specify several mapping files");
 368             end if;
 369
 370             Mapping_File := new String'(Argv (4 .. Argv'Last));
 371
 372          --  -Mname
 373
 374          elsif Argv'Length >= 3 and then Argv (2) = 'M' then
 375             if not Is_Cross_Compiler then
 376                Write_Line
 377                  ("gnatbind: -M not expected to be used on native platforms");
 378             end if;
 379
 380             Opt.Bind_Alternate_Main_Name := True;
 381             Opt.Alternate_Main_Name := new String'(Argv (3 .. Argv'Last));
 382
 383          --  All other options are single character and are handled by
 384          --  Scan_Binder_Switches.
 385
 386          else
 387             Scan_Binder_Switches (Argv);
 388          end if;
 389
 390       --  Not a switch, so must be a file name (if non-empty)
 391
 392       elsif Argv'Length /= 0 then
 393          if Argv'Length > 4
 394            and then Argv (Argv'Last - 3 .. Argv'Last) = ".ali"
 395          then
 396             Add_File (Argv);
 397          else
 398             Add_File (Argv & ".ali");
 399          end if;
 400       end if;
 401    end Scan_Bind_Arg;
 402
 403 --  Start of processing for Gnatbind
 404
 405 begin
 406
 407    --  Set default for Shared_Libgnat option
 408
 409    declare
 410       Shared_Libgnat_Default : Character;
 411       pragma Import
 412         (C, Shared_Libgnat_Default, "__gnat_shared_libgnat_default");
 413
 414       SHARED : constant Character := 'H';
 415       STATIC : constant Character := 'T';
 416
 417    begin
 418       pragma Assert
 419         (Shared_Libgnat_Default = SHARED
 420          or else
 421         Shared_Libgnat_Default = STATIC);
 422       Shared_Libgnat := (Shared_Libgnat_Default = SHARED);
 423    end;
 424
 425    --  Scan the switches and arguments
 426
 427    --  First, scan to detect --version and/or --help
 428
 429    Check_Version_And_Help ("GNATBIND", "1995", Bindusg.Display'Access);
 430
 431    --  Use low level argument routines to avoid dragging in the secondary stack
 432
 433    Next_Arg := 1;
 434    Scan_Args : while Next_Arg < Arg_Count loop
 435       declare
 436          Next_Argv : String (1 .. Len_Arg (Next_Arg));
 437       begin
 438          Fill_Arg (Next_Argv'Address, Next_Arg);
 439
 440          if Next_Argv'Length > 0 then
 441             if Next_Argv (1) = '@' then
 442                if Next_Argv'Length > 1 then
 443                   declare
 444                      Arguments : constant Argument_List :=
 445                                    Response_File.Arguments_From
 446                                      (Response_File_Name        =>
 447                                         Next_Argv (2 .. Next_Argv'Last),
 448                                       Recursive                 => True,
 449                                       Ignore_Non_Existing_Files => True);
 450                   begin
 451                      for J in Arguments'Range loop
 452                         Scan_Bind_Arg (Arguments (J).all);
 453                      end loop;
 454                   end;
 455                end if;
 456
 457             else
 458                Scan_Bind_Arg (Next_Argv);
 459             end if;
 460          end if;
 461       end;
 462
 463       Next_Arg := Next_Arg + 1;
 464    end loop Scan_Args;
 465
 466    if Use_Pragma_Linker_Constructor then
 467       if Bind_Main_Program then
 468          Fail ("switch -a must be used in conjunction with -n or -Lxxx");
 469
 470       elsif not Gnatbind_Supports_Auto_Init then
 471          Fail ("automatic initialisation of elaboration " &
 472                "not supported on this platform");
 473       end if;
 474    end if;
 475
 476    --  Test for trailing -o switch
 477
 478    if Opt.Output_File_Name_Present
 479      and then not Output_File_Name_Seen
 480    then
 481       Fail ("output file name missing after -o");
 482    end if;
 483
 484    --  Output usage if requested
 485
 486    if Usage_Requested then
 487       Bindusg.Display;
 488    end if;
 489
 490    --  Check that the Ada binder file specified has extension .adb and that
 491    --  the C binder file has extension .c
 492
 493    if Opt.Output_File_Name_Present
 494      and then Output_File_Name_Seen
 495    then
 496       Check_Extensions : declare
 497          Length : constant Natural := Output_File_Name'Length;
 498          Last   : constant Natural := Output_File_Name'Last;
 499
 500       begin
 501          if Ada_Bind_File then
 502             if Length <= 4
 503               or else Output_File_Name (Last - 3 .. Last) /= ".adb"
 504             then
 505                Fail ("output file name should have .adb extension");
 506             end if;
 507
 508          else
 509             if Length <= 2
 510               or else Output_File_Name (Last - 1 .. Last) /= ".c"
 511             then
 512                Fail ("output file name should have .c extension");
 513             end if;
 514          end if;
 515       end Check_Extensions;
 516    end if;
 517
 518    Osint.Add_Default_Search_Dirs;
 519
 520    --  Carry out package initializations. These are initializations which
 521    --  might logically be performed at elaboration time, but Namet at least
 522    --  can't be done that way (because it is used in the Compiler), and we
 523    --  decide to be consistent. Like elaboration, the order in which these
 524    --  calls are made is in some cases important.
 525
 526    Csets.Initialize;
 527    Namet.Initialize;
 528    Snames.Initialize;
 529
 530    --  Acquire target parameters
 531
 532    Targparm.Get_Target_Parameters;
 533
 534    --  Initialize Cumulative_Restrictions with the restrictions on the target
 535    --  scanned from the system.ads file. Then as we read ALI files, we will
 536    --  accumulate additional restrictions specified in other files.
 537
 538    Cumulative_Restrictions := Targparm.Restrictions_On_Target;
 539
 540    --  On OpenVMS, when -L is used, all external names used in pragmas Export
 541    --  are in upper case. The reason is that on OpenVMS, the macro-assembler
 542    --  MACASM-32, used to build Stand-Alone Libraries, only understands
 543    --  uppercase.
 544
 545    if L_Switch_Seen and then OpenVMS_On_Target then
 546       To_Upper (Opt.Ada_Init_Name.all);
 547       To_Upper (Opt.Ada_Final_Name.all);
 548       To_Upper (Opt.Ada_Main_Name.all);
 549    end if;
 550
 551    --  Acquire configurable run-time mode
 552
 553    if Configurable_Run_Time_On_Target then
 554       Configurable_Run_Time_Mode := True;
 555    end if;
 556
 557    --  Output copyright notice if in verbose mode
 558
 559    if Verbose_Mode then
 560       Write_Eol;
 561       Display_Version ("GNATBIND", "1995");
 562    end if;
 563
 564    --  Output usage information if no files
 565
 566    if not More_Lib_Files then
 567       Bindusg.Display;
 568       Exit_Program (E_Fatal);
 569    end if;
 570
 571    --  If a mapping file was specified, initialize the file mapping
 572
 573    if Mapping_File /= null then
 574       Fmap.Initialize (Mapping_File.all);
 575    end if;
 576
 577    --  The block here is to catch the Unrecoverable_Error exception in the
 578    --  case where we exceed the maximum number of permissible errors or some
 579    --  other unrecoverable error occurs.
 580
 581    begin
 582       --  Initialize binder packages
 583
 584       Initialize_Binderr;
 585       Initialize_ALI;
 586       Initialize_ALI_Source;
 587
 588       if Verbose_Mode then
 589          Write_Eol;
 590       end if;
 591
 592       --  Input ALI files
 593
 594       while More_Lib_Files loop
 595          Main_Lib_File := Next_Main_Lib_File;
 596
 597          if Verbose_Mode then
 598             if Check_Only then
 599                Write_Str ("Checking: ");
 600             else
 601                Write_Str ("Binding: ");
 602             end if;
 603
 604             Write_Name (Main_Lib_File);
 605             Write_Eol;
 606          end if;
 607
 608          Text := Read_Library_Info (Main_Lib_File, True);
 609
 610          declare
 611             Id : ALI_Id;
 612             pragma Warnings (Off, Id);
 613
 614          begin
 615             Id := Scan_ALI
 616                     (F             => Main_Lib_File,
 617                      T             => Text,
 618                      Ignore_ED     => False,
 619                      Err           => False,
 620                      Ignore_Errors => Debug_Flag_I);
 621          end;
 622
 623          Free (Text);
 624       end loop;
 625
 626       --  No_Run_Time mode
 627
 628       if No_Run_Time_Mode then
 629
 630          --  Set standard configuration parameters
 631
 632          Suppress_Standard_Library_On_Target := True;
 633          Configurable_Run_Time_Mode          := True;
 634       end if;
 635
 636       --  For main ALI files, even if they are interfaces, we get their
 637       --  dependencies. To be sure, we reset the Interface flag for all main
 638       --  ALI files.
 639
 640       for Index in ALIs.First .. ALIs.Last loop
 641          ALIs.Table (Index).SAL_Interface := False;
 642       end loop;
 643
 644       --  Add System.Standard_Library to list to ensure that these files are
 645       --  included in the bind, even if not directly referenced from Ada code
 646       --  This is suppressed if the appropriate targparm switch is set.
 647
 648       if not Suppress_Standard_Library_On_Target then
 649          Name_Buffer (1 .. 12) := "s-stalib.ali";
 650          Name_Len := 12;
 651          Std_Lib_File := Name_Find;
 652          Text := Read_Library_Info (Std_Lib_File, True);
 653
 654          declare
 655             Id : ALI_Id;
 656             pragma Warnings (Off, Id);
 657
 658          begin
 659             Id :=
 660               Scan_ALI
 661                 (F             => Std_Lib_File,
 662                  T             => Text,
 663                  Ignore_ED     => False,
 664                  Err           => False,
 665                  Ignore_Errors => Debug_Flag_I);
 666          end;
 667
 668          Free (Text);
 669       end if;
 670
 671       --  Acquire all information in ALI files that have been read in
 672
 673       for Index in ALIs.First .. ALIs.Last loop
 674          Read_ALI (Index);
 675       end loop;
 676
 677       --  Quit if some file needs compiling
 678
 679       if No_Object_Specified then
 680          raise Unrecoverable_Error;
 681       end if;
 682
 683       --  Build source file table from the ALI files we have read in
 684
 685       Set_Source_Table;
 686
 687       --  Check that main library file is a suitable main program
 688
 689       if Bind_Main_Program
 690         and then ALIs.Table (ALIs.First).Main_Program = None
 691         and then not No_Main_Subprogram
 692       then
 693          Error_Msg_File_1 := Main_Lib_File;
 694          Error_Msg ("% does not contain a unit that can be a main program");
 695       end if;
 696
 697       --  Perform consistency and correctness checks
 698
 699       Check_Duplicated_Subunits;
 700       Check_Versions;
 701       Check_Consistency;
 702       Check_Configuration_Consistency;
 703
 704       --  List restrictions that could be applied to this partition
 705
 706       if List_Restrictions then
 707          List_Applicable_Restrictions;
 708       end if;
 709
 710       --  Complete bind if no errors
 711
 712       if Errors_Detected = 0 then
 713          Find_Elab_Order;
 714
 715          if Errors_Detected = 0 then
 716             --  Display elaboration order if -l was specified
 717
 718             if Elab_Order_Output then
 719                if not Zero_Formatting then
 720                   Write_Eol;
 721                   Write_Str ("ELABORATION ORDER");
 722                   Write_Eol;
 723                end if;
 724
 725                for J in Elab_Order.First .. Elab_Order.Last loop
 726                   if not Units.Table (Elab_Order.Table (J)).SAL_Interface then
 727                      if not Zero_Formatting then
 728                         Write_Str ("   ");
 729                      end if;
 730
 731                      Write_Unit_Name
 732                        (Units.Table (Elab_Order.Table (J)).Uname);
 733                      Write_Eol;
 734                   end if;
 735                end loop;
 736
 737                if not Zero_Formatting then
 738                   Write_Eol;
 739                end if;
 740             end if;
 741
 742             if not Check_Only then
 743                Gen_Output_File (Output_File_Name.all);
 744             end if;
 745
 746             --  Display list of sources in the closure (except predefined
 747             --  sources) if -R was used.
 748
 749             if List_Closure then
 750                if not Zero_Formatting then
 751                   Write_Eol;
 752                   Write_Str ("REFERENCED SOURCES");
 753                   Write_Eol;
 754                end if;
 755
 756                for J in reverse Elab_Order.First .. Elab_Order.Last loop
 757
 758                   --  Do not include the sources of the runtime
 759
 760                   if not Is_Internal_File_Name
 761                            (Units.Table (Elab_Order.Table (J)).Sfile)
 762                   then
 763                      if not Zero_Formatting then
 764                         Write_Str ("   ");
 765                      end if;
 766
 767                      Write_Str
 768                        (Get_Name_String
 769                           (Units.Table (Elab_Order.Table (J)).Sfile));
 770                      Write_Eol;
 771                   end if;
 772                end loop;
 773
 774                if not Zero_Formatting then
 775                   Write_Eol;
 776                end if;
 777             end if;
 778          end if;
 779       end if;
 780
 781       Total_Errors := Total_Errors + Errors_Detected;
 782       Total_Warnings := Total_Warnings + Warnings_Detected;
 783
 784    exception
 785       when Unrecoverable_Error =>
 786          Total_Errors := Total_Errors + Errors_Detected;
 787          Total_Warnings := Total_Warnings + Warnings_Detected;
 788    end;
 789
 790    --  All done. Set proper exit status
 791
 792    Finalize_Binderr;
 793    Namet.Finalize;
 794
 795    if Total_Errors > 0 then
 796       Exit_Program (E_Errors);
 797
 798    elsif Total_Warnings > 0 then
 799       Exit_Program (E_Warnings);
 800
 801    else
 802       --  Do not call Exit_Program (E_Success), so that finalization occurs
 803       --  normally.
 804
 805       null;
 806    end if;
 807
 808 end Gnatbind;