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