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       --  Acquire all information in ALI files that have been read in
 742
 743       for Index in ALIs.First .. ALIs.Last loop
 744          Read_ALI (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       --  Build source file table from the ALI files we have read in
 754
 755       Set_Source_Table;
 756
 757       --  If there is main program to bind, set Main_Lib_File to the first
 758       --  library file, and the name from which to derive the binder generate
 759       --  file to the first ALI file.
 760
 761       if Bind_Main_Program then
 762          Main_Lib_File := First_Main_Lib_File;
 763          Set_Current_File_Name_Index (To => 1);
 764       end if;
 765
 766       --  Check that main library file is a suitable main program
 767
 768       if Bind_Main_Program
 769         and then ALIs.Table (ALIs.First).Main_Program = None
 770         and then not No_Main_Subprogram
 771       then
 772          Error_Msg_File_1 := Main_Lib_File;
 773          Error_Msg ("{ does not contain a unit that can be a main program");
 774       end if;
 775
 776       --  Perform consistency and correctness checks
 777
 778       Check_Duplicated_Subunits;
 779       Check_Versions;
 780       Check_Consistency;
 781       Check_Configuration_Consistency;
 782
 783       --  List restrictions that could be applied to this partition
 784
 785       if List_Restrictions then
 786          List_Applicable_Restrictions;
 787       end if;
 788
 789       --  Complete bind if no errors
 790
 791       if Errors_Detected = 0 then
 792          Find_Elab_Order;
 793
 794          if Errors_Detected = 0 then
 795             --  Display elaboration order if -l was specified
 796
 797             if Elab_Order_Output then
 798                if not Zero_Formatting then
 799                   Write_Eol;
 800                   Write_Str ("ELABORATION ORDER");
 801                   Write_Eol;
 802                end if;
 803
 804                for J in Elab_Order.First .. Elab_Order.Last loop
 805                   if not Units.Table (Elab_Order.Table (J)).SAL_Interface then
 806                      if not Zero_Formatting then
 807                         Write_Str ("   ");
 808                      end if;
 809
 810                      Write_Unit_Name
 811                        (Units.Table (Elab_Order.Table (J)).Uname);
 812                      Write_Eol;
 813                   end if;
 814                end loop;
 815
 816                if not Zero_Formatting then
 817                   Write_Eol;
 818                end if;
 819             end if;
 820
 821             if not Check_Only then
 822                Gen_Output_File (Output_File_Name.all);
 823             end if;
 824
 825             --  Display list of sources in the closure (except predefined
 826             --  sources) if -R was used.
 827
 828             if List_Closure then
 829                List_Closure_Display : declare
 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 .. Closure_Sources.Last loop
 846                         if Closure_Sources.Table (J) = S then
 847                            return False;
 848                         end if;
 849                      end loop;
 850
 851                      Closure_Sources.Append (S);
 852                      return True;
 853                   end Put_In_Sources;
 854
 855                --  Start of processing for List_Closure_Display
 856
 857                begin
 858                   Closure_Sources.Init;
 859
 860                   if not Zero_Formatting then
 861                      Write_Eol;
 862                      Write_Str ("REFERENCED SOURCES");
 863                      Write_Eol;
 864                   end if;
 865
 866                   for J in reverse Elab_Order.First .. Elab_Order.Last loop
 867                      Source := Units.Table (Elab_Order.Table (J)).Sfile;
 868
 869                      --  Do not include the sources of the runtime and do not
 870                      --  include the same source several times.
 871
 872                      if Put_In_Sources (Source)
 873                        and then not Is_Internal_File_Name (Source)
 874                      then
 875                         if not Zero_Formatting then
 876                            Write_Str ("   ");
 877                         end if;
 878
 879                         Write_Str (Get_Name_String (Source));
 880                         Write_Eol;
 881                      end if;
 882                   end loop;
 883
 884                   --  Subunits do not appear in the elaboration table because
 885                   --  they are subsumed by their parent units, but we need to
 886                   --  list them for other tools. For now they are listed after
 887                   --  other files, rather than right after their parent, since
 888                   --  there is no easy link between the elaboration table and
 889                   --  the ALIs table ??? As subunits may appear repeatedly in
 890                   --  the list, if the parent unit appears in the context of
 891                   --  several units in the closure, duplicates are suppressed.
 892
 893                   for J in Sdep.First .. Sdep.Last loop
 894                      Source := Sdep.Table (J).Sfile;
 895
 896                      if Sdep.Table (J).Subunit_Name /= No_Name
 897                        and then Put_In_Sources (Source)
 898                        and then not Is_Internal_File_Name (Source)
 899                      then
 900                         if not Zero_Formatting then
 901                            Write_Str ("   ");
 902                         end if;
 903
 904                         Write_Str (Get_Name_String (Source));
 905                         Write_Eol;
 906                      end if;
 907                   end loop;
 908
 909                   if not Zero_Formatting then
 910                      Write_Eol;
 911                   end if;
 912                end List_Closure_Display;
 913             end if;
 914          end if;
 915       end if;
 916
 917       Total_Errors := Total_Errors + Errors_Detected;
 918       Total_Warnings := Total_Warnings + Warnings_Detected;
 919
 920    exception
 921       when Unrecoverable_Error =>
 922          Total_Errors := Total_Errors + Errors_Detected;
 923          Total_Warnings := Total_Warnings + Warnings_Detected;
 924    end;
 925
 926    --  All done. Set proper exit status
 927
 928    Finalize_Binderr;
 929    Namet.Finalize;
 930
 931    if Total_Errors > 0 then
 932       Exit_Program (E_Errors);
 933
 934    elsif Total_Warnings > 0 then
 935       Exit_Program (E_Warnings);
 936
 937    else
 938       --  Do not call Exit_Program (E_Success), so that finalization occurs
 939       --  normally.
 940
 941       null;
 942    end if;
 943
 944 end Gnatbind;