gcc/ada/gnatlink.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                             G N A T L I N K                              --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --          Copyright (C) 1996-2024, 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 --  Gnatlink usage: please consult the gnat documentation
  27
  28 with ALI;      use ALI;
  29 with Csets;
  30 with Gnatvsn;  use Gnatvsn;
  31 with Indepsw;  use Indepsw;
  32 with Namet;    use Namet;
  33 with Opt;
  34 with Osint;    use Osint;
  35 with Output;   use Output;
  36 with Snames;
  37 with Switch;   use Switch;
  38 with System;   use System;
  39 with Table;
  40 with Targparm;
  41 with Types;
  42
  43 with Ada.Command_Line; use Ada.Command_Line;
  44 with Ada.Exceptions;   use Ada.Exceptions;
  45
  46 with System.OS_Lib; use System.OS_Lib;
  47 with System.CRTL;
  48
  49 with Interfaces.C_Streams; use Interfaces.C_Streams;
  50 with Interfaces.C.Strings; use Interfaces.C.Strings;
  51
  52 procedure Gnatlink is
  53    pragma Ident (Gnatvsn.Gnat_Static_Version_String);
  54
  55    Shared_Libgcc_String : constant String := "-shared-libgcc";
  56    Shared_Libgcc        : constant String_Access :=
  57                             new String'(Shared_Libgcc_String);
  58    --  Used to invoke gcc when the binder is invoked with -shared
  59
  60    Static_Libgcc_String : constant String := "-static-libgcc";
  61    Static_Libgcc        : constant String_Access :=
  62                             new String'(Static_Libgcc_String);
  63    --  Used to invoke gcc when shared libs are not used
  64
  65    package Gcc_Linker_Options is new Table.Table (
  66      Table_Component_Type => String_Access,
  67      Table_Index_Type     => Integer,
  68      Table_Low_Bound      => 1,
  69      Table_Initial        => 20,
  70      Table_Increment      => 100,
  71      Table_Name           => "Gnatlink.Gcc_Linker_Options");
  72    --  Options to be passed to the gcc linker
  73
  74    package Libpath is new Table.Table (
  75      Table_Component_Type => Character,
  76      Table_Index_Type     => Integer,
  77      Table_Low_Bound      => 1,
  78      Table_Initial        => 4096,
  79      Table_Increment      => 100,
  80      Table_Name           => "Gnatlink.Libpath");
  81    --  Library search path
  82
  83    package Linker_Options is new Table.Table (
  84      Table_Component_Type => String_Access,
  85      Table_Index_Type     => Integer,
  86      Table_Low_Bound      => 1,
  87      Table_Initial        => 20,
  88      Table_Increment      => 100,
  89      Table_Name           => "Gnatlink.Linker_Options");
  90    --  Options to be passed to gnatlink
  91
  92    package Linker_Objects is new Table.Table (
  93      Table_Component_Type => String_Access,
  94      Table_Index_Type     => Integer,
  95      Table_Low_Bound      => 1,
  96      Table_Initial        => 20,
  97      Table_Increment      => 100,
  98      Table_Name           => "Gnatlink.Linker_Objects");
  99    --  This table collects the objects file to be passed to the linker. In the
 100    --  case where the linker command line is too long then programs objects
 101    --  are put on the Response_File_Objects table. Note that the binder object
 102    --  file and the user's objects remain in this table. This is very
 103    --  important because on the GNU linker command line the -L switch is not
 104    --  used to look for objects files but -L switch is used to look for
 105    --  objects listed in the response file. This is not a problem with the
 106    --  applications objects as they are specified with a full name.
 107
 108    package Response_File_Objects is new Table.Table (
 109      Table_Component_Type => String_Access,
 110      Table_Index_Type     => Integer,
 111      Table_Low_Bound      => 1,
 112      Table_Initial        => 20,
 113      Table_Increment      => 100,
 114      Table_Name           => "Gnatlink.Response_File_Objects");
 115    --  This table collects the objects file that are to be put in the response
 116    --  file. Only application objects are collected there (see details in
 117    --  Linker_Objects table comments)
 118
 119    package Binder_Options_From_ALI is new Table.Table (
 120      Table_Component_Type => String_Access,
 121      Table_Index_Type     => Integer,
 122      Table_Low_Bound      => 1, -- equals low bound of Argument_List for Spawn
 123      Table_Initial        => 20,
 124      Table_Increment      => 100,
 125      Table_Name           => "Gnatlink.Binder_Options_From_ALI");
 126    --  This table collects the switches from the ALI file of the main
 127    --  subprogram.
 128
 129    package Binder_Options is new Table.Table (
 130      Table_Component_Type => String_Access,
 131      Table_Index_Type     => Integer,
 132      Table_Low_Bound      => 1, -- equals low bound of Argument_List for Spawn
 133      Table_Initial        => 20,
 134      Table_Increment      => 100,
 135      Table_Name           => "Gnatlink.Binder_Options");
 136    --  This table collects the arguments to be passed to compile the binder
 137    --  generated file.
 138
 139    Gcc : String_Access := Program_Name ("gcc", "gnatlink");
 140
 141    Read_Mode : constant String := "r" & ASCII.NUL;
 142
 143    Begin_Info : constant String := "--  BEGIN Object file/option list";
 144    End_Info   : constant String := "--  END Object file/option list   ";
 145
 146    Gcc_Path             : String_Access;
 147    Linker_Path          : String_Access;
 148    Output_File_Name     : String_Access;
 149    Ali_File_Name        : String_Access;
 150    Binder_Spec_Src_File : String_Access;
 151    Binder_Body_Src_File : String_Access;
 152    Binder_Ali_File      : String_Access;
 153    Binder_Obj_File      : String_Access;
 154
 155    Base_Command_Name    : String_Access;
 156
 157    Target_Debuggable_Suffix : String_Access;
 158
 159    Tname    : Temp_File_Name;
 160    Tname_FD : File_Descriptor := Invalid_FD;
 161    --  Temporary file used by linker to pass list of object files on
 162    --  certain systems with limitations on size of arguments.
 163
 164    Debug_Flag_Present : Boolean := False;
 165    Verbose_Mode       : Boolean := False;
 166    Very_Verbose_Mode  : Boolean := False;
 167
 168    Standard_Gcc : Boolean := True;
 169
 170    Compile_Bind_File : Boolean := True;
 171    --  Set to False if bind file is not to be compiled
 172
 173    Create_Map_File : Boolean := False;
 174    --  Set to True by switch -M. The map file name is derived from
 175    --  the ALI file name (mainprog.ali => mainprog.map).
 176
 177    Object_List_File_Supported : Boolean;
 178    for Object_List_File_Supported'Size use Character'Size;
 179    pragma Import
 180      (C, Object_List_File_Supported, "__gnat_objlist_file_supported");
 181    --  Predicate indicating whether the linker has an option whereby the
 182    --  names of object files can be passed to the linker in a file.
 183
 184    Object_File_Option_Ptr : Interfaces.C.Strings.chars_ptr;
 185    pragma Import (C, Object_File_Option_Ptr, "__gnat_object_file_option");
 186    --  Pointer to a string representing the linker option which specifies
 187    --  the response file.
 188
 189    Object_File_Option : constant String := Value (Object_File_Option_Ptr);
 190    --  The linker option which specifies the response file as a string
 191
 192    Using_GNU_response_file : constant Boolean :=
 193      Object_File_Option'Length > 0
 194        and then Object_File_Option (Object_File_Option'Last) = '@';
 195    --  Whether a GNU response file is used
 196
 197    Object_List_File_Required : Boolean := False;
 198    --  Set to True to force generation of a response file
 199
 200    Shared_Libgcc_Default : Character;
 201    for Shared_Libgcc_Default'Size use Character'Size;
 202    pragma Import
 203      (C, Shared_Libgcc_Default, "__gnat_shared_libgcc_default");
 204    --  Indicates wether libgcc should be statically linked (use 'T') or
 205    --  dynamically linked (use 'H') by default.
 206
 207    Link_Max : Integer;
 208    pragma Import (C, Link_Max, "__gnat_link_max");
 209    --  Maximum number of bytes on the command line supported by the OS
 210    --  linker. Passed this limit the response file mechanism must be used
 211    --  if supported.
 212
 213    Run_Path_Option_Ptr : Interfaces.C.Strings.chars_ptr;
 214    pragma Import (C, Run_Path_Option_Ptr, "__gnat_run_path_option");
 215    --  Pointer to string representing the native linker option which
 216    --  specifies the path where the dynamic loader should find shared
 217    --  libraries. Equal to null string if this system doesn't support it.
 218
 219    Libgcc_Subdir_Ptr : Interfaces.C.Strings.chars_ptr;
 220    pragma Import (C, Libgcc_Subdir_Ptr, "__gnat_default_libgcc_subdir");
 221    --  Pointer to string indicating the installation subdirectory where
 222    --  a default shared libgcc might be found.
 223
 224    Object_Library_Ext_Ptr : Interfaces.C.Strings.chars_ptr;
 225    pragma Import
 226      (C, Object_Library_Ext_Ptr, "__gnat_object_library_extension");
 227    --  Pointer to string specifying the default extension for
 228    --  object libraries, e.g. Unix uses ".a".
 229
 230    Separate_Run_Path_Options : Boolean;
 231    for Separate_Run_Path_Options'Size use Character'Size;
 232    pragma Import
 233      (C, Separate_Run_Path_Options, "__gnat_separate_run_path_options");
 234    --  Whether separate rpath options should be emitted for each directory
 235
 236    function Get_Maximum_File_Name_Length return Integer;
 237    pragma Import (C, Get_Maximum_File_Name_Length,
 238                      "__gnat_get_maximum_file_name_length");
 239
 240    function Base_Name (File_Name : String) return String;
 241    --  Return just the file name part without the extension (if present)
 242
 243    procedure Check_Existing_Executable (File_Name : String);
 244    --  Delete any existing executable to avoid accidentally updating the target
 245    --  of a symbolic link, but produce a Fatal_Error if File_Name matches any
 246    --  of the source file names. This avoids overwriting of extensionless
 247    --  source files by accident on systems where executables do not have
 248    --  extensions.
 249
 250    procedure Delete (Name : String);
 251    --  Wrapper to unlink as status is ignored by this application
 252
 253    procedure Error_Msg (Message : String);
 254    --  Output the error or warning Message
 255
 256    procedure Exit_With_Error (Error : String);
 257    --  Output Error and exit program with a fatal condition
 258
 259    procedure Process_Args;
 260    --  Go through all the arguments and build option tables
 261
 262    procedure Process_Binder_File (Name : String);
 263    --  Reads the binder file and extracts linker arguments
 264
 265    function Index (S, Pattern : String) return Natural;
 266    --  Return the last occurrence of Pattern in S, or 0 if none
 267
 268    procedure Search_Library_Path
 269      (Next_Line   : String;
 270       Nfirst      : Integer;
 271       Nlast       : Integer;
 272       Last        : Integer;
 273       GNAT_Static : Boolean;
 274       GNAT_Shared : Boolean);
 275    --  Given a Gnat standard library, search the library path to find the
 276    --  library location. Parameters are documented in Process_Binder_File.
 277
 278    procedure Usage;
 279    --  Display usage
 280
 281    procedure Write_Header;
 282    --  Show user the program name, version and copyright
 283
 284    procedure Write_Usage;
 285    --  Show user the program options
 286
 287    ---------------
 288    -- Base_Name --
 289    ---------------
 290
 291    function Base_Name (File_Name : String) return String is
 292       Findex1 : Natural;
 293       Findex2 : Natural;
 294
 295    begin
 296       Findex1 := File_Name'First;
 297
 298       --  The file might be specified by a full path name. However,
 299       --  we want the path to be stripped away.
 300
 301       for J in reverse File_Name'Range loop
 302          if Is_Directory_Separator (File_Name (J)) then
 303             Findex1 := J + 1;
 304             exit;
 305          end if;
 306       end loop;
 307
 308       Findex2 := File_Name'Last;
 309       while Findex2 > Findex1 and then File_Name (Findex2) /=  '.' loop
 310          Findex2 := Findex2 - 1;
 311       end loop;
 312
 313       if Findex2 = Findex1 then
 314          Findex2 := File_Name'Last + 1;
 315       end if;
 316
 317       return File_Name (Findex1 .. Findex2 - 1);
 318    end Base_Name;
 319
 320    -------------------------------
 321    -- Check_Existing_Executable --
 322    -------------------------------
 323
 324    procedure Check_Existing_Executable (File_Name : String) is
 325       Ename : String := File_Name;
 326       Efile : File_Name_Type;
 327       Sfile : File_Name_Type;
 328
 329    begin
 330       Canonical_Case_File_Name (Ename);
 331       Name_Len := 0;
 332       Add_Str_To_Name_Buffer (Ename);
 333       Efile := Name_Find;
 334
 335       for J in Units.Table'First .. Units.Last loop
 336          Sfile := Units.Table (J).Sfile;
 337          if Sfile = Efile then
 338             Exit_With_Error
 339               ("executable name """ & File_Name & """ matches "
 340                & "source file name """ & Get_Name_String (Sfile) & """");
 341          end if;
 342       end loop;
 343
 344       Delete (File_Name);
 345    end Check_Existing_Executable;
 346
 347    ------------
 348    -- Delete --
 349    ------------
 350
 351    procedure Delete (Name : String) is
 352       Status : int;
 353       pragma Unreferenced (Status);
 354    begin
 355       Status := unlink (Name'Address);
 356    end Delete;
 357
 358    ---------------
 359    -- Error_Msg --
 360    ---------------
 361
 362    procedure Error_Msg (Message : String) is
 363    begin
 364       Write_Str (Base_Command_Name.all);
 365       Write_Str (": ");
 366       Write_Str (Message);
 367       Write_Eol;
 368    end Error_Msg;
 369
 370    ---------------------
 371    -- Exit_With_Error --
 372    ---------------------
 373
 374    procedure Exit_With_Error (Error : String) is
 375    begin
 376       Error_Msg (Error);
 377       Exit_Program (E_Fatal);
 378    end Exit_With_Error;
 379
 380    -----------
 381    -- Index --
 382    -----------
 383
 384    function Index (S, Pattern : String) return Natural is
 385       Len : constant Natural := Pattern'Length;
 386
 387    begin
 388       for J in reverse S'First .. S'Last - Len + 1 loop
 389          if Pattern = S (J .. J + Len - 1) then
 390             return J;
 391          end if;
 392       end loop;
 393
 394       return 0;
 395    end Index;
 396
 397    ------------------
 398    -- Process_Args --
 399    ------------------
 400
 401    procedure Process_Args is
 402       Next_Arg : Integer;
 403
 404       Skip_Next : Boolean := False;
 405       --  Set to true if the next argument is to be added into the list of
 406       --  linker's argument without parsing it.
 407
 408       procedure Check_Version_And_Help is new Check_Version_And_Help_G (Usage);
 409
 410    --  Start of processing for Process_Args
 411
 412    begin
 413       --  First, check for --version and --help
 414
 415       Check_Version_And_Help ("GNATLINK", "1996");
 416
 417       --  Loop through arguments of gnatlink command
 418
 419       Next_Arg := 1;
 420       loop
 421          exit when Next_Arg > Argument_Count;
 422
 423          Process_One_Arg : declare
 424             Arg : constant String := Argument (Next_Arg);
 425
 426          begin
 427             --  This argument must not be parsed, just add it to the list of
 428             --  linker's options.
 429
 430             if Skip_Next then
 431
 432                Skip_Next := False;
 433
 434                Linker_Options.Increment_Last;
 435                Linker_Options.Table (Linker_Options.Last) :=
 436                  new String'(Arg);
 437
 438             --  Case of argument which is a switch
 439
 440             elsif Arg'Length /= 0 and then Arg (1) = '-' then
 441                if Arg'Length > 4 and then Arg (2 .. 5) = "gnat" then
 442                   Exit_With_Error
 443                     ("invalid switch: """ & Arg & """ (gnat not needed here)");
 444                end if;
 445
 446                if Arg = "-Xlinker" then
 447
 448                   --  Next argument should be sent directly to the linker.
 449                   --  We do not want to parse it here.
 450
 451                   Skip_Next := True;
 452
 453                   Linker_Options.Increment_Last;
 454                   Linker_Options.Table (Linker_Options.Last) :=
 455                     new String'(Arg);
 456
 457                elsif Arg (2) = 'g'
 458                  and then (Arg'Length < 5 or else Arg (2 .. 5) /= "gnat")
 459                then
 460                   Debug_Flag_Present := True;
 461
 462                   Linker_Options.Increment_Last;
 463                   Linker_Options.Table (Linker_Options.Last) :=
 464                    new String'(Arg);
 465
 466                   Binder_Options.Increment_Last;
 467                   Binder_Options.Table (Binder_Options.Last) :=
 468                     Linker_Options.Table (Linker_Options.Last);
 469
 470                elsif Arg'Length >= 3 and then Arg (2) = 'M' then
 471                   declare
 472                      Switches : String_List_Access;
 473
 474                   begin
 475                      Convert (Map_File, Arg (3 .. Arg'Last), Switches);
 476
 477                      if Switches /= null then
 478                         for J in Switches'Range loop
 479                            Linker_Options.Increment_Last;
 480                            Linker_Options.Table (Linker_Options.Last) :=
 481                              Switches (J);
 482                         end loop;
 483                      end if;
 484                   end;
 485
 486                elsif Arg'Length = 2 then
 487                   case Arg (2) is
 488                      when 'f' =>
 489                         if Object_List_File_Supported then
 490                            Object_List_File_Required := True;
 491                         else
 492                            Exit_With_Error
 493                              ("Object list file not supported on this target");
 494                         end if;
 495
 496                      when 'M' =>
 497                         Create_Map_File := True;
 498
 499                      when 'n' =>
 500                         Compile_Bind_File := False;
 501
 502                      when 'o' =>
 503                         Next_Arg := Next_Arg + 1;
 504
 505                         if Next_Arg > Argument_Count then
 506                            Exit_With_Error ("Missing argument for -o");
 507                         end if;
 508
 509                         Output_File_Name :=
 510                           new String'(Executable_Name
 511                                         (Argument (Next_Arg),
 512                                          Only_If_No_Suffix => True));
 513
 514                      when 'P' =>
 515                         Opt.CodePeer_Mode := True;
 516
 517                      when 'R' =>
 518                         Opt.Run_Path_Option := False;
 519
 520                      when 'v' =>
 521
 522                         --  Support "double" verbose mode. Second -v
 523                         --  gets sent to the linker and binder phases.
 524
 525                         if Verbose_Mode then
 526                            Very_Verbose_Mode := True;
 527
 528                            Linker_Options.Increment_Last;
 529                            Linker_Options.Table (Linker_Options.Last) :=
 530                             new String'(Arg);
 531
 532                            Binder_Options.Increment_Last;
 533                            Binder_Options.Table (Binder_Options.Last) :=
 534                              Linker_Options.Table (Linker_Options.Last);
 535
 536                         else
 537                            Verbose_Mode := True;
 538
 539                         end if;
 540
 541                      when others =>
 542                         Linker_Options.Increment_Last;
 543                         Linker_Options.Table (Linker_Options.Last) :=
 544                          new String'(Arg);
 545
 546                   end case;
 547
 548                elsif Arg (2) = 'B' then
 549                   Linker_Options.Increment_Last;
 550                   Linker_Options.Table (Linker_Options.Last) :=
 551                     new String'(Arg);
 552
 553                   Binder_Options.Increment_Last;
 554                   Binder_Options.Table (Binder_Options.Last) :=
 555                     Linker_Options.Table (Linker_Options.Last);
 556
 557                elsif Arg'Length >= 7 and then Arg (1 .. 7) = "--LINK=" then
 558                   if Arg'Length = 7 then
 559                      Exit_With_Error ("Missing argument for --LINK=");
 560                   end if;
 561
 562                   declare
 563                      L_Args : constant Argument_List_Access :=
 564                                Argument_String_To_List (Arg (8 .. Arg'Last));
 565                   begin
 566                      --  The linker program is the first argument
 567
 568                      Linker_Path :=
 569                       System.OS_Lib.Locate_Exec_On_Path (L_Args.all (1).all);
 570
 571                      if Linker_Path = null then
 572                         Exit_With_Error
 573                           ("Could not locate linker: " & L_Args.all (1).all);
 574                      end if;
 575
 576                      --  The other arguments are passed as-is to the linker and
 577                      --  override those coming from --GCC= if any.
 578
 579                      if L_Args.all'Last >= 2 then
 580                         Gcc_Linker_Options.Set_Last (0);
 581                      end if;
 582
 583                      for J in 2 .. L_Args.all'Last loop
 584                         Gcc_Linker_Options.Increment_Last;
 585                         Gcc_Linker_Options.Table
 586                           (Gcc_Linker_Options.Last) :=
 587                                              new String'(L_Args.all (J).all);
 588                      end loop;
 589                   end;
 590
 591                elsif Arg'Length >= 6 and then Arg (1 .. 6) = "--GCC=" then
 592                   if Arg'Length = 6 then
 593                      Exit_With_Error ("Missing argument for --GCC=");
 594                   end if;
 595
 596                   declare
 597                      Program_Args : constant Argument_List_Access :=
 598                                       Argument_String_To_List
 599                                                  (Arg (7 .. Arg'Last));
 600
 601                   begin
 602                      if Program_Args.all (1).all /= Gcc.all then
 603                         Gcc := new String'(Program_Args.all (1).all);
 604                         Standard_Gcc := False;
 605                      end if;
 606
 607                      --  Set appropriate flags for switches passed
 608
 609                      for J in 2 .. Program_Args.all'Last loop
 610                         declare
 611                            Arg : constant String := Program_Args.all (J).all;
 612                            AF  : constant Integer := Arg'First;
 613
 614                         begin
 615                            if Arg'Length /= 0 and then Arg (AF) = '-' then
 616                               if Arg (AF + 1) = 'g'
 617                                 and then (Arg'Length = 2
 618                                   or else Arg (AF + 2) in '0' .. '3'
 619                                   or else Arg (AF + 2 .. Arg'Last) = "coff")
 620                               then
 621                                  Debug_Flag_Present := True;
 622                               end if;
 623                            end if;
 624
 625                            --  Add directory to source search dirs so that
 626                            --  Get_Target_Parameters can find system.ads
 627
 628                            if Arg (AF .. AF + 1) = "-I"
 629                              and then Arg'Length > 2
 630                            then
 631                               Add_Src_Search_Dir (Arg (AF + 2 .. Arg'Last));
 632                            end if;
 633
 634                            --  Pass to gcc for compiling binder generated file
 635                            --  No use passing libraries, it will just generate
 636                            --  a warning
 637
 638                            if not (Arg (AF .. AF + 1) = "-l"
 639                              or else Arg (AF .. AF + 1) = "-L")
 640                            then
 641                               Binder_Options.Increment_Last;
 642                               Binder_Options.Table (Binder_Options.Last) :=
 643                                 new String'(Arg);
 644                            end if;
 645
 646                            --  Pass to gcc for linking program
 647
 648                            Gcc_Linker_Options.Increment_Last;
 649                            Gcc_Linker_Options.Table
 650                              (Gcc_Linker_Options.Last) := new String'(Arg);
 651                         end;
 652                      end loop;
 653                   end;
 654
 655                --  Send all multi-character switches not recognized as
 656                --  a special case by gnatlink to the linker/loader stage.
 657
 658                else
 659                   Linker_Options.Increment_Last;
 660                   Linker_Options.Table (Linker_Options.Last) :=
 661                     new String'(Arg);
 662                end if;
 663
 664             --  Here if argument is a file name rather than a switch
 665
 666             else
 667                --  If explicit ali file, capture it
 668
 669                if Arg'Length > 4
 670                  and then Arg (Arg'Last - 3 .. Arg'Last) = ".ali"
 671                then
 672                   if Ali_File_Name = null then
 673                      Ali_File_Name := new String'(Arg);
 674                   else
 675                      Exit_With_Error ("cannot handle more than one ALI file");
 676                   end if;
 677
 678                --  If target object file, record object file
 679
 680                elsif Arg'Length > Get_Target_Object_Suffix.all'Length
 681                  and then Arg
 682                    (Arg'Last -
 683                     Get_Target_Object_Suffix.all'Length + 1 .. Arg'Last)
 684                    = Get_Target_Object_Suffix.all
 685                then
 686                   Linker_Objects.Increment_Last;
 687                   Linker_Objects.Table (Linker_Objects.Last) :=
 688                     new String'(Arg);
 689
 690                --  If host object file, record object file
 691
 692                elsif Arg'Length > Get_Object_Suffix.all'Length
 693                  and then Arg
 694                    (Arg'Last - Get_Object_Suffix.all'Length + 1 .. Arg'Last)
 695                                                 = Get_Object_Suffix.all
 696                then
 697                   Linker_Objects.Increment_Last;
 698                   Linker_Objects.Table (Linker_Objects.Last) :=
 699                     new String'(Arg);
 700
 701                --  If corresponding ali file exists, capture it
 702
 703                elsif Ali_File_Name = null
 704                  and then Is_Regular_File (Arg & ".ali")
 705                then
 706                   Ali_File_Name := new String'(Arg & ".ali");
 707
 708                --  Otherwise assume this is a linker options entry, but
 709                --  see below for interesting adjustment to this assumption.
 710
 711                else
 712                   Linker_Options.Increment_Last;
 713                   Linker_Options.Table (Linker_Options.Last) :=
 714                     new String'(Arg);
 715                end if;
 716             end if;
 717          end Process_One_Arg;
 718
 719          Next_Arg := Next_Arg + 1;
 720       end loop;
 721
 722       --  Compile the bind file with warnings suppressed, because
 723       --  otherwise the with of the main program may cause junk warnings.
 724
 725       Binder_Options.Increment_Last;
 726       Binder_Options.Table (Binder_Options.Last) := new String'("-gnatws");
 727
 728       --  If we did not get an ali file at all, and we had at least one
 729       --  linker option, then assume that was the intended ali file after
 730       --  all, so that we get a nicer message later on.
 731
 732       if Ali_File_Name = null
 733         and then Linker_Options.Last >= Linker_Options.First
 734       then
 735          Ali_File_Name :=
 736            new String'(Linker_Options.Table (Linker_Options.First).all
 737                        & ".ali");
 738       end if;
 739    end Process_Args;
 740
 741    -------------------------
 742    -- Process_Binder_File --
 743    -------------------------
 744
 745    procedure Process_Binder_File (Name : String) is
 746       Fd : FILEs;
 747       --  Binder file's descriptor
 748
 749       Link_Bytes : Integer := 0;
 750       --  Projected number of bytes for the linker command line
 751
 752       Next_Line : String (1 .. 1000);
 753       --  Current line value
 754
 755       Nlast  : Integer;
 756       Nfirst : Integer;
 757       --  Current line slice (the slice does not contain line terminator)
 758
 759       Last : Integer;
 760       --  Current line last character for shared libraries (without version)
 761
 762       Objs_Begin : Integer := 0;
 763       --  First object file index in Linker_Objects table
 764
 765       Objs_End : Integer := 0;
 766       --  Last object file index in Linker_Objects table
 767
 768       Status : int;
 769       pragma Warnings (Off, Status);
 770       --  Used for various Interfaces.C_Streams calls
 771
 772       Closing_Status : Boolean;
 773       pragma Warnings (Off, Closing_Status);
 774       --  For call to Close
 775
 776       GNAT_Static : Boolean := False;
 777       --  Save state of -static option
 778
 779       GNAT_Shared : Boolean := False;
 780       --  Save state of -shared option
 781
 782       Xlinker_Was_Previous : Boolean := False;
 783       --  Indicate that "-Xlinker" was the option preceding the current option.
 784       --  If True, then the current option is never suppressed.
 785
 786       --  Rollback data
 787
 788       --  These data items are used to store current binder file context. The
 789       --  context is composed of the file descriptor position and the current
 790       --  line together with the slice indexes (first and last position) for
 791       --  this line. The rollback data are used by the Store_File_Context and
 792       --  Rollback_File_Context routines below. The file context mechanism
 793       --  interact only with the Get_Next_Line call. For example:
 794
 795       --     Store_File_Context;
 796       --     Get_Next_Line;
 797       --     Rollback_File_Context;
 798       --     Get_Next_Line;
 799
 800       --  Both Get_Next_Line calls above will read the exact same data from
 801       --  the file. In other words, Next_Line, Nfirst and Nlast variables
 802       --  will be set with the exact same values.
 803
 804       RB_File_Pos  : long;                -- File position
 805       RB_Next_Line : String (1 .. 1000);  -- Current line content
 806       RB_Nlast     : Integer;             -- Slice last index
 807       RB_Nfirst    : Integer;             -- Slice first index
 808
 809       procedure Get_Next_Line;
 810       --  Read the next line from the binder file without the line
 811       --  terminator.
 812
 813       procedure Store_File_Context;
 814       --  Store current file context, Fd position and current line data.
 815       --  The file context is stored into the rollback data above (RB_*).
 816       --  Store_File_Context can be called at any time, only the last call
 817       --  will be used (i.e. this routine overwrites the file context).
 818
 819       procedure Rollback_File_Context;
 820       --  Restore file context from rollback data. This routine must be called
 821       --  after Store_File_Context. The binder file context will be restored
 822       --  with the data stored by the last Store_File_Context call.
 823
 824       procedure Write_RF (S : String);
 825       --  Write a string to the response file and check if it was successful.
 826       --  Fail the program if it was not successful (disk full).
 827
 828       -------------------
 829       -- Get_Next_Line --
 830       -------------------
 831
 832       procedure Get_Next_Line is
 833          Fchars : chars;
 834
 835       begin
 836          Fchars := fgets (Next_Line'Address, Next_Line'Length, Fd);
 837
 838          if Fchars = System.Null_Address then
 839             Exit_With_Error ("Error reading binder output");
 840          end if;
 841
 842          Nfirst := Next_Line'First;
 843          Nlast := Nfirst;
 844          while Nlast <= Next_Line'Last
 845            and then Next_Line (Nlast) /= ASCII.LF
 846            and then Next_Line (Nlast) /= ASCII.CR
 847          loop
 848             Nlast := Nlast + 1;
 849          end loop;
 850
 851          Nlast := Nlast - 1;
 852       end Get_Next_Line;
 853
 854       ---------------------------
 855       -- Rollback_File_Context --
 856       ---------------------------
 857
 858       procedure Rollback_File_Context is
 859       begin
 860          Next_Line := RB_Next_Line;
 861          Nfirst    := RB_Nfirst;
 862          Nlast     := RB_Nlast;
 863          Status    := fseek (Fd, RB_File_Pos, Interfaces.C_Streams.SEEK_SET);
 864
 865          if Status = -1 then
 866             Exit_With_Error ("Error setting file position");
 867          end if;
 868       end Rollback_File_Context;
 869
 870       ------------------------
 871       -- Store_File_Context --
 872       ------------------------
 873
 874       procedure Store_File_Context is
 875          use type System.CRTL.long;
 876
 877       begin
 878          RB_Next_Line := Next_Line;
 879          RB_Nfirst    := Nfirst;
 880          RB_Nlast     := Nlast;
 881          RB_File_Pos  := ftell (Fd);
 882
 883          if RB_File_Pos = -1 then
 884             Exit_With_Error ("Error getting file position");
 885          end if;
 886       end Store_File_Context;
 887
 888       --------------
 889       -- Write_RF --
 890       --------------
 891
 892       procedure Write_RF (S : String) is
 893          Success    : Boolean            := True;
 894          Back_Slash : constant Character := '\';
 895
 896       begin
 897          --  If a GNU response file is used, space and backslash need to be
 898          --  escaped because they are interpreted as a string separator and
 899          --  an escape character respectively by the underlying mechanism.
 900          --  On the other hand, quote and double-quote are not escaped since
 901          --  they are interpreted as string delimiters on both sides.
 902
 903          if Using_GNU_response_file then
 904             for J in S'Range loop
 905                if S (J) = ' ' or else S (J) = '\' then
 906                   if Write (Tname_FD, Back_Slash'Address, 1) /= 1 then
 907                      Success := False;
 908                   end if;
 909                end if;
 910
 911                if Write (Tname_FD, S (J)'Address, 1) /= 1 then
 912                   Success := False;
 913                end if;
 914             end loop;
 915
 916          else
 917             if Write (Tname_FD, S'Address, S'Length) /= S'Length then
 918                Success := False;
 919             end if;
 920          end if;
 921
 922          if Write (Tname_FD, ASCII.LF'Address, 1) /= 1 then
 923             Success := False;
 924          end if;
 925
 926          if not Success then
 927             Exit_With_Error ("Error generating response file: disk full");
 928          end if;
 929       end Write_RF;
 930
 931    --  Start of processing for Process_Binder_File
 932
 933    begin
 934       Fd := fopen (Name'Address, Read_Mode'Address);
 935
 936       if Fd = NULL_Stream then
 937          Exit_With_Error ("Failed to open binder output");
 938       end if;
 939
 940       --  Skip up to the Begin Info line
 941
 942       loop
 943          Get_Next_Line;
 944          exit when Next_Line (Nfirst .. Nlast) = Begin_Info;
 945       end loop;
 946
 947       loop
 948          Get_Next_Line;
 949
 950          --  Go to end when end line is reached (this will happen in
 951          --  High_Integrity_Mode where no -L switches are generated)
 952
 953          exit when Next_Line (Nfirst .. Nlast) = End_Info;
 954
 955          Next_Line (Nfirst .. Nlast - 8) := Next_Line (Nfirst + 8 .. Nlast);
 956          Nlast := Nlast - 8;
 957
 958          --  Go to next section when switches are reached
 959
 960          exit when Next_Line (1) = '-';
 961
 962          --  Otherwise we have another object file to collect
 963
 964          Linker_Objects.Increment_Last;
 965
 966          --  Mark the positions of first and last object files in case they
 967          --  need to be placed with a named file on systems having linker
 968          --  line limitations.
 969
 970          if Objs_Begin = 0 then
 971             Objs_Begin := Linker_Objects.Last;
 972          end if;
 973
 974          Linker_Objects.Table (Linker_Objects.Last) :=
 975            new String'(Next_Line (Nfirst .. Nlast));
 976
 977          --  Nlast - Nfirst + 1, for the size, plus one for the space between
 978          --  each arguments.
 979
 980          Link_Bytes := Link_Bytes + Nlast - Nfirst + 2;
 981       end loop;
 982
 983       Objs_End := Linker_Objects.Last;
 984
 985       --  Continue to compute the Link_Bytes, the linker options are part of
 986       --  command line length.
 987
 988       Store_File_Context;
 989
 990       while Next_Line (Nfirst .. Nlast) /= End_Info loop
 991          Link_Bytes := Link_Bytes + Nlast - Nfirst + 2;
 992          Get_Next_Line;
 993       end loop;
 994
 995       Rollback_File_Context;
 996
 997       --  On systems that have limitations on handling very long linker lines
 998       --  we make use of the system linker option which takes a list of object
 999       --  file names from a file instead of the command line itself. What we do
1000       --  is to replace the list of object files by the special linker option
1001       --  which then reads the object file list from a file instead. The option
1002       --  to read from a file instead of the command line is only triggered if
1003       --  a conservative threshold is passed.
1004
1005       if Object_List_File_Required
1006         or else (Object_List_File_Supported
1007                    and then Link_Bytes > Link_Max)
1008       then
1009          --  Create a temporary file containing the Ada user object files
1010          --  needed by the link. This list is taken from the bind file and is
1011          --  output one object per line for maximal compatibility with linkers
1012          --  supporting this option.
1013
1014          Create_Temp_File (Tname_FD, Tname);
1015
1016          --  ??? File descriptor should be checked to not be Invalid_FD.
1017          --  Status of Write and Close operations should be checked, and
1018          --  failure should occur if a status is wrong.
1019
1020          for J in Objs_Begin .. Objs_End loop
1021             Write_RF (Linker_Objects.Table (J).all);
1022
1023             Response_File_Objects.Increment_Last;
1024             Response_File_Objects.Table (Response_File_Objects.Last) :=
1025               Linker_Objects.Table (J);
1026          end loop;
1027
1028          Close (Tname_FD, Closing_Status);
1029
1030          --  Add the special objects list file option together with the name
1031          --  of the temporary file (removing the null character) to the objects
1032          --  file table.
1033
1034          Linker_Objects.Table (Objs_Begin) :=
1035            new String'(Object_File_Option &
1036                        Tname (Tname'First .. Tname'Last - 1));
1037
1038          --  The slots containing these object file names are then removed
1039          --  from the objects table so they do not appear in the link. They are
1040          --  removed by moving up the linker options and non-Ada object files
1041          --  appearing after the Ada object list in the table.
1042
1043          declare
1044             N : Integer;
1045
1046          begin
1047             N := Objs_End - Objs_Begin + 1;
1048
1049             for J in Objs_End + 1 .. Linker_Objects.Last loop
1050                Linker_Objects.Table (J - N + 1) := Linker_Objects.Table (J);
1051             end loop;
1052
1053             Linker_Objects.Set_Last (Linker_Objects.Last - N + 1);
1054          end;
1055       end if;
1056
1057       --  Process switches and options
1058
1059       if Next_Line (Nfirst .. Nlast) /= End_Info then
1060          Xlinker_Was_Previous := False;
1061
1062          loop
1063             if Xlinker_Was_Previous
1064               or else Next_Line (Nfirst .. Nlast) = "-Xlinker"
1065             then
1066                Linker_Options.Increment_Last;
1067                Linker_Options.Table (Linker_Options.Last) :=
1068                  new String'(Next_Line (Nfirst .. Nlast));
1069
1070             elsif Next_Line (Nfirst .. Nlast) = "-static" then
1071                GNAT_Static := True;
1072
1073             elsif Next_Line (Nfirst .. Nlast) = "-shared" then
1074                GNAT_Shared := True;
1075
1076             --  Add binder options only if not already set on the command line.
1077             --  This rule is a way to control the linker options order.
1078
1079             else
1080                if Nlast > Nfirst + 2 and then
1081                  Next_Line (Nfirst .. Nfirst + 1) = "-L"
1082                then
1083                   --  Construct a library search path for use later to locate
1084                   --  static gnatlib libraries.
1085
1086                   if Libpath.Last > 1 then
1087                      Libpath.Increment_Last;
1088                      Libpath.Table (Libpath.Last) := Path_Separator;
1089                   end if;
1090
1091                   for I in Nfirst + 2 .. Nlast loop
1092                      Libpath.Increment_Last;
1093                      Libpath.Table (Libpath.Last) := Next_Line (I);
1094                   end loop;
1095
1096                   Linker_Options.Increment_Last;
1097
1098                   Linker_Options.Table (Linker_Options.Last) :=
1099                     new String'(Next_Line (Nfirst .. Nlast));
1100
1101                elsif Next_Line (Nfirst .. Nlast) = "-lgnarl"
1102                  or else Next_Line (Nfirst .. Nlast) = "-lgnat"
1103                  or else
1104                    Next_Line
1105                      (1 .. Natural'Min (Nlast, 8 + Library_Version'Length)) =
1106                        Shared_Lib ("gnarl")
1107                  or else
1108                    Next_Line
1109                      (1 .. Natural'Min (Nlast, 7 + Library_Version'Length)) =
1110                        Shared_Lib ("gnat")
1111                then
1112                   --  If it is a shared library, remove the library version.
1113                   --  We will be looking for the static version of the library
1114                   --  as it is in the same directory as the shared version.
1115
1116                   if Nlast >= Library_Version'Length
1117                     and then
1118                       Next_Line (Nlast - Library_Version'Length + 1 .. Nlast) =
1119                         Library_Version
1120                   then
1121                      --  Set Last to point to last character before the
1122                      --  library version.
1123
1124                      Last := Nlast - Library_Version'Length - 1;
1125                   else
1126                      Last := Nlast;
1127                   end if;
1128
1129                   Search_Library_Path
1130                     (Next_Line   => Next_Line,
1131                      Nfirst      => Nfirst,
1132                      Nlast       => Nlast,
1133                      Last        => Last,
1134                      GNAT_Static => GNAT_Static,
1135                      GNAT_Shared => GNAT_Shared);
1136
1137                else
1138                   Linker_Options.Increment_Last;
1139                   Linker_Options.Table (Linker_Options.Last) :=
1140                     new String'(Next_Line (Nfirst .. Nlast));
1141                end if;
1142             end if;
1143
1144             Xlinker_Was_Previous := Next_Line (Nfirst .. Nlast) = "-Xlinker";
1145
1146             Get_Next_Line;
1147             exit when Next_Line (Nfirst .. Nlast) = End_Info;
1148
1149             Next_Line (Nfirst .. Nlast - 8) := Next_Line (Nfirst + 8 .. Nlast);
1150             Nlast := Nlast - 8;
1151          end loop;
1152       end if;
1153
1154       --  If -shared was specified, invoke gcc with -shared-libgcc
1155
1156       if GNAT_Shared then
1157          Linker_Options.Increment_Last;
1158          Linker_Options.Table (Linker_Options.Last) := Shared_Libgcc;
1159       end if;
1160
1161       Status := fclose (Fd);
1162    end Process_Binder_File;
1163
1164    -------------------------
1165    -- Search_Library_Path --
1166    -------------------------
1167
1168    procedure Search_Library_Path
1169      (Next_Line   : String;
1170       Nfirst      : Integer;
1171       Nlast       : Integer;
1172       Last        : Integer;
1173       GNAT_Static : Boolean;
1174       GNAT_Shared : Boolean)
1175    is
1176       File_Path : String_Access;
1177
1178       Object_Lib_Extension : constant String :=
1179         Value (Object_Library_Ext_Ptr);
1180
1181       File_Name : constant String := "lib" &
1182         Next_Line (Nfirst + 2 .. Last) & Object_Lib_Extension;
1183
1184       Run_Path_Opt : constant String :=
1185         Value (Run_Path_Option_Ptr);
1186
1187       GCC_Index          : Natural;
1188       Run_Path_Opt_Index : Natural := 0;
1189
1190    begin
1191       File_Path :=
1192         Locate_Regular_File (File_Name,
1193           String (Libpath.Table (1 .. Libpath.Last)));
1194
1195       if File_Path /= null then
1196          if GNAT_Static then
1197
1198             --  If static gnatlib found, explicitly specify to overcome
1199             --  possible linker default usage of shared version.
1200
1201             Linker_Options.Increment_Last;
1202
1203             Linker_Options.Table (Linker_Options.Last) :=
1204               new String'(File_Path.all);
1205
1206          elsif GNAT_Shared then
1207             if Opt.Run_Path_Option then
1208
1209                --  If shared gnatlib desired, add appropriate system specific
1210                --  switch so that it can be located at runtime.
1211
1212                if Run_Path_Opt'Length /= 0 then
1213
1214                   --  Output the system specific linker command that allows the
1215                   --  image activator to find the shared library at
1216                   --  runtime. Also add path to find libgcc_s.so, if relevant.
1217
1218                   declare
1219                      Path : String (1 .. File_Path'Length + 15);
1220
1221                      Path_Last : constant Natural := File_Path'Length;
1222
1223                   begin
1224                      Path (1 .. File_Path'Length) := File_Path.all;
1225
1226                   --  To find the location of the shared version of libgcc, we
1227                   --  look for "gcc-lib" in the path of the library. However,
1228                   --  this subdirectory is no longer present in recent versions
1229                   --  of GCC. So, we look for the last subdirectory "lib" in
1230                   --  the path.
1231
1232                      GCC_Index := Index (Path (1 .. Path_Last), "gcc-lib");
1233
1234                      if GCC_Index /= 0 then
1235
1236                         --  The shared version of libgcc is located in the
1237                         --  parent directory.
1238
1239                         GCC_Index := GCC_Index - 1;
1240
1241                      else
1242                         GCC_Index := Index (Path (1 .. Path_Last), "/lib/");
1243
1244                         if GCC_Index = 0 then
1245                            GCC_Index :=
1246                              Index (Path (1 .. Path_Last),
1247                                     Directory_Separator & "lib"
1248                                     & Directory_Separator);
1249                         end if;
1250
1251                         --  If we have found a "lib" subdir in the path to
1252                         --  libgnat, the possible shared libgcc of interest by
1253                         --  default is in libgcc_subdir at the same level.
1254
1255                         if GCC_Index /= 0 then
1256                            declare
1257                               Subdir : constant String :=
1258                                 Value (Libgcc_Subdir_Ptr);
1259
1260                            begin
1261                               Path (GCC_Index + 1 .. GCC_Index + Subdir'Length)
1262                                 := Subdir;
1263                               GCC_Index := GCC_Index + Subdir'Length;
1264                            end;
1265                         end if;
1266                      end if;
1267
1268                   --  Look for an eventual run_path_option in
1269                   --  the linker switches.
1270
1271                      if Separate_Run_Path_Options then
1272                         Linker_Options.Increment_Last;
1273                         Linker_Options.Table
1274                           (Linker_Options.Last) :=
1275                             new String'
1276                               (Run_Path_Opt
1277                                & File_Path
1278                                  (1 .. File_Path'Length
1279                                   - File_Name'Length));
1280
1281                         if GCC_Index /= 0 then
1282                            Linker_Options.Increment_Last;
1283                            Linker_Options.Table (Linker_Options.Last) :=
1284                              new String'
1285                                (Run_Path_Opt
1286                                 & Path (1 .. GCC_Index));
1287                         end if;
1288
1289                      else
1290                         for J in reverse 1 .. Linker_Options.Last loop
1291                            if Linker_Options.Table (J) /= null
1292                              and then
1293                                Linker_Options.Table (J)'Length
1294                                          > Run_Path_Opt'Length
1295                              and then
1296                                Linker_Options.Table (J)
1297                                  (1 .. Run_Path_Opt'Length) =
1298                                                   Run_Path_Opt
1299                            then
1300                               --  We have found an already specified
1301                               --  run_path_option: we will add to this switch,
1302                               --  because only one run_path_option should be
1303                               --  specified.
1304
1305                               Run_Path_Opt_Index := J;
1306                               exit;
1307                            end if;
1308                         end loop;
1309
1310                         --  If there is no run_path_option, we need to add one.
1311
1312                         if Run_Path_Opt_Index = 0 then
1313                            Linker_Options.Increment_Last;
1314                         end if;
1315
1316                         if GCC_Index = 0 then
1317                            if Run_Path_Opt_Index = 0 then
1318                               Linker_Options.Table
1319                                 (Linker_Options.Last) :=
1320                                   new String'
1321                                     (Run_Path_Opt
1322                                      & File_Path
1323                                        (1 .. File_Path'Length
1324                                         - File_Name'Length));
1325
1326                            else
1327                               Linker_Options.Table
1328                                 (Run_Path_Opt_Index) :=
1329                                   new String'
1330                                     (Linker_Options.Table
1331                                       (Run_Path_Opt_Index).all
1332                                      & Path_Separator
1333                                      & File_Path
1334                                        (1 .. File_Path'Length
1335                                         - File_Name'Length));
1336                            end if;
1337
1338                         else
1339                            if Run_Path_Opt_Index = 0 then
1340                               Linker_Options.Table
1341                                 (Linker_Options.Last) :=
1342                                   new String'
1343                                     (Run_Path_Opt
1344                                      & File_Path
1345                                        (1 .. File_Path'Length
1346                                         - File_Name'Length)
1347                                      & Path_Separator
1348                                      & Path (1 .. GCC_Index));
1349
1350                            else
1351                               Linker_Options.Table
1352                                 (Run_Path_Opt_Index) :=
1353                                   new String'
1354                                     (Linker_Options.Table
1355                                       (Run_Path_Opt_Index).all
1356                                      & Path_Separator
1357                                      & File_Path
1358                                        (1 .. File_Path'Length
1359                                         - File_Name'Length)
1360                                      & Path_Separator
1361                                      & Path (1 .. GCC_Index));
1362                            end if;
1363                         end if;
1364                      end if;
1365                   end;
1366                end if;
1367             end if;
1368
1369             --  Then we add the appropriate -l switch
1370
1371             Linker_Options.Increment_Last;
1372             Linker_Options.Table (Linker_Options.Last) :=
1373               new String'(Next_Line (Nfirst .. Nlast));
1374          end if;
1375
1376       else
1377          --  If gnatlib library not found, then add it anyway in
1378          --  case some other mechanism may find it.
1379
1380          Linker_Options.Increment_Last;
1381          Linker_Options.Table (Linker_Options.Last) :=
1382            new String'(Next_Line (Nfirst .. Nlast));
1383       end if;
1384    end Search_Library_Path;
1385
1386    -----------
1387    -- Usage --
1388    -----------
1389
1390    procedure Usage is
1391    begin
1392       Write_Str ("Usage: ");
1393       Write_Str (Base_Command_Name.all);
1394       Write_Str (" switches mainprog.ali [non-Ada-objects] [linker-options]");
1395       Write_Eol;
1396       Write_Eol;
1397       Write_Line ("  mainprog.ali   the ALI file of the main program");
1398       Write_Eol;
1399       Write_Eol;
1400       Display_Usage_Version_And_Help;
1401       Write_Line ("  -f    Force object file list to be generated");
1402       Write_Line ("  -g    Compile binder source file with debug information");
1403       Write_Line ("  -n    Do not compile the binder source file");
1404       Write_Line ("  -P    Process files for use by CodePeer");
1405       Write_Line ("  -R    Do not use a run_path_option");
1406       Write_Line ("  -v    Verbose mode");
1407       Write_Line ("  -v -v Very verbose mode");
1408       Write_Eol;
1409       Write_Line ("  -o nam     Use 'nam' as the name of the executable");
1410       Write_Line ("  -Bdir      Load compiler executables from dir");
1411
1412       if Is_Supported (Map_File) then
1413          Write_Line ("  -Mmap      Create map file map");
1414          Write_Line ("  -M         Create map file mainprog.map");
1415       end if;
1416
1417       Write_Line ("  --GCC=comp Use 'comp' as the compiler rather than 'gcc'");
1418       Write_Line ("  --LINK=lnk Use 'lnk' as the linker rather than 'gcc'");
1419       Write_Eol;
1420       Write_Line ("  [non-Ada-objects]  list of non Ada object files");
1421       Write_Line ("  [linker-options]   other options for the linker");
1422    end Usage;
1423
1424    ------------------
1425    -- Write_Header --
1426    ------------------
1427
1428    procedure Write_Header is
1429    begin
1430       if Verbose_Mode then
1431          Write_Eol;
1432          Display_Version ("GNATLINK", "1995");
1433       end if;
1434    end Write_Header;
1435
1436    -----------------
1437    -- Write_Usage --
1438    -----------------
1439
1440    procedure Write_Usage is
1441    begin
1442       Write_Header;
1443       Usage;
1444    end Write_Usage;
1445
1446 --  Start of processing for Gnatlink
1447
1448 begin
1449    --  Add the directory where gnatlink is invoked in front of the path, if
1450    --  gnatlink is invoked with directory information.
1451
1452    declare
1453       Command : constant String := Command_Name;
1454    begin
1455       for Index in reverse Command'Range loop
1456          if Command (Index) = Directory_Separator then
1457             declare
1458                Absolute_Dir : constant String :=
1459                  Normalize_Pathname
1460                    (Command (Command'First .. Index));
1461
1462                PATH : constant String :=
1463                  Absolute_Dir &
1464                  Path_Separator &
1465                  Getenv ("PATH").all;
1466
1467             begin
1468                Setenv ("PATH", PATH);
1469             end;
1470
1471             exit;
1472          end if;
1473       end loop;
1474    end;
1475
1476    Base_Command_Name := new String'(Base_Name (Command_Name));
1477    Process_Args;
1478
1479    if Argument_Count = 0
1480      or else (Verbose_Mode and then Argument_Count = 1)
1481    then
1482       Write_Usage;
1483       Exit_Program (E_Fatal);
1484    end if;
1485
1486    --  Initialize packages to be used
1487
1488    Csets.Initialize;
1489    Snames.Initialize;
1490
1491    --  We always compile with -c
1492
1493    Binder_Options_From_ALI.Increment_Last;
1494    Binder_Options_From_ALI.Table (Binder_Options_From_ALI.Last) :=
1495      new String'("-c");
1496
1497    if Ali_File_Name = null then
1498       Exit_With_Error ("no ali file given for link");
1499    end if;
1500
1501    if not Is_Regular_File (Ali_File_Name.all) then
1502       Exit_With_Error (Ali_File_Name.all & " not found");
1503    end if;
1504
1505    --  Read the ALI file of the main subprogram if the binder generated file
1506    --  needs to be compiled and no --GCC= switch has been specified. Fetch the
1507    --  back end switches from this ALI file and use these switches to compile
1508    --  the binder generated file
1509
1510    if Compile_Bind_File and then Standard_Gcc then
1511       Initialize_ALI;
1512       Name_Len := Ali_File_Name'Length;
1513       Name_Buffer (1 .. Name_Len) := Ali_File_Name.all;
1514
1515       declare
1516          use Types;
1517          F : constant File_Name_Type := Name_Find;
1518          T : Text_Buffer_Ptr;
1519          A : ALI_Id;
1520
1521       begin
1522          --  Load the ALI file
1523
1524          T := Read_Library_Info (F, True);
1525
1526          --  Read it. Note that we ignore errors, since we only want very
1527          --  limited information from the ali file, and likely a slightly
1528          --  wrong version will be just fine, though in normal operation
1529          --  we don't expect this to happen.
1530
1531          A := Scan_ALI
1532                (F,
1533                 T,
1534                 Err           => False,
1535                 Ignore_Errors => True);
1536
1537          if A /= No_ALI_Id then
1538             for
1539               Index in Units.Table (ALIs.Table (A).First_Unit).First_Arg ..
1540                        Units.Table (ALIs.Table (A).First_Unit).Last_Arg
1541             loop
1542                --  Do not compile with the front end switches. However, --RTS
1543                --  is to be dealt with specially because it needs to be passed
1544                --  to compile the file generated by the binder.
1545
1546                declare
1547                   Arg : String_Ptr renames Args.Table (Index);
1548                begin
1549                   if not Is_Front_End_Switch (Arg.all) then
1550                      Binder_Options_From_ALI.Increment_Last;
1551                      Binder_Options_From_ALI.Table
1552                        (Binder_Options_From_ALI.Last) := String_Access (Arg);
1553
1554                      --  GNAT doesn't support GCC's multilib mechanism when it
1555                      --  is configured with --disable-libada. This means that,
1556                      --  when a multilib switch is used to request a particular
1557                      --  compilation mode, the corresponding --RTS switch must
1558                      --  also be specified. It is convenient to eliminate the
1559                      --  redundancy by keying the compilation mode on a single
1560                      --  switch, namely --RTS, and have the compiler reinstate
1561                      --  the multilib switch (see gcc-interface/lang-specs.h).
1562                      --  This switch must be passed to the driver at link time.
1563
1564                      if Arg'Length = 5
1565                        and then Arg (Arg'First + 1 .. Arg'First + 4) = "mrtp"
1566                      then
1567                         Linker_Options.Increment_Last;
1568                         Linker_Options.Table
1569                           (Linker_Options.Last) := String_Access (Arg);
1570                      end if;
1571
1572                   elsif Arg'Length > 5
1573                     and then Arg (Arg'First + 2 .. Arg'First + 5) = "RTS="
1574                   then
1575                      Binder_Options_From_ALI.Increment_Last;
1576                      Binder_Options_From_ALI.Table
1577                        (Binder_Options_From_ALI.Last) := String_Access (Arg);
1578
1579                      --  Set the RTS_*_Path_Name variables, so that
1580                      --  the correct directories will be set when
1581                      --  Osint.Add_Default_Search_Dirs will be called later.
1582
1583                      Opt.RTS_Src_Path_Name :=
1584                        Get_RTS_Search_Dir
1585                          (Arg (Arg'First + 6 .. Arg'Last), Include);
1586
1587                      Opt.RTS_Lib_Path_Name :=
1588                        Get_RTS_Search_Dir
1589                          (Arg (Arg'First + 6 .. Arg'Last), Objects);
1590                   end if;
1591                end;
1592             end loop;
1593          end if;
1594       end;
1595    end if;
1596
1597    --  Get target parameters
1598
1599    Osint.Add_Default_Search_Dirs;
1600    Targparm.Get_Target_Parameters;
1601
1602    --  Compile the bind file with the following switches:
1603
1604    --    -gnatA   stops reading gnat.adc, since we don't know what
1605    --             pragmas would work, and we do not need it anyway.
1606
1607    --    -gnatWb  allows brackets coding for wide characters
1608
1609    --    -gnatiw  allows wide characters in identifiers. This is needed
1610    --             because bindgen uses brackets encoding for all upper
1611    --             half and wide characters in identifier names.
1612
1613    --  In addition, in CodePeer mode compile with -x adascil -gnatcC
1614
1615    Binder_Options_From_ALI.Increment_Last;
1616    Binder_Options_From_ALI.Table (Binder_Options_From_ALI.Last) :=
1617         new String'("-gnatA");
1618    Binder_Options_From_ALI.Increment_Last;
1619    Binder_Options_From_ALI.Table (Binder_Options_From_ALI.Last) :=
1620         new String'("-gnatWb");
1621    Binder_Options_From_ALI.Increment_Last;
1622    Binder_Options_From_ALI.Table (Binder_Options_From_ALI.Last) :=
1623         new String'("-gnatiw");
1624
1625    if Opt.CodePeer_Mode then
1626       Binder_Options_From_ALI.Increment_Last;
1627       Binder_Options_From_ALI.Table (Binder_Options_From_ALI.Last) :=
1628         new String'("-x");
1629       Binder_Options_From_ALI.Increment_Last;
1630       Binder_Options_From_ALI.Table (Binder_Options_From_ALI.Last) :=
1631         new String'("adascil");
1632       Binder_Options_From_ALI.Increment_Last;
1633       Binder_Options_From_ALI.Table (Binder_Options_From_ALI.Last) :=
1634         new String'("-gnatcC");
1635    end if;
1636
1637    --  Locate all the necessary programs and verify required files are present
1638
1639    Gcc_Path := System.OS_Lib.Locate_Exec_On_Path (Gcc.all);
1640
1641    if Gcc_Path = null then
1642       Exit_With_Error ("Couldn't locate " & Gcc.all);
1643    end if;
1644
1645    if Linker_Path = null then
1646       Linker_Path := Gcc_Path;
1647    end if;
1648
1649    Write_Header;
1650
1651    Target_Debuggable_Suffix := Get_Target_Debuggable_Suffix;
1652
1653    --  If no output name specified, then use the base name of .ali file name
1654
1655    if Output_File_Name = null then
1656       Output_File_Name :=
1657         new String'(Base_Name (Ali_File_Name.all)
1658                       & Target_Debuggable_Suffix.all);
1659    end if;
1660
1661    Linker_Options.Increment_Last;
1662    Linker_Options.Table (Linker_Options.Last) := new String'("-o");
1663
1664    Linker_Options.Increment_Last;
1665    Linker_Options.Table (Linker_Options.Last) :=
1666      new String'(Output_File_Name.all);
1667
1668    Check_Existing_Executable (Output_File_Name.all);
1669
1670    --  Warn if main program is called "test", as that may be a built-in command
1671    --  on Unix. On non-Unix systems executables have a suffix, so the warning
1672    --  will not appear. However, do not warn in the case of a cross compiler.
1673
1674    --  Assume this is a cross tool if the executable name is not gnatlink.
1675    --  Note that the executable name is also gnatlink on windows, but in that
1676    --  case the output file name will be test.exe rather than test.
1677
1678    if Base_Command_Name.all = "gnatlink"
1679      and then Output_File_Name.all = "test"
1680    then
1681       Error_Msg ("warning: executable name """ & Output_File_Name.all
1682                  & """ may conflict with shell command");
1683    end if;
1684
1685    --  Special warnings for worrisome file names on windows
1686
1687    --  Recent versions of Windows by default cause privilege escalation if an
1688    --  executable file name contains substrings "install", "setup", "update"
1689    --  or "patch". A console application will typically fail to load as a
1690    --  result, so we should warn the user.
1691
1692    Bad_File_Names_On_Windows : declare
1693       FN : String := Output_File_Name.all;
1694
1695       procedure Check_File_Name (S : String);
1696       --  Warn if file name has the substring S
1697
1698       procedure Check_File_Name (S : String) is
1699       begin
1700          for J in 1 .. FN'Length - (S'Length - 1) loop
1701             if FN (J .. J + (S'Length - 1)) = S then
1702                Error_Msg
1703                  ("warning: executable file name """ & Output_File_Name.all
1704                   & """ contains substring """ & S & '"');
1705                Error_Msg
1706                  ("admin privileges may be required to run this file");
1707             end if;
1708          end loop;
1709       end Check_File_Name;
1710
1711    --  Start of processing for Bad_File_Names_On_Windows
1712
1713    begin
1714       for J in FN'Range loop
1715             FN (J) := Csets.Fold_Lower (FN (J));
1716       end loop;
1717
1718       --  For now we detect Windows by its executable suffix of .exe
1719
1720       if Target_Debuggable_Suffix.all = ".exe" then
1721          Check_File_Name ("install");
1722          Check_File_Name ("setup");
1723          Check_File_Name ("update");
1724          Check_File_Name ("patch");
1725       end if;
1726    end Bad_File_Names_On_Windows;
1727
1728    --  If -M switch was specified, add the switches to create the map file
1729
1730    if Create_Map_File then
1731       declare
1732          Map_Name : constant String := Base_Name (Ali_File_Name.all) & ".map";
1733          Switches : String_List_Access;
1734
1735       begin
1736          Convert (Map_File, Map_Name, Switches);
1737
1738          if Switches /= null then
1739             for J in Switches'Range loop
1740                Linker_Options.Increment_Last;
1741                Linker_Options.Table (Linker_Options.Last) := Switches (J);
1742             end loop;
1743          end if;
1744       end;
1745    end if;
1746
1747    --  Perform consistency checks
1748
1749    --  Transform the .ali file name into the binder output file name
1750
1751    Make_Binder_File_Names : declare
1752       Fname     : constant String  := Base_Name (Ali_File_Name.all);
1753       Fname_Len : Integer := Fname'Length;
1754
1755       Maximum_File_Name_Length : constant Integer :=
1756                                    Get_Maximum_File_Name_Length;
1757
1758       Bind_File_Prefix : Types.String_Ptr;
1759       --  Contains prefix used for bind files
1760
1761    begin
1762       --  Set prefix
1763
1764       Bind_File_Prefix := new String'("b~");
1765
1766       --  If the length of the binder file becomes too long due to
1767       --  the addition of the "b?" prefix, then truncate it.
1768
1769       if Maximum_File_Name_Length > 0 then
1770          while Fname_Len >
1771                  Maximum_File_Name_Length - Bind_File_Prefix.all'Length
1772          loop
1773             Fname_Len := Fname_Len - 1;
1774          end loop;
1775       end if;
1776
1777       declare
1778          Fnam : constant String :=
1779                   Bind_File_Prefix.all &
1780                     Fname (Fname'First .. Fname'First + Fname_Len - 1);
1781
1782       begin
1783          Binder_Spec_Src_File := new String'(Fnam & ".ads");
1784          Binder_Body_Src_File := new String'(Fnam & ".adb");
1785          Binder_Ali_File      := new String'(Fnam & ".ali");
1786
1787          Binder_Obj_File := new String'(Fnam & Get_Target_Object_Suffix.all);
1788       end;
1789
1790       if Fname_Len /= Fname'Length then
1791          Binder_Options.Increment_Last;
1792          Binder_Options.Table (Binder_Options.Last) := new String'("-o");
1793          Binder_Options.Increment_Last;
1794          Binder_Options.Table (Binder_Options.Last) := Binder_Obj_File;
1795       end if;
1796    end Make_Binder_File_Names;
1797
1798    Process_Binder_File (Binder_Body_Src_File.all & ASCII.NUL);
1799
1800    --  Compile the binder file. This is fast, so we always do it, unless
1801    --  specifically told not to by the -n switch
1802
1803    if Compile_Bind_File then
1804       Bind_Step : declare
1805          Success : Boolean;
1806
1807          Args : Argument_List
1808                  (1 .. Binder_Options_From_ALI.Last + Binder_Options.Last + 1);
1809
1810       begin
1811          for J in 1 .. Binder_Options_From_ALI.Last loop
1812             Args (J) := Binder_Options_From_ALI.Table (J);
1813          end loop;
1814
1815          for J in 1 .. Binder_Options.Last loop
1816             Args (Binder_Options_From_ALI.Last + J) :=
1817               Binder_Options.Table (J);
1818          end loop;
1819
1820          --  Use the full path of the binder generated source, so that it is
1821          --  guaranteed that the debugger will find this source, even with
1822          --  STABS.
1823
1824          Args (Args'Last) :=
1825            new String'(Normalize_Pathname (Binder_Body_Src_File.all));
1826
1827          if Verbose_Mode then
1828             Write_Str (Base_Name (Gcc_Path.all));
1829
1830             for J in Args'Range loop
1831                Write_Str (" ");
1832                Write_Str (Args (J).all);
1833             end loop;
1834
1835             Write_Eol;
1836          end if;
1837
1838          System.OS_Lib.Spawn (Gcc_Path.all, Args, Success);
1839
1840          if not Success then
1841             Exit_Program (E_Fatal);
1842          end if;
1843       end Bind_Step;
1844    end if;
1845
1846    --  In CodePeer mode, there's nothing left to do after the binder file has
1847    --  been compiled.
1848
1849    if Opt.CodePeer_Mode then
1850       if Tname_FD /= Invalid_FD then
1851          Delete (Tname);
1852       end if;
1853
1854       return;
1855    end if;
1856
1857    --  Now, actually link the program
1858
1859    Link_Step : declare
1860       Num_Args : Natural :=
1861         (Linker_Options.Last - Linker_Options.First + 1) +
1862         (Gcc_Linker_Options.Last - Gcc_Linker_Options.First + 1) +
1863         (Linker_Objects.Last - Linker_Objects.First + 1);
1864       Stack_Op : Boolean := False;
1865
1866    begin
1867       --  Remove duplicate stack size setting from the Linker_Options table.
1868       --  The stack setting option "-Xlinker --stack=R,C" can be found
1869       --  in one line when set by a pragma Linker_Options or in two lines
1870       --  ("-Xlinker" then "--stack=R,C") when set on the command line. We
1871       --  also check for the "-Wl,--stack=R" style option.
1872
1873       --  We must remove the second stack setting option instance because
1874       --  the one on the command line will always be the first one. And any
1875       --  subsequent stack setting option will overwrite the previous one.
1876       --  This is done especially for GNAT/NT where we set the stack size
1877       --  for tasking programs by a pragma in the NT specific tasking
1878       --  package System.Task_Primitives.Operations.
1879
1880       --  Note: This is not a FOR loop that runs from Linker_Options.First
1881       --  to Linker_Options.Last, since operations within the loop can
1882       --  modify the length of the table.
1883
1884       Clean_Link_Option_Set : declare
1885          J                  : Natural;
1886          Shared_Libgcc_Seen : Boolean := False;
1887          Static_Libgcc_Seen : Boolean := False;
1888
1889       begin
1890          J := Linker_Options.First;
1891          while J <= Linker_Options.Last loop
1892             if Linker_Options.Table (J).all = "-Xlinker"
1893               and then J < Linker_Options.Last
1894               and then Linker_Options.Table (J + 1)'Length > 8
1895               and then Linker_Options.Table (J + 1) (1 .. 8) = "--stack="
1896             then
1897                if Stack_Op then
1898                   Linker_Options.Table (J .. Linker_Options.Last - 2) :=
1899                     Linker_Options.Table (J + 2 .. Linker_Options.Last);
1900                   Linker_Options.Decrement_Last;
1901                   Linker_Options.Decrement_Last;
1902                   Num_Args := Num_Args - 2;
1903
1904                else
1905                   Stack_Op := True;
1906                end if;
1907             end if;
1908
1909             --  Remove duplicate -shared-libgcc switches
1910
1911             if Linker_Options.Table (J).all = Shared_Libgcc_String then
1912                if Shared_Libgcc_Seen then
1913                   Linker_Options.Table (J .. Linker_Options.Last - 1) :=
1914                     Linker_Options.Table (J + 1 .. Linker_Options.Last);
1915                   Linker_Options.Decrement_Last;
1916                   Num_Args := Num_Args - 1;
1917
1918                else
1919                   Shared_Libgcc_Seen := True;
1920                end if;
1921             end if;
1922
1923             --  Remove duplicate -static-libgcc switches
1924
1925             if Linker_Options.Table (J).all = Static_Libgcc_String then
1926                if Static_Libgcc_Seen then
1927                   Linker_Options.Table (J .. Linker_Options.Last - 1) :=
1928                     Linker_Options.Table (J + 1 .. Linker_Options.Last);
1929                   Linker_Options.Decrement_Last;
1930                   Num_Args := Num_Args - 1;
1931
1932                else
1933                   Static_Libgcc_Seen := True;
1934                end if;
1935             end if;
1936
1937             --  Here we just check for a canonical form that matches the
1938             --  pragma Linker_Options set in the NT runtime.
1939
1940             if (Linker_Options.Table (J)'Length > 17
1941                 and then Linker_Options.Table (J) (1 .. 17) =
1942                   "-Xlinker --stack=")
1943               or else
1944                 (Linker_Options.Table (J)'Length > 12
1945                  and then Linker_Options.Table (J) (1 .. 12) =
1946                        "-Wl,--stack=")
1947             then
1948                if Stack_Op then
1949                   Linker_Options.Table (J .. Linker_Options.Last - 1) :=
1950                     Linker_Options.Table (J + 1 .. Linker_Options.Last);
1951                   Linker_Options.Decrement_Last;
1952                   Num_Args := Num_Args - 1;
1953
1954                else
1955                   Stack_Op := True;
1956                end if;
1957             end if;
1958
1959             J := J + 1;
1960          end loop;
1961
1962          if Linker_Path = Gcc_Path then
1963
1964             --  For systems where the default is to link statically with
1965             --  libgcc, if gcc is not called with -shared-libgcc, call it
1966             --  with -static-libgcc, as there are some platforms where one
1967             --  of these two switches is compulsory to link.
1968             --  Don't push extra switches if we already saw one.
1969
1970             if Shared_Libgcc_Default = 'T'
1971               and then not Shared_Libgcc_Seen
1972               and then not Static_Libgcc_Seen
1973             then
1974                Linker_Options.Increment_Last;
1975                Linker_Options.Table (Linker_Options.Last) := Static_Libgcc;
1976                Num_Args := Num_Args + 1;
1977             end if;
1978
1979             --  Likewise, the reverse.
1980
1981             if Shared_Libgcc_Default = 'H'
1982               and then not Static_Libgcc_Seen
1983               and then not Shared_Libgcc_Seen
1984             then
1985                Linker_Options.Increment_Last;
1986                Linker_Options.Table (Linker_Options.Last) := Shared_Libgcc;
1987                Num_Args := Num_Args + 1;
1988             end if;
1989          end if;
1990       end Clean_Link_Option_Set;
1991
1992       --  Prepare arguments for call to linker
1993
1994       Call_Linker : declare
1995          Success  : Boolean;
1996          Args     : Argument_List (1 .. Num_Args + 1);
1997          Index    : Integer := Args'First;
1998
1999       begin
2000          Args (Index) := Binder_Obj_File;
2001
2002          --  Add the object files and any -largs libraries
2003
2004          for J in Linker_Objects.First .. Linker_Objects.Last loop
2005             Index := Index + 1;
2006             Args (Index) := Linker_Objects.Table (J);
2007          end loop;
2008
2009          --  Add the linker options from the binder file
2010
2011          for J in Linker_Options.First .. Linker_Options.Last loop
2012             Index := Index + 1;
2013             Args (Index) := Linker_Options.Table (J);
2014          end loop;
2015
2016          --  Finally add the libraries from the --GCC= switch
2017
2018          for J in Gcc_Linker_Options.First .. Gcc_Linker_Options.Last loop
2019             Index := Index + 1;
2020             Args (Index) := Gcc_Linker_Options.Table (J);
2021          end loop;
2022
2023          if Verbose_Mode then
2024             Write_Str (Linker_Path.all);
2025
2026             for J in Args'Range loop
2027                Write_Str (" ");
2028                Write_Str (Args (J).all);
2029             end loop;
2030
2031             Write_Eol;
2032
2033             --  If we are on very verbose mode (-v -v) and a response file
2034             --  is used we display its content.
2035
2036             if Very_Verbose_Mode and then Tname_FD /= Invalid_FD then
2037                Write_Eol;
2038                Write_Str ("Response file (" &
2039                             Tname (Tname'First .. Tname'Last - 1) &
2040                             ") content : ");
2041                Write_Eol;
2042
2043                for J in
2044                  Response_File_Objects.First .. Response_File_Objects.Last
2045                loop
2046                   Write_Str (Response_File_Objects.Table (J).all);
2047                   Write_Eol;
2048                end loop;
2049
2050                Write_Eol;
2051             end if;
2052          end if;
2053
2054          System.OS_Lib.Spawn (Linker_Path.all, Args, Success);
2055
2056          --  Delete the temporary file used in conjunction with linking if one
2057          --  was created. See Process_Bind_File for details.
2058
2059          if Tname_FD /= Invalid_FD then
2060             Delete (Tname);
2061          end if;
2062
2063          if not Success then
2064             Error_Msg ("error when calling " & Linker_Path.all);
2065             Exit_Program (E_Fatal);
2066          end if;
2067       end Call_Linker;
2068    end Link_Step;
2069
2070    --  Only keep the binder output file and it's associated object
2071    --  file if compiling with the -g option. These files are only
2072    --  useful if debugging.
2073
2074    if not Debug_Flag_Present then
2075       Delete (Binder_Ali_File.all & ASCII.NUL);
2076       Delete (Binder_Spec_Src_File.all & ASCII.NUL);
2077       Delete (Binder_Body_Src_File.all & ASCII.NUL);
2078       Delete (Binder_Obj_File.all & ASCII.NUL);
2079    end if;
2080
2081    Exit_Program (E_Success);
2082
2083 exception
2084    when X : others =>
2085       Write_Line (Exception_Information (X));
2086       Exit_With_Error ("INTERNAL ERROR. Please report");
2087 end Gnatlink;