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