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