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