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 --                            $Revision: 1.1 $
  10 --                                                                          --
  11 --          Copyright (C) 1996-2001 Free Software Foundation, Inc.          --
  12 --                                                                          --
  13 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  14 -- terms of the  GNU General Public License as published  by the Free Soft- --
  15 -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
  16 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  17 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  18 -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  19 -- for  more details.  You should have  received  a copy of the GNU General --
  20 -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
  21 -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
  22 -- MA 02111-1307, USA.                                                      --
  23 --                                                                          --
  24 -- GNAT was originally developed  by the GNAT team at  New York University. --
  25 -- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
  26 --                                                                          --
  27 ------------------------------------------------------------------------------
  28
  29 --  Gnatlink usage: please consult the gnat documentation
  30
  31 with Gnatvsn;  use Gnatvsn;
  32 with Hostparm;
  33 with Osint;    use Osint;
  34 with Output;   use Output;
  35 with System;   use System;
  36 with Table;
  37
  38 with Ada.Command_Line;     use Ada.Command_Line;
  39 with GNAT.OS_Lib;          use GNAT.OS_Lib;
  40 with Interfaces.C_Streams; use Interfaces.C_Streams;
  41
  42 procedure Gnatlink is
  43
  44    pragma Ident (Gnat_Version_String);
  45
  46    package Gcc_Linker_Options is new Table.Table (
  47      Table_Component_Type => String_Access,
  48      Table_Index_Type     => Integer,
  49      Table_Low_Bound      => 1,
  50      Table_Initial        => 20,
  51      Table_Increment      => 100,
  52      Table_Name           => "Gnatlink.Gcc_Linker_Options");
  53    --  Comments needed ???
  54
  55    package Libpath is new Table.Table (
  56      Table_Component_Type => Character,
  57      Table_Index_Type     => Integer,
  58      Table_Low_Bound      => 1,
  59      Table_Initial        => 4096,
  60      Table_Increment      => 2,
  61      Table_Name           => "Gnatlink.Libpath");
  62    --  Comments needed ???
  63
  64    package Linker_Options is new Table.Table (
  65      Table_Component_Type => String_Access,
  66      Table_Index_Type     => Integer,
  67      Table_Low_Bound      => 1,
  68      Table_Initial        => 20,
  69      Table_Increment      => 100,
  70      Table_Name           => "Gnatlink.Linker_Options");
  71    --  Comments needed ???
  72
  73    package Linker_Objects is new Table.Table (
  74      Table_Component_Type => String_Access,
  75      Table_Index_Type     => Integer,
  76      Table_Low_Bound      => 1,
  77      Table_Initial        => 20,
  78      Table_Increment      => 100,
  79      Table_Name           => "Gnatlink.Linker_Objects");
  80    --  This table collects the objects file to be passed to the linker. In the
  81    --  case where the linker command line is too long then programs objects
  82    --  are put on the Response_File_Objects table. Note that the binder object
  83    --  file and the user's objects remain in this table. This is very
  84    --  important because on the GNU linker command line the -L switch is not
  85    --  used to look for objects files but -L switch is used to look for
  86    --  objects listed in the response file. This is not a problem with the
  87    --  applications objects as they are specified with a fullname.
  88
  89    package Response_File_Objects is new Table.Table (
  90      Table_Component_Type => String_Access,
  91      Table_Index_Type     => Integer,
  92      Table_Low_Bound      => 1,
  93      Table_Initial        => 20,
  94      Table_Increment      => 100,
  95      Table_Name           => "Gnatlink.Response_File_Objects");
  96    --  This table collects the objects file that are to be put in the response
  97    --  file. Only application objects are collected there (see details in
  98    --  Linker_Objects table comments)
  99
 100    package Binder_Options is new Table.Table (
 101      Table_Component_Type => String_Access,
 102      Table_Index_Type     => Integer,
 103      Table_Low_Bound      => 1, -- equals low bound of Argument_List for Spawn
 104      Table_Initial        => 20,
 105      Table_Increment      => 100,
 106      Table_Name           => "Gnatlink.Binder_Options");
 107    --  This table collects the arguments to be passed to compile the binder
 108    --  generated file.
 109
 110    subtype chars_ptr is System.Address;
 111
 112    Gcc : String_Access := Program_Name ("gcc");
 113
 114    Read_Mode  : constant String := "r" & ASCII.Nul;
 115
 116    Begin_Info : String := "-- BEGIN Object file/option list";
 117    End_Info   : String := "-- END Object file/option list   ";
 118    --  Note: above lines are modified in C mode, see option processing
 119
 120    Gcc_Path             : String_Access;
 121    Linker_Path          : String_Access;
 122
 123    Output_File_Name     : String_Access;
 124    Ali_File_Name        : String_Access;
 125    Binder_Spec_Src_File : String_Access;
 126    Binder_Body_Src_File : String_Access;
 127    Binder_Ali_File      : String_Access;
 128    Binder_Obj_File      : String_Access;
 129
 130    Tname    : Temp_File_Name;
 131    Tname_FD : File_Descriptor := Invalid_FD;
 132    --  Temporary file used by linker to pass list of object files on
 133    --  certain systems with limitations on size of arguments.
 134
 135    Debug_Flag_Present : Boolean := False;
 136    Verbose_Mode       : Boolean := False;
 137    Very_Verbose_Mode  : Boolean := False;
 138
 139    Ada_Bind_File : Boolean := True;
 140    --  Set to True if bind file is generated in Ada
 141
 142    Compile_Bind_File : Boolean := True;
 143    --  Set to False if bind file is not to be compiled
 144
 145    Object_List_File_Supported : Boolean;
 146    pragma Import (C, Object_List_File_Supported, "objlist_file_supported");
 147    --  Predicate indicating whether the linker has an option whereby the
 148    --  names of object files can be passed to the linker in a file.
 149
 150    Object_List_File_Required : Boolean := False;
 151    --  Set to True to force generation of a response file
 152
 153    function Base_Name (File_Name : in String) return String;
 154    --  Return just the file name part without the extension (if present).
 155
 156    procedure Delete (Name : in String);
 157    --  Wrapper to unlink as status is ignored by this application.
 158
 159    procedure Error_Msg (Message : in String);
 160    --  Output the error or warning Message
 161
 162    procedure Exit_With_Error (Error : in String);
 163    --  Output Error and exit program with a fatal condition.
 164
 165    procedure Process_Args;
 166    --  Go through all the arguments and build option tables.
 167
 168    procedure Process_Binder_File (Name : in String);
 169    --  Reads the binder file and extracts linker arguments.
 170
 171    function Value (chars : chars_ptr) return String;
 172    --  Return NUL-terminated string chars as an Ada string.
 173
 174    procedure Write_Usage;
 175    --  Show user the program options.
 176
 177    ---------------
 178    -- Base_Name --
 179    ---------------
 180
 181    function Base_Name (File_Name : in String) return String is
 182       Findex1 : Natural;
 183       Findex2 : Natural;
 184
 185    begin
 186       Findex1 := File_Name'First;
 187
 188       --  The file might be specified by a full path name. However,
 189       --  we want the path to be stripped away.
 190
 191       for J in reverse File_Name'Range loop
 192          if Is_Directory_Separator (File_Name (J)) then
 193             Findex1 := J + 1;
 194             exit;
 195          end if;
 196       end loop;
 197
 198       Findex2 := File_Name'Last;
 199       while Findex2 > Findex1
 200         and then File_Name (Findex2) /=  '.'
 201       loop
 202          Findex2 := Findex2 - 1;
 203       end loop;
 204
 205       if Findex2 = Findex1 then
 206          Findex2 := File_Name'Last + 1;
 207       end if;
 208
 209       return File_Name (Findex1 .. Findex2 - 1);
 210    end Base_Name;
 211
 212    ------------
 213    -- Delete --
 214    ------------
 215
 216    procedure Delete (Name : in String) is
 217       Status : int;
 218
 219    begin
 220       Status := unlink (Name'Address);
 221    end Delete;
 222
 223    ---------------
 224    -- Error_Msg --
 225    ---------------
 226
 227    procedure Error_Msg (Message : in String) is
 228    begin
 229       Write_Str (Base_Name (Command_Name));
 230       Write_Str (": ");
 231       Write_Str (Message);
 232       Write_Eol;
 233    end Error_Msg;
 234
 235    ---------------------
 236    -- Exit_With_Error --
 237    ---------------------
 238
 239    procedure Exit_With_Error (Error : in String) is
 240    begin
 241       Error_Msg (Error);
 242       Exit_Program (E_Fatal);
 243    end Exit_With_Error;
 244
 245    ------------------
 246    -- Process_Args --
 247    ------------------
 248
 249    procedure Process_Args is
 250       Next_Arg : Integer;
 251
 252    begin
 253       Binder_Options.Increment_Last;
 254       Binder_Options.Table (Binder_Options.Last) := new String'("-c");
 255
 256       --  If the main program is in Ada it is compiled with the following
 257       --  switches:
 258
 259       --    -gnatA   stops reading gnat.adc, since we don't know what
 260       --             pagmas would work, and we do not need it anyway.
 261
 262       --    -gnatWb  allows brackets coding for wide characters
 263
 264       --    -gnatiw  allows wide characters in identifiers. This is needed
 265       --             because bindgen uses brackets encoding for all upper
 266       --             half and wide characters in identifier names.
 267
 268       if Ada_Bind_File then
 269          Binder_Options.Increment_Last;
 270          Binder_Options.Table (Binder_Options.Last) := new String'("-gnatA");
 271          Binder_Options.Increment_Last;
 272          Binder_Options.Table (Binder_Options.Last) := new String'("-gnatWb");
 273          Binder_Options.Increment_Last;
 274          Binder_Options.Table (Binder_Options.Last) := new String'("-gnatiw");
 275       end if;
 276
 277       --  Loop through arguments of gnatlink command
 278
 279       Next_Arg := 1;
 280       loop
 281          exit when Next_Arg > Argument_Count;
 282
 283          Process_One_Arg : declare
 284             Arg : String := Argument (Next_Arg);
 285
 286          begin
 287             --  Case of argument which is a switch
 288
 289             --  We definitely need section by section comments here ???
 290
 291             if Arg'Length /= 0
 292               and then (Arg (1) = Switch_Character or else Arg (1) = '-')
 293             then
 294                if Arg'Length > 4
 295                  and then Arg (2 .. 5) =  "gnat"
 296                then
 297                   Exit_With_Error
 298                     ("invalid switch: """ & Arg & """ (gnat not needed here)");
 299                end if;
 300
 301                if Arg (2) = 'g'
 302                  and then (Arg'Length < 5 or else Arg (2 .. 5) /= "gnat")
 303                then
 304                   Debug_Flag_Present := True;
 305
 306                   Linker_Options.Increment_Last;
 307                   Linker_Options.Table (Linker_Options.Last) :=
 308                    new String'(Arg);
 309
 310                   Binder_Options.Increment_Last;
 311                   Binder_Options.Table (Binder_Options.Last) :=
 312                     Linker_Options.Table (Linker_Options.Last);
 313
 314                elsif Arg'Length = 2 then
 315                   case Arg (2) is
 316                      when 'A' =>
 317                         Ada_Bind_File := True;
 318                         Begin_Info := "-- BEGIN Object file/option list";
 319                         End_Info   := "-- END Object file/option list   ";
 320
 321                      when 'b' =>
 322                         Linker_Options.Increment_Last;
 323                         Linker_Options.Table (Linker_Options.Last) :=
 324                           new String'(Arg);
 325
 326                         Binder_Options.Increment_Last;
 327                         Binder_Options.Table (Binder_Options.Last) :=
 328                           Linker_Options.Table (Linker_Options.Last);
 329
 330                         Next_Arg := Next_Arg + 1;
 331
 332                         if Next_Arg > Argument_Count then
 333                            Exit_With_Error ("Missing argument for -b");
 334                         end if;
 335
 336                         Get_Machine_Name : declare
 337                            Name_Arg : String_Access :=
 338                                         new String'(Argument (Next_Arg));
 339
 340                         begin
 341                            Linker_Options.Increment_Last;
 342                            Linker_Options.Table (Linker_Options.Last) :=
 343                              Name_Arg;
 344
 345                            Binder_Options.Increment_Last;
 346                            Binder_Options.Table (Binder_Options.Last) :=
 347                              Name_Arg;
 348
 349                         end Get_Machine_Name;
 350
 351                      when 'C' =>
 352                         Ada_Bind_File := False;
 353                         Begin_Info := "/* BEGIN Object file/option list";
 354                         End_Info   := "   END Object file/option list */";
 355
 356                      when 'f' =>
 357                         if Object_List_File_Supported then
 358                            Object_List_File_Required := True;
 359                         else
 360                            Exit_With_Error
 361                              ("Object list file not supported on this target");
 362                         end if;
 363
 364                      when 'n' =>
 365                         Compile_Bind_File := False;
 366
 367                      when 'o' =>
 368                         Linker_Options.Increment_Last;
 369                         Linker_Options.Table (Linker_Options.Last) :=
 370                          new String'(Arg);
 371
 372                         Next_Arg := Next_Arg + 1;
 373
 374                         if Next_Arg > Argument_Count then
 375                            Exit_With_Error ("Missing argument for -o");
 376                         end if;
 377
 378                         Output_File_Name := new String'(Argument (Next_Arg));
 379
 380                         Linker_Options.Increment_Last;
 381                         Linker_Options.Table (Linker_Options.Last) :=
 382                           Output_File_Name;
 383
 384                      when 'v' =>
 385
 386                         --  Support "double" verbose mode.  Second -v
 387                         --  gets sent to the linker and binder phases.
 388
 389                         if Verbose_Mode then
 390                            Very_Verbose_Mode := True;
 391
 392                            Linker_Options.Increment_Last;
 393                            Linker_Options.Table (Linker_Options.Last) :=
 394                             new String'(Arg);
 395
 396                            Binder_Options.Increment_Last;
 397                            Binder_Options.Table (Binder_Options.Last) :=
 398                              Linker_Options.Table (Linker_Options.Last);
 399
 400                         else
 401                            Verbose_Mode := True;
 402
 403                         end if;
 404
 405                      when others =>
 406                         Linker_Options.Increment_Last;
 407                         Linker_Options.Table (Linker_Options.Last) :=
 408                          new String'(Arg);
 409
 410                   end case;
 411
 412                elsif Arg (2) = 'B' then
 413                   Linker_Options.Increment_Last;
 414                   Linker_Options.Table (Linker_Options.Last) :=
 415                    new String'(Arg);
 416
 417                   Binder_Options.Increment_Last;
 418                   Binder_Options.Table (Binder_Options.Last) :=
 419                     Linker_Options.Table (Linker_Options.Last);
 420
 421                elsif Arg'Length >= 7 and then Arg (1 .. 7) = "--LINK=" then
 422
 423                   if Arg'Length = 7 then
 424                      Exit_With_Error ("Missing argument for --LINK=");
 425                   end if;
 426
 427                   Linker_Path :=
 428                     GNAT.OS_Lib.Locate_Exec_On_Path (Arg (8 .. Arg'Last));
 429
 430                   if Linker_Path = null then
 431                      Exit_With_Error
 432                        ("Could not locate linker: " & Arg (8 .. Arg'Last));
 433                   end if;
 434
 435                elsif Arg'Length > 6 and then Arg (1 .. 6) = "--GCC=" then
 436                   declare
 437                      Program_Args : Argument_List_Access :=
 438                                       Argument_String_To_List
 439                                                  (Arg (7 .. Arg'Last));
 440
 441                   begin
 442                      Gcc := new String'(Program_Args.all (1).all);
 443
 444                      --  Set appropriate flags for switches passed
 445
 446                      for J in 2 .. Program_Args.all'Last loop
 447                         declare
 448                            Arg : String := Program_Args.all (J).all;
 449                            AF  : Integer := Arg'First;
 450
 451                         begin
 452                            if Arg'Length /= 0
 453                              and then (Arg (AF) = Switch_Character
 454                                         or else Arg (AF) = '-')
 455                            then
 456                               if Arg (AF + 1) = 'g'
 457                                 and then (Arg'Length = 2
 458                                   or else Arg (AF + 2) in '0' .. '3'
 459                                   or else Arg (AF + 2 .. Arg'Last) = "coff")
 460                               then
 461                                  Debug_Flag_Present := True;
 462                               end if;
 463                            end if;
 464
 465                            --  Pass to gcc for compiling binder generated file
 466                            --  No use passing libraries, it will just generate
 467                            --  a warning
 468
 469                            if not (Arg (AF .. AF + 1) = "-l"
 470                              or else Arg (AF .. AF + 1) = "-L")
 471                            then
 472                               Binder_Options.Increment_Last;
 473                               Binder_Options.Table (Binder_Options.Last) :=
 474                                 new String'(Arg);
 475                            end if;
 476
 477                            --  Pass to gcc for linking program.
 478
 479                            Gcc_Linker_Options.Increment_Last;
 480                            Gcc_Linker_Options.Table
 481                              (Gcc_Linker_Options.Last) := new String'(Arg);
 482                         end;
 483                      end loop;
 484                   end;
 485
 486                --  Send all multi-character switches not recognized as
 487                --  a special case by gnatlink to the linker/loader stage.
 488
 489                else
 490                   Linker_Options.Increment_Last;
 491                   Linker_Options.Table (Linker_Options.Last) :=
 492                     new String'(Arg);
 493                end if;
 494
 495             --  Here if argument is a file name rather than a switch
 496
 497             else
 498                if Arg'Length > 4
 499                  and then Arg (Arg'Last - 3 .. Arg'Last) = ".ali"
 500                then
 501                   if Ali_File_Name = null then
 502                      Ali_File_Name := new String'(Arg);
 503                   else
 504                      Exit_With_Error ("cannot handle more than one ALI file");
 505                   end if;
 506
 507                elsif Is_Regular_File (Arg & ".ali")
 508                  and then Ali_File_Name = null
 509                then
 510                   Ali_File_Name := new String'(Arg & ".ali");
 511
 512                elsif Arg'Length > Get_Object_Suffix.all'Length
 513                  and then Arg
 514                    (Arg'Last - Get_Object_Suffix.all'Length + 1 .. Arg'Last)
 515                                                 = Get_Object_Suffix.all
 516                then
 517                   Linker_Objects.Increment_Last;
 518                   Linker_Objects.Table (Linker_Objects.Last) :=
 519                     new String'(Arg);
 520
 521                else
 522                   Linker_Options.Increment_Last;
 523                   Linker_Options.Table (Linker_Options.Last) :=
 524                     new String'(Arg);
 525                end if;
 526
 527             end if;
 528
 529          end Process_One_Arg;
 530
 531          Next_Arg := Next_Arg + 1;
 532       end loop;
 533
 534       --  If Ada bind file, then compile it with warnings suppressed, because
 535       --  otherwise the with of the main program may cause junk warnings.
 536
 537       if Ada_Bind_File then
 538          Binder_Options.Increment_Last;
 539          Binder_Options.Table (Binder_Options.Last) := new String'("-gnatws");
 540       end if;
 541    end Process_Args;
 542
 543    -------------------------
 544    -- Process_Binder_File --
 545    -------------------------
 546
 547    procedure Process_Binder_File (Name : in String) is
 548       Fd           : FILEs;
 549       Link_Bytes   : Integer := 0;
 550       Link_Max     : Integer;
 551       pragma Import (C, Link_Max, "link_max");
 552
 553       Next_Line    : String (1 .. 1000);
 554       Nlast        : Integer;
 555       Nfirst       : Integer;
 556       Objs_Begin   : Integer := 0;
 557       Objs_End     : Integer := 0;
 558
 559       Status       : int;
 560       N            : Integer;
 561
 562       GNAT_Static  : Boolean := False;
 563       --  Save state of -static option.
 564
 565       GNAT_Shared  : Boolean := False;
 566       --  Save state of -shared option.
 567
 568       Run_Path_Option_Ptr : Address;
 569       pragma Import (C, Run_Path_Option_Ptr, "run_path_option");
 570       --  Pointer to string representing the native linker option which
 571       --  specifies the path where the dynamic loader should find shared
 572       --  libraries. Equal to null string if this system doesn't support it.
 573
 574       Object_Library_Ext_Ptr : Address;
 575       pragma Import (C, Object_Library_Ext_Ptr, "object_library_extension");
 576       --  Pointer to string specifying the default extension for
 577       --  object libraries, e.g. Unix uses ".a", VMS uses ".olb".
 578
 579       Object_File_Option_Ptr : Address;
 580       pragma Import (C, Object_File_Option_Ptr, "object_file_option");
 581       --  Pointer to a string representing the linker option which specifies
 582       --  the response file.
 583
 584       Using_GNU_Linker : Boolean;
 585       pragma Import (C, Using_GNU_Linker, "using_gnu_linker");
 586       --  Predicate indicating whether this target uses the GNU linker. In
 587       --  this case we must output a GNU linker compatible response file.
 588
 589       procedure Get_Next_Line;
 590       --  Read the next line from the binder file without the line
 591       --  terminator.
 592
 593       function Is_Option_Present (Opt : in String) return Boolean;
 594       --  Return true if the option Opt is already present in
 595       --  Linker_Options table.
 596
 597       procedure Get_Next_Line is
 598          Fchars : chars;
 599
 600       begin
 601          Fchars := fgets (Next_Line'Address, Next_Line'Length, Fd);
 602
 603          if Fchars = System.Null_Address then
 604             Exit_With_Error ("Error reading binder output");
 605          end if;
 606
 607          Nfirst := Next_Line'First;
 608          Nlast := Nfirst;
 609          while Nlast <= Next_Line'Last
 610            and then Next_Line (Nlast) /= ASCII.LF
 611            and then Next_Line (Nlast) /= ASCII.CR
 612          loop
 613             Nlast := Nlast + 1;
 614          end loop;
 615
 616          Nlast := Nlast - 1;
 617       end Get_Next_Line;
 618
 619       function Is_Option_Present (Opt : in String) return Boolean is
 620       begin
 621          for I in 1 .. Linker_Options.Last loop
 622
 623             if Linker_Options.Table (I).all = Opt then
 624                return True;
 625             end if;
 626
 627          end loop;
 628
 629          return False;
 630       end Is_Option_Present;
 631
 632    --  Start of processing for Process_Binder_File
 633
 634    begin
 635       Fd := fopen (Name'Address, Read_Mode'Address);
 636
 637       if Fd = NULL_Stream then
 638          Exit_With_Error ("Failed to open binder output");
 639       end if;
 640
 641       --  Skip up to the Begin Info line
 642
 643       loop
 644          Get_Next_Line;
 645          exit when Next_Line (Nfirst .. Nlast) = Begin_Info;
 646       end loop;
 647
 648       loop
 649          Get_Next_Line;
 650
 651          --  Go to end when end line is reached (this will happen in
 652          --  No_Run_Time mode where no -L switches are generated)
 653
 654          exit when Next_Line (Nfirst .. Nlast) = End_Info;
 655
 656          if Ada_Bind_File then
 657             Next_Line (Nfirst .. Nlast - 8) :=
 658               Next_Line (Nfirst + 8 .. Nlast);
 659             Nlast := Nlast - 8;
 660          end if;
 661
 662          --  Go to next section when switches are reached
 663
 664          exit when Next_Line (1) = '-';
 665
 666          --  Otherwise we have another object file to collect
 667
 668          Linker_Objects.Increment_Last;
 669
 670          --  Mark the positions of first and last object files in case
 671          --  they need to be placed with a named file on systems having
 672          --  linker line limitations.
 673
 674          if Objs_Begin = 0 then
 675             Objs_Begin := Linker_Objects.Last;
 676          end if;
 677
 678          Linker_Objects.Table (Linker_Objects.Last) :=
 679            new String'(Next_Line (Nfirst .. Nlast));
 680
 681          Link_Bytes := Link_Bytes + Nlast - Nfirst;
 682       end loop;
 683
 684       Objs_End := Linker_Objects.Last;
 685
 686       --  On systems that have limitations on handling very long linker lines
 687       --  we make use of the system linker option which takes a list of object
 688       --  file names from a file instead of the command line itself. What we do
 689       --  is to replace the list of object files by the special linker option
 690       --  which then reads the object file list from a file instead. The option
 691       --  to read from a file instead of the command line is only triggered if
 692       --  a conservative threshold is passed.
 693
 694       if Object_List_File_Required
 695         or else (Object_List_File_Supported
 696                    and then Link_Bytes > Link_Max)
 697       then
 698          --  Create a temporary file containing the Ada user object files
 699          --  needed by the link. This list is taken from the bind file
 700          --  and is output one object per line for maximal compatibility with
 701          --  linkers supporting this option.
 702
 703          Create_Temp_File (Tname_FD, Tname);
 704
 705          --  If target is using the GNU linker we must add a special header
 706          --  and footer in the response file.
 707          --  The syntax is : INPUT (object1.o object2.o ... )
 708
 709          if Using_GNU_Linker then
 710             declare
 711                GNU_Header : aliased constant String := "INPUT (";
 712
 713             begin
 714                Status := Write (Tname_FD, GNU_Header'Address,
 715                  GNU_Header'Length);
 716             end;
 717          end if;
 718
 719          for J in Objs_Begin .. Objs_End loop
 720             Status := Write (Tname_FD, Linker_Objects.Table (J).all'Address,
 721               Linker_Objects.Table (J).all'Length);
 722             Status := Write (Tname_FD, ASCII.LF'Address, 1);
 723
 724             Response_File_Objects.Increment_Last;
 725             Response_File_Objects.Table (Response_File_Objects.Last) :=
 726               Linker_Objects.Table (J);
 727          end loop;
 728
 729          --  handle GNU linker response file footer.
 730
 731          if Using_GNU_Linker then
 732             declare
 733                GNU_Footer : aliased constant String := ")";
 734
 735             begin
 736                Status := Write (Tname_FD, GNU_Footer'Address,
 737                  GNU_Footer'Length);
 738             end;
 739          end if;
 740
 741          Close (Tname_FD);
 742
 743          --  Add the special objects list file option together with the name
 744          --  of the temporary file (removing the null character) to the objects
 745          --  file table.
 746
 747          Linker_Objects.Table (Objs_Begin) :=
 748            new String'(Value (Object_File_Option_Ptr) &
 749                        Tname (Tname'First .. Tname'Last - 1));
 750
 751          --  The slots containing these object file names are then removed
 752          --  from the objects table so they do not appear in the link. They
 753          --  are removed by moving up the linker options and non-Ada object
 754          --  files appearing after the Ada object list in the table.
 755
 756          N := Objs_End - Objs_Begin + 1;
 757          for J in Objs_End + 1 .. Linker_Objects.Last loop
 758             Linker_Objects.Table (J - N + 1) := Linker_Objects.Table (J);
 759          end loop;
 760
 761          Linker_Objects.Set_Last (Linker_Objects.Last - N + 1);
 762       end if;
 763
 764       --  Process switches and options
 765
 766       if Next_Line (Nfirst .. Nlast) /= End_Info then
 767          loop
 768             --  Add binder options only if not already set on the command
 769             --  line. This rule is a way to control the linker options order.
 770
 771             if not Is_Option_Present
 772               (Next_Line (Nfirst .. Nlast))
 773             then
 774                if Next_Line (Nfirst .. Nlast) = "-static" then
 775                   GNAT_Static := True;
 776
 777                elsif Next_Line (Nfirst .. Nlast) = "-shared" then
 778                   GNAT_Shared := True;
 779
 780                else
 781                   if Nlast > Nfirst + 2 and then
 782                     Next_Line (Nfirst .. Nfirst + 1) = "-L"
 783                   then
 784                      --  Construct a library search path for use later
 785                      --  to locate static gnatlib libraries.
 786
 787                      if Libpath.Last > 1 then
 788                         Libpath.Increment_Last;
 789                         Libpath.Table (Libpath.Last) := Path_Separator;
 790                      end if;
 791
 792                      for I in Nfirst + 2 .. Nlast loop
 793                         Libpath.Increment_Last;
 794                         Libpath.Table (Libpath.Last) := Next_Line (I);
 795                      end loop;
 796
 797                      Linker_Options.Increment_Last;
 798
 799                      Linker_Options.Table (Linker_Options.Last) :=
 800                       new String'(Next_Line (Nfirst .. Nlast));
 801
 802                   elsif Next_Line (Nfirst .. Nlast) = "-ldecgnat"
 803                     or else Next_Line (Nfirst .. Nlast) = "-lgnarl"
 804                     or else Next_Line (Nfirst .. Nlast) = "-lgnat"
 805                   then
 806                      --  Given a Gnat standard library, search the
 807                      --  library path to find the library location
 808                      declare
 809                         File_Path : String_Access;
 810
 811                         Object_Lib_Extension : constant String :=
 812                                                  Value
 813                                                    (Object_Library_Ext_Ptr);
 814
 815                         File_Name : String :=
 816                                       "lib" &
 817                                         Next_Line (Nfirst + 2 .. Nlast) &
 818                                         Object_Lib_Extension;
 819
 820                      begin
 821                         File_Path :=
 822                           Locate_Regular_File
 823                            (File_Name,
 824                             String (Libpath.Table (1 .. Libpath.Last)));
 825
 826                         if File_Path /= null then
 827                            if GNAT_Static then
 828
 829                               --  If static gnatlib found, explicitly
 830                               --  specify to overcome possible linker
 831                               --  default usage of shared version.
 832
 833                               Linker_Options.Increment_Last;
 834
 835                               Linker_Options.Table (Linker_Options.Last) :=
 836                                new String'(File_Path.all);
 837
 838                            elsif GNAT_Shared then
 839
 840                               --  If shared gnatlib desired, add the
 841                               --  appropriate system specific switch
 842                               --  so that it can be located at runtime.
 843
 844                               declare
 845                                  Run_Path_Opt : constant String :=
 846                                                   Value
 847                                                     (Run_Path_Option_Ptr);
 848
 849                               begin
 850                                  if Run_Path_Opt'Length /= 0 then
 851
 852                                     --  Output the system specific linker
 853                                     --  command that allows the image
 854                                     --  activator to find the shared library
 855                                     --  at runtime.
 856
 857                                     Linker_Options.Increment_Last;
 858
 859                                     Linker_Options.Table
 860                                      (Linker_Options.Last) :=
 861                                        new String'(Run_Path_Opt
 862                                           & File_Path
 863                                             (1 .. File_Path'Length
 864                                                    - File_Name'Length));
 865                                  end if;
 866
 867                                  Linker_Options.Increment_Last;
 868
 869                                  Linker_Options.Table
 870                                   (Linker_Options.Last) :=
 871                                    new String'(Next_Line
 872                                                 (Nfirst .. Nlast));
 873
 874                               end;
 875                            end if;
 876
 877                         else
 878                            --  If gnatlib library not found, then
 879                            --  add it anyway in case some other
 880                            --  mechanimsm may find it.
 881
 882                            Linker_Options.Increment_Last;
 883
 884                            Linker_Options.Table (Linker_Options.Last) :=
 885                              new String'(Next_Line (Nfirst .. Nlast));
 886                         end if;
 887                      end;
 888                   else
 889                      Linker_Options.Increment_Last;
 890                      Linker_Options.Table (Linker_Options.Last) :=
 891                       new String'(Next_Line (Nfirst .. Nlast));
 892                   end if;
 893                end if;
 894             end if;
 895
 896             Get_Next_Line;
 897             exit when Next_Line (Nfirst .. Nlast) = End_Info;
 898
 899             if Ada_Bind_File then
 900                Next_Line (Nfirst .. Nlast - 8) :=
 901                  Next_Line (Nfirst + 8 .. Nlast);
 902                Nlast := Nlast - 8;
 903             end if;
 904          end loop;
 905       end if;
 906
 907       Status := fclose (Fd);
 908    end Process_Binder_File;
 909
 910    -----------
 911    -- Value --
 912    -----------
 913
 914    function Value (chars : chars_ptr) return String is
 915       function Strlen (chars : chars_ptr) return Natural;
 916       pragma Import (C, Strlen);
 917
 918    begin
 919       if chars = Null_Address then
 920          return "";
 921
 922       else
 923          declare
 924             subtype Result_Type is String (1 .. Strlen (chars));
 925
 926             Result : Result_Type;
 927             for Result'Address use chars;
 928
 929          begin
 930             return Result;
 931          end;
 932       end if;
 933    end Value;
 934
 935    -----------------
 936    -- Write_Usage --
 937    -----------------
 938
 939    procedure Write_Usage is
 940    begin
 941       Write_Str ("Usage: ");
 942       Write_Str (Base_Name (Command_Name));
 943       Write_Str (" switches mainprog.ali [non-Ada-objects] [linker-options]");
 944       Write_Eol;
 945       Write_Eol;
 946       Write_Line ("  mainprog.ali   the ALI file of the main program");
 947       Write_Eol;
 948       Write_Line ("  -A    Binder generated source file is in Ada (default)");
 949       Write_Line ("  -C    Binder generated source file is in C");
 950       Write_Line ("  -f    force object file list to be generated");
 951       Write_Line ("  -g    Compile binder source file with debug information");
 952       Write_Line ("  -n    Do not compile the binder source file");
 953       Write_Line ("  -v    verbose mode");
 954       Write_Line ("  -v -v very verbose mode");
 955       Write_Eol;
 956       Write_Line ("  -o nam     Use 'nam' as the name of the executable");
 957       Write_Line ("  -b target  Compile the binder source to run on target");
 958       Write_Line ("  -Bdir      Load compiler executables from dir");
 959       Write_Line ("  --GCC=comp Use comp as the compiler");
 960       Write_Line ("  --LINK=nam Use 'nam' for the linking rather than 'gcc'");
 961       Write_Eol;
 962       Write_Line ("  [non-Ada-objects]  list of non Ada object files");
 963       Write_Line ("  [linker-options]   other options for the linker");
 964    end Write_Usage;
 965
 966 --  Start of processing for Gnatlink
 967
 968 begin
 969
 970    if Argument_Count = 0 then
 971       Write_Usage;
 972       Exit_Program (E_Fatal);
 973    end if;
 974
 975    if Hostparm.Java_VM then
 976       Gcc := new String'("jgnat");
 977       Ada_Bind_File := True;
 978       Begin_Info := "-- BEGIN Object file/option list";
 979       End_Info   := "-- END Object file/option list   ";
 980    end if;
 981
 982    Process_Args;
 983
 984    --  Locate all the necessary programs and verify required files are present
 985
 986    Gcc_Path := GNAT.OS_Lib.Locate_Exec_On_Path (Gcc.all);
 987
 988    if Gcc_Path = null then
 989       Exit_With_Error ("Couldn't locate " & Gcc.all);
 990    end if;
 991
 992    if Linker_Path = null then
 993       Linker_Path := Gcc_Path;
 994    end if;
 995
 996    if Ali_File_Name = null then
 997       Exit_With_Error ("Required 'name'.ali not present.");
 998    end if;
 999
1000    if not Is_Regular_File (Ali_File_Name.all) then
1001       Exit_With_Error (Ali_File_Name.all & " not found.");
1002    end if;
1003
1004    if Verbose_Mode then
1005       Write_Eol;
1006       Write_Str ("GNATLINK ");
1007       Write_Str (Gnat_Version_String);
1008       Write_Str (" Copyright 1996-2001 Free Software Foundation, Inc.");
1009       Write_Eol;
1010    end if;
1011
1012    --  If there wasn't an output specified, then use the base name of
1013    --  the .ali file name.
1014
1015    if Output_File_Name = null then
1016
1017       Output_File_Name :=
1018         new String'(Base_Name (Ali_File_Name.all)
1019                        & Get_Debuggable_Suffix.all);
1020
1021       Linker_Options.Increment_Last;
1022       Linker_Options.Table (Linker_Options.Last) :=
1023         new String'("-o");
1024
1025       Linker_Options.Increment_Last;
1026       Linker_Options.Table (Linker_Options.Last) :=
1027         new String'(Output_File_Name.all);
1028
1029    end if;
1030
1031    --  Warn if main program is called "test", as that may be a built-in command
1032    --  on Unix. On non-Unix systems executables have a suffix, so the warning
1033    --  will not appear. However, do not warn in the case of a cross compiler.
1034
1035    --  Assume that if the executable name is not gnatlink, this is a cross
1036    --  tool.
1037
1038    if Base_Name (Command_Name) = "gnatlink"
1039      and then Output_File_Name.all = "test"
1040    then
1041       Error_Msg ("warning: executable name """ & Output_File_Name.all
1042                    & """ may conflict with shell command");
1043    end if;
1044
1045    --  Perform consistency checks
1046
1047    --  Transform the .ali file name into the binder output file name.
1048
1049    Make_Binder_File_Names : declare
1050       Fname     : String  := Base_Name (Ali_File_Name.all);
1051       Fname_Len : Integer := Fname'Length;
1052
1053       function Get_Maximum_File_Name_Length return Integer;
1054       pragma Import (C, Get_Maximum_File_Name_Length,
1055                         "__gnat_get_maximum_file_name_length");
1056
1057       Maximum_File_Name_Length : Integer := Get_Maximum_File_Name_Length;
1058
1059       Second_Char : Character;
1060       --  Second character of name of files
1061
1062    begin
1063       --  Set proper second character of file name
1064
1065       if not Ada_Bind_File then
1066          Second_Char := '_';
1067
1068       elsif Hostparm.OpenVMS then
1069          Second_Char := '$';
1070
1071       else
1072          Second_Char := '~';
1073       end if;
1074
1075       --  If the length of the binder file becomes too long due to
1076       --  the addition of the "b?" prefix, then truncate it.
1077
1078       if Maximum_File_Name_Length > 0 then
1079          while Fname_Len > Maximum_File_Name_Length - 2 loop
1080             Fname_Len := Fname_Len - 1;
1081          end loop;
1082       end if;
1083
1084       if Ada_Bind_File then
1085          Binder_Spec_Src_File :=
1086            new String'('b'
1087                        & Second_Char
1088                        & Fname (Fname'First .. Fname'First + Fname_Len - 1)
1089                        & ".ads");
1090          Binder_Body_Src_File :=
1091            new String'('b'
1092                        & Second_Char
1093                        & Fname (Fname'First .. Fname'First + Fname_Len - 1)
1094                        & ".adb");
1095          Binder_Ali_File :=
1096            new String'('b'
1097                        & Second_Char
1098                        & Fname (Fname'First .. Fname'First + Fname_Len - 1)
1099                        & ".ali");
1100
1101       else
1102          Binder_Body_Src_File :=
1103            new String'('b'
1104                        & Second_Char
1105                        & Fname (Fname'First .. Fname'First + Fname_Len - 1)
1106                        & ".c");
1107       end if;
1108
1109       Binder_Obj_File :=
1110         new String'('b'
1111                     & Second_Char
1112                     & Fname (Fname'First .. Fname'First + Fname_Len - 1)
1113                     & Get_Object_Suffix.all);
1114
1115       if Fname_Len /= Fname'Length then
1116          Binder_Options.Increment_Last;
1117          Binder_Options.Table (Binder_Options.Last) := new String'("-o");
1118          Binder_Options.Increment_Last;
1119          Binder_Options.Table (Binder_Options.Last) := Binder_Obj_File;
1120       end if;
1121
1122    end Make_Binder_File_Names;
1123
1124    Process_Binder_File (Binder_Body_Src_File.all & ASCII.NUL);
1125
1126    --  Compile the binder file. This is fast, so we always do it, unless
1127    --  specifically told not to by the -n switch
1128
1129    if Compile_Bind_File then
1130       Bind_Step : declare
1131          Success : Boolean;
1132          Args    : Argument_List (1 .. Binder_Options.Last + 1);
1133
1134       begin
1135          for J in Binder_Options.First .. Binder_Options.Last loop
1136             Args (J) := Binder_Options.Table (J);
1137          end loop;
1138
1139          Args (Args'Last) := Binder_Body_Src_File;
1140
1141          if Verbose_Mode then
1142             Write_Str (Base_Name (Gcc_Path.all));
1143
1144             for J in Args'Range loop
1145                Write_Str (" ");
1146                Write_Str (Args (J).all);
1147             end loop;
1148
1149             Write_Eol;
1150          end if;
1151
1152          GNAT.OS_Lib.Spawn (Gcc_Path.all, Args, Success);
1153
1154          if not Success then
1155             Exit_Program (E_Fatal);
1156          end if;
1157       end Bind_Step;
1158    end if;
1159
1160    --  Now, actually link the program.
1161
1162    --  Skip this step for now on the JVM since the Java interpreter will do
1163    --  the actual link at run time. We might consider packing all class files
1164    --  in a .zip file during this step.
1165
1166    if not Hostparm.Java_VM then
1167       Link_Step : declare
1168          Num_Args : Natural :=
1169                      (Linker_Options.Last - Linker_Options.First + 1) +
1170                      (Gcc_Linker_Options.Last - Gcc_Linker_Options.First + 1) +
1171                      (Linker_Objects.Last - Linker_Objects.First + 1);
1172          Stack_Op : Boolean := False;
1173          IDENT_Op : Boolean := False;
1174
1175       begin
1176          --  Remove duplicate stack size setting from the Linker_Options
1177          --  table. The stack setting option "-Xlinker --stack=R,C" can be
1178          --  found in one line when set by a pragma Linker_Options or in two
1179          --  lines ("-Xlinker" then "--stack=R,C") when set on the command
1180          --  line. We also check for the "-Wl,--stack=R" style option.
1181
1182          --  We must remove the second stack setting option instance
1183          --  because the one on the command line will always be the first
1184          --  one. And any subsequent stack setting option will overwrite the
1185          --  previous one. This is done especially for GNAT/NT where we set
1186          --  the stack size for tasking programs by a pragma in the NT
1187          --  specific tasking package System.Task_Primitives.Oparations.
1188
1189          for J in Linker_Options.First .. Linker_Options.Last loop
1190             if Linker_Options.Table (J).all = "-Xlinker"
1191               and then J < Linker_Options.Last
1192               and then Linker_Options.Table (J + 1)'Length > 8
1193               and then Linker_Options.Table (J + 1) (1 .. 8) = "--stack="
1194             then
1195                if Stack_Op then
1196                   Linker_Options.Table (J .. Linker_Options.Last - 2) :=
1197                     Linker_Options.Table (J + 2 .. Linker_Options.Last);
1198                   Linker_Options.Decrement_Last;
1199                   Linker_Options.Decrement_Last;
1200                   Num_Args := Num_Args - 2;
1201
1202                else
1203                   Stack_Op := True;
1204                end if;
1205             end if;
1206
1207             --  Here we just check for a canonical form that matches the
1208             --  pragma Linker_Options set in the NT runtime.
1209
1210             if (Linker_Options.Table (J)'Length > 17
1211                 and then Linker_Options.Table (J) (1 .. 17)
1212                         = "-Xlinker --stack=")
1213               or else
1214                (Linker_Options.Table (J)'Length > 12
1215                 and then Linker_Options.Table (J) (1 .. 12)
1216                          = "-Wl,--stack=")
1217             then
1218                if Stack_Op then
1219                   Linker_Options.Table (J .. Linker_Options.Last - 1) :=
1220                     Linker_Options.Table (J + 1 .. Linker_Options.Last);
1221                   Linker_Options.Decrement_Last;
1222                   Num_Args := Num_Args - 1;
1223
1224                else
1225                   Stack_Op := True;
1226                end if;
1227             end if;
1228
1229             --  Remove duplicate IDENTIFICATION directives (VMS)
1230
1231             if Linker_Options.Table (J)'Length > 27
1232               and then Linker_Options.Table (J) (1 .. 27)
1233                        = "--for-linker=IDENTIFICATION="
1234             then
1235                if IDENT_Op then
1236                   Linker_Options.Table (J .. Linker_Options.Last - 1) :=
1237                     Linker_Options.Table (J + 1 .. Linker_Options.Last);
1238                   Linker_Options.Decrement_Last;
1239                   Num_Args := Num_Args - 1;
1240                else
1241                   IDENT_Op := True;
1242                end if;
1243             end if;
1244          end loop;
1245
1246          --  Prepare arguments for call to linker
1247
1248          Call_Linker : declare
1249             Success  : Boolean;
1250             Args     : Argument_List (1 .. Num_Args + 1);
1251             Index    : Integer := Args'First;
1252
1253          begin
1254             Args (Index) := Binder_Obj_File;
1255
1256             --  Add the object files and any -largs libraries
1257
1258             for J in Linker_Objects.First .. Linker_Objects.Last loop
1259                Index := Index + 1;
1260                Args (Index) := Linker_Objects.Table (J);
1261             end loop;
1262
1263             --  Add the linker options from the binder file
1264
1265             for J in Linker_Options.First .. Linker_Options.Last loop
1266                Index := Index + 1;
1267                Args (Index) := Linker_Options.Table (J);
1268             end loop;
1269
1270             --  Finally add the libraries from the --GCC= switch
1271
1272             for J in Gcc_Linker_Options.First .. Gcc_Linker_Options.Last loop
1273                Index := Index + 1;
1274                Args (Index) := Gcc_Linker_Options.Table (J);
1275             end loop;
1276
1277             if Verbose_Mode then
1278                Write_Str (Linker_Path.all);
1279
1280                for J in Args'Range loop
1281                   Write_Str (" ");
1282                   Write_Str (Args (J).all);
1283                end loop;
1284
1285                Write_Eol;
1286
1287                --  If we are on very verbose mode (-v -v) and a response file
1288                --  is used we display its content.
1289
1290                if Very_Verbose_Mode and then Tname_FD /= Invalid_FD then
1291                   Write_Eol;
1292                   Write_Str ("Response file (" &
1293                              Tname (Tname'First .. Tname'Last - 1) &
1294                              ") content : ");
1295                   Write_Eol;
1296
1297                   for J in
1298                     Response_File_Objects.First ..
1299                     Response_File_Objects.Last
1300                   loop
1301                      Write_Str (Response_File_Objects.Table (J).all);
1302                      Write_Eol;
1303                   end loop;
1304
1305                   Write_Eol;
1306                end if;
1307             end if;
1308
1309             GNAT.OS_Lib.Spawn (Linker_Path.all, Args, Success);
1310
1311             --  Delete the temporary file used in conjuction with linking if
1312             --  one was created. See Process_Bind_File for details.
1313
1314             if Tname_FD /= Invalid_FD then
1315                Delete (Tname);
1316             end if;
1317
1318             if not Success then
1319                Error_Msg ("cannot call " & Linker_Path.all);
1320                Exit_Program (E_Fatal);
1321             end if;
1322          end Call_Linker;
1323       end Link_Step;
1324    end if;
1325
1326    --  Only keep the binder output file and it's associated object
1327    --  file if compiling with the -g option.  These files are only
1328    --  useful if debugging.
1329
1330    if not Debug_Flag_Present then
1331       if Binder_Ali_File /= null then
1332          Delete (Binder_Ali_File.all & ASCII.NUL);
1333       end if;
1334
1335       if Binder_Spec_Src_File /= null then
1336          Delete (Binder_Spec_Src_File.all & ASCII.NUL);
1337       end if;
1338
1339       Delete (Binder_Body_Src_File.all & ASCII.NUL);
1340
1341       if not Hostparm.Java_VM then
1342          Delete (Binder_Obj_File.all & ASCII.NUL);
1343       end if;
1344    end if;
1345
1346    Exit_Program (E_Success);
1347
1348 exception
1349    when others =>
1350       Exit_With_Error ("INTERNAL ERROR. Please report.");
1351 end Gnatlink;