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