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