1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 2002-2007, AdaCore --
11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 2, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
17 -- for more details. You should have received a copy of the GNU General --
18 -- Public License distributed with GNAT; see file COPYING. If not, write --
19 -- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
20 -- Boston, MA 02110-1301, USA. --
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 with MLib.Fil; use MLib.Fil;
28 with MLib.Tgt; use MLib.Tgt;
31 with Output; use Output;
33 with Interfaces.C.Strings; use Interfaces.C.Strings;
37 package body MLib.Utl is
39 Gcc_Name : constant String := Osint.Program_Name ("gcc").all;
40 -- Default value of the "gcc" executable used in procedure Gcc
42 Gcc_Exec : String_Access;
43 -- The full path name of the "gcc" executable
45 Ar_Name : String_Access;
46 -- The name of the archive builder for the platform, set when procedure Ar
47 -- is called for the first time.
49 Ar_Exec : String_Access;
50 -- The full path name of the archive builder
52 Ar_Options : String_List_Access;
53 -- The minimum options used when invoking the archive builder
55 Ar_Append_Options : String_List_Access;
56 -- The options to be used when invoking the archive builder to add chunks
57 -- of object files, when building the archive in chunks.
59 Opt_Length : Natural := 0;
60 -- The max number of options for the Archive_Builder
62 Initial_Size : Natural := 0;
63 -- The minimum number of bytes for the invocation of the Archive Builder
64 -- (without name of the archive or object files).
66 Ranlib_Name : String_Access;
67 -- The name of the archive indexer for the platform, if there is one
69 Ranlib_Exec : String_Access := null;
70 -- The full path name of the archive indexer
72 Ranlib_Options : String_List_Access := null;
73 -- The options to be used when invoking the archive indexer, if any
79 procedure Ar (Output_File : String; Objects : Argument_List) is
80 Full_Output_File : constant String :=
81 Ext_To (Output_File, Archive_Ext);
83 Arguments : Argument_List_Access;
84 Last_Arg : Natural := 0;
86 Line_Length : Natural := 0;
88 Maximum_Size : Integer;
89 pragma Import (C, Maximum_Size, "__gnat_link_max");
90 -- Maximum number of bytes to put in an invocation of the
94 -- The number of bytes for the invocation of the archive builder
96 Current_Object : Natural;
99 -- Display an invocation of the Archive Builder
107 if not Opt.Quiet_Output then
108 Write_Str (Ar_Name.all);
109 Line_Length := Ar_Name'Length;
111 for J in 1 .. Last_Arg loop
113 -- Make sure the Output buffer does not overflow
115 if Line_Length + 1 + Arguments (J)'Length > Buffer_Max then
122 -- Only output the first object files when not in verbose mode
124 if (not Opt.Verbose_Mode) and then J = Opt_Length + 3 then
129 Write_Str (Arguments (J).all);
130 Line_Length := Line_Length + 1 + Arguments (J)'Length;
139 if Ar_Exec = null then
140 Ar_Name := Osint.Program_Name (Archive_Builder);
141 Ar_Exec := Locate_Exec_On_Path (Ar_Name.all);
143 if Ar_Exec = null then
145 Ar_Name := new String'(Archive_Builder);
146 Ar_Exec := Locate_Exec_On_Path (Ar_Name.all);
149 if Ar_Exec = null then
150 Fail (Ar_Name.all, " not found in path");
152 elsif Opt.Verbose_Mode then
153 Write_Str ("found ");
154 Write_Line (Ar_Exec.all);
157 Ar_Options := Archive_Builder_Options;
160 for J in Ar_Options'Range loop
161 Initial_Size := Initial_Size + Ar_Options (J)'Length + 1;
164 Ar_Append_Options := Archive_Builder_Append_Options;
166 Opt_Length := Ar_Options'Length;
168 if Ar_Append_Options /= null then
169 Opt_Length := Natural'Max (Ar_Append_Options'Length, Opt_Length);
172 for J in Ar_Append_Options'Range loop
173 Size := Size + Ar_Append_Options (J)'Length + 1;
176 Initial_Size := Integer'Max (Initial_Size, Size);
181 Ranlib_Name := Osint.Program_Name (Archive_Indexer);
183 if Ranlib_Name'Length > 0 then
184 Ranlib_Exec := Locate_Exec_On_Path (Ranlib_Name.all);
186 if Ranlib_Exec = null then
188 Ranlib_Name := new String'(Archive_Indexer);
189 Ranlib_Exec := Locate_Exec_On_Path (Ranlib_Name.all);
192 if Ranlib_Exec /= null and then Opt.Verbose_Mode then
193 Write_Str ("found ");
194 Write_Line (Ranlib_Exec.all);
198 Ranlib_Options := Archive_Indexer_Options;
202 new String_List (1 .. 1 + Opt_Length + Objects'Length);
203 Arguments (1 .. Ar_Options'Length) := Ar_Options.all; -- "ar cr ..."
204 Arguments (Ar_Options'Length + 1) := new String'(Full_Output_File);
206 Delete_File (Full_Output_File);
208 Size := Initial_Size + Full_Output_File'Length + 1;
210 -- Check the full size of a call of the archive builder with all the
213 for J in Objects'Range loop
214 Size := Size + Objects (J)'Length + 1;
217 -- If the size is not too large or if it is not possible to build the
218 -- archive in chunks, build the archive in a single invocation.
220 if Size <= Maximum_Size or else Ar_Append_Options = null then
221 Last_Arg := Ar_Options'Length + 1 + Objects'Length;
222 Arguments (Ar_Options'Length + 2 .. Last_Arg) := Objects;
226 Spawn (Ar_Exec.all, Arguments (1 .. Last_Arg), Success);
229 -- Build the archive in several invocation, making sure to not
230 -- go over the maximum size for each invocation.
232 Last_Arg := Ar_Options'Length + 1;
233 Current_Object := Objects'First;
234 Size := Initial_Size + Full_Output_File'Length + 1;
238 while Current_Object <= Objects'Last loop
239 Size := Size + Objects (Current_Object)'Length + 1;
240 exit when Size > Maximum_Size;
241 Last_Arg := Last_Arg + 1;
242 Arguments (Last_Arg) := Objects (Current_Object);
243 Current_Object := Current_Object + 1;
248 Spawn (Ar_Exec.all, Arguments (1 .. Last_Arg), Success);
250 Arguments (1 .. Ar_Append_Options'Length) := Ar_Append_Options.all;
252 (Ar_Append_Options'Length + 1) := new String'(Full_Output_File);
254 -- Appending invocation(s)
256 Big_Loop : while Success and then Current_Object <= Objects'Last loop
257 Last_Arg := Ar_Append_Options'Length + 1;
258 Size := Initial_Size + Full_Output_File'Length + 1;
260 Inner_Loop : while Current_Object <= Objects'Last loop
261 Size := Size + Objects (Current_Object)'Length + 1;
262 exit Inner_Loop when Size > Maximum_Size;
263 Last_Arg := Last_Arg + 1;
264 Arguments (Last_Arg) := Objects (Current_Object);
265 Current_Object := Current_Object + 1;
270 Spawn (Ar_Exec.all, Arguments (1 .. Last_Arg), Success);
275 Fail (Ar_Name.all, " execution error.");
278 -- If we have found ranlib, run it over the library
280 if Ranlib_Exec /= null then
281 if not Opt.Quiet_Output then
282 Write_Str (Ranlib_Name.all);
284 Write_Line (Arguments (Ar_Options'Length + 1).all);
289 Ranlib_Options.all & (Arguments (Ar_Options'Length + 1)),
293 Fail (Ranlib_Name.all, " execution error.");
302 procedure Delete_File (Filename : String) is
303 File : constant String := Filename & ASCII.Nul;
307 Delete_File (File'Address, Success);
309 if Opt.Verbose_Mode then
311 Write_Str ("deleted ");
314 Write_Str ("could not delete ");
317 Write_Line (Filename);
326 (Output_File : String;
327 Objects : Argument_List;
328 Options : Argument_List;
329 Options_2 : Argument_List;
330 Driver_Name : Name_Id := No_Name)
332 Link_Bytes : Integer := 0;
333 -- Projected number of bytes for the linker command line
336 pragma Import (C, Link_Max, "__gnat_link_max");
337 -- Maximum number of bytes on the command line supported by the OS
338 -- linker. Passed this limit the response file mechanism must be used
341 Object_List_File_Supported : Boolean;
342 for Object_List_File_Supported'Size use Character'Size;
344 (C, Object_List_File_Supported, "__gnat_objlist_file_supported");
345 -- Predicate indicating whether the linker has an option whereby the
346 -- names of object files can be passed to the linker in a file.
348 Object_File_Option_Ptr : Interfaces.C.Strings.chars_ptr;
349 pragma Import (C, Object_File_Option_Ptr, "__gnat_object_file_option");
350 -- Pointer to a string representing the linker option which specifies
351 -- the response file.
353 Using_GNU_Linker : Boolean;
354 for Using_GNU_Linker'Size use Character'Size;
355 pragma Import (C, Using_GNU_Linker, "__gnat_using_gnu_linker");
356 -- Predicate indicating whether this target uses the GNU linker. In
357 -- this case we must output a GNU linker compatible response file.
359 Opening : aliased constant String := """";
360 Closing : aliased constant String := '"' & ASCII.LF;
361 -- Needed to quote object paths in object list files when GNU linker
364 Tname : String_Access;
365 Tname_FD : File_Descriptor := Invalid_FD;
366 -- Temporary file used by linker to pass list of object files on
367 -- certain systems with limitations on size of arguments.
369 Closing_Status : Boolean;
374 (1 .. 7 + Objects'Length + Options'Length + Options_2'Length);
379 Out_Opt : constant String_Access := new String'("-o");
380 Out_V : constant String_Access := new String'(Output_File);
381 Lib_Dir : constant String_Access := new String'("-L" & Lib_Directory);
382 Lib_Opt : constant String_Access := new String'(Dynamic_Option);
384 Driver : String_Access;
386 type Object_Position is (First, Second, Last);
388 Position : Object_Position;
390 procedure Write_RF (A : System.Address; N : Integer);
391 -- Write a string to the response file and check if it was successful.
392 -- Fail the program if it was not successful (disk full).
398 procedure Write_RF (A : System.Address; N : Integer) is
401 Status := Write (Tname_FD, A, N);
404 Fail ("cannot generate response file to link library: disk full");
409 if Driver_Name = No_Name then
410 if Gcc_Exec = null then
411 Gcc_Exec := Locate_Exec_On_Path (Gcc_Name);
413 if Gcc_Exec = null then
414 Fail (Gcc_Name, " not found in path");
421 Driver := Locate_Exec_On_Path (Get_Name_String (Driver_Name));
423 if Driver = null then
424 Fail (Get_Name_String (Driver_Name), " not found in path");
430 if Lib_Opt'Length /= 0 then
432 Arguments (A) := Lib_Opt;
433 Link_Bytes := Link_Bytes + Lib_Opt'Length + 1;
437 Arguments (A) := Out_Opt;
438 Link_Bytes := Link_Bytes + Out_Opt'Length + 1;
441 Arguments (A) := Out_V;
442 Link_Bytes := Link_Bytes + Out_V'Length + 1;
445 Arguments (A) := Lib_Dir;
446 Link_Bytes := Link_Bytes + Lib_Dir'Length + 1;
448 A := A + Options'Length;
449 Arguments (A - Options'Length + 1 .. A) := Options;
451 for J in Options'Range loop
452 Link_Bytes := Link_Bytes + Options (J)'Length + 1;
455 if not Opt.Quiet_Output then
456 Write_Str (Driver.all);
460 Write_Str (Arguments (J).all);
463 -- Do not display all the object files if not in verbose mode, only
467 for J in Objects'Range loop
468 if Opt.Verbose_Mode or else Position = First then
470 Write_Str (Objects (J).all);
473 elsif Position = Second then
479 for J in Options_2'Range loop
481 Write_Str (Options_2 (J).all);
487 for J in Objects'Range loop
488 Link_Bytes := Link_Bytes + Objects (J)'Length + 1;
491 for J in Options_2'Range loop
492 Link_Bytes := Link_Bytes + Options_2 (J)'Length + 1;
495 if Object_List_File_Supported and then Link_Bytes > Link_Max then
496 -- Create a temporary file containing the object files, one object
497 -- file per line for maximal compatibility with linkers supporting
500 Create_Temp_File (Tname_FD, Tname);
502 -- If target is using the GNU linker we must add a special header
503 -- and footer in the response file.
505 -- The syntax is : INPUT (object1.o object2.o ... )
507 -- Because the GNU linker does not like name with characters such
508 -- as '!', we must put the object paths between double quotes.
510 if Using_GNU_Linker then
512 GNU_Header : aliased constant String := "INPUT (";
515 Write_RF (GNU_Header'Address, GNU_Header'Length);
519 for J in Objects'Range loop
520 -- Opening quote for GNU linker
522 if Using_GNU_Linker then
523 Write_RF (Opening'Address, 1);
527 (Objects (J).all'Address, Objects (J).all'Length);
529 -- Closing quote for GNU linker
531 if Using_GNU_Linker then
532 Write_RF (Closing'Address, 2);
535 Write_RF (ASCII.LF'Address, 1);
539 -- Handle GNU linker response file footer
541 if Using_GNU_Linker then
543 GNU_Footer : aliased constant String := ")";
546 Write_RF (GNU_Footer'Address, GNU_Footer'Length);
550 Close (Tname_FD, Closing_Status);
552 if not Closing_Status then
553 Fail ("cannot generate response file to link library: disk full");
558 new String'(Value (Object_File_Option_Ptr) & Tname.all);
561 A := A + Objects'Length;
562 Arguments (A - Objects'Length + 1 .. A) := Objects;
565 A := A + Options_2'Length;
566 Arguments (A - Options_2'Length + 1 .. A) := Options_2;
568 Spawn (Driver.all, Arguments (1 .. A), Success);
570 if Tname /= null then
571 Delete_File (Tname.all, Closing_Status);
573 if not Closing_Status then
574 Write_Str ("warning: could not delete response file """);
575 Write_Str (Tname.all);
576 Write_Line (""" to link library");
581 if Driver_Name = No_Name then
582 Fail (Gcc_Name, " execution error");
584 Fail (Get_Name_String (Driver_Name), " execution error");
593 function Lib_Directory return String is
594 Libgnat : constant String := Tgt.Libgnat;
597 Name_Len := Libgnat'Length;
598 Name_Buffer (1 .. Name_Len) := Libgnat;
599 Get_Name_String (Osint.Find_File (Name_Enter, Osint.Library));
603 return Name_Buffer (1 .. Name_Len - Libgnat'Length);