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