1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1996-2003 Free Software Foundation, Inc. --
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, 59 Temple Place - Suite 330, Boston, --
20 -- MA 02111-1307, USA. --
22 -- GNAT was originally developed by the GNAT team at New York University. --
23 -- Extensive contributions were provided by Ada Core Technologies Inc. --
25 ------------------------------------------------------------------------------
27 -- Gnatlink usage: please consult the gnat documentation
29 with Ada.Exceptions; use Ada.Exceptions;
31 with Gnatvsn; use Gnatvsn;
33 with Namet; use Namet;
35 with Osint; use Osint;
36 with Output; use Output;
37 with Switch; use Switch;
38 with System; use System;
42 with Ada.Command_Line; use Ada.Command_Line;
43 with GNAT.OS_Lib; use GNAT.OS_Lib;
44 with Interfaces.C_Streams; use Interfaces.C_Streams;
48 package Gcc_Linker_Options is new Table.Table (
49 Table_Component_Type => String_Access,
50 Table_Index_Type => Integer,
53 Table_Increment => 100,
54 Table_Name => "Gnatlink.Gcc_Linker_Options");
55 -- Comments needed ???
57 package Libpath is new Table.Table (
58 Table_Component_Type => Character,
59 Table_Index_Type => Integer,
61 Table_Initial => 4096,
63 Table_Name => "Gnatlink.Libpath");
64 -- Comments needed ???
66 package Linker_Options is new Table.Table (
67 Table_Component_Type => String_Access,
68 Table_Index_Type => Integer,
71 Table_Increment => 100,
72 Table_Name => "Gnatlink.Linker_Options");
73 -- Comments needed ???
75 package Linker_Objects is new Table.Table (
76 Table_Component_Type => String_Access,
77 Table_Index_Type => Integer,
80 Table_Increment => 100,
81 Table_Name => "Gnatlink.Linker_Objects");
82 -- This table collects the objects file to be passed to the linker. In the
83 -- case where the linker command line is too long then programs objects
84 -- are put on the Response_File_Objects table. Note that the binder object
85 -- file and the user's objects remain in this table. This is very
86 -- important because on the GNU linker command line the -L switch is not
87 -- used to look for objects files but -L switch is used to look for
88 -- objects listed in the response file. This is not a problem with the
89 -- applications objects as they are specified with a fullname.
91 package Response_File_Objects is new Table.Table (
92 Table_Component_Type => String_Access,
93 Table_Index_Type => Integer,
96 Table_Increment => 100,
97 Table_Name => "Gnatlink.Response_File_Objects");
98 -- This table collects the objects file that are to be put in the response
99 -- file. Only application objects are collected there (see details in
100 -- Linker_Objects table comments)
102 package Binder_Options_From_ALI is new Table.Table (
103 Table_Component_Type => String_Access,
104 Table_Index_Type => Integer,
105 Table_Low_Bound => 1, -- equals low bound of Argument_List for Spawn
107 Table_Increment => 100,
108 Table_Name => "Gnatlink.Binder_Options_From_ALI");
109 -- This table collects the switches from the ALI file of the main
112 package Binder_Options is new Table.Table (
113 Table_Component_Type => String_Access,
114 Table_Index_Type => Integer,
115 Table_Low_Bound => 1, -- equals low bound of Argument_List for Spawn
117 Table_Increment => 100,
118 Table_Name => "Gnatlink.Binder_Options");
119 -- This table collects the arguments to be passed to compile the binder
122 subtype chars_ptr is System.Address;
124 Gcc : String_Access := Program_Name ("gcc");
126 Read_Mode : constant String := "r" & ASCII.Nul;
128 Begin_Info : String := "-- BEGIN Object file/option list";
129 End_Info : String := "-- END Object file/option list ";
130 -- Note: above lines are modified in C mode, see option processing
132 Gcc_Path : String_Access;
133 Linker_Path : String_Access;
135 Output_File_Name : String_Access;
136 Ali_File_Name : String_Access;
137 Binder_Spec_Src_File : String_Access;
138 Binder_Body_Src_File : String_Access;
139 Binder_Ali_File : String_Access;
140 Binder_Obj_File : String_Access;
142 Tname : Temp_File_Name;
143 Tname_FD : File_Descriptor := Invalid_FD;
144 -- Temporary file used by linker to pass list of object files on
145 -- certain systems with limitations on size of arguments.
147 Debug_Flag_Present : Boolean := False;
148 Verbose_Mode : Boolean := False;
149 Very_Verbose_Mode : Boolean := False;
151 Ada_Bind_File : Boolean := True;
152 -- Set to True if bind file is generated in Ada
154 Standard_Gcc : Boolean := True;
156 Compile_Bind_File : Boolean := True;
157 -- Set to False if bind file is not to be compiled
159 Object_List_File_Supported : Boolean;
160 pragma Import (C, Object_List_File_Supported, "objlist_file_supported");
161 -- Predicate indicating whether the linker has an option whereby the
162 -- names of object files can be passed to the linker in a file.
164 Object_List_File_Required : Boolean := False;
165 -- Set to True to force generation of a response file
167 function Base_Name (File_Name : in String) return String;
168 -- Return just the file name part without the extension (if present).
170 procedure Delete (Name : in String);
171 -- Wrapper to unlink as status is ignored by this application.
173 procedure Error_Msg (Message : in String);
174 -- Output the error or warning Message
176 procedure Exit_With_Error (Error : in String);
177 -- Output Error and exit program with a fatal condition.
179 procedure Process_Args;
180 -- Go through all the arguments and build option tables.
182 procedure Process_Binder_File (Name : in String);
183 -- Reads the binder file and extracts linker arguments.
185 function Value (chars : chars_ptr) return String;
186 -- Return NUL-terminated string chars as an Ada string.
188 procedure Write_Header;
189 -- Show user the program name, version and copyright.
191 procedure Write_Usage;
192 -- Show user the program options.
198 function Base_Name (File_Name : in String) return String is
203 Findex1 := File_Name'First;
205 -- The file might be specified by a full path name. However,
206 -- we want the path to be stripped away.
208 for J in reverse File_Name'Range loop
209 if Is_Directory_Separator (File_Name (J)) then
215 Findex2 := File_Name'Last;
216 while Findex2 > Findex1
217 and then File_Name (Findex2) /= '.'
219 Findex2 := Findex2 - 1;
222 if Findex2 = Findex1 then
223 Findex2 := File_Name'Last + 1;
226 return File_Name (Findex1 .. Findex2 - 1);
233 procedure Delete (Name : in String) is
237 Status := unlink (Name'Address);
244 procedure Error_Msg (Message : in String) is
246 Write_Str (Base_Name (Command_Name));
252 ---------------------
253 -- Exit_With_Error --
254 ---------------------
256 procedure Exit_With_Error (Error : in String) is
259 Exit_Program (E_Fatal);
266 procedure Process_Args is
268 Skip_Next : Boolean := False;
269 -- Set to true if the next argument is to be added into the list of
270 -- linker's argument without parsing it.
273 -- Loop through arguments of gnatlink command
277 exit when Next_Arg > Argument_Count;
279 Process_One_Arg : declare
280 Arg : constant String := Argument (Next_Arg);
283 -- Case of argument which is a switch
285 -- We definitely need section by section comments here ???
289 -- This argument must not be parsed, just add it to the
290 -- list of linker's options.
294 Linker_Options.Increment_Last;
295 Linker_Options.Table (Linker_Options.Last) :=
298 elsif Arg'Length /= 0 and then Arg (1) = '-' then
300 and then Arg (2 .. 5) = "gnat"
303 ("invalid switch: """ & Arg & """ (gnat not needed here)");
306 if Arg = "-Xlinker" then
308 -- Next argument should be sent directly to the linker.
309 -- We do not want to parse it here.
313 Linker_Options.Increment_Last;
314 Linker_Options.Table (Linker_Options.Last) :=
318 and then (Arg'Length < 5 or else Arg (2 .. 5) /= "gnat")
320 Debug_Flag_Present := True;
322 Linker_Options.Increment_Last;
323 Linker_Options.Table (Linker_Options.Last) :=
326 Binder_Options.Increment_Last;
327 Binder_Options.Table (Binder_Options.Last) :=
328 Linker_Options.Table (Linker_Options.Last);
330 elsif Arg'Length = 2 then
333 Ada_Bind_File := True;
334 Begin_Info := "-- BEGIN Object file/option list";
335 End_Info := "-- END Object file/option list ";
338 Linker_Options.Increment_Last;
339 Linker_Options.Table (Linker_Options.Last) :=
342 Binder_Options.Increment_Last;
343 Binder_Options.Table (Binder_Options.Last) :=
344 Linker_Options.Table (Linker_Options.Last);
346 Next_Arg := Next_Arg + 1;
348 if Next_Arg > Argument_Count then
349 Exit_With_Error ("Missing argument for -b");
352 Get_Machine_Name : declare
353 Name_Arg : constant String_Access :=
354 new String'(Argument (Next_Arg));
357 Linker_Options.Increment_Last;
358 Linker_Options.Table (Linker_Options.Last) :=
361 Binder_Options.Increment_Last;
362 Binder_Options.Table (Binder_Options.Last) :=
365 end Get_Machine_Name;
368 Ada_Bind_File := False;
369 Begin_Info := "/* BEGIN Object file/option list";
370 End_Info := " END Object file/option list */";
373 if Object_List_File_Supported then
374 Object_List_File_Required := True;
377 ("Object list file not supported on this target");
381 Compile_Bind_File := False;
384 Linker_Options.Increment_Last;
385 Linker_Options.Table (Linker_Options.Last) :=
388 Next_Arg := Next_Arg + 1;
390 if Next_Arg > Argument_Count then
391 Exit_With_Error ("Missing argument for -o");
394 Output_File_Name := new String'(Argument (Next_Arg));
396 Linker_Options.Increment_Last;
397 Linker_Options.Table (Linker_Options.Last) :=
401 Opt.Run_Path_Option := False;
405 -- Support "double" verbose mode. Second -v
406 -- gets sent to the linker and binder phases.
409 Very_Verbose_Mode := True;
411 Linker_Options.Increment_Last;
412 Linker_Options.Table (Linker_Options.Last) :=
415 Binder_Options.Increment_Last;
416 Binder_Options.Table (Binder_Options.Last) :=
417 Linker_Options.Table (Linker_Options.Last);
420 Verbose_Mode := True;
425 Linker_Options.Increment_Last;
426 Linker_Options.Table (Linker_Options.Last) :=
431 elsif Arg (2) = 'B' then
432 Linker_Options.Increment_Last;
433 Linker_Options.Table (Linker_Options.Last) :=
436 Binder_Options.Increment_Last;
437 Binder_Options.Table (Binder_Options.Last) :=
438 Linker_Options.Table (Linker_Options.Last);
440 elsif Arg'Length >= 7 and then Arg (1 .. 7) = "--LINK=" then
442 if Arg'Length = 7 then
443 Exit_With_Error ("Missing argument for --LINK=");
447 GNAT.OS_Lib.Locate_Exec_On_Path (Arg (8 .. Arg'Last));
449 if Linker_Path = null then
451 ("Could not locate linker: " & Arg (8 .. Arg'Last));
454 elsif Arg'Length > 6 and then Arg (1 .. 6) = "--GCC=" then
456 Program_Args : constant Argument_List_Access :=
457 Argument_String_To_List
458 (Arg (7 .. Arg'Last));
461 Gcc := new String'(Program_Args.all (1).all);
462 Standard_Gcc := False;
464 -- Set appropriate flags for switches passed
466 for J in 2 .. Program_Args.all'Last loop
468 Arg : constant String := Program_Args.all (J).all;
469 AF : constant Integer := Arg'First;
472 if Arg'Length /= 0 and then Arg (AF) = '-' then
473 if Arg (AF + 1) = 'g'
474 and then (Arg'Length = 2
475 or else Arg (AF + 2) in '0' .. '3'
476 or else Arg (AF + 2 .. Arg'Last) = "coff")
478 Debug_Flag_Present := True;
482 -- Pass to gcc for compiling binder generated file
483 -- No use passing libraries, it will just generate
486 if not (Arg (AF .. AF + 1) = "-l"
487 or else Arg (AF .. AF + 1) = "-L")
489 Binder_Options.Increment_Last;
490 Binder_Options.Table (Binder_Options.Last) :=
494 -- Pass to gcc for linking program.
496 Gcc_Linker_Options.Increment_Last;
497 Gcc_Linker_Options.Table
498 (Gcc_Linker_Options.Last) := new String'(Arg);
503 -- Send all multi-character switches not recognized as
504 -- a special case by gnatlink to the linker/loader stage.
507 Linker_Options.Increment_Last;
508 Linker_Options.Table (Linker_Options.Last) :=
512 -- Here if argument is a file name rather than a switch
515 -- If explicit ali file, capture it
518 and then Arg (Arg'Last - 3 .. Arg'Last) = ".ali"
520 if Ali_File_Name = null then
521 Ali_File_Name := new String'(Arg);
523 Exit_With_Error ("cannot handle more than one ALI file");
526 -- If object file, record object file
528 elsif Arg'Length > Get_Object_Suffix.all'Length
530 (Arg'Last - Get_Object_Suffix.all'Length + 1 .. Arg'Last)
531 = Get_Object_Suffix.all
533 Linker_Objects.Increment_Last;
534 Linker_Objects.Table (Linker_Objects.Last) :=
537 -- If corresponding ali file exists, capture it
539 elsif Ali_File_Name = null
540 and then Is_Regular_File (Arg & ".ali")
542 Ali_File_Name := new String'(Arg & ".ali");
544 -- Otherwise assume this is a linker options entry, but
545 -- see below for interesting adjustment to this assumption.
548 Linker_Options.Increment_Last;
549 Linker_Options.Table (Linker_Options.Last) :=
555 Next_Arg := Next_Arg + 1;
558 -- If Ada bind file, then compile it with warnings suppressed, because
559 -- otherwise the with of the main program may cause junk warnings.
561 if Ada_Bind_File then
562 Binder_Options.Increment_Last;
563 Binder_Options.Table (Binder_Options.Last) := new String'("-gnatws");
566 -- If we did not get an ali file at all, and we had at least one
567 -- linker option, then assume that was the intended ali file after
568 -- all, so that we get a nicer message later on.
570 if Ali_File_Name = null
571 and then Linker_Options.Last >= Linker_Options.First
574 new String'(Linker_Options.Table (Linker_Options.First).all &
579 -------------------------
580 -- Process_Binder_File --
581 -------------------------
583 procedure Process_Binder_File (Name : in String) is
585 -- Binder file's descriptor
587 Link_Bytes : Integer := 0;
588 -- Projected number of bytes for the linker command line
591 pragma Import (C, Link_Max, "link_max");
592 -- Maximum number of bytes on the command line supported by the OS
593 -- linker. Passed this limit the response file mechanism must be used
596 Next_Line : String (1 .. 1000);
597 -- Current line value
601 -- Current line slice (the slice does not contain line terminator)
603 Objs_Begin : Integer := 0;
604 -- First object file index in Linker_Objects table
606 Objs_End : Integer := 0;
607 -- Last object file index in Linker_Objects table
610 -- Used for various Interfaces.C_Streams calls
612 Closing_Status : Boolean;
615 GNAT_Static : Boolean := False;
616 -- Save state of -static option.
618 GNAT_Shared : Boolean := False;
619 -- Save state of -shared option.
623 -- These data items are used to store current binder file context.
624 -- The context is composed of the file descriptor position and the
625 -- current line together with the slice indexes (first and last
626 -- position) for this line. The rollback data are used by the
627 -- Store_File_Context and Rollback_File_Context routines below.
628 -- The file context mechanism interact only with the Get_Next_Line
629 -- call. For example:
631 -- Store_File_Context;
633 -- Rollback_File_Context;
636 -- Both Get_Next_Line calls above will read the exact same data from
637 -- the file. In other words, Next_Line, Nfirst and Nlast variables
638 -- will be set with the exact same values.
640 RB_File_Pos : long; -- File position
641 RB_Next_Line : String (1 .. 1000); -- Current line content
642 RB_Nlast : Integer; -- Slice last index
643 RB_Nfirst : Integer; -- Slice first index
645 Run_Path_Option_Ptr : Address;
646 pragma Import (C, Run_Path_Option_Ptr, "run_path_option");
647 -- Pointer to string representing the native linker option which
648 -- specifies the path where the dynamic loader should find shared
649 -- libraries. Equal to null string if this system doesn't support it.
651 Object_Library_Ext_Ptr : Address;
652 pragma Import (C, Object_Library_Ext_Ptr, "object_library_extension");
653 -- Pointer to string specifying the default extension for
654 -- object libraries, e.g. Unix uses ".a", VMS uses ".olb".
656 Object_File_Option_Ptr : Address;
657 pragma Import (C, Object_File_Option_Ptr, "object_file_option");
658 -- Pointer to a string representing the linker option which specifies
659 -- the response file.
661 Using_GNU_Linker : Boolean;
662 pragma Import (C, Using_GNU_Linker, "using_gnu_linker");
663 -- Predicate indicating whether this target uses the GNU linker. In
664 -- this case we must output a GNU linker compatible response file.
666 procedure Get_Next_Line;
667 -- Read the next line from the binder file without the line
670 function Index (S, Pattern : String) return Natural;
671 -- Return the first occurrence of Pattern in S, or 0 if none.
673 function Is_Option_Present (Opt : in String) return Boolean;
674 -- Return true if the option Opt is already present in
675 -- Linker_Options table.
677 procedure Store_File_Context;
678 -- Store current file context, Fd position and current line data.
679 -- The file context is stored into the rollback data above (RB_*).
680 -- Store_File_Context can be called at any time, only the last call
681 -- will be used (i.e. this routine overwrites the file context).
683 procedure Rollback_File_Context;
684 -- Restore file context from rollback data. This routine must be called
685 -- after Store_File_Context. The binder file context will be restored
686 -- with the data stored by the last Store_File_Context call.
692 procedure Get_Next_Line is
696 Fchars := fgets (Next_Line'Address, Next_Line'Length, Fd);
698 if Fchars = System.Null_Address then
699 Exit_With_Error ("Error reading binder output");
702 Nfirst := Next_Line'First;
704 while Nlast <= Next_Line'Last
705 and then Next_Line (Nlast) /= ASCII.LF
706 and then Next_Line (Nlast) /= ASCII.CR
718 function Index (S, Pattern : String) return Natural is
719 Len : constant Natural := Pattern'Length;
721 for J in S'First .. S'Last - Len + 1 loop
722 if Pattern = S (J .. J + Len - 1) then
730 -----------------------
731 -- Is_Option_Present --
732 -----------------------
734 function Is_Option_Present (Opt : in String) return Boolean is
736 for I in 1 .. Linker_Options.Last loop
738 if Linker_Options.Table (I).all = Opt then
745 end Is_Option_Present;
747 ---------------------------
748 -- Rollback_File_Context --
749 ---------------------------
751 procedure Rollback_File_Context is
753 Next_Line := RB_Next_Line;
756 Status := fseek (Fd, RB_File_Pos, Interfaces.C_Streams.SEEK_SET);
759 Exit_With_Error ("Error setting file position");
761 end Rollback_File_Context;
763 ------------------------
764 -- Store_File_Context --
765 ------------------------
767 procedure Store_File_Context is
769 RB_Next_Line := Next_Line;
772 RB_File_Pos := ftell (Fd);
774 if RB_File_Pos = -1 then
775 Exit_With_Error ("Error getting file position");
777 end Store_File_Context;
779 -- Start of processing for Process_Binder_File
782 Fd := fopen (Name'Address, Read_Mode'Address);
784 if Fd = NULL_Stream then
785 Exit_With_Error ("Failed to open binder output");
788 -- Skip up to the Begin Info line
792 exit when Next_Line (Nfirst .. Nlast) = Begin_Info;
798 -- Go to end when end line is reached (this will happen in
799 -- High_Integrity_Mode where no -L switches are generated)
801 exit when Next_Line (Nfirst .. Nlast) = End_Info;
803 if Ada_Bind_File then
804 Next_Line (Nfirst .. Nlast - 8) :=
805 Next_Line (Nfirst + 8 .. Nlast);
809 -- Go to next section when switches are reached
811 exit when Next_Line (1) = '-';
813 -- Otherwise we have another object file to collect
815 Linker_Objects.Increment_Last;
817 -- Mark the positions of first and last object files in case
818 -- they need to be placed with a named file on systems having
819 -- linker line limitations.
821 if Objs_Begin = 0 then
822 Objs_Begin := Linker_Objects.Last;
825 Linker_Objects.Table (Linker_Objects.Last) :=
826 new String'(Next_Line (Nfirst .. Nlast));
828 Link_Bytes := Link_Bytes + Nlast - Nfirst + 2;
829 -- Nlast - Nfirst + 1, for the size, plus one for the space between
833 Objs_End := Linker_Objects.Last;
835 -- Let's continue to compute the Link_Bytes, the linker options are
836 -- part of command line length.
840 while Next_Line (Nfirst .. Nlast) /= End_Info loop
841 Link_Bytes := Link_Bytes + Nlast - Nfirst + 2;
846 Rollback_File_Context;
848 -- On systems that have limitations on handling very long linker lines
849 -- we make use of the system linker option which takes a list of object
850 -- file names from a file instead of the command line itself. What we do
851 -- is to replace the list of object files by the special linker option
852 -- which then reads the object file list from a file instead. The option
853 -- to read from a file instead of the command line is only triggered if
854 -- a conservative threshold is passed.
856 if Object_List_File_Required
857 or else (Object_List_File_Supported
858 and then Link_Bytes > Link_Max)
860 -- Create a temporary file containing the Ada user object files
861 -- needed by the link. This list is taken from the bind file
862 -- and is output one object per line for maximal compatibility with
863 -- linkers supporting this option.
865 Create_Temp_File (Tname_FD, Tname);
867 -- ??? File descriptor should be checked to not be Invalid_FD.
868 -- ??? Status of Write and Close operations should be checked, and
869 -- failure should occur if a status is wrong.
871 -- If target is using the GNU linker we must add a special header
872 -- and footer in the response file.
873 -- The syntax is : INPUT (object1.o object2.o ... )
875 if Using_GNU_Linker then
877 GNU_Header : aliased constant String := "INPUT (";
880 Status := Write (Tname_FD, GNU_Header'Address,
885 for J in Objs_Begin .. Objs_End loop
886 Status := Write (Tname_FD, Linker_Objects.Table (J).all'Address,
887 Linker_Objects.Table (J).all'Length);
888 Status := Write (Tname_FD, ASCII.LF'Address, 1);
890 Response_File_Objects.Increment_Last;
891 Response_File_Objects.Table (Response_File_Objects.Last) :=
892 Linker_Objects.Table (J);
895 -- handle GNU linker response file footer.
897 if Using_GNU_Linker then
899 GNU_Footer : aliased constant String := ")";
902 Status := Write (Tname_FD, GNU_Footer'Address,
907 Close (Tname_FD, Closing_Status);
909 -- Add the special objects list file option together with the name
910 -- of the temporary file (removing the null character) to the objects
913 Linker_Objects.Table (Objs_Begin) :=
914 new String'(Value (Object_File_Option_Ptr) &
915 Tname (Tname'First .. Tname'Last - 1));
917 -- The slots containing these object file names are then removed
918 -- from the objects table so they do not appear in the link. They
919 -- are removed by moving up the linker options and non-Ada object
920 -- files appearing after the Ada object list in the table.
925 N := Objs_End - Objs_Begin + 1;
927 for J in Objs_End + 1 .. Linker_Objects.Last loop
928 Linker_Objects.Table (J - N + 1) := Linker_Objects.Table (J);
931 Linker_Objects.Set_Last (Linker_Objects.Last - N + 1);
935 -- Process switches and options
937 if Next_Line (Nfirst .. Nlast) /= End_Info then
939 if Next_Line (Nfirst .. Nlast) = "-static" then
942 elsif Next_Line (Nfirst .. Nlast) = "-shared" then
945 -- Add binder options only if not already set on the command
946 -- line. This rule is a way to control the linker options order.
948 elsif not Is_Option_Present (Next_Line (Nfirst .. Nlast))
949 or else Next_Line (Nfirst .. Nlast) = "-Xlinker"
951 if Nlast > Nfirst + 2 and then
952 Next_Line (Nfirst .. Nfirst + 1) = "-L"
954 -- Construct a library search path for use later
955 -- to locate static gnatlib libraries.
957 if Libpath.Last > 1 then
958 Libpath.Increment_Last;
959 Libpath.Table (Libpath.Last) := Path_Separator;
962 for I in Nfirst + 2 .. Nlast loop
963 Libpath.Increment_Last;
964 Libpath.Table (Libpath.Last) := Next_Line (I);
967 Linker_Options.Increment_Last;
969 Linker_Options.Table (Linker_Options.Last) :=
970 new String'(Next_Line (Nfirst .. Nlast));
972 elsif Next_Line (Nfirst .. Nlast) = "-ldecgnat"
973 or else Next_Line (Nfirst .. Nlast) = "-lgnarl"
974 or else Next_Line (Nfirst .. Nlast) = "-lgnat"
976 -- Given a Gnat standard library, search the
977 -- library path to find the library location
980 File_Path : String_Access;
981 Object_Lib_Extension : constant String :=
982 Value (Object_Library_Ext_Ptr);
983 File_Name : constant String := "lib" &
984 Next_Line (Nfirst + 2 .. Nlast) &
985 Object_Lib_Extension;
986 Run_Path_Opt : constant String :=
987 Value (Run_Path_Option_Ptr);
989 Run_Path_Opt_Index : Natural := 0;
993 Locate_Regular_File (File_Name,
994 String (Libpath.Table (1 .. Libpath.Last)));
996 if File_Path /= null then
999 -- If static gnatlib found, explicitly
1000 -- specify to overcome possible linker
1001 -- default usage of shared version.
1003 Linker_Options.Increment_Last;
1005 Linker_Options.Table (Linker_Options.Last) :=
1006 new String'(File_Path.all);
1008 elsif GNAT_Shared then
1009 if Opt.Run_Path_Option then
1010 -- If shared gnatlib desired, add the
1011 -- appropriate system specific switch
1012 -- so that it can be located at runtime.
1014 if Run_Path_Opt'Length /= 0 then
1015 -- Output the system specific linker command
1016 -- that allows the image activator to find
1017 -- the shared library at runtime.
1018 -- Also add path to find libgcc_s.so, if
1021 GCC_Index := Index (File_Path.all, "gcc-lib");
1023 -- Look for an eventual run_path_option in
1024 -- the linker switches.
1026 for J in reverse 1 .. Linker_Options.Last loop
1027 if Linker_Options.Table (J) /= null
1029 Linker_Options.Table (J)'Length
1030 > Run_Path_Opt'Length
1032 Linker_Options.Table (J)
1033 (1 .. Run_Path_Opt'Length) =
1036 -- We have found a already specified
1037 -- run_path_option: we will add to this
1038 -- switch, because only one
1039 -- run_path_option should be specified.
1041 Run_Path_Opt_Index := J;
1046 -- If there is no run_path_option, we need
1049 if Run_Path_Opt_Index = 0 then
1050 Linker_Options.Increment_Last;
1053 if GCC_Index = 0 then
1054 if Run_Path_Opt_Index = 0 then
1055 Linker_Options.Table
1056 (Linker_Options.Last) :=
1060 (1 .. File_Path'Length
1061 - File_Name'Length));
1064 Linker_Options.Table
1065 (Run_Path_Opt_Index) :=
1067 (Linker_Options.Table
1068 (Run_Path_Opt_Index).all
1071 (1 .. File_Path'Length
1072 - File_Name'Length));
1076 if Run_Path_Opt_Index = 0 then
1077 Linker_Options.Table
1078 (Linker_Options.Last) :=
1079 new String'(Run_Path_Opt
1081 (1 .. File_Path'Length
1084 & File_Path (1 .. GCC_Index - 1));
1087 Linker_Options.Table
1088 (Run_Path_Opt_Index) :=
1090 (Linker_Options.Table
1091 (Run_Path_Opt_Index).all
1094 (1 .. File_Path'Length
1097 & File_Path (1 .. GCC_Index - 1));
1103 -- Then we add the appropriate -l switch
1105 Linker_Options.Increment_Last;
1106 Linker_Options.Table (Linker_Options.Last) :=
1107 new String'(Next_Line (Nfirst .. Nlast));
1111 -- If gnatlib library not found, then
1112 -- add it anyway in case some other
1113 -- mechanimsm may find it.
1115 Linker_Options.Increment_Last;
1116 Linker_Options.Table (Linker_Options.Last) :=
1117 new String'(Next_Line (Nfirst .. Nlast));
1121 Linker_Options.Increment_Last;
1122 Linker_Options.Table (Linker_Options.Last) :=
1123 new String'(Next_Line (Nfirst .. Nlast));
1128 exit when Next_Line (Nfirst .. Nlast) = End_Info;
1130 if Ada_Bind_File then
1131 Next_Line (Nfirst .. Nlast - 8) :=
1132 Next_Line (Nfirst + 8 .. Nlast);
1138 Status := fclose (Fd);
1139 end Process_Binder_File;
1145 function Value (chars : chars_ptr) return String is
1146 function Strlen (chars : chars_ptr) return Natural;
1147 pragma Import (C, Strlen);
1150 if chars = Null_Address then
1155 subtype Result_Type is String (1 .. Strlen (chars));
1157 Result : Result_Type;
1158 for Result'Address use chars;
1170 procedure Write_Header is
1172 if Verbose_Mode then
1174 Write_Str ("GNATLINK ");
1175 Write_Str (Gnat_Version_String);
1176 Write_Str (" Copyright 1995-2003 Free Software Foundation, Inc");
1185 procedure Write_Usage is
1189 Write_Str ("Usage: ");
1190 Write_Str (Base_Name (Command_Name));
1191 Write_Str (" switches mainprog.ali [non-Ada-objects] [linker-options]");
1194 Write_Line (" mainprog.ali the ALI file of the main program");
1196 Write_Line (" -A Binder generated source file is in Ada (default)");
1197 Write_Line (" -C Binder generated source file is in C");
1198 Write_Line (" -f force object file list to be generated");
1199 Write_Line (" -g Compile binder source file with debug information");
1200 Write_Line (" -n Do not compile the binder source file");
1201 Write_Line (" -R Do not use a run_path_option");
1202 Write_Line (" -v verbose mode");
1203 Write_Line (" -v -v very verbose mode");
1205 Write_Line (" -o nam Use 'nam' as the name of the executable");
1206 Write_Line (" -b target Compile the binder source to run on target");
1207 Write_Line (" -Bdir Load compiler executables from dir");
1208 Write_Line (" --GCC=comp Use comp as the compiler");
1209 Write_Line (" --LINK=nam Use 'nam' for the linking rather than 'gcc'");
1211 Write_Line (" [non-Ada-objects] list of non Ada object files");
1212 Write_Line (" [linker-options] other options for the linker");
1215 -- Start of processing for Gnatlink
1220 if Argument_Count = 0
1222 (Verbose_Mode and then Argument_Count = 1)
1225 Exit_Program (E_Fatal);
1228 if Hostparm.Java_VM then
1229 Gcc := new String'("jgnat");
1230 Ada_Bind_File := True;
1231 Begin_Info := "-- BEGIN Object file/option list";
1232 End_Info := "-- END Object file/option list ";
1235 -- We always compile with -c
1237 Binder_Options_From_ALI.Increment_Last;
1238 Binder_Options_From_ALI.Table (Binder_Options_From_ALI.Last) :=
1241 -- If the main program is in Ada it is compiled with the following
1244 -- -gnatA stops reading gnat.adc, since we don't know what
1245 -- pagmas would work, and we do not need it anyway.
1247 -- -gnatWb allows brackets coding for wide characters
1249 -- -gnatiw allows wide characters in identifiers. This is needed
1250 -- because bindgen uses brackets encoding for all upper
1251 -- half and wide characters in identifier names.
1253 if Ada_Bind_File then
1254 Binder_Options_From_ALI.Increment_Last;
1255 Binder_Options_From_ALI.Table (Binder_Options_From_ALI.Last) :=
1256 new String'("-gnatA");
1257 Binder_Options_From_ALI.Increment_Last;
1258 Binder_Options_From_ALI.Table (Binder_Options_From_ALI.Last) :=
1259 new String'("-gnatWb");
1260 Binder_Options_From_ALI.Increment_Last;
1261 Binder_Options_From_ALI.Table (Binder_Options_From_ALI.Last) :=
1262 new String'("-gnatiw");
1265 -- Locate all the necessary programs and verify required files are present
1267 Gcc_Path := GNAT.OS_Lib.Locate_Exec_On_Path (Gcc.all);
1269 if Gcc_Path = null then
1270 Exit_With_Error ("Couldn't locate " & Gcc.all);
1273 if Linker_Path = null then
1274 Linker_Path := Gcc_Path;
1277 if Ali_File_Name = null then
1278 Exit_With_Error ("no ali file given for link");
1281 if not Is_Regular_File (Ali_File_Name.all) then
1282 Exit_With_Error (Ali_File_Name.all & " not found");
1284 -- Read the ALI file of the main subprogram if the binder generated
1285 -- file needs to be compiled and no --GCC= switch has been specified.
1286 -- Fetch the back end switches from this ALI file and use these switches
1287 -- to compile the binder generated file
1289 elsif Compile_Bind_File and then Standard_Gcc then
1290 -- Do some initializations
1294 Name_Len := Ali_File_Name'Length;
1295 Name_Buffer (1 .. Name_Len) := Ali_File_Name.all;
1299 F : constant File_Name_Type := Name_Find;
1300 T : Text_Buffer_Ptr;
1304 -- Osint.Add_Default_Search_Dirs;
1305 -- Load the ALI file
1307 T := Read_Library_Info (F, True);
1311 A := Scan_ALI (F, T, Ignore_ED => False, Err => False);
1313 if A /= No_ALI_Id then
1315 Index in Units.Table (ALIs.Table (A).First_Unit).First_Arg ..
1316 Units.Table (ALIs.Table (A).First_Unit).Last_Arg
1318 -- Do not compile with the front end switches except for --RTS
1321 Arg : String_Ptr renames Args.Table (Index);
1323 if not Is_Front_End_Switch (Arg.all)
1324 or else Arg (Arg'First + 2 .. Arg'First + 5) = "RTS="
1326 Binder_Options_From_ALI.Increment_Last;
1327 Binder_Options_From_ALI.Table
1328 (Binder_Options_From_ALI.Last) := String_Access (Arg);
1338 -- If no output name specified, then use the base name of .ali file name
1340 if Output_File_Name = null then
1343 new String'(Base_Name (Ali_File_Name.all)
1344 & Get_Debuggable_Suffix.all);
1346 Linker_Options.Increment_Last;
1347 Linker_Options.Table (Linker_Options.Last) :=
1350 Linker_Options.Increment_Last;
1351 Linker_Options.Table (Linker_Options.Last) :=
1352 new String'(Output_File_Name.all);
1356 -- Warn if main program is called "test", as that may be a built-in command
1357 -- on Unix. On non-Unix systems executables have a suffix, so the warning
1358 -- will not appear. However, do not warn in the case of a cross compiler.
1360 -- Assume that if the executable name is not gnatlink, this is a cross
1363 if Base_Name (Command_Name) = "gnatlink"
1364 and then Output_File_Name.all = "test"
1366 Error_Msg ("warning: executable name """ & Output_File_Name.all
1367 & """ may conflict with shell command");
1370 -- Perform consistency checks
1372 -- Transform the .ali file name into the binder output file name.
1374 Make_Binder_File_Names : declare
1375 Fname : constant String := Base_Name (Ali_File_Name.all);
1376 Fname_Len : Integer := Fname'Length;
1378 function Get_Maximum_File_Name_Length return Integer;
1379 pragma Import (C, Get_Maximum_File_Name_Length,
1380 "__gnat_get_maximum_file_name_length");
1382 Maximum_File_Name_Length : constant Integer :=
1383 Get_Maximum_File_Name_Length;
1385 Second_Char : Character;
1386 -- Second character of name of files
1389 -- Set proper second character of file name
1391 if not Ada_Bind_File then
1394 elsif Hostparm.OpenVMS then
1401 -- If the length of the binder file becomes too long due to
1402 -- the addition of the "b?" prefix, then truncate it.
1404 if Maximum_File_Name_Length > 0 then
1405 while Fname_Len > Maximum_File_Name_Length - 2 loop
1406 Fname_Len := Fname_Len - 1;
1410 if Ada_Bind_File then
1411 Binder_Spec_Src_File :=
1414 & Fname (Fname'First .. Fname'First + Fname_Len - 1)
1416 Binder_Body_Src_File :=
1419 & Fname (Fname'First .. Fname'First + Fname_Len - 1)
1424 & Fname (Fname'First .. Fname'First + Fname_Len - 1)
1428 Binder_Body_Src_File :=
1431 & Fname (Fname'First .. Fname'First + Fname_Len - 1)
1438 & Fname (Fname'First .. Fname'First + Fname_Len - 1)
1439 & Get_Object_Suffix.all);
1441 if Fname_Len /= Fname'Length then
1442 Binder_Options.Increment_Last;
1443 Binder_Options.Table (Binder_Options.Last) := new String'("-o");
1444 Binder_Options.Increment_Last;
1445 Binder_Options.Table (Binder_Options.Last) := Binder_Obj_File;
1448 end Make_Binder_File_Names;
1450 Process_Binder_File (Binder_Body_Src_File.all & ASCII.NUL);
1452 -- Compile the binder file. This is fast, so we always do it, unless
1453 -- specifically told not to by the -n switch
1455 if Compile_Bind_File then
1458 Args : Argument_List
1459 (1 .. Binder_Options_From_ALI.Last + Binder_Options.Last + 1);
1462 for J in 1 .. Binder_Options_From_ALI.Last loop
1463 Args (J) := Binder_Options_From_ALI.Table (J);
1466 for J in 1 .. Binder_Options.Last loop
1467 Args (Binder_Options_From_ALI.Last + J) :=
1468 Binder_Options.Table (J);
1471 Args (Args'Last) := Binder_Body_Src_File;
1473 if Verbose_Mode then
1474 Write_Str (Base_Name (Gcc_Path.all));
1476 for J in Args'Range loop
1478 Write_Str (Args (J).all);
1484 GNAT.OS_Lib.Spawn (Gcc_Path.all, Args, Success);
1487 Exit_Program (E_Fatal);
1492 -- Now, actually link the program.
1494 -- Skip this step for now on the JVM since the Java interpreter will do
1495 -- the actual link at run time. We might consider packing all class files
1496 -- in a .zip file during this step.
1498 if not Hostparm.Java_VM then
1500 Num_Args : Natural :=
1501 (Linker_Options.Last - Linker_Options.First + 1) +
1502 (Gcc_Linker_Options.Last - Gcc_Linker_Options.First + 1) +
1503 (Linker_Objects.Last - Linker_Objects.First + 1);
1504 Stack_Op : Boolean := False;
1505 IDENT_Op : Boolean := False;
1508 -- Remove duplicate stack size setting from the Linker_Options
1509 -- table. The stack setting option "-Xlinker --stack=R,C" can be
1510 -- found in one line when set by a pragma Linker_Options or in two
1511 -- lines ("-Xlinker" then "--stack=R,C") when set on the command
1512 -- line. We also check for the "-Wl,--stack=R" style option.
1514 -- We must remove the second stack setting option instance
1515 -- because the one on the command line will always be the first
1516 -- one. And any subsequent stack setting option will overwrite the
1517 -- previous one. This is done especially for GNAT/NT where we set
1518 -- the stack size for tasking programs by a pragma in the NT
1519 -- specific tasking package System.Task_Primitives.Oparations.
1521 -- Note: This is not a FOR loop that runs from Linker_Options.First
1522 -- to Linker_Options.Last, since operations within the loop can
1523 -- modify the length of the table.
1525 Clean_Link_Option_Set : declare
1526 J : Natural := Linker_Options.First;
1529 while J <= Linker_Options.Last loop
1531 if Linker_Options.Table (J).all = "-Xlinker"
1532 and then J < Linker_Options.Last
1533 and then Linker_Options.Table (J + 1)'Length > 8
1534 and then Linker_Options.Table (J + 1) (1 .. 8) = "--stack="
1537 Linker_Options.Table (J .. Linker_Options.Last - 2) :=
1538 Linker_Options.Table (J + 2 .. Linker_Options.Last);
1539 Linker_Options.Decrement_Last;
1540 Linker_Options.Decrement_Last;
1541 Num_Args := Num_Args - 2;
1548 -- Here we just check for a canonical form that matches the
1549 -- pragma Linker_Options set in the NT runtime.
1551 if (Linker_Options.Table (J)'Length > 17
1552 and then Linker_Options.Table (J) (1 .. 17)
1553 = "-Xlinker --stack=")
1555 (Linker_Options.Table (J)'Length > 12
1556 and then Linker_Options.Table (J) (1 .. 12)
1560 Linker_Options.Table (J .. Linker_Options.Last - 1) :=
1561 Linker_Options.Table (J + 1 .. Linker_Options.Last);
1562 Linker_Options.Decrement_Last;
1563 Num_Args := Num_Args - 1;
1570 -- Remove duplicate IDENTIFICATION directives (VMS)
1572 if Linker_Options.Table (J)'Length > 27
1573 and then Linker_Options.Table (J) (1 .. 27)
1574 = "--for-linker=IDENTIFICATION="
1577 Linker_Options.Table (J .. Linker_Options.Last - 1) :=
1578 Linker_Options.Table (J + 1 .. Linker_Options.Last);
1579 Linker_Options.Decrement_Last;
1580 Num_Args := Num_Args - 1;
1588 end Clean_Link_Option_Set;
1590 -- Prepare arguments for call to linker
1592 Call_Linker : declare
1594 Args : Argument_List (1 .. Num_Args + 1);
1595 Index : Integer := Args'First;
1598 Args (Index) := Binder_Obj_File;
1600 -- Add the object files and any -largs libraries
1602 for J in Linker_Objects.First .. Linker_Objects.Last loop
1604 Args (Index) := Linker_Objects.Table (J);
1607 -- Add the linker options from the binder file
1609 for J in Linker_Options.First .. Linker_Options.Last loop
1611 Args (Index) := Linker_Options.Table (J);
1614 -- Finally add the libraries from the --GCC= switch
1616 for J in Gcc_Linker_Options.First .. Gcc_Linker_Options.Last loop
1618 Args (Index) := Gcc_Linker_Options.Table (J);
1621 if Verbose_Mode then
1622 Write_Str (Linker_Path.all);
1624 for J in Args'Range loop
1626 Write_Str (Args (J).all);
1631 -- If we are on very verbose mode (-v -v) and a response file
1632 -- is used we display its content.
1634 if Very_Verbose_Mode and then Tname_FD /= Invalid_FD then
1636 Write_Str ("Response file (" &
1637 Tname (Tname'First .. Tname'Last - 1) &
1642 Response_File_Objects.First ..
1643 Response_File_Objects.Last
1645 Write_Str (Response_File_Objects.Table (J).all);
1653 GNAT.OS_Lib.Spawn (Linker_Path.all, Args, Success);
1655 -- Delete the temporary file used in conjuction with linking if
1656 -- one was created. See Process_Bind_File for details.
1658 if Tname_FD /= Invalid_FD then
1663 Error_Msg ("cannot call " & Linker_Path.all);
1664 Exit_Program (E_Fatal);
1670 -- Only keep the binder output file and it's associated object
1671 -- file if compiling with the -g option. These files are only
1672 -- useful if debugging.
1674 if not Debug_Flag_Present then
1675 if Binder_Ali_File /= null then
1676 Delete (Binder_Ali_File.all & ASCII.NUL);
1679 if Binder_Spec_Src_File /= null then
1680 Delete (Binder_Spec_Src_File.all & ASCII.NUL);
1683 Delete (Binder_Body_Src_File.all & ASCII.NUL);
1685 if not Hostparm.Java_VM then
1686 Delete (Binder_Obj_File.all & ASCII.NUL);
1690 Exit_Program (E_Success);
1694 Write_Line (Exception_Information (X));
1695 Exit_With_Error ("INTERNAL ERROR. Please report");