gcc/ada/gnatlink.adb

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