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, and we decide to be
 587    --  consistent. Like elaboration, the order in which these calls are made
 588    --  is in some cases important.
 589
 590    Csets.Initialize;
 591    Snames.Initialize;
 592
 593    --  Acquire target parameters
 594
 595    Targparm.Get_Target_Parameters;
 596
 597    --  Initialize Cumulative_Restrictions with the restrictions on the target
 598    --  scanned from the system.ads file. Then as we read ALI files, we will
 599    --  accumulate additional restrictions specified in other files.
 600
 601    Cumulative_Restrictions := Targparm.Restrictions_On_Target;
 602
 603    --  On OpenVMS, when -L is used, all external names used in pragmas Export
 604    --  are in upper case. The reason is that on OpenVMS, the macro-assembler
 605    --  MACASM-32, used to build Stand-Alone Libraries, only understands
 606    --  uppercase.
 607
 608    if L_Switch_Seen and then OpenVMS_On_Target then
 609       To_Upper (Opt.Ada_Init_Name.all);
 610       To_Upper (Opt.Ada_Final_Name.all);
 611       To_Upper (Opt.Ada_Main_Name.all);
 612    end if;
 613
 614    --  Acquire configurable run-time mode
 615
 616    if Configurable_Run_Time_On_Target then
 617       Configurable_Run_Time_Mode := True;
 618    end if;
 619
 620    --  Output copyright notice if in verbose mode
 621
 622    if Verbose_Mode then
 623       Write_Eol;
 624       Display_Version ("GNATBIND", "1995");
 625    end if;
 626
 627    --  Output usage information if no files
 628
 629    if not More_Lib_Files then
 630       Bindusg.Display;
 631       Exit_Program (E_Fatal);
 632    end if;
 633
 634    --  If a mapping file was specified, initialize the file mapping
 635
 636    if Mapping_File /= null then
 637       Fmap.Initialize (Mapping_File.all);
 638    end if;
 639
 640    --  The block here is to catch the Unrecoverable_Error exception in the
 641    --  case where we exceed the maximum number of permissible errors or some
 642    --  other unrecoverable error occurs.
 643
 644    begin
 645       --  Initialize binder packages
 646
 647       Initialize_Binderr;
 648       Initialize_ALI;
 649       Initialize_ALI_Source;
 650
 651       if Verbose_Mode then
 652          Write_Eol;
 653       end if;
 654
 655       --  Input ALI files
 656
 657       while More_Lib_Files loop
 658          Main_Lib_File := Next_Main_Lib_File;
 659
 660          if First_Main_Lib_File = No_File then
 661             First_Main_Lib_File := Main_Lib_File;
 662          end if;
 663
 664          if Verbose_Mode then
 665             if Check_Only then
 666                Write_Str ("Checking: ");
 667             else
 668                Write_Str ("Binding: ");
 669             end if;
 670
 671             Write_Name (Main_Lib_File);
 672             Write_Eol;
 673          end if;
 674
 675          Text := Read_Library_Info (Main_Lib_File, True);
 676
 677          declare
 678             Id : ALI_Id;
 679             pragma Warnings (Off, Id);
 680
 681          begin
 682             Id := Scan_ALI
 683                     (F                => Main_Lib_File,
 684                      T                => Text,
 685                      Ignore_ED        => False,
 686                      Err              => False,
 687                      Ignore_Errors    => Debug_Flag_I,
 688                      Directly_Scanned => True);
 689          end;
 690
 691          Free (Text);
 692       end loop;
 693
 694       --  No_Run_Time mode
 695
 696       if No_Run_Time_Mode then
 697
 698          --  Set standard configuration parameters
 699
 700          Suppress_Standard_Library_On_Target := True;
 701          Configurable_Run_Time_Mode          := True;
 702       end if;
 703
 704       --  For main ALI files, even if they are interfaces, we get their
 705       --  dependencies. To be sure, we reset the Interface flag for all main
 706       --  ALI files.
 707
 708       for Index in ALIs.First .. ALIs.Last loop
 709          ALIs.Table (Index).SAL_Interface := False;
 710       end loop;
 711
 712       --  Add System.Standard_Library to list to ensure that these files are
 713       --  included in the bind, even if not directly referenced from Ada code
 714       --  This is suppressed if the appropriate targparm switch is set.
 715
 716       if not Suppress_Standard_Library_On_Target then
 717          Name_Buffer (1 .. 12) := "s-stalib.ali";
 718          Name_Len := 12;
 719          Std_Lib_File := Name_Find;
 720          Text := Read_Library_Info (Std_Lib_File, True);
 721
 722          declare
 723             Id : ALI_Id;
 724             pragma Warnings (Off, Id);
 725
 726          begin
 727             Id :=
 728               Scan_ALI
 729                 (F             => Std_Lib_File,
 730                  T             => Text,
 731                  Ignore_ED     => False,
 732                  Err           => False,
 733                  Ignore_Errors => Debug_Flag_I);
 734          end;
 735
 736          Free (Text);
 737       end if;
 738
 739       --  Load ALIs for all dependent units
 740
 741       for Index in ALIs.First .. ALIs.Last loop
 742          Read_Withed_ALIs (Index);
 743       end loop;
 744
 745       --  Quit if some file needs compiling
 746
 747       if No_Object_Specified then
 748          raise Unrecoverable_Error;
 749       end if;
 750
 751       --  Output list of ALI files in closure
 752
 753       if Output_ALI_List then
 754          if ALI_List_Filename /= null then
 755             Set_List_File (ALI_List_Filename.all);
 756          end if;
 757
 758          for Index in ALIs.First .. ALIs.Last loop
 759             declare
 760                Full_Afile : constant File_Name_Type :=
 761                               Find_File (ALIs.Table (Index).Afile, Library);
 762             begin
 763                Write_Name (Full_Afile);
 764                Write_Eol;
 765             end;
 766          end loop;
 767
 768          if ALI_List_Filename /= null then
 769             Close_List_File;
 770          end if;
 771       end if;
 772
 773       --  Build source file table from the ALI files we have read in
 774
 775       Set_Source_Table;
 776
 777       --  If there is main program to bind, set Main_Lib_File to the first
 778       --  library file, and the name from which to derive the binder generate
 779       --  file to the first ALI file.
 780
 781       if Bind_Main_Program then
 782          Main_Lib_File := First_Main_Lib_File;
 783          Set_Current_File_Name_Index (To => 1);
 784       end if;
 785
 786       --  Check that main library file is a suitable main program
 787
 788       if Bind_Main_Program
 789         and then ALIs.Table (ALIs.First).Main_Program = None
 790         and then not No_Main_Subprogram
 791       then
 792          Error_Msg_File_1 := Main_Lib_File;
 793          Error_Msg ("{ does not contain a unit that can be a main program");
 794       end if;
 795
 796       --  Perform consistency and correctness checks
 797
 798       Check_Duplicated_Subunits;
 799       Check_Versions;
 800       Check_Consistency;
 801       Check_Configuration_Consistency;
 802
 803       --  List restrictions that could be applied to this partition
 804
 805       if List_Restrictions then
 806          List_Applicable_Restrictions;
 807       end if;
 808
 809       --  Complete bind if no errors
 810
 811       if Errors_Detected = 0 then
 812          Find_Elab_Order;
 813
 814          if Errors_Detected = 0 then
 815             --  Display elaboration order if -l was specified
 816
 817             if Elab_Order_Output then
 818                if not Zero_Formatting then
 819                   Write_Eol;
 820                   Write_Str ("ELABORATION ORDER");
 821                   Write_Eol;
 822                end if;
 823
 824                for J in Elab_Order.First .. Elab_Order.Last loop
 825                   if not Units.Table (Elab_Order.Table (J)).SAL_Interface then
 826                      if not Zero_Formatting then
 827                         Write_Str ("   ");
 828                      end if;
 829
 830                      Write_Unit_Name
 831                        (Units.Table (Elab_Order.Table (J)).Uname);
 832                      Write_Eol;
 833                   end if;
 834                end loop;
 835
 836                if not Zero_Formatting then
 837                   Write_Eol;
 838                end if;
 839             end if;
 840
 841             if not Check_Only then
 842                Gen_Output_File (Output_File_Name.all);
 843             end if;
 844
 845             --  Display list of sources in the closure (except predefined
 846             --  sources) if -R was used.
 847
 848             if List_Closure then
 849                List_Closure_Display : declare
 850                   Source : File_Name_Type;
 851
 852                   function Put_In_Sources (S : File_Name_Type) return Boolean;
 853                   --  Check if S is already in table Sources and put in Sources
 854                   --  if it is not. Return False if the source is already in
 855                   --  Sources, and True if it is added.
 856
 857                   --------------------
 858                   -- Put_In_Sources --
 859                   --------------------
 860
 861                   function Put_In_Sources (S : File_Name_Type)
 862                                            return Boolean
 863                   is
 864                   begin
 865                      for J in 1 .. Closure_Sources.Last loop
 866                         if Closure_Sources.Table (J) = S then
 867                            return False;
 868                         end if;
 869                      end loop;
 870
 871                      Closure_Sources.Append (S);
 872                      return True;
 873                   end Put_In_Sources;
 874
 875                --  Start of processing for List_Closure_Display
 876
 877                begin
 878                   Closure_Sources.Init;
 879
 880                   if not Zero_Formatting then
 881                      Write_Eol;
 882                      Write_Str ("REFERENCED SOURCES");
 883                      Write_Eol;
 884                   end if;
 885
 886                   for J in reverse Elab_Order.First .. Elab_Order.Last loop
 887                      Source := Units.Table (Elab_Order.Table (J)).Sfile;
 888
 889                      --  Do not include the sources of the runtime and do not
 890                      --  include the same source several times.
 891
 892                      if Put_In_Sources (Source)
 893                        and then not Is_Internal_File_Name (Source)
 894                      then
 895                         if not Zero_Formatting then
 896                            Write_Str ("   ");
 897                         end if;
 898
 899                         Write_Str (Get_Name_String (Source));
 900                         Write_Eol;
 901                      end if;
 902                   end loop;
 903
 904                   --  Subunits do not appear in the elaboration table because
 905                   --  they are subsumed by their parent units, but we need to
 906                   --  list them for other tools. For now they are listed after
 907                   --  other files, rather than right after their parent, since
 908                   --  there is no easy link between the elaboration table and
 909                   --  the ALIs table ??? As subunits may appear repeatedly in
 910                   --  the list, if the parent unit appears in the context of
 911                   --  several units in the closure, duplicates are suppressed.
 912
 913                   for J in Sdep.First .. Sdep.Last loop
 914                      Source := Sdep.Table (J).Sfile;
 915
 916                      if Sdep.Table (J).Subunit_Name /= No_Name
 917                        and then Put_In_Sources (Source)
 918                        and then not Is_Internal_File_Name (Source)
 919                      then
 920                         if not Zero_Formatting then
 921                            Write_Str ("   ");
 922                         end if;
 923
 924                         Write_Str (Get_Name_String (Source));
 925                         Write_Eol;
 926                      end if;
 927                   end loop;
 928
 929                   if not Zero_Formatting then
 930                      Write_Eol;
 931                   end if;
 932                end List_Closure_Display;
 933             end if;
 934          end if;
 935       end if;
 936
 937       Total_Errors := Total_Errors + Errors_Detected;
 938       Total_Warnings := Total_Warnings + Warnings_Detected;
 939
 940    exception
 941       when Unrecoverable_Error =>
 942          Total_Errors := Total_Errors + Errors_Detected;
 943          Total_Warnings := Total_Warnings + Warnings_Detected;
 944    end;
 945
 946    --  All done. Set proper exit status
 947
 948    Finalize_Binderr;
 949    Namet.Finalize;
 950
 951    if Total_Errors > 0 then
 952       Exit_Program (E_Errors);
 953
 954    elsif Total_Warnings > 0 then
 955       Exit_Program (E_Warnings);
 956
 957    else
 958       --  Do not call Exit_Program (E_Success), so that finalization occurs
 959       --  normally.
 960
 961       null;
 962    end if;
 963
 964 end Gnatbind;