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