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