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