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