aboutsummaryrefslogtreecommitdiff
path: root/gcc
diff options
context:
space:
mode:
authorVincent Celier <celier@adacore.com>2007-06-06 12:38:29 +0200
committerArnaud Charlet <charlet@gcc.gnu.org>2007-06-06 12:38:29 +0200
commitb5755e2ba523ae36cb5f033ec1dd29d4cda71c09 (patch)
tree8aaae1b1f0d5ee967a99f3a84e73a2967488926f /gcc
parentda4d406dcb68d1de187d81c93ae50864cc3f8fb0 (diff)
downloadgcc-b5755e2ba523ae36cb5f033ec1dd29d4cda71c09.zip
gcc-b5755e2ba523ae36cb5f033ec1dd29d4cda71c09.tar.gz
gcc-b5755e2ba523ae36cb5f033ec1dd29d4cda71c09.tar.bz2
mlib.ads, mlib.adb (Build_Library): Do not use hard-coded directory separator...
2007-04-20 Vincent Celier <celier@adacore.com> * mlib.ads, mlib.adb (Build_Library): Do not use hard-coded directory separator, use instead the proper host directory separator. (Copy_ALI_Files): Make sure that an already existing ALI file in the ALI copy dir is writable, before doing the copy. * mlib-utl.ads, mlib-utl.adb: (Gcc): If length of command line is too long, put the list of object files in a response file, if this is supported by the platform. (Ar): If invocation of the archive builder is allowed to be done in chunks and building it in one shot would go above an OS dependent limit on the number of characters on the command line, build the archive in chunks. From-SVN: r125435
Diffstat (limited to 'gcc')
-rw-r--r--gcc/ada/mlib-utl.adb390
-rw-r--r--gcc/ada/mlib-utl.ads6
-rw-r--r--gcc/ada/mlib.adb28
-rw-r--r--gcc/ada/mlib.ads9
4 files changed, 360 insertions, 73 deletions
diff --git a/gcc/ada/mlib-utl.adb b/gcc/ada/mlib-utl.adb
index 09c8926..3352591 100644
--- a/gcc/ada/mlib-utl.adb
+++ b/gcc/ada/mlib-utl.adb
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 2002-2006, AdaCore --
+-- Copyright (C) 2002-2007, AdaCore --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -26,26 +26,51 @@
with MLib.Fil; use MLib.Fil;
with MLib.Tgt; use MLib.Tgt;
-
-with Namet; use Namet;
with Opt;
with Osint;
with Output; use Output;
-with GNAT; use GNAT;
+with Interfaces.C.Strings; use Interfaces.C.Strings;
+
+with System;
package body MLib.Utl is
Gcc_Name : constant String := Osint.Program_Name ("gcc").all;
- Gcc_Exec : OS_Lib.String_Access;
+ -- Default value of the "gcc" executable used in procedure Gcc
+
+ Gcc_Exec : String_Access;
+ -- The full path name of the "gcc" executable
+
+ Ar_Name : String_Access;
+ -- The name of the archive builder for the platform, set when procedure Ar
+ -- is called for the first time.
+
+ Ar_Exec : String_Access;
+ -- The full path name of the archive builder
+
+ Ar_Options : String_List_Access;
+ -- The minimum options used when invoking the archive builder
+
+ Ar_Append_Options : String_List_Access;
+ -- The options to be used when invoking the archive builder to add chunks
+ -- of object files, when building the archive in chunks.
- Ar_Name : OS_Lib.String_Access;
- Ar_Exec : OS_Lib.String_Access;
- Ar_Options : OS_Lib.String_List_Access;
+ Opt_Length : Natural := 0;
+ -- The max number of options for the Archive_Builder
- Ranlib_Name : OS_Lib.String_Access;
- Ranlib_Exec : OS_Lib.String_Access := null;
- Ranlib_Options : OS_Lib.String_List_Access := null;
+ Initial_Size : Natural := 0;
+ -- The minimum number of bytes for the invocation of the Archive Builder
+ -- (without name of the archive or object files).
+
+ Ranlib_Name : String_Access;
+ -- The name of the archive indexer for the platform, if there is one
+
+ Ranlib_Exec : String_Access := null;
+ -- The full path name of the archive indexer
+
+ Ranlib_Options : String_List_Access := null;
+ -- The options to be used when invoking the archive indexer, if any
--------
-- Ar --
@@ -55,19 +80,70 @@ package body MLib.Utl is
Full_Output_File : constant String :=
Ext_To (Output_File, Archive_Ext);
- Arguments : OS_Lib.Argument_List_Access;
+ Arguments : Argument_List_Access;
+ Last_Arg : Natural := 0;
Success : Boolean;
Line_Length : Natural := 0;
+ Maximum_Size : Integer;
+ pragma Import (C, Maximum_Size, "__gnat_link_max");
+ -- Maximum number of bytes to put in an invocation of the
+ -- Archive_Builder.
+
+ Size : Integer;
+ -- The number of bytes for the invocation of the archive builder
+
+ Current_Object : Natural;
+
+ procedure Display;
+ -- Display an invocation of the Archive Builder
+
+ -------------
+ -- Display --
+ -------------
+
+ procedure Display is
+ begin
+ if not Opt.Quiet_Output then
+ Write_Str (Ar_Name.all);
+ Line_Length := Ar_Name'Length;
+
+ for J in 1 .. Last_Arg loop
+
+ -- Make sure the Output buffer does not overflow
+
+ if Line_Length + 1 + Arguments (J)'Length > Buffer_Max then
+ Write_Eol;
+ Line_Length := 0;
+ end if;
+
+ Write_Char (' ');
+
+ -- Only output the first object files when not in verbose mode
+
+ if (not Opt.Verbose_Mode) and then J = Opt_Length + 3 then
+ Write_Str ("...");
+ exit;
+ end if;
+
+ Write_Str (Arguments (J).all);
+ Line_Length := Line_Length + 1 + Arguments (J)'Length;
+ end loop;
+
+ Write_Eol;
+ end if;
+
+ end Display;
+
begin
if Ar_Exec = null then
Ar_Name := Osint.Program_Name (Archive_Builder);
- Ar_Exec := OS_Lib.Locate_Exec_On_Path (Ar_Name.all);
+ Ar_Exec := Locate_Exec_On_Path (Ar_Name.all);
if Ar_Exec = null then
Free (Ar_Name);
Ar_Name := new String'(Archive_Builder);
- Ar_Exec := OS_Lib.Locate_Exec_On_Path (Ar_Name.all);
+ Ar_Exec := Locate_Exec_On_Path (Ar_Name.all);
end if;
if Ar_Exec = null then
@@ -80,17 +156,37 @@ package body MLib.Utl is
Ar_Options := Archive_Builder_Options;
+ Initial_Size := 0;
+ for J in Ar_Options'Range loop
+ Initial_Size := Initial_Size + Ar_Options (J)'Length + 1;
+ end loop;
+
+ Ar_Append_Options := Archive_Builder_Append_Options;
+
+ Opt_Length := Ar_Options'Length;
+
+ if Ar_Append_Options /= null then
+ Opt_Length := Natural'Max (Ar_Append_Options'Length, Opt_Length);
+
+ Size := 0;
+ for J in Ar_Append_Options'Range loop
+ Size := Size + Ar_Append_Options (J)'Length + 1;
+ end loop;
+
+ Initial_Size := Integer'Max (Initial_Size, Size);
+ end if;
+
-- ranlib
Ranlib_Name := Osint.Program_Name (Archive_Indexer);
if Ranlib_Name'Length > 0 then
- Ranlib_Exec := OS_Lib.Locate_Exec_On_Path (Ranlib_Name.all);
+ Ranlib_Exec := Locate_Exec_On_Path (Ranlib_Name.all);
if Ranlib_Exec = null then
Free (Ranlib_Name);
Ranlib_Name := new String'(Archive_Indexer);
- Ranlib_Exec := OS_Lib.Locate_Exec_On_Path (Ranlib_Name.all);
+ Ranlib_Exec := Locate_Exec_On_Path (Ranlib_Name.all);
end if;
if Ranlib_Exec /= null and then Opt.Verbose_Mode then
@@ -103,43 +199,77 @@ package body MLib.Utl is
end if;
Arguments :=
- new String_List (1 .. 1 + Ar_Options'Length + Objects'Length);
+ new String_List (1 .. 1 + Opt_Length + Objects'Length);
Arguments (1 .. Ar_Options'Length) := Ar_Options.all; -- "ar cr ..."
Arguments (Ar_Options'Length + 1) := new String'(Full_Output_File);
- Arguments (Ar_Options'Length + 2 .. Arguments'Last) := Objects;
Delete_File (Full_Output_File);
- if not Opt.Quiet_Output then
- Write_Str (Ar_Name.all);
- Line_Length := Ar_Name'Length;
+ Size := Initial_Size + Full_Output_File'Length + 1;
- for J in Arguments'Range loop
+ -- Check the full size of a call of the archive builder with all the
+ -- object files.
- -- Make sure the Output buffer does not overflow
+ for J in Objects'Range loop
+ Size := Size + Objects (J)'Length + 1;
+ end loop;
- if Line_Length + 1 + Arguments (J)'Length > Buffer_Max then
- Write_Eol;
- Line_Length := 0;
- end if;
+ -- If the size is not too large or if it is not possible to build the
+ -- archive in chunks, build the archive in a single invocation.
- Write_Char (' ');
+ if Size <= Maximum_Size or else Ar_Append_Options = null then
+ Last_Arg := Ar_Options'Length + 1 + Objects'Length;
+ Arguments (Ar_Options'Length + 2 .. Last_Arg) := Objects;
- -- Only output the first object files when not in verbose mode
+ Display;
- if (not Opt.Verbose_Mode) and then J = Ar_Options'Length + 3 then
- Write_Str ("...");
- exit;
- end if;
+ Spawn (Ar_Exec.all, Arguments (1 .. Last_Arg), Success);
- Write_Str (Arguments (J).all);
- Line_Length := Line_Length + 1 + Arguments (J)'Length;
+ else
+ -- Build the archive in several invocation, making sure to not
+ -- go over the maximum size for each invocation.
+
+ Last_Arg := Ar_Options'Length + 1;
+ Current_Object := Objects'First;
+ Size := Initial_Size + Full_Output_File'Length + 1;
+
+ -- First invocation
+
+ while Current_Object <= Objects'Last loop
+ Size := Size + Objects (Current_Object)'Length + 1;
+ exit when Size > Maximum_Size;
+ Last_Arg := Last_Arg + 1;
+ Arguments (Last_Arg) := Objects (Current_Object);
+ Current_Object := Current_Object + 1;
end loop;
- Write_Eol;
- end if;
+ Display;
+
+ Spawn (Ar_Exec.all, Arguments (1 .. Last_Arg), Success);
+
+ Arguments (1 .. Ar_Append_Options'Length) := Ar_Append_Options.all;
+ Arguments
+ (Ar_Append_Options'Length + 1) := new String'(Full_Output_File);
- OS_Lib.Spawn (Ar_Exec.all, Arguments.all, Success);
+ -- Appending invocation(s)
+
+ Big_Loop : while Success and then Current_Object <= Objects'Last loop
+ Last_Arg := Ar_Append_Options'Length + 1;
+ Size := Initial_Size + Full_Output_File'Length + 1;
+
+ Inner_Loop : while Current_Object <= Objects'Last loop
+ Size := Size + Objects (Current_Object)'Length + 1;
+ exit Inner_Loop when Size > Maximum_Size;
+ Last_Arg := Last_Arg + 1;
+ Arguments (Last_Arg) := Objects (Current_Object);
+ Current_Object := Current_Object + 1;
+ end loop Inner_Loop;
+
+ Display;
+
+ Spawn (Ar_Exec.all, Arguments (1 .. Last_Arg), Success);
+ end loop Big_Loop;
+ end if;
if not Success then
Fail (Ar_Name.all, " execution error.");
@@ -154,7 +284,7 @@ package body MLib.Utl is
Write_Line (Arguments (Ar_Options'Length + 1).all);
end if;
- OS_Lib.Spawn
+ Spawn
(Ranlib_Exec.all,
Ranlib_Options.all & (Arguments (Ar_Options'Length + 1)),
Success);
@@ -174,7 +304,7 @@ package body MLib.Utl is
Success : Boolean;
begin
- OS_Lib.Delete_File (File'Address, Success);
+ Delete_File (File'Address, Success);
if Opt.Verbose_Mode then
if Success then
@@ -199,32 +329,86 @@ package body MLib.Utl is
Options_2 : Argument_List;
Driver_Name : Name_Id := No_Name)
is
+ Link_Bytes : Integer := 0;
+ -- Projected number of bytes for the linker command line
+
+ Link_Max : Integer;
+ pragma Import (C, Link_Max, "__gnat_link_max");
+ -- Maximum number of bytes on the command line supported by the OS
+ -- linker. Passed this limit the response file mechanism must be used
+ -- if supported.
+
+ Object_List_File_Supported : Boolean;
+ for Object_List_File_Supported'Size use Character'Size;
+ pragma Import
+ (C, Object_List_File_Supported, "__gnat_objlist_file_supported");
+ -- Predicate indicating whether the linker has an option whereby the
+ -- names of object files can be passed to the linker in a file.
+
+ Object_File_Option_Ptr : Interfaces.C.Strings.chars_ptr;
+ pragma Import (C, Object_File_Option_Ptr, "__gnat_object_file_option");
+ -- Pointer to a string representing the linker option which specifies
+ -- the response file.
+
+ Using_GNU_Linker : Boolean;
+ for Using_GNU_Linker'Size use Character'Size;
+ pragma Import (C, Using_GNU_Linker, "__gnat_using_gnu_linker");
+ -- Predicate indicating whether this target uses the GNU linker. In
+ -- this case we must output a GNU linker compatible response file.
+
+ Opening : aliased constant String := """";
+ Closing : aliased constant String := '"' & ASCII.LF;
+ -- Needed to quote object paths in object list files when GNU linker
+ -- is used.
+
+ Tname : String_Access;
+ Tname_FD : File_Descriptor := Invalid_FD;
+ -- Temporary file used by linker to pass list of object files on
+ -- certain systems with limitations on size of arguments.
+
+ Closing_Status : Boolean;
+ -- For call to Close
+
Arguments :
- OS_Lib.Argument_List
+ Argument_List
(1 .. 7 + Objects'Length + Options'Length + Options_2'Length);
A : Natural := 0;
Success : Boolean;
- Out_Opt : constant OS_Lib.String_Access :=
- new String'("-o");
- Out_V : constant OS_Lib.String_Access :=
- new String'(Output_File);
- Lib_Dir : constant OS_Lib.String_Access :=
- new String'("-L" & Lib_Directory);
- Lib_Opt : constant OS_Lib.String_Access :=
- new String'(Dynamic_Option);
+ Out_Opt : constant String_Access := new String'("-o");
+ Out_V : constant String_Access := new String'(Output_File);
+ Lib_Dir : constant String_Access := new String'("-L" & Lib_Directory);
+ Lib_Opt : constant String_Access := new String'(Dynamic_Option);
- Driver : String_Access;
+ Driver : String_Access;
type Object_Position is (First, Second, Last);
Position : Object_Position;
+ procedure Write_RF (A : System.Address; N : Integer);
+ -- Write a string to the response file and check if it was successful.
+ -- Fail the program if it was not successful (disk full).
+
+ --------------
+ -- Write_RF --
+ --------------
+
+ procedure Write_RF (A : System.Address; N : Integer) is
+ Status : Integer;
+ begin
+ Status := Write (Tname_FD, A, N);
+
+ if Status /= N then
+ Fail ("cannot generate response file to link library: disk full");
+ end if;
+ end Write_RF;
+
begin
if Driver_Name = No_Name then
if Gcc_Exec = null then
- Gcc_Exec := OS_Lib.Locate_Exec_On_Path (Gcc_Name);
+ Gcc_Exec := Locate_Exec_On_Path (Gcc_Name);
if Gcc_Exec = null then
Fail (Gcc_Name, " not found in path");
@@ -234,30 +418,40 @@ package body MLib.Utl is
Driver := Gcc_Exec;
else
- Driver := OS_Lib.Locate_Exec_On_Path (Get_Name_String (Driver_Name));
+ Driver := Locate_Exec_On_Path (Get_Name_String (Driver_Name));
if Driver = null then
Fail (Get_Name_String (Driver_Name), " not found in path");
end if;
end if;
+ Link_Bytes := 0;
+
if Lib_Opt'Length /= 0 then
A := A + 1;
Arguments (A) := Lib_Opt;
+ Link_Bytes := Link_Bytes + Lib_Opt'Length + 1;
end if;
A := A + 1;
Arguments (A) := Out_Opt;
+ Link_Bytes := Link_Bytes + Out_Opt'Length + 1;
A := A + 1;
Arguments (A) := Out_V;
+ Link_Bytes := Link_Bytes + Out_V'Length + 1;
A := A + 1;
Arguments (A) := Lib_Dir;
+ Link_Bytes := Link_Bytes + Lib_Dir'Length + 1;
A := A + Options'Length;
Arguments (A - Options'Length + 1 .. A) := Options;
+ for J in Options'Range loop
+ Link_Bytes := Link_Bytes + Options (J)'Length + 1;
+ end loop;
+
if not Opt.Quiet_Output then
Write_Str (Driver.all);
@@ -290,18 +484,102 @@ package body MLib.Utl is
Write_Eol;
end if;
- A := A + Objects'Length;
- Arguments (A - Objects'Length + 1 .. A) := Objects;
+ for J in Objects'Range loop
+ Link_Bytes := Link_Bytes + Objects (J)'Length + 1;
+ end loop;
+
+ for J in Options_2'Range loop
+ Link_Bytes := Link_Bytes + Options_2 (J)'Length + 1;
+ end loop;
+
+ if Object_List_File_Supported and then Link_Bytes > Link_Max then
+ -- Create a temporary file containing the object files, one object
+ -- file per line for maximal compatibility with linkers supporting
+ -- this option.
+
+ Create_Temp_File (Tname_FD, Tname);
+
+ -- If target is using the GNU linker we must add a special header
+ -- and footer in the response file.
+
+ -- The syntax is : INPUT (object1.o object2.o ... )
+
+ -- Because the GNU linker does not like name with characters such
+ -- as '!', we must put the object paths between double quotes.
+
+ if Using_GNU_Linker then
+ declare
+ GNU_Header : aliased constant String := "INPUT (";
+
+ begin
+ Write_RF (GNU_Header'Address, GNU_Header'Length);
+ end;
+ end if;
+
+ for J in Objects'Range loop
+ -- Opening quote for GNU linker
+
+ if Using_GNU_Linker then
+ Write_RF (Opening'Address, 1);
+ end if;
+
+ Write_RF
+ (Objects (J).all'Address, Objects (J).all'Length);
+
+ -- Closing quote for GNU linker
+
+ if Using_GNU_Linker then
+ Write_RF (Closing'Address, 2);
+
+ else
+ Write_RF (ASCII.LF'Address, 1);
+ end if;
+ end loop;
+
+ -- Handle GNU linker response file footer
+
+ if Using_GNU_Linker then
+ declare
+ GNU_Footer : aliased constant String := ")";
+
+ begin
+ Write_RF (GNU_Footer'Address, GNU_Footer'Length);
+ end;
+ end if;
+
+ Close (Tname_FD, Closing_Status);
+
+ if not Closing_Status then
+ Fail ("cannot generate response file to link library: disk full");
+ end if;
+
+ A := A + 1;
+ Arguments (A) :=
+ new String'(Value (Object_File_Option_Ptr) & Tname.all);
+
+ else
+ A := A + Objects'Length;
+ Arguments (A - Objects'Length + 1 .. A) := Objects;
+ end if;
A := A + Options_2'Length;
Arguments (A - Options_2'Length + 1 .. A) := Options_2;
- OS_Lib.Spawn (Driver.all, Arguments (1 .. A), Success);
+ Spawn (Driver.all, Arguments (1 .. A), Success);
+
+ if Tname /= null then
+ Delete_File (Tname.all, Closing_Status);
+
+ if not Closing_Status then
+ Write_Str ("warning: could not delete response file """);
+ Write_Str (Tname.all);
+ Write_Line (""" to link library");
+ end if;
+ end if;
if not Success then
if Driver_Name = No_Name then
Fail (Gcc_Name, " execution error");
-
else
Fail (Get_Name_String (Driver_Name), " execution error");
end if;
diff --git a/gcc/ada/mlib-utl.ads b/gcc/ada/mlib-utl.ads
index 0050110..d0476b0 100644
--- a/gcc/ada/mlib-utl.ads
+++ b/gcc/ada/mlib-utl.ads
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
--- Copyright (C) 2001-2006, AdaCore --
+-- Copyright (C) 2001-2007, AdaCore --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -30,8 +30,8 @@
package MLib.Utl is
procedure Delete_File (Filename : String);
- -- Delete the file Filename
- -- Why is this different from the standard OS_Lib routine???
+ -- Delete the file Filename and output the name of the deleted file in
+ -- verbose mode.
procedure Gcc
(Output_File : String;
diff --git a/gcc/ada/mlib.adb b/gcc/ada/mlib.adb
index def15c2..d2aeaab 100644
--- a/gcc/ada/mlib.adb
+++ b/gcc/ada/mlib.adb
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 1999-2006, AdaCore --
+-- Copyright (C) 1999-2007, AdaCore --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -30,7 +30,6 @@ with Interfaces.C.Strings;
with Hostparm;
with Opt;
with Output; use Output;
-with Namet; use Namet;
with MLib.Utl; use MLib.Utl;
@@ -59,7 +58,8 @@ package body MLib is
Write_Line (Output_File);
end if;
- Ar (Output_Dir & "/lib" & Output_File & ".a", Objects => Ofiles);
+ Ar (Output_Dir & Directory_Separator &
+ "lib" & Output_File & ".a", Objects => Ofiles);
end Build_Library;
------------------------
@@ -97,7 +97,7 @@ package body MLib is
procedure Copy_ALI_Files
(Files : Argument_List;
- To : Name_Id;
+ To : Path_Name_Type;
Interfaces : String_List)
is
Success : Boolean := False;
@@ -130,6 +130,10 @@ package body MLib is
for Index in Files'Range loop
Verbose_Copy (Index);
+ Set_Writable
+ (To_Dir &
+ Directory_Separator &
+ Base_Name (Files (Index).all));
Copy_File
(Files (Index).all,
To_Dir,
@@ -169,15 +173,19 @@ package body MLib is
if Is_Interface then
Success := False;
Verbose_Copy (Index);
+ Set_Writable
+ (To_Dir &
+ Directory_Separator &
+ Base_Name (Files (Index).all));
declare
- FD : File_Descriptor;
- Len : Integer;
- Actual_Len : Integer;
- S : String_Access;
- Curr : Natural;
+ FD : File_Descriptor;
+ Len : Integer;
+ Actual_Len : Integer;
+ S : String_Access;
+ Curr : Natural;
P_Line_Found : Boolean;
- Status : Boolean;
+ Status : Boolean;
begin
-- Open the file
diff --git a/gcc/ada/mlib.ads b/gcc/ada/mlib.ads
index c993d8e..2c020fd 100644
--- a/gcc/ada/mlib.ads
+++ b/gcc/ada/mlib.ads
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
--- Copyright (C) 1999-2005, AdaCore --
+-- Copyright (C) 1999-2007, AdaCore --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -27,9 +27,10 @@
-- This package provides the core high level routines used by GNATMLIB
-- and GNATMAKE to build libraries
+with Namet; use Namet;
+with Osint; use Osint;
+
with GNAT.OS_Lib; use GNAT.OS_Lib;
-with Osint; use Osint;
-with Types; use Types;
package MLib is
@@ -60,7 +61,7 @@ package MLib is
procedure Copy_ALI_Files
(Files : Argument_List;
- To : Name_Id;
+ To : Path_Name_Type;
Interfaces : String_List);
-- Copy all ALI files Files to directory To.
-- Mark Interfaces ALI files as interfaces, if any.