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