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