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