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