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 --                            $Revision$
  10 --                                                                          --
  11 --          Copyright (C) 1996-2002 Free Software Foundation, Inc.          --
  12 --                                                                          --
  13 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  14 -- terms of the  GNU General Public License as published  by the Free Soft- --
  15 -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
  16 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  17 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  18 -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  19 -- for  more details.  You should have  received  a copy of the GNU General --
  20 -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
  21 -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
  22 -- MA 02111-1307, USA.                                                      --
  23 --                                                                          --
  24 -- GNAT was originally developed  by the GNAT team at  New York University. --
  25 -- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
  26 --                                                                          --
  27 ------------------------------------------------------------------------------
  28
  29 --  Gnatlink usage: please consult the gnat documentation
  30
  31 with Ada.Exceptions; use Ada.Exceptions;
  32 with ALI;      use ALI;
  33 with Gnatvsn;  use Gnatvsn;
  34 with Hostparm;
  35 with Namet;    use Namet;
  36 with Osint;    use Osint;
  37 with Output;   use Output;
  38 with Switch;   use Switch;
  39 with System;   use System;
  40 with Table;
  41 with Types;
  42
  43 with Ada.Command_Line;     use Ada.Command_Line;
  44 with GNAT.OS_Lib;          use GNAT.OS_Lib;
  45 with Interfaces.C_Streams; use Interfaces.C_Streams;
  46
  47 procedure Gnatlink is
  48
  49    pragma Ident (Gnat_Version_String);
  50
  51    package Gcc_Linker_Options is new Table.Table (
  52      Table_Component_Type => String_Access,
  53      Table_Index_Type     => Integer,
  54      Table_Low_Bound      => 1,
  55      Table_Initial        => 20,
  56      Table_Increment      => 100,
  57      Table_Name           => "Gnatlink.Gcc_Linker_Options");
  58    --  Comments needed ???
  59
  60    package Libpath is new Table.Table (
  61      Table_Component_Type => Character,
  62      Table_Index_Type     => Integer,
  63      Table_Low_Bound      => 1,
  64      Table_Initial        => 4096,
  65      Table_Increment      => 2,
  66      Table_Name           => "Gnatlink.Libpath");
  67    --  Comments needed ???
  68
  69    package Linker_Options is new Table.Table (
  70      Table_Component_Type => String_Access,
  71      Table_Index_Type     => Integer,
  72      Table_Low_Bound      => 1,
  73      Table_Initial        => 20,
  74      Table_Increment      => 100,
  75      Table_Name           => "Gnatlink.Linker_Options");
  76    --  Comments needed ???
  77
  78    package Linker_Objects is new Table.Table (
  79      Table_Component_Type => String_Access,
  80      Table_Index_Type     => Integer,
  81      Table_Low_Bound      => 1,
  82      Table_Initial        => 20,
  83      Table_Increment      => 100,
  84      Table_Name           => "Gnatlink.Linker_Objects");
  85    --  This table collects the objects file to be passed to the linker. In the
  86    --  case where the linker command line is too long then programs objects
  87    --  are put on the Response_File_Objects table. Note that the binder object
  88    --  file and the user's objects remain in this table. This is very
  89    --  important because on the GNU linker command line the -L switch is not
  90    --  used to look for objects files but -L switch is used to look for
  91    --  objects listed in the response file. This is not a problem with the
  92    --  applications objects as they are specified with a fullname.
  93
  94    package Response_File_Objects is new Table.Table (
  95      Table_Component_Type => String_Access,
  96      Table_Index_Type     => Integer,
  97      Table_Low_Bound      => 1,
  98      Table_Initial        => 20,
  99      Table_Increment      => 100,
 100      Table_Name           => "Gnatlink.Response_File_Objects");
 101    --  This table collects the objects file that are to be put in the response
 102    --  file. Only application objects are collected there (see details in
 103    --  Linker_Objects table comments)
 104
 105    package Binder_Options_From_ALI is new Table.Table (
 106      Table_Component_Type => String_Access,
 107      Table_Index_Type     => Integer,
 108      Table_Low_Bound      => 1, -- equals low bound of Argument_List for Spawn
 109      Table_Initial        => 20,
 110      Table_Increment      => 100,
 111      Table_Name           => "Gnatlink.Binder_Options_From_ALI");
 112    --  This table collects the switches from the ALI file of the main
 113    --  subprogram.
 114
 115    package Binder_Options is new Table.Table (
 116      Table_Component_Type => String_Access,
 117      Table_Index_Type     => Integer,
 118      Table_Low_Bound      => 1, -- equals low bound of Argument_List for Spawn
 119      Table_Initial        => 20,
 120      Table_Increment      => 100,
 121      Table_Name           => "Gnatlink.Binder_Options");
 122    --  This table collects the arguments to be passed to compile the binder
 123    --  generated file.
 124
 125    subtype chars_ptr is System.Address;
 126
 127    Gcc : String_Access := Program_Name ("gcc");
 128
 129    Read_Mode  : constant String := "r" & ASCII.Nul;
 130
 131    Begin_Info : String := "-- BEGIN Object file/option list";
 132    End_Info   : String := "-- END Object file/option list   ";
 133    --  Note: above lines are modified in C mode, see option processing
 134
 135    Gcc_Path             : String_Access;
 136    Linker_Path          : String_Access;
 137
 138    Output_File_Name     : String_Access;
 139    Ali_File_Name        : String_Access;
 140    Binder_Spec_Src_File : String_Access;
 141    Binder_Body_Src_File : String_Access;
 142    Binder_Ali_File      : String_Access;
 143    Binder_Obj_File      : String_Access;
 144
 145    Tname    : Temp_File_Name;
 146    Tname_FD : File_Descriptor := Invalid_FD;
 147    --  Temporary file used by linker to pass list of object files on
 148    --  certain systems with limitations on size of arguments.
 149
 150    Debug_Flag_Present : Boolean := False;
 151    Verbose_Mode       : Boolean := False;
 152    Very_Verbose_Mode  : Boolean := False;
 153
 154    Ada_Bind_File : Boolean := True;
 155    --  Set to True if bind file is generated in Ada
 156
 157    Standard_Gcc  : Boolean := True;
 158
 159    Compile_Bind_File : Boolean := True;
 160    --  Set to False if bind file is not to be compiled
 161
 162    Object_List_File_Supported : Boolean;
 163    pragma Import (C, Object_List_File_Supported, "objlist_file_supported");
 164    --  Predicate indicating whether the linker has an option whereby the
 165    --  names of object files can be passed to the linker in a file.
 166
 167    Object_List_File_Required : Boolean := False;
 168    --  Set to True to force generation of a response file
 169
 170    function Base_Name (File_Name : in String) return String;
 171    --  Return just the file name part without the extension (if present).
 172
 173    procedure Delete (Name : in String);
 174    --  Wrapper to unlink as status is ignored by this application.
 175
 176    procedure Error_Msg (Message : in String);
 177    --  Output the error or warning Message
 178
 179    procedure Exit_With_Error (Error : in String);
 180    --  Output Error and exit program with a fatal condition.
 181
 182    procedure Process_Args;
 183    --  Go through all the arguments and build option tables.
 184
 185    procedure Process_Binder_File (Name : in String);
 186    --  Reads the binder file and extracts linker arguments.
 187
 188    function Value (chars : chars_ptr) return String;
 189    --  Return NUL-terminated string chars as an Ada string.
 190
 191    procedure Write_Usage;
 192    --  Show user the program options.
 193
 194    ---------------
 195    -- Base_Name --
 196    ---------------
 197
 198    function Base_Name (File_Name : in String) return String is
 199       Findex1 : Natural;
 200       Findex2 : Natural;
 201
 202    begin
 203       Findex1 := File_Name'First;
 204
 205       --  The file might be specified by a full path name. However,
 206       --  we want the path to be stripped away.
 207
 208       for J in reverse File_Name'Range loop
 209          if Is_Directory_Separator (File_Name (J)) then
 210             Findex1 := J + 1;
 211             exit;
 212          end if;
 213       end loop;
 214
 215       Findex2 := File_Name'Last;
 216       while Findex2 > Findex1
 217         and then File_Name (Findex2) /=  '.'
 218       loop
 219          Findex2 := Findex2 - 1;
 220       end loop;
 221
 222       if Findex2 = Findex1 then
 223          Findex2 := File_Name'Last + 1;
 224       end if;
 225
 226       return File_Name (Findex1 .. Findex2 - 1);
 227    end Base_Name;
 228
 229    ------------
 230    -- Delete --
 231    ------------
 232
 233    procedure Delete (Name : in String) is
 234       Status : int;
 235
 236    begin
 237       Status := unlink (Name'Address);
 238    end Delete;
 239
 240    ---------------
 241    -- Error_Msg --
 242    ---------------
 243
 244    procedure Error_Msg (Message : in String) is
 245    begin
 246       Write_Str (Base_Name (Command_Name));
 247       Write_Str (": ");
 248       Write_Str (Message);
 249       Write_Eol;
 250    end Error_Msg;
 251
 252    ---------------------
 253    -- Exit_With_Error --
 254    ---------------------
 255
 256    procedure Exit_With_Error (Error : in String) is
 257    begin
 258       Error_Msg (Error);
 259       Exit_Program (E_Fatal);
 260    end Exit_With_Error;
 261
 262    ------------------
 263    -- Process_Args --
 264    ------------------
 265
 266    procedure Process_Args is
 267       Next_Arg : Integer;
 268
 269    begin
 270       --  Loop through arguments of gnatlink command
 271
 272       Next_Arg := 1;
 273       loop
 274          exit when Next_Arg > Argument_Count;
 275
 276          Process_One_Arg : declare
 277             Arg : String := Argument (Next_Arg);
 278
 279          begin
 280             --  Case of argument which is a switch
 281
 282             --  We definitely need section by section comments here ???
 283
 284             if Arg'Length /= 0 and then Arg (1) = '-' then
 285                if Arg'Length > 4
 286                  and then Arg (2 .. 5) =  "gnat"
 287                then
 288                   Exit_With_Error
 289                     ("invalid switch: """ & Arg & """ (gnat not needed here)");
 290                end if;
 291
 292                if Arg (2) = 'g'
 293                  and then (Arg'Length < 5 or else Arg (2 .. 5) /= "gnat")
 294                then
 295                   Debug_Flag_Present := True;
 296
 297                   Linker_Options.Increment_Last;
 298                   Linker_Options.Table (Linker_Options.Last) :=
 299                    new String'(Arg);
 300
 301                   Binder_Options.Increment_Last;
 302                   Binder_Options.Table (Binder_Options.Last) :=
 303                     Linker_Options.Table (Linker_Options.Last);
 304
 305                elsif Arg'Length = 2 then
 306                   case Arg (2) is
 307                      when 'A' =>
 308                         Ada_Bind_File := True;
 309                         Begin_Info := "-- BEGIN Object file/option list";
 310                         End_Info   := "-- END Object file/option list   ";
 311
 312                      when 'b' =>
 313                         Linker_Options.Increment_Last;
 314                         Linker_Options.Table (Linker_Options.Last) :=
 315                           new String'(Arg);
 316
 317                         Binder_Options.Increment_Last;
 318                         Binder_Options.Table (Binder_Options.Last) :=
 319                           Linker_Options.Table (Linker_Options.Last);
 320
 321                         Next_Arg := Next_Arg + 1;
 322
 323                         if Next_Arg > Argument_Count then
 324                            Exit_With_Error ("Missing argument for -b");
 325                         end if;
 326
 327                         Get_Machine_Name : declare
 328                            Name_Arg : String_Access :=
 329                                         new String'(Argument (Next_Arg));
 330
 331                         begin
 332                            Linker_Options.Increment_Last;
 333                            Linker_Options.Table (Linker_Options.Last) :=
 334                              Name_Arg;
 335
 336                            Binder_Options.Increment_Last;
 337                            Binder_Options.Table (Binder_Options.Last) :=
 338                              Name_Arg;
 339
 340                         end Get_Machine_Name;
 341
 342                      when 'C' =>
 343                         Ada_Bind_File := False;
 344                         Begin_Info := "/* BEGIN Object file/option list";
 345                         End_Info   := "   END Object file/option list */";
 346
 347                      when 'f' =>
 348                         if Object_List_File_Supported then
 349                            Object_List_File_Required := True;
 350                         else
 351                            Exit_With_Error
 352                              ("Object list file not supported on this target");
 353                         end if;
 354
 355                      when 'n' =>
 356                         Compile_Bind_File := False;
 357
 358                      when 'o' =>
 359                         Linker_Options.Increment_Last;
 360                         Linker_Options.Table (Linker_Options.Last) :=
 361                          new String'(Arg);
 362
 363                         Next_Arg := Next_Arg + 1;
 364
 365                         if Next_Arg > Argument_Count then
 366                            Exit_With_Error ("Missing argument for -o");
 367                         end if;
 368
 369                         Output_File_Name := new String'(Argument (Next_Arg));
 370
 371                         Linker_Options.Increment_Last;
 372                         Linker_Options.Table (Linker_Options.Last) :=
 373                           Output_File_Name;
 374
 375                      when 'v' =>
 376
 377                         --  Support "double" verbose mode.  Second -v
 378                         --  gets sent to the linker and binder phases.
 379
 380                         if Verbose_Mode then
 381                            Very_Verbose_Mode := True;
 382
 383                            Linker_Options.Increment_Last;
 384                            Linker_Options.Table (Linker_Options.Last) :=
 385                             new String'(Arg);
 386
 387                            Binder_Options.Increment_Last;
 388                            Binder_Options.Table (Binder_Options.Last) :=
 389                              Linker_Options.Table (Linker_Options.Last);
 390
 391                         else
 392                            Verbose_Mode := True;
 393
 394                         end if;
 395
 396                      when others =>
 397                         Linker_Options.Increment_Last;
 398                         Linker_Options.Table (Linker_Options.Last) :=
 399                          new String'(Arg);
 400
 401                   end case;
 402
 403                elsif Arg (2) = 'B' then
 404                   Linker_Options.Increment_Last;
 405                   Linker_Options.Table (Linker_Options.Last) :=
 406                    new String'(Arg);
 407
 408                   Binder_Options.Increment_Last;
 409                   Binder_Options.Table (Binder_Options.Last) :=
 410                     Linker_Options.Table (Linker_Options.Last);
 411
 412                elsif Arg'Length >= 7 and then Arg (1 .. 7) = "--LINK=" then
 413
 414                   if Arg'Length = 7 then
 415                      Exit_With_Error ("Missing argument for --LINK=");
 416                   end if;
 417
 418                   Linker_Path :=
 419                     GNAT.OS_Lib.Locate_Exec_On_Path (Arg (8 .. Arg'Last));
 420
 421                   if Linker_Path = null then
 422                      Exit_With_Error
 423                        ("Could not locate linker: " & Arg (8 .. Arg'Last));
 424                   end if;
 425
 426                elsif Arg'Length > 6 and then Arg (1 .. 6) = "--GCC=" then
 427                   declare
 428                      Program_Args : Argument_List_Access :=
 429                                       Argument_String_To_List
 430                                                  (Arg (7 .. Arg'Last));
 431
 432                   begin
 433                      Gcc := new String'(Program_Args.all (1).all);
 434                      Standard_Gcc := False;
 435
 436                      --  Set appropriate flags for switches passed
 437
 438                      for J in 2 .. Program_Args.all'Last loop
 439                         declare
 440                            Arg : String := Program_Args.all (J).all;
 441                            AF  : Integer := Arg'First;
 442
 443                         begin
 444                            if Arg'Length /= 0 and then Arg (AF) = '-' then
 445                               if Arg (AF + 1) = 'g'
 446                                 and then (Arg'Length = 2
 447                                   or else Arg (AF + 2) in '0' .. '3'
 448                                   or else Arg (AF + 2 .. Arg'Last) = "coff")
 449                               then
 450                                  Debug_Flag_Present := True;
 451                               end if;
 452                            end if;
 453
 454                            --  Pass to gcc for compiling binder generated file
 455                            --  No use passing libraries, it will just generate
 456                            --  a warning
 457
 458                            if not (Arg (AF .. AF + 1) = "-l"
 459                              or else Arg (AF .. AF + 1) = "-L")
 460                            then
 461                               Binder_Options.Increment_Last;
 462                               Binder_Options.Table (Binder_Options.Last) :=
 463                                 new String'(Arg);
 464                            end if;
 465
 466                            --  Pass to gcc for linking program.
 467
 468                            Gcc_Linker_Options.Increment_Last;
 469                            Gcc_Linker_Options.Table
 470                              (Gcc_Linker_Options.Last) := new String'(Arg);
 471                         end;
 472                      end loop;
 473                   end;
 474
 475                --  Send all multi-character switches not recognized as
 476                --  a special case by gnatlink to the linker/loader stage.
 477
 478                else
 479                   Linker_Options.Increment_Last;
 480                   Linker_Options.Table (Linker_Options.Last) :=
 481                     new String'(Arg);
 482                end if;
 483
 484             --  Here if argument is a file name rather than a switch
 485
 486             else
 487                if Arg'Length > 4
 488                  and then Arg (Arg'Last - 3 .. Arg'Last) = ".ali"
 489                then
 490                   if Ali_File_Name = null then
 491                      Ali_File_Name := new String'(Arg);
 492                   else
 493                      Exit_With_Error ("cannot handle more than one ALI file");
 494                   end if;
 495
 496                elsif Is_Regular_File (Arg & ".ali")
 497                  and then Ali_File_Name = null
 498                then
 499                   Ali_File_Name := new String'(Arg & ".ali");
 500
 501                elsif Arg'Length > Get_Object_Suffix.all'Length
 502                  and then Arg
 503                    (Arg'Last - Get_Object_Suffix.all'Length + 1 .. Arg'Last)
 504                                                 = Get_Object_Suffix.all
 505                then
 506                   Linker_Objects.Increment_Last;
 507                   Linker_Objects.Table (Linker_Objects.Last) :=
 508                     new String'(Arg);
 509
 510                else
 511                   Linker_Options.Increment_Last;
 512                   Linker_Options.Table (Linker_Options.Last) :=
 513                     new String'(Arg);
 514                end if;
 515
 516             end if;
 517
 518          end Process_One_Arg;
 519
 520          Next_Arg := Next_Arg + 1;
 521       end loop;
 522
 523       --  If Ada bind file, then compile it with warnings suppressed, because
 524       --  otherwise the with of the main program may cause junk warnings.
 525
 526       if Ada_Bind_File then
 527          Binder_Options.Increment_Last;
 528          Binder_Options.Table (Binder_Options.Last) := new String'("-gnatws");
 529       end if;
 530    end Process_Args;
 531
 532    -------------------------
 533    -- Process_Binder_File --
 534    -------------------------
 535
 536    procedure Process_Binder_File (Name : in String) is
 537       Fd           : FILEs;
 538       Link_Bytes   : Integer := 0;
 539       Link_Max     : Integer;
 540       pragma Import (C, Link_Max, "link_max");
 541
 542       Next_Line    : String (1 .. 1000);
 543       Nlast        : Integer;
 544       Nfirst       : Integer;
 545       Objs_Begin   : Integer := 0;
 546       Objs_End     : Integer := 0;
 547
 548       Status       : int;
 549       N            : Integer;
 550
 551       GNAT_Static  : Boolean := False;
 552       --  Save state of -static option.
 553
 554       GNAT_Shared  : Boolean := False;
 555       --  Save state of -shared option.
 556
 557       Run_Path_Option_Ptr : Address;
 558       pragma Import (C, Run_Path_Option_Ptr, "run_path_option");
 559       --  Pointer to string representing the native linker option which
 560       --  specifies the path where the dynamic loader should find shared
 561       --  libraries. Equal to null string if this system doesn't support it.
 562
 563       Object_Library_Ext_Ptr : Address;
 564       pragma Import (C, Object_Library_Ext_Ptr, "object_library_extension");
 565       --  Pointer to string specifying the default extension for
 566       --  object libraries, e.g. Unix uses ".a", VMS uses ".olb".
 567
 568       Object_File_Option_Ptr : Address;
 569       pragma Import (C, Object_File_Option_Ptr, "object_file_option");
 570       --  Pointer to a string representing the linker option which specifies
 571       --  the response file.
 572
 573       Using_GNU_Linker : Boolean;
 574       pragma Import (C, Using_GNU_Linker, "using_gnu_linker");
 575       --  Predicate indicating whether this target uses the GNU linker. In
 576       --  this case we must output a GNU linker compatible response file.
 577
 578       procedure Get_Next_Line;
 579       --  Read the next line from the binder file without the line
 580       --  terminator.
 581
 582       function Is_Option_Present (Opt : in String) return Boolean;
 583       --  Return true if the option Opt is already present in
 584       --  Linker_Options table.
 585
 586       procedure Get_Next_Line is
 587          Fchars : chars;
 588
 589       begin
 590          Fchars := fgets (Next_Line'Address, Next_Line'Length, Fd);
 591
 592          if Fchars = System.Null_Address then
 593             Exit_With_Error ("Error reading binder output");
 594          end if;
 595
 596          Nfirst := Next_Line'First;
 597          Nlast := Nfirst;
 598          while Nlast <= Next_Line'Last
 599            and then Next_Line (Nlast) /= ASCII.LF
 600            and then Next_Line (Nlast) /= ASCII.CR
 601          loop
 602             Nlast := Nlast + 1;
 603          end loop;
 604
 605          Nlast := Nlast - 1;
 606       end Get_Next_Line;
 607
 608       function Is_Option_Present (Opt : in String) return Boolean is
 609       begin
 610          for I in 1 .. Linker_Options.Last loop
 611
 612             if Linker_Options.Table (I).all = Opt then
 613                return True;
 614             end if;
 615
 616          end loop;
 617
 618          return False;
 619       end Is_Option_Present;
 620
 621    --  Start of processing for Process_Binder_File
 622
 623    begin
 624       Fd := fopen (Name'Address, Read_Mode'Address);
 625
 626       if Fd = NULL_Stream then
 627          Exit_With_Error ("Failed to open binder output");
 628       end if;
 629
 630       --  Skip up to the Begin Info line
 631
 632       loop
 633          Get_Next_Line;
 634          exit when Next_Line (Nfirst .. Nlast) = Begin_Info;
 635       end loop;
 636
 637       loop
 638          Get_Next_Line;
 639
 640          --  Go to end when end line is reached (this will happen in
 641          --  No_Run_Time mode where no -L switches are generated)
 642
 643          exit when Next_Line (Nfirst .. Nlast) = End_Info;
 644
 645          if Ada_Bind_File then
 646             Next_Line (Nfirst .. Nlast - 8) :=
 647               Next_Line (Nfirst + 8 .. Nlast);
 648             Nlast := Nlast - 8;
 649          end if;
 650
 651          --  Go to next section when switches are reached
 652
 653          exit when Next_Line (1) = '-';
 654
 655          --  Otherwise we have another object file to collect
 656
 657          Linker_Objects.Increment_Last;
 658
 659          --  Mark the positions of first and last object files in case
 660          --  they need to be placed with a named file on systems having
 661          --  linker line limitations.
 662
 663          if Objs_Begin = 0 then
 664             Objs_Begin := Linker_Objects.Last;
 665          end if;
 666
 667          Linker_Objects.Table (Linker_Objects.Last) :=
 668            new String'(Next_Line (Nfirst .. Nlast));
 669
 670          Link_Bytes := Link_Bytes + Nlast - Nfirst;
 671       end loop;
 672
 673       Objs_End := Linker_Objects.Last;
 674
 675       --  On systems that have limitations on handling very long linker lines
 676       --  we make use of the system linker option which takes a list of object
 677       --  file names from a file instead of the command line itself. What we do
 678       --  is to replace the list of object files by the special linker option
 679       --  which then reads the object file list from a file instead. The option
 680       --  to read from a file instead of the command line is only triggered if
 681       --  a conservative threshold is passed.
 682
 683       if Object_List_File_Required
 684         or else (Object_List_File_Supported
 685                    and then Link_Bytes > Link_Max)
 686       then
 687          --  Create a temporary file containing the Ada user object files
 688          --  needed by the link. This list is taken from the bind file
 689          --  and is output one object per line for maximal compatibility with
 690          --  linkers supporting this option.
 691
 692          Create_Temp_File (Tname_FD, Tname);
 693
 694          --  If target is using the GNU linker we must add a special header
 695          --  and footer in the response file.
 696          --  The syntax is : INPUT (object1.o object2.o ... )
 697
 698          if Using_GNU_Linker then
 699             declare
 700                GNU_Header : aliased constant String := "INPUT (";
 701
 702             begin
 703                Status := Write (Tname_FD, GNU_Header'Address,
 704                  GNU_Header'Length);
 705             end;
 706          end if;
 707
 708          for J in Objs_Begin .. Objs_End loop
 709             Status := Write (Tname_FD, Linker_Objects.Table (J).all'Address,
 710               Linker_Objects.Table (J).all'Length);
 711             Status := Write (Tname_FD, ASCII.LF'Address, 1);
 712
 713             Response_File_Objects.Increment_Last;
 714             Response_File_Objects.Table (Response_File_Objects.Last) :=
 715               Linker_Objects.Table (J);
 716          end loop;
 717
 718          --  handle GNU linker response file footer.
 719
 720          if Using_GNU_Linker then
 721             declare
 722                GNU_Footer : aliased constant String := ")";
 723
 724             begin
 725                Status := Write (Tname_FD, GNU_Footer'Address,
 726                  GNU_Footer'Length);
 727             end;
 728          end if;
 729
 730          Close (Tname_FD);
 731
 732          --  Add the special objects list file option together with the name
 733          --  of the temporary file (removing the null character) to the objects
 734          --  file table.
 735
 736          Linker_Objects.Table (Objs_Begin) :=
 737            new String'(Value (Object_File_Option_Ptr) &
 738                        Tname (Tname'First .. Tname'Last - 1));
 739
 740          --  The slots containing these object file names are then removed
 741          --  from the objects table so they do not appear in the link. They
 742          --  are removed by moving up the linker options and non-Ada object
 743          --  files appearing after the Ada object list in the table.
 744
 745          N := Objs_End - Objs_Begin + 1;
 746          for J in Objs_End + 1 .. Linker_Objects.Last loop
 747             Linker_Objects.Table (J - N + 1) := Linker_Objects.Table (J);
 748          end loop;
 749
 750          Linker_Objects.Set_Last (Linker_Objects.Last - N + 1);
 751       end if;
 752
 753       --  Process switches and options
 754
 755       if Next_Line (Nfirst .. Nlast) /= End_Info then
 756          loop
 757             if Next_Line (Nfirst .. Nlast) = "-static" then
 758                GNAT_Static := True;
 759
 760             elsif Next_Line (Nfirst .. Nlast) = "-shared" then
 761                GNAT_Shared := True;
 762
 763             --  Add binder options only if not already set on the command
 764             --  line. This rule is a way to control the linker options order.
 765
 766             elsif not Is_Option_Present (Next_Line (Nfirst .. Nlast)) then
 767                if Nlast > Nfirst + 2 and then
 768                  Next_Line (Nfirst .. Nfirst + 1) = "-L"
 769                then
 770                   --  Construct a library search path for use later
 771                   --  to locate static gnatlib libraries.
 772
 773                   if Libpath.Last > 1 then
 774                      Libpath.Increment_Last;
 775                      Libpath.Table (Libpath.Last) := Path_Separator;
 776                   end if;
 777
 778                   for I in Nfirst + 2 .. Nlast loop
 779                      Libpath.Increment_Last;
 780                      Libpath.Table (Libpath.Last) := Next_Line (I);
 781                   end loop;
 782
 783                   Linker_Options.Increment_Last;
 784
 785                   Linker_Options.Table (Linker_Options.Last) :=
 786                     new String'(Next_Line (Nfirst .. Nlast));
 787
 788                elsif Next_Line (Nfirst .. Nlast) = "-ldecgnat"
 789                  or else Next_Line (Nfirst .. Nlast) = "-lgnarl"
 790                  or else Next_Line (Nfirst .. Nlast) = "-lgnat"
 791                then
 792                   --  Given a Gnat standard library, search the
 793                   --  library path to find the library location
 794
 795                   declare
 796                      File_Path : String_Access;
 797                      Object_Lib_Extension : constant String :=
 798                        Value (Object_Library_Ext_Ptr);
 799
 800                      File_Name : String := "lib" &
 801                        Next_Line (Nfirst + 2 .. Nlast) & Object_Lib_Extension;
 802
 803                   begin
 804                      File_Path :=
 805                        Locate_Regular_File (File_Name,
 806                          String (Libpath.Table (1 .. Libpath.Last)));
 807
 808                      if File_Path /= null then
 809                         if GNAT_Static then
 810
 811                            --  If static gnatlib found, explicitly
 812                            --  specify to overcome possible linker
 813                            --  default usage of shared version.
 814
 815                            Linker_Options.Increment_Last;
 816
 817                            Linker_Options.Table (Linker_Options.Last) :=
 818                              new String'(File_Path.all);
 819
 820                         elsif GNAT_Shared then
 821
 822                            --  If shared gnatlib desired, add the
 823                            --  appropriate system specific switch
 824                            --  so that it can be located at runtime.
 825
 826                            declare
 827                               Run_Path_Opt : constant String :=
 828                                 Value (Run_Path_Option_Ptr);
 829
 830                            begin
 831                               if Run_Path_Opt'Length /= 0 then
 832
 833                                  --  Output the system specific linker
 834                                  --  command that allows the image
 835                                  --  activator to find the shared library
 836                                  --  at runtime.
 837
 838                                  Linker_Options.Increment_Last;
 839
 840                                  Linker_Options.Table (Linker_Options.Last)
 841                                       := new String'(Run_Path_Opt
 842                                            & File_Path
 843                                               (1 .. File_Path'Length
 844                                                      - File_Name'Length));
 845                               end if;
 846
 847                               Linker_Options.Increment_Last;
 848                               Linker_Options.Table (Linker_Options.Last)
 849                                 := new String'(Next_Line (Nfirst .. Nlast));
 850                            end;
 851                         end if;
 852
 853                      else
 854                         --  If gnatlib library not found, then
 855                         --  add it anyway in case some other
 856                         --  mechanimsm may find it.
 857
 858                         Linker_Options.Increment_Last;
 859                         Linker_Options.Table (Linker_Options.Last)
 860                           := new String'(Next_Line (Nfirst .. Nlast));
 861                      end if;
 862                   end;
 863                else
 864                   Linker_Options.Increment_Last;
 865                   Linker_Options.Table (Linker_Options.Last)
 866                     := new String'(Next_Line (Nfirst .. Nlast));
 867                end if;
 868             end if;
 869
 870             Get_Next_Line;
 871             exit when Next_Line (Nfirst .. Nlast) = End_Info;
 872
 873             if Ada_Bind_File then
 874                Next_Line (Nfirst .. Nlast - 8)
 875                  := Next_Line (Nfirst + 8 .. Nlast);
 876                Nlast := Nlast - 8;
 877             end if;
 878          end loop;
 879       end if;
 880
 881       Status := fclose (Fd);
 882    end Process_Binder_File;
 883
 884    -----------
 885    -- Value --
 886    -----------
 887
 888    function Value (chars : chars_ptr) return String is
 889       function Strlen (chars : chars_ptr) return Natural;
 890       pragma Import (C, Strlen);
 891
 892    begin
 893       if chars = Null_Address then
 894          return "";
 895
 896       else
 897          declare
 898             subtype Result_Type is String (1 .. Strlen (chars));
 899
 900             Result : Result_Type;
 901             for Result'Address use chars;
 902
 903          begin
 904             return Result;
 905          end;
 906       end if;
 907    end Value;
 908
 909    -----------------
 910    -- Write_Usage --
 911    -----------------
 912
 913    procedure Write_Usage is
 914    begin
 915       Write_Str ("Usage: ");
 916       Write_Str (Base_Name (Command_Name));
 917       Write_Str (" switches mainprog.ali [non-Ada-objects] [linker-options]");
 918       Write_Eol;
 919       Write_Eol;
 920       Write_Line ("  mainprog.ali   the ALI file of the main program");
 921       Write_Eol;
 922       Write_Line ("  -A    Binder generated source file is in Ada (default)");
 923       Write_Line ("  -C    Binder generated source file is in C");
 924       Write_Line ("  -f    force object file list to be generated");
 925       Write_Line ("  -g    Compile binder source file with debug information");
 926       Write_Line ("  -n    Do not compile the binder source file");
 927       Write_Line ("  -v    verbose mode");
 928       Write_Line ("  -v -v very verbose mode");
 929       Write_Eol;
 930       Write_Line ("  -o nam     Use 'nam' as the name of the executable");
 931       Write_Line ("  -b target  Compile the binder source to run on target");
 932       Write_Line ("  -Bdir      Load compiler executables from dir");
 933       Write_Line ("  --GCC=comp Use comp as the compiler");
 934       Write_Line ("  --LINK=nam Use 'nam' for the linking rather than 'gcc'");
 935       Write_Eol;
 936       Write_Line ("  [non-Ada-objects]  list of non Ada object files");
 937       Write_Line ("  [linker-options]   other options for the linker");
 938    end Write_Usage;
 939
 940 --  Start of processing for Gnatlink
 941
 942 begin
 943    if Argument_Count = 0 then
 944       Write_Usage;
 945       Exit_Program (E_Fatal);
 946    end if;
 947
 948    if Hostparm.Java_VM then
 949       Gcc := new String'("jgnat");
 950       Ada_Bind_File := True;
 951       Begin_Info := "-- BEGIN Object file/option list";
 952       End_Info   := "-- END Object file/option list   ";
 953    end if;
 954
 955    Process_Args;
 956
 957    --  We always compile with -c
 958
 959    Binder_Options_From_ALI.Increment_Last;
 960    Binder_Options_From_ALI.Table (Binder_Options_From_ALI.Last) :=
 961      new String'("-c");
 962
 963    --  If the main program is in Ada it is compiled with the following
 964    --  switches:
 965
 966    --    -gnatA   stops reading gnat.adc, since we don't know what
 967    --             pagmas would work, and we do not need it anyway.
 968
 969    --    -gnatWb  allows brackets coding for wide characters
 970
 971    --    -gnatiw  allows wide characters in identifiers. This is needed
 972    --             because bindgen uses brackets encoding for all upper
 973    --             half and wide characters in identifier names.
 974
 975    if Ada_Bind_File then
 976       Binder_Options_From_ALI.Increment_Last;
 977       Binder_Options_From_ALI.Table (Binder_Options_From_ALI.Last) :=
 978         new String'("-gnatA");
 979       Binder_Options_From_ALI.Increment_Last;
 980       Binder_Options_From_ALI.Table (Binder_Options_From_ALI.Last) :=
 981         new String'("-gnatWb");
 982       Binder_Options_From_ALI.Increment_Last;
 983       Binder_Options_From_ALI.Table (Binder_Options_From_ALI.Last) :=
 984         new String'("-gnatiw");
 985    end if;
 986
 987    --  Locate all the necessary programs and verify required files are present
 988
 989    Gcc_Path := GNAT.OS_Lib.Locate_Exec_On_Path (Gcc.all);
 990
 991    if Gcc_Path = null then
 992       Exit_With_Error ("Couldn't locate " & Gcc.all);
 993    end if;
 994
 995    if Linker_Path = null then
 996       Linker_Path := Gcc_Path;
 997    end if;
 998
 999    if Ali_File_Name = null then
1000       Exit_With_Error ("Required 'name'.ali not present.");
1001    end if;
1002
1003    if not Is_Regular_File (Ali_File_Name.all) then
1004       Exit_With_Error (Ali_File_Name.all & " not found.");
1005
1006    --  Read the ALI file of the main subprogram if the binder generated
1007    --  file is in Ada, it need to be compiled and no --GCC= switch has
1008    --  been specified. Fetch the back end switches from this ALI file and use
1009    --  these switches to compile the binder generated file
1010
1011    elsif Ada_Bind_File
1012      and then Compile_Bind_File
1013      and then Standard_Gcc
1014    then
1015       --  Do some initializations
1016
1017       Initialize_ALI;
1018       Namet.Initialize;
1019       Name_Len := Ali_File_Name'Length;
1020       Name_Buffer (1 .. Name_Len) := Ali_File_Name.all;
1021
1022       declare
1023          use Types;
1024          F : constant File_Name_Type := Name_Find;
1025          T : Text_Buffer_Ptr;
1026          A : ALI_Id;
1027
1028       begin
1029          --  Osint.Add_Default_Search_Dirs;
1030          --  Load the ALI file
1031
1032          T := Read_Library_Info (F, True);
1033
1034          --  Read it
1035
1036          A := Scan_ALI (F, T, False, False, False);
1037
1038          if A /= No_ALI_Id then
1039             for
1040               Index in Units.Table (ALIs.Table (A).First_Unit).First_Arg
1041               .. Units.Table (ALIs.Table (A).First_Unit).Last_Arg
1042             loop
1043                --  Do not compile with the front end switches
1044
1045                if not Is_Front_End_Switch (Args.Table (Index).all) then
1046                   Binder_Options_From_ALI.Increment_Last;
1047                   Binder_Options_From_ALI.Table (Binder_Options_From_ALI.Last)
1048                     := String_Access (Args.Table (Index));
1049                end if;
1050             end loop;
1051          end if;
1052       end;
1053    end if;
1054
1055    if Verbose_Mode then
1056       Write_Eol;
1057       Write_Str ("GNATLINK ");
1058       Write_Str (Gnat_Version_String);
1059       Write_Str (" Copyright 1996-2002 Free Software Foundation, Inc.");
1060       Write_Eol;
1061    end if;
1062
1063    --  If there wasn't an output specified, then use the base name of
1064    --  the .ali file name.
1065
1066    if Output_File_Name = null then
1067
1068       Output_File_Name :=
1069         new String'(Base_Name (Ali_File_Name.all)
1070                        & Get_Debuggable_Suffix.all);
1071
1072       Linker_Options.Increment_Last;
1073       Linker_Options.Table (Linker_Options.Last) :=
1074         new String'("-o");
1075
1076       Linker_Options.Increment_Last;
1077       Linker_Options.Table (Linker_Options.Last) :=
1078         new String'(Output_File_Name.all);
1079
1080    end if;
1081
1082    --  Warn if main program is called "test", as that may be a built-in command
1083    --  on Unix. On non-Unix systems executables have a suffix, so the warning
1084    --  will not appear. However, do not warn in the case of a cross compiler.
1085
1086    --  Assume that if the executable name is not gnatlink, this is a cross
1087    --  tool.
1088
1089    if Base_Name (Command_Name) = "gnatlink"
1090      and then Output_File_Name.all = "test"
1091    then
1092       Error_Msg ("warning: executable name """ & Output_File_Name.all
1093                    & """ may conflict with shell command");
1094    end if;
1095
1096    --  Perform consistency checks
1097
1098    --  Transform the .ali file name into the binder output file name.
1099
1100    Make_Binder_File_Names : declare
1101       Fname     : String  := Base_Name (Ali_File_Name.all);
1102       Fname_Len : Integer := Fname'Length;
1103
1104       function Get_Maximum_File_Name_Length return Integer;
1105       pragma Import (C, Get_Maximum_File_Name_Length,
1106                         "__gnat_get_maximum_file_name_length");
1107
1108       Maximum_File_Name_Length : Integer := Get_Maximum_File_Name_Length;
1109
1110       Second_Char : Character;
1111       --  Second character of name of files
1112
1113    begin
1114       --  Set proper second character of file name
1115
1116       if not Ada_Bind_File then
1117          Second_Char := '_';
1118
1119       elsif Hostparm.OpenVMS then
1120          Second_Char := '$';
1121
1122       else
1123          Second_Char := '~';
1124       end if;
1125
1126       --  If the length of the binder file becomes too long due to
1127       --  the addition of the "b?" prefix, then truncate it.
1128
1129       if Maximum_File_Name_Length > 0 then
1130          while Fname_Len > Maximum_File_Name_Length - 2 loop
1131             Fname_Len := Fname_Len - 1;
1132          end loop;
1133       end if;
1134
1135       if Ada_Bind_File then
1136          Binder_Spec_Src_File :=
1137            new String'('b'
1138                        & Second_Char
1139                        & Fname (Fname'First .. Fname'First + Fname_Len - 1)
1140                        & ".ads");
1141          Binder_Body_Src_File :=
1142            new String'('b'
1143                        & Second_Char
1144                        & Fname (Fname'First .. Fname'First + Fname_Len - 1)
1145                        & ".adb");
1146          Binder_Ali_File :=
1147            new String'('b'
1148                        & Second_Char
1149                        & Fname (Fname'First .. Fname'First + Fname_Len - 1)
1150                        & ".ali");
1151
1152       else
1153          Binder_Body_Src_File :=
1154            new String'('b'
1155                        & Second_Char
1156                        & Fname (Fname'First .. Fname'First + Fname_Len - 1)
1157                        & ".c");
1158       end if;
1159
1160       Binder_Obj_File :=
1161         new String'('b'
1162                     & Second_Char
1163                     & Fname (Fname'First .. Fname'First + Fname_Len - 1)
1164                     & Get_Object_Suffix.all);
1165
1166       if Fname_Len /= Fname'Length then
1167          Binder_Options.Increment_Last;
1168          Binder_Options.Table (Binder_Options.Last) := new String'("-o");
1169          Binder_Options.Increment_Last;
1170          Binder_Options.Table (Binder_Options.Last) := Binder_Obj_File;
1171       end if;
1172
1173    end Make_Binder_File_Names;
1174
1175    Process_Binder_File (Binder_Body_Src_File.all & ASCII.NUL);
1176
1177    --  Compile the binder file. This is fast, so we always do it, unless
1178    --  specifically told not to by the -n switch
1179
1180    if Compile_Bind_File then
1181       Bind_Step : declare
1182          Success : Boolean;
1183          Args    : Argument_List
1184            (1 .. Binder_Options_From_ALI.Last + Binder_Options.Last + 1);
1185
1186       begin
1187          for J in 1 .. Binder_Options_From_ALI.Last loop
1188             Args (J) := Binder_Options_From_ALI.Table (J);
1189          end loop;
1190
1191          for J in 1 .. Binder_Options.Last loop
1192             Args (Binder_Options_From_ALI.Last + J) :=
1193               Binder_Options.Table (J);
1194          end loop;
1195
1196          Args (Args'Last) := Binder_Body_Src_File;
1197
1198          if Verbose_Mode then
1199             Write_Str (Base_Name (Gcc_Path.all));
1200
1201             for J in Args'Range loop
1202                Write_Str (" ");
1203                Write_Str (Args (J).all);
1204             end loop;
1205
1206             Write_Eol;
1207          end if;
1208
1209          GNAT.OS_Lib.Spawn (Gcc_Path.all, Args, Success);
1210
1211          if not Success then
1212             Exit_Program (E_Fatal);
1213          end if;
1214       end Bind_Step;
1215    end if;
1216
1217    --  Now, actually link the program.
1218
1219    --  Skip this step for now on the JVM since the Java interpreter will do
1220    --  the actual link at run time. We might consider packing all class files
1221    --  in a .zip file during this step.
1222
1223    if not Hostparm.Java_VM then
1224       Link_Step : declare
1225          Num_Args : Natural :=
1226                      (Linker_Options.Last - Linker_Options.First + 1) +
1227                      (Gcc_Linker_Options.Last - Gcc_Linker_Options.First + 1) +
1228                      (Linker_Objects.Last - Linker_Objects.First + 1);
1229          Stack_Op : Boolean := False;
1230          IDENT_Op : Boolean := False;
1231
1232       begin
1233          --  Remove duplicate stack size setting from the Linker_Options
1234          --  table. The stack setting option "-Xlinker --stack=R,C" can be
1235          --  found in one line when set by a pragma Linker_Options or in two
1236          --  lines ("-Xlinker" then "--stack=R,C") when set on the command
1237          --  line. We also check for the "-Wl,--stack=R" style option.
1238
1239          --  We must remove the second stack setting option instance
1240          --  because the one on the command line will always be the first
1241          --  one. And any subsequent stack setting option will overwrite the
1242          --  previous one. This is done especially for GNAT/NT where we set
1243          --  the stack size for tasking programs by a pragma in the NT
1244          --  specific tasking package System.Task_Primitives.Oparations.
1245
1246          for J in Linker_Options.First .. Linker_Options.Last loop
1247             if Linker_Options.Table (J).all = "-Xlinker"
1248               and then J < Linker_Options.Last
1249               and then Linker_Options.Table (J + 1)'Length > 8
1250               and then Linker_Options.Table (J + 1) (1 .. 8) = "--stack="
1251             then
1252                if Stack_Op then
1253                   Linker_Options.Table (J .. Linker_Options.Last - 2) :=
1254                     Linker_Options.Table (J + 2 .. Linker_Options.Last);
1255                   Linker_Options.Decrement_Last;
1256                   Linker_Options.Decrement_Last;
1257                   Num_Args := Num_Args - 2;
1258
1259                else
1260                   Stack_Op := True;
1261                end if;
1262             end if;
1263
1264             --  Here we just check for a canonical form that matches the
1265             --  pragma Linker_Options set in the NT runtime.
1266
1267             if (Linker_Options.Table (J)'Length > 17
1268                 and then Linker_Options.Table (J) (1 .. 17)
1269                         = "-Xlinker --stack=")
1270               or else
1271                (Linker_Options.Table (J)'Length > 12
1272                 and then Linker_Options.Table (J) (1 .. 12)
1273                          = "-Wl,--stack=")
1274             then
1275                if Stack_Op then
1276                   Linker_Options.Table (J .. Linker_Options.Last - 1) :=
1277                     Linker_Options.Table (J + 1 .. Linker_Options.Last);
1278                   Linker_Options.Decrement_Last;
1279                   Num_Args := Num_Args - 1;
1280
1281                else
1282                   Stack_Op := True;
1283                end if;
1284             end if;
1285
1286             --  Remove duplicate IDENTIFICATION directives (VMS)
1287
1288             if Linker_Options.Table (J)'Length > 27
1289               and then Linker_Options.Table (J) (1 .. 27)
1290                        = "--for-linker=IDENTIFICATION="
1291             then
1292                if IDENT_Op then
1293                   Linker_Options.Table (J .. Linker_Options.Last - 1) :=
1294                     Linker_Options.Table (J + 1 .. Linker_Options.Last);
1295                   Linker_Options.Decrement_Last;
1296                   Num_Args := Num_Args - 1;
1297                else
1298                   IDENT_Op := True;
1299                end if;
1300             end if;
1301          end loop;
1302
1303          --  Prepare arguments for call to linker
1304
1305          Call_Linker : declare
1306             Success  : Boolean;
1307             Args     : Argument_List (1 .. Num_Args + 1);
1308             Index    : Integer := Args'First;
1309
1310          begin
1311             Args (Index) := Binder_Obj_File;
1312
1313             --  Add the object files and any -largs libraries
1314
1315             for J in Linker_Objects.First .. Linker_Objects.Last loop
1316                Index := Index + 1;
1317                Args (Index) := Linker_Objects.Table (J);
1318             end loop;
1319
1320             --  Add the linker options from the binder file
1321
1322             for J in Linker_Options.First .. Linker_Options.Last loop
1323                Index := Index + 1;
1324                Args (Index) := Linker_Options.Table (J);
1325             end loop;
1326
1327             --  Finally add the libraries from the --GCC= switch
1328
1329             for J in Gcc_Linker_Options.First .. Gcc_Linker_Options.Last loop
1330                Index := Index + 1;
1331                Args (Index) := Gcc_Linker_Options.Table (J);
1332             end loop;
1333
1334             if Verbose_Mode then
1335                Write_Str (Linker_Path.all);
1336
1337                for J in Args'Range loop
1338                   Write_Str (" ");
1339                   Write_Str (Args (J).all);
1340                end loop;
1341
1342                Write_Eol;
1343
1344                --  If we are on very verbose mode (-v -v) and a response file
1345                --  is used we display its content.
1346
1347                if Very_Verbose_Mode and then Tname_FD /= Invalid_FD then
1348                   Write_Eol;
1349                   Write_Str ("Response file (" &
1350                              Tname (Tname'First .. Tname'Last - 1) &
1351                              ") content : ");
1352                   Write_Eol;
1353
1354                   for J in
1355                     Response_File_Objects.First ..
1356                     Response_File_Objects.Last
1357                   loop
1358                      Write_Str (Response_File_Objects.Table (J).all);
1359                      Write_Eol;
1360                   end loop;
1361
1362                   Write_Eol;
1363                end if;
1364             end if;
1365
1366             GNAT.OS_Lib.Spawn (Linker_Path.all, Args, Success);
1367
1368             --  Delete the temporary file used in conjuction with linking if
1369             --  one was created. See Process_Bind_File for details.
1370
1371             if Tname_FD /= Invalid_FD then
1372                Delete (Tname);
1373             end if;
1374
1375             if not Success then
1376                Error_Msg ("cannot call " & Linker_Path.all);
1377                Exit_Program (E_Fatal);
1378             end if;
1379          end Call_Linker;
1380       end Link_Step;
1381    end if;
1382
1383    --  Only keep the binder output file and it's associated object
1384    --  file if compiling with the -g option.  These files are only
1385    --  useful if debugging.
1386
1387    if not Debug_Flag_Present then
1388       if Binder_Ali_File /= null then
1389          Delete (Binder_Ali_File.all & ASCII.NUL);
1390       end if;
1391
1392       if Binder_Spec_Src_File /= null then
1393          Delete (Binder_Spec_Src_File.all & ASCII.NUL);
1394       end if;
1395
1396       Delete (Binder_Body_Src_File.all & ASCII.NUL);
1397
1398       if not Hostparm.Java_VM then
1399          Delete (Binder_Obj_File.all & ASCII.NUL);
1400       end if;
1401    end if;
1402
1403    Exit_Program (E_Success);
1404
1405 exception
1406    when X : others =>
1407       Write_Line (Exception_Information (X));
1408       Exit_With_Error ("INTERNAL ERROR. Please report.");
1409 end Gnatlink;