1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 2002-2008, 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 3, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
17 -- for more details. You should have received a copy of the GNU General --
18 -- Public License distributed with GNAT; see file COPYING3. If not, go to --
19 -- http://www.gnu.org/licenses for a complete copy of the license. --
21 -- GNAT was originally developed by the GNAT team at New York University. --
22 -- Extensive contributions were provided by Ada Core Technologies Inc. --
24 ------------------------------------------------------------------------------
26 with MLib
.Fil
; use MLib
.Fil
;
27 with MLib
.Tgt
; use MLib
.Tgt
;
30 with Output
; use Output
;
32 with Interfaces
.C
.Strings
; use Interfaces
.C
.Strings
;
36 package body MLib
.Utl
is
38 Adalib_Path
: String_Access
:= null;
39 -- Path of the GNAT adalib directory, specified in procedure
40 -- Specify_Adalib_Dir. Used in function Lib_Directory.
42 Gcc_Name
: String_Access
;
43 -- Default value of the "gcc" executable used in procedure Gcc
45 Gcc_Exec
: String_Access
;
46 -- The full path name of the "gcc" executable
48 Ar_Name
: String_Access
;
49 -- The name of the archive builder for the platform, set when procedure Ar
50 -- is called for the first time.
52 Ar_Exec
: String_Access
;
53 -- The full path name of the archive builder
55 Ar_Options
: String_List_Access
;
56 -- The minimum options used when invoking the archive builder
58 Ar_Append_Options
: String_List_Access
;
59 -- The options to be used when invoking the archive builder to add chunks
60 -- of object files, when building the archive in chunks.
62 Opt_Length
: Natural := 0;
63 -- The max number of options for the Archive_Builder
65 Initial_Size
: Natural := 0;
66 -- The minimum number of bytes for the invocation of the Archive Builder
67 -- (without name of the archive or object files).
69 Ranlib_Name
: String_Access
;
70 -- The name of the archive indexer for the platform, if there is one
72 Ranlib_Exec
: String_Access
:= null;
73 -- The full path name of the archive indexer
75 Ranlib_Options
: String_List_Access
:= null;
76 -- The options to be used when invoking the archive indexer, if any
82 procedure Ar
(Output_File
: String; Objects
: Argument_List
) is
83 Full_Output_File
: constant String :=
84 Ext_To
(Output_File
, Archive_Ext
);
86 Arguments
: Argument_List_Access
;
87 Last_Arg
: Natural := 0;
89 Line_Length
: Natural := 0;
91 Maximum_Size
: Integer;
92 pragma Import
(C
, Maximum_Size
, "__gnat_link_max");
93 -- Maximum number of bytes to put in an invocation of the
97 -- The number of bytes for the invocation of the archive builder
99 Current_Object
: Natural;
102 -- Display an invocation of the Archive Builder
110 if not Opt
.Quiet_Output
then
111 Write_Str
(Ar_Name
.all);
112 Line_Length
:= Ar_Name
'Length;
114 for J
in 1 .. Last_Arg
loop
116 -- Make sure the Output buffer does not overflow
118 if Line_Length
+ 1 + Arguments
(J
)'Length > Buffer_Max
then
125 -- Only output the first object files when not in verbose mode
127 if (not Opt
.Verbose_Mode
) and then J
= Opt_Length
+ 3 then
132 Write_Str
(Arguments
(J
).all);
133 Line_Length
:= Line_Length
+ 1 + Arguments
(J
)'Length;
142 if Ar_Exec
= null then
143 Ar_Name
:= Osint
.Program_Name
(Archive_Builder
, "gnatmake");
144 Ar_Exec
:= Locate_Exec_On_Path
(Ar_Name
.all);
146 if Ar_Exec
= null then
148 Ar_Name
:= new String'(Archive_Builder);
149 Ar_Exec := Locate_Exec_On_Path (Ar_Name.all);
152 if Ar_Exec = null then
153 Fail (Ar_Name.all & " not found in path");
155 elsif Opt.Verbose_Mode then
156 Write_Str ("found ");
157 Write_Line (Ar_Exec.all);
160 Ar_Options := Archive_Builder_Options;
163 for J in Ar_Options'Range loop
164 Initial_Size := Initial_Size + Ar_Options (J)'Length + 1;
167 Ar_Append_Options := Archive_Builder_Append_Options;
169 Opt_Length := Ar_Options'Length;
171 if Ar_Append_Options /= null then
172 Opt_Length := Natural'Max (Ar_Append_Options'Length, Opt_Length);
175 for J in Ar_Append_Options'Range loop
176 Size := Size + Ar_Append_Options (J)'Length + 1;
179 Initial_Size := Integer'Max (Initial_Size, Size);
184 Ranlib_Name := Osint.Program_Name (Archive_Indexer, "gnatmake");
186 if Ranlib_Name'Length > 0 then
187 Ranlib_Exec := Locate_Exec_On_Path (Ranlib_Name.all);
189 if Ranlib_Exec = null then
191 Ranlib_Name := new String'(Archive_Indexer
);
192 Ranlib_Exec
:= Locate_Exec_On_Path
(Ranlib_Name
.all);
195 if Ranlib_Exec
/= null and then Opt
.Verbose_Mode
then
196 Write_Str
("found ");
197 Write_Line
(Ranlib_Exec
.all);
201 Ranlib_Options
:= Archive_Indexer_Options
;
205 new String_List
(1 .. 1 + Opt_Length
+ Objects
'Length);
206 Arguments
(1 .. Ar_Options
'Length) := Ar_Options
.all; -- "ar cr ..."
207 Arguments
(Ar_Options
'Length + 1) := new String'(Full_Output_File);
209 Delete_File (Full_Output_File);
211 Size := Initial_Size + Full_Output_File'Length + 1;
213 -- Check the full size of a call of the archive builder with all the
216 for J in Objects'Range loop
217 Size := Size + Objects (J)'Length + 1;
220 -- If the size is not too large or if it is not possible to build the
221 -- archive in chunks, build the archive in a single invocation.
223 if Size <= Maximum_Size or else Ar_Append_Options = null then
224 Last_Arg := Ar_Options'Length + 1 + Objects'Length;
225 Arguments (Ar_Options'Length + 2 .. Last_Arg) := Objects;
229 Spawn (Ar_Exec.all, Arguments (1 .. Last_Arg), Success);
232 -- Build the archive in several invocation, making sure to not
233 -- go over the maximum size for each invocation.
235 Last_Arg := Ar_Options'Length + 1;
236 Current_Object := Objects'First;
237 Size := Initial_Size + Full_Output_File'Length + 1;
241 while Current_Object <= Objects'Last loop
242 Size := Size + Objects (Current_Object)'Length + 1;
243 exit when Size > Maximum_Size;
244 Last_Arg := Last_Arg + 1;
245 Arguments (Last_Arg) := Objects (Current_Object);
246 Current_Object := Current_Object + 1;
251 Spawn (Ar_Exec.all, Arguments (1 .. Last_Arg), Success);
253 Arguments (1 .. Ar_Append_Options'Length) := Ar_Append_Options.all;
255 (Ar_Append_Options'Length + 1) := new String'(Full_Output_File
);
257 -- Appending invocation(s)
259 Big_Loop
: while Success
and then Current_Object
<= Objects
'Last loop
260 Last_Arg
:= Ar_Append_Options
'Length + 1;
261 Size
:= Initial_Size
+ Full_Output_File
'Length + 1;
263 Inner_Loop
: while Current_Object
<= Objects
'Last loop
264 Size
:= Size
+ Objects
(Current_Object
)'Length + 1;
265 exit Inner_Loop
when Size
> Maximum_Size
;
266 Last_Arg
:= Last_Arg
+ 1;
267 Arguments
(Last_Arg
) := Objects
(Current_Object
);
268 Current_Object
:= Current_Object
+ 1;
273 Spawn
(Ar_Exec
.all, Arguments
(1 .. Last_Arg
), Success
);
278 Fail
(Ar_Name
.all & " execution error.");
281 -- If we have found ranlib, run it over the library
283 if Ranlib_Exec
/= null then
284 if not Opt
.Quiet_Output
then
285 Write_Str
(Ranlib_Name
.all);
287 Write_Line
(Arguments
(Ar_Options
'Length + 1).all);
292 Ranlib_Options
.all & (Arguments
(Ar_Options
'Length + 1)),
296 Fail
(Ranlib_Name
.all & " execution error.");
305 procedure Delete_File
(Filename
: String) is
306 File
: constant String := Filename
& ASCII
.NUL
;
310 Delete_File
(File
'Address, Success
);
312 if Opt
.Verbose_Mode
then
314 Write_Str
("deleted ");
317 Write_Str
("could not delete ");
320 Write_Line
(Filename
);
329 (Output_File
: String;
330 Objects
: Argument_List
;
331 Options
: Argument_List
;
332 Options_2
: Argument_List
;
333 Driver_Name
: Name_Id
:= No_Name
)
335 Link_Bytes
: Integer := 0;
336 -- Projected number of bytes for the linker command line
339 pragma Import
(C
, Link_Max
, "__gnat_link_max");
340 -- Maximum number of bytes on the command line supported by the OS
341 -- linker. Passed this limit the response file mechanism must be used
344 Object_List_File_Supported
: Boolean;
345 for Object_List_File_Supported
'Size use Character'Size;
347 (C
, Object_List_File_Supported
, "__gnat_objlist_file_supported");
348 -- Predicate indicating whether the linker has an option whereby the
349 -- names of object files can be passed to the linker in a file.
351 Object_File_Option_Ptr
: Interfaces
.C
.Strings
.chars_ptr
;
352 pragma Import
(C
, Object_File_Option_Ptr
, "__gnat_object_file_option");
353 -- Pointer to a string representing the linker option which specifies
354 -- the response file.
356 Using_GNU_Linker
: Boolean;
357 for Using_GNU_Linker
'Size use Character'Size;
358 pragma Import
(C
, Using_GNU_Linker
, "__gnat_using_gnu_linker");
359 -- Predicate indicating whether this target uses the GNU linker. In
360 -- this case we must output a GNU linker compatible response file.
362 Opening
: aliased constant String := """";
363 Closing
: aliased constant String := '"' & ASCII
.LF
;
364 -- Needed to quote object paths in object list files when GNU linker
367 Tname
: String_Access
;
368 Tname_FD
: File_Descriptor
:= Invalid_FD
;
369 -- Temporary file used by linker to pass list of object files on
370 -- certain systems with limitations on size of arguments.
372 Closing_Status
: Boolean;
377 (1 .. 7 + Objects
'Length + Options
'Length + Options_2
'Length);
382 Out_Opt
: constant String_Access
:= new String'("-o");
383 Out_V : constant String_Access := new String'(Output_File
);
384 Lib_Dir
: constant String_Access
:= new String'("-L" & Lib_Directory);
385 Lib_Opt : constant String_Access := new String'(Dynamic_Option
);
387 Driver
: String_Access
;
389 type Object_Position
is (First
, Second
, Last
);
391 Position
: Object_Position
;
393 procedure Write_RF
(A
: System
.Address
; N
: Integer);
394 -- Write a string to the response file and check if it was successful.
395 -- Fail the program if it was not successful (disk full).
401 procedure Write_RF
(A
: System
.Address
; N
: Integer) is
404 Status
:= Write
(Tname_FD
, A
, N
);
407 Fail
("cannot generate response file to link library: disk full");
412 if Driver_Name
= No_Name
then
413 if Gcc_Exec
= null then
414 if Gcc_Name
= null then
415 Gcc_Name
:= Osint
.Program_Name
("gcc", "gnatmake");
418 Gcc_Exec
:= Locate_Exec_On_Path
(Gcc_Name
.all);
420 if Gcc_Exec
= null then
421 Fail
(Gcc_Name
.all & " not found in path");
428 Driver
:= Locate_Exec_On_Path
(Get_Name_String
(Driver_Name
));
430 if Driver
= null then
431 Fail
(Get_Name_String
(Driver_Name
) & " not found in path");
437 if Lib_Opt
'Length /= 0 then
439 Arguments
(A
) := Lib_Opt
;
440 Link_Bytes
:= Link_Bytes
+ Lib_Opt
'Length + 1;
444 Arguments
(A
) := Out_Opt
;
445 Link_Bytes
:= Link_Bytes
+ Out_Opt
'Length + 1;
448 Arguments
(A
) := Out_V
;
449 Link_Bytes
:= Link_Bytes
+ Out_V
'Length + 1;
452 Arguments
(A
) := Lib_Dir
;
453 Link_Bytes
:= Link_Bytes
+ Lib_Dir
'Length + 1;
455 A
:= A
+ Options
'Length;
456 Arguments
(A
- Options
'Length + 1 .. A
) := Options
;
458 for J
in Options
'Range loop
459 Link_Bytes
:= Link_Bytes
+ Options
(J
)'Length + 1;
462 if not Opt
.Quiet_Output
then
463 Write_Str
(Driver
.all);
467 Write_Str
(Arguments
(J
).all);
470 -- Do not display all the object files if not in verbose mode, only
474 for J
in Objects
'Range loop
475 if Opt
.Verbose_Mode
or else Position
= First
then
477 Write_Str
(Objects
(J
).all);
480 elsif Position
= Second
then
486 for J
in Options_2
'Range loop
488 Write_Str
(Options_2
(J
).all);
494 for J
in Objects
'Range loop
495 Link_Bytes
:= Link_Bytes
+ Objects
(J
)'Length + 1;
498 for J
in Options_2
'Range loop
499 Link_Bytes
:= Link_Bytes
+ Options_2
(J
)'Length + 1;
502 if Object_List_File_Supported
and then Link_Bytes
> Link_Max
then
503 -- Create a temporary file containing the object files, one object
504 -- file per line for maximal compatibility with linkers supporting
507 Create_Temp_File
(Tname_FD
, Tname
);
509 -- If target is using the GNU linker we must add a special header
510 -- and footer in the response file.
512 -- The syntax is : INPUT (object1.o object2.o ... )
514 -- Because the GNU linker does not like name with characters such
515 -- as '!', we must put the object paths between double quotes.
517 if Using_GNU_Linker
then
519 GNU_Header
: aliased constant String := "INPUT (";
522 Write_RF
(GNU_Header
'Address, GNU_Header
'Length);
526 for J
in Objects
'Range loop
527 -- Opening quote for GNU linker
529 if Using_GNU_Linker
then
530 Write_RF
(Opening
'Address, 1);
534 (Objects
(J
).all'Address, Objects
(J
).all'Length);
536 -- Closing quote for GNU linker
538 if Using_GNU_Linker
then
539 Write_RF
(Closing
'Address, 2);
542 Write_RF
(ASCII
.LF
'Address, 1);
546 -- Handle GNU linker response file footer
548 if Using_GNU_Linker
then
550 GNU_Footer
: aliased constant String := ")";
553 Write_RF
(GNU_Footer
'Address, GNU_Footer
'Length);
557 Close
(Tname_FD
, Closing_Status
);
559 if not Closing_Status
then
560 Fail
("cannot generate response file to link library: disk full");
565 new String'(Value (Object_File_Option_Ptr) & Tname.all);
568 A := A + Objects'Length;
569 Arguments (A - Objects'Length + 1 .. A) := Objects;
572 A := A + Options_2'Length;
573 Arguments (A - Options_2'Length + 1 .. A) := Options_2;
575 Spawn (Driver.all, Arguments (1 .. A), Success);
577 if Tname /= null then
578 Delete_File (Tname.all, Closing_Status);
580 if not Closing_Status then
581 Write_Str ("warning: could not delete response file """);
582 Write_Str (Tname.all);
583 Write_Line (""" to link library");
588 if Driver_Name = No_Name then
589 Fail (Gcc_Name.all & " execution error");
591 Fail (Get_Name_String (Driver_Name) & " execution error");
600 function Lib_Directory return String is
601 Libgnat : constant String := Tgt.Libgnat;
604 -- If procedure Specify_Adalib_Dir has been called, used the specified
607 if Adalib_Path /= null then
608 return Adalib_Path.all;
611 Name_Len := Libgnat'Length;
612 Name_Buffer (1 .. Name_Len) := Libgnat;
613 Get_Name_String (Osint.Find_File (Name_Enter, Osint.Library));
617 return Name_Buffer (1 .. Name_Len - Libgnat'Length);
620 ------------------------
621 -- Specify_Adalib_Dir --
622 ------------------------
624 procedure Specify_Adalib_Dir (Path : String) is
626 if Path'Length = 0 then
629 Adalib_Path := new String'(Path
);
631 end Specify_Adalib_Dir
;