===================================================================
@@ -1470,6 +1470,8 @@
extra_objs="winnt.o winnt-stubs.o"
c_target_objs="${c_target_objs} msformat-c.o"
cxx_target_objs="${cxx_target_objs} winnt-cxx.o msformat-c.o"
+ gas=yes
+ gnu_ld=yes
default_use_cxa_atexit=yes
use_gcc_stdint=wrap
case ${enable_threads} in
===================================================================
@@ -213,9 +213,6 @@
[Define to enable the use of a default linker.])
fi
-gnu_ld=`if test x"$gnu_ld_flag" = x"yes"; then echo 1; else echo 0; fi`
-AC_DEFINE_UNQUOTED(HAVE_GNU_LD, $gnu_ld, [Define if using GNU ld.])
-
AC_MSG_CHECKING([whether a default linker was specified])
if test x"${DEFAULT_LINKER+set}" = x"set"; then
if test x"$gnu_ld_flag" = x"no"; then
@@ -256,9 +253,6 @@
[Define to enable the use of a default assembler.])
fi
-gnu_as=`if test x"$gas_flag" = x"yes"; then echo 1; else echo 0; fi`
-AC_DEFINE_UNQUOTED(HAVE_GNU_AS, $gnu_as, [Define if using GNU as.])
-
AC_MSG_CHECKING([whether a default assembler was specified])
if test x"${DEFAULT_ASSEMBLER+set}" = x"set"; then
if test x"$gas_flag" = x"no"; then
@@ -1328,6 +1322,12 @@
efficiently supported by the host hardware.])
fi
+gnu_ld_bool=`if test x"$gnu_ld" = x"yes"; then echo 1; else echo 0; fi`
+AC_DEFINE_UNQUOTED(HAVE_GNU_LD, $gnu_ld_bool, [Define to 1 if using GNU ld.])
+
+gnu_as_bool=`if test x"$gas" = x"yes"; then echo 1; else echo 0; fi`
+AC_DEFINE_UNQUOTED(HAVE_GNU_AS, $gnu_as_bool, [Define to 1 if using GNU as.])
+
count=a
for f in $host_xm_file; do
count=${count}x
===================================================================
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
+-- Copyright (C) 2002-2012, 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- --
@@ -31,8 +31,6 @@
with Interfaces.C.Strings; use Interfaces.C.Strings;
-with System;
-
package body MLib.Utl is
Adalib_Path : String_Access := null;
@@ -353,16 +351,13 @@
-- 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.
+ Object_File_Option : constant String := Value (Object_File_Option_Ptr);
+ -- The linker option which specifies the response file as a string
- Opening : aliased constant String := """";
- Closing : aliased constant String := '"' & ASCII.LF;
- -- Needed to quote object paths in object list files when GNU linker
- -- is used.
+ Using_GNU_response_file : constant Boolean :=
+ Object_File_Option'Length > 0
+ and then Object_File_Option (Object_File_Option'Last) = '@';
+ -- Whether a GNU response file is used
Tname : String_Access;
Tname_FD : File_Descriptor := Invalid_FD;
@@ -390,7 +385,7 @@
Position : Object_Position;
- procedure Write_RF (A : System.Address; N : Integer);
+ procedure Write_RF (S : String);
-- Write a string to the response file and check if it was successful.
-- Fail the program if it was not successful (disk full).
@@ -398,12 +393,38 @@
-- Write_RF --
--------------
- procedure Write_RF (A : System.Address; N : Integer) is
- Status : Integer;
+ procedure Write_RF (S : String) is
+ Success : Boolean := True;
begin
- Status := Write (Tname_FD, A, N);
+ -- If a GNU response file is used, space and backslash need to be
+ -- escaped because they are interpreted as a string separator and
+ -- an escape character respectively by the underlying mechanism.
+ -- On the other hand, quote and double-quote are not escaped since
+ -- they are interpreted as string delimiters on both sides.
- if Status /= N then
+ if Using_GNU_response_file then
+ for I in S'Range loop
+ if S (I) = ' ' or else S (I) = '\' then
+ if Write (Tname_FD, ASCII.BACK_SLASH'Address, 1) /= 1 then
+ Success := False;
+ end if;
+ end if;
+
+ if Write (Tname_FD, S (I)'Address, 1) /= 1 then
+ Success := False;
+ end if;
+ end loop;
+ else
+ if Write (Tname_FD, S'Address, S'Length) /= S'Length then
+ Success := False;
+ end if;
+ end if;
+
+ if Write (Tname_FD, ASCII.LF'Address, 1) /= 1 then
+ Success := False;
+ end if;
+
+ if not Success then
Fail ("cannot generate response file to link library: disk full");
end if;
end Write_RF;
@@ -529,53 +550,10 @@
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;
+ Write_RF (Objects (J).all);
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
@@ -583,8 +561,7 @@
end if;
A := A + 1;
- Arguments (A) :=
- new String'(Value (Object_File_Option_Ptr) & Tname.all);
+ Arguments (A) := new String'(Object_File_Option & Tname.all);
else
A := A + Objects'Length;
@@ -596,17 +573,15 @@
Spawn (Driver.all, Arguments (1 .. A), Success);
- if Tname /= null then
- Delete_File (Tname.all, Closing_Status);
+ if Success then
+ -- Delete the temporary file used in conjunction with linking
+ -- if one was created.
- if not Closing_Status then
- Write_Str ("warning: could not delete response file """);
- Write_Str (Tname.all);
- Write_Line (""" to link library");
+ if Tname_FD /= Invalid_FD then
+ Delete_File (Tname.all);
end if;
- end if;
- if not Success then
+ else
if Driver_Name = No_Name then
Fail (Gcc_Name.all & " execution error");
else
===================================================================
@@ -178,6 +178,19 @@
-- 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.
+
+ Object_File_Option : constant String := Value (Object_File_Option_Ptr);
+ -- The linker option which specifies the response file as a string
+
+ Using_GNU_response_file : constant Boolean :=
+ Object_File_Option'Length > 0
+ and then Object_File_Option (Object_File_Option'Last) = '@';
+ -- Whether a GNU response file is used
+
Object_List_File_Required : Boolean := False;
-- Set to True to force generation of a response file
@@ -760,28 +773,12 @@
-- Pointer to string specifying the default extension for
-- object libraries, e.g. Unix uses ".a", VMS uses ".olb".
- 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.
-
Separate_Run_Path_Options : Boolean;
for Separate_Run_Path_Options'Size use Character'Size;
pragma Import
(C, Separate_Run_Path_Options, "__gnat_separate_run_path_options");
-- Whether separate rpath options should be emitted for each directory
- Opening : aliased constant String := """";
- Closing : aliased constant String := '"' & ASCII.LF;
- -- Needed to quote object paths in object list files when GNU linker
- -- is used.
-
procedure Get_Next_Line;
-- Read the next line from the binder file without the line
-- terminator.
@@ -804,6 +801,10 @@
-- after Store_File_Context. The binder file context will be restored
-- with the data stored by the last Store_File_Context call.
+ procedure Write_RF (S : String);
+ -- Write a string to the response file and check if it was successful.
+ -- Fail the program if it was not successful (disk full).
+
-------------------
-- Get_Next_Line --
-------------------
@@ -897,6 +898,46 @@
end if;
end Store_File_Context;
+ --------------
+ -- Write_RF --
+ --------------
+
+ procedure Write_RF (S : String) is
+ Success : Boolean := True;
+ begin
+ -- If a GNU response file is used, space and backslash need to be
+ -- escaped because they are interpreted as a string separator and
+ -- an escape character respectively by the underlying mechanism.
+ -- On the other hand, quote and double-quote are not escaped since
+ -- they are interpreted as string delimiters on both sides.
+
+ if Using_GNU_response_file then
+ for I in S'Range loop
+ if S (I) = ' ' or else S (I) = '\' then
+ if Write (Tname_FD, ASCII.BACK_SLASH'Address, 1) /= 1 then
+ Success := False;
+ end if;
+ end if;
+
+ if Write (Tname_FD, S (I)'Address, 1) /= 1 then
+ Success := False;
+ end if;
+ end loop;
+ else
+ if Write (Tname_FD, S'Address, S'Length) /= S'Length then
+ Success := False;
+ end if;
+ end if;
+
+ if Write (Tname_FD, ASCII.LF'Address, 1) /= 1 then
+ Success := False;
+ end if;
+
+ if not Success then
+ Exit_With_Error ("Error generating response file: disk full");
+ end if;
+ end Write_RF;
+
-- Start of processing for Process_Binder_File
begin
@@ -985,61 +1026,14 @@
-- ??? Status of Write and Close operations should be checked, and
-- failure should occur if a status is wrong.
- -- 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
- Status := Write (Tname_FD, GNU_Header'Address,
- GNU_Header'Length);
- end;
- end if;
-
for J in Objs_Begin .. Objs_End loop
+ Write_RF (Linker_Objects.Table (J).all);
- -- Opening quote for GNU linker
-
- if Using_GNU_Linker then
- Status := Write (Tname_FD, Opening'Address, 1);
- end if;
-
- Status := Write (Tname_FD, Linker_Objects.Table (J).all'Address,
- Linker_Objects.Table (J).all'Length);
-
- -- Closing quote for GNU linker
-
- if Using_GNU_Linker then
- Status := Write (Tname_FD, Closing'Address, 2);
-
- else
- Status := Write (Tname_FD, ASCII.LF'Address, 1);
- end if;
-
Response_File_Objects.Increment_Last;
Response_File_Objects.Table (Response_File_Objects.Last) :=
Linker_Objects.Table (J);
end loop;
- -- Handle GNU linker response file footer
-
- if Using_GNU_Linker then
- declare
- GNU_Footer : aliased constant String := ")";
-
- begin
- Status := Write (Tname_FD, GNU_Footer'Address,
- GNU_Footer'Length);
- end;
- end if;
-
Close (Tname_FD, Closing_Status);
-- Add the special objects list file option together with the name
@@ -1047,7 +1041,7 @@
-- file table.
Linker_Objects.Table (Objs_Begin) :=
- new String'(Value (Object_File_Option_Ptr) &
+ new String'(Object_File_Option &
Tname (Tname'First .. Tname'Last - 1));
-- The slots containing these object file names are then removed
@@ -2213,14 +2207,15 @@
System.OS_Lib.Spawn (Linker_Path.all, Args, Success);
- -- Delete the temporary file used in conjunction with linking if
- -- one was created. See Process_Bind_File for details.
+ if Success then
+ -- Delete the temporary file used in conjunction with linking
+ -- if one was created. See Process_Bind_File for details.
- if Tname_FD /= Invalid_FD then
- Delete (Tname);
- end if;
+ if Tname_FD /= Invalid_FD then
+ Delete (Tname);
+ end if;
- if not Success then
+ else
Error_Msg ("error when calling " & Linker_Path.all);
Exit_Program (E_Fatal);
end if;
===================================================================
@@ -72,38 +72,22 @@
/* shared_libgcc_default gives the system dependent link method that */
/* be used by default for linking libgcc (shared or static) */
-/* using_gnu_linker is set to 1 when the GNU linker is used under this */
-/* target. */
-
/* separate_run_path_options is set to 1 when separate "rpath" arguments */
/* must be passed to the linker for each directory in the rpath. */
/* default_libgcc_subdir is the subdirectory name (from the installation */
/* root) where we may find a shared libgcc to use by default. */
-/* RESPONSE FILE & GNU LINKER */
-/* -------------------------- */
-/* objlist_file_supported and using_gnu_link used together tell gnatlink */
-/* to generate a GNU style response file. Note that object_file_option */
-/* must be set to "" in this case, since no option is required for a */
-/* response file to be passed to GNU ld. With a GNU linker we use the */
-/* linker script to implement the response file feature. Any file passed */
-/* in the GNU ld command line with an unknown extension is supposed to be */
-/* a linker script. Each linker script augment the current configuration. */
-/* The format of such response file is as follow : */
-/* INPUT (obj1.p obj2.o ...) */
-
#define SHARED 'H'
#define STATIC 'T'
#if defined (__WIN32)
-const char *__gnat_object_file_option = "";
+const char *__gnat_object_file_option = "-Wl,@";
const char *__gnat_run_path_option = "";
int __gnat_link_max = 30000;
unsigned char __gnat_objlist_file_supported = 1;
char __gnat_shared_libgnat_default = STATIC;
char __gnat_shared_libgcc_default = STATIC;
-unsigned char __gnat_using_gnu_linker = 1;
const char *__gnat_object_library_extension = ".a";
unsigned char __gnat_separate_run_path_options = 0;
const char *__gnat_default_libgcc_subdir = "lib";
@@ -115,19 +99,17 @@
unsigned char __gnat_objlist_file_supported = 1;
char __gnat_shared_libgnat_default = STATIC;
char __gnat_shared_libgcc_default = STATIC;
-unsigned char __gnat_using_gnu_linker = 0;
const char *__gnat_object_library_extension = ".a";
unsigned char __gnat_separate_run_path_options = 0;
const char *__gnat_default_libgcc_subdir = "lib";
#elif defined (__FreeBSD__)
-const char *__gnat_object_file_option = "";
+const char *__gnat_object_file_option = "-Wl,@";
const char *__gnat_run_path_option = "-Wl,-rpath,";
char __gnat_shared_libgnat_default = STATIC;
char __gnat_shared_libgcc_default = STATIC;
int __gnat_link_max = 8192;
unsigned char __gnat_objlist_file_supported = 1;
-unsigned char __gnat_using_gnu_linker = 1;
const char *__gnat_object_library_extension = ".a";
unsigned char __gnat_separate_run_path_options = 0;
const char *__gnat_default_libgcc_subdir = "lib";
@@ -139,19 +121,17 @@
char __gnat_shared_libgcc_default = SHARED;
int __gnat_link_max = 262144;
unsigned char __gnat_objlist_file_supported = 1;
-unsigned char __gnat_using_gnu_linker = 0;
const char *__gnat_object_library_extension = ".a";
unsigned char __gnat_separate_run_path_options = 1;
const char *__gnat_default_libgcc_subdir = "lib";
#elif defined (linux) || defined(__GLIBC__)
-const char *__gnat_object_file_option = "";
+const char *__gnat_object_file_option = "-Wl,@";
const char *__gnat_run_path_option = "-Wl,-rpath,";
char __gnat_shared_libgnat_default = STATIC;
char __gnat_shared_libgcc_default = STATIC;
int __gnat_link_max = 8192;
unsigned char __gnat_objlist_file_supported = 1;
-unsigned char __gnat_using_gnu_linker = 1;
const char *__gnat_object_library_extension = ".a";
unsigned char __gnat_separate_run_path_options = 0;
#if defined (__x86_64)
@@ -174,7 +154,6 @@
char __gnat_shared_libgcc_default = STATIC;
int __gnat_link_max = 15000;
const unsigned char __gnat_objlist_file_supported = 1;
-unsigned char __gnat_using_gnu_linker = 0;
const char *__gnat_object_library_extension = ".a";
unsigned char __gnat_separate_run_path_options = 0;
const char *__gnat_default_libgcc_subdir = "lib";
@@ -183,13 +162,12 @@
/* These are the settings for all systems that use gnu ld. GNU style response
file is supported, the shared library default is STATIC. */
-const char *__gnat_object_file_option = "";
+const char *__gnat_object_file_option = "-Wl,@";
const char *__gnat_run_path_option = "";
char __gnat_shared_libgnat_default = STATIC;
char __gnat_shared_libgcc_default = STATIC;
int __gnat_link_max = 8192;
unsigned char __gnat_objlist_file_supported = 1;
-unsigned char __gnat_using_gnu_linker = 1;
const char *__gnat_object_library_extension = ".a";
unsigned char __gnat_separate_run_path_options = 0;
const char *__gnat_default_libgcc_subdir = "lib";
@@ -201,7 +179,6 @@
char __gnat_shared_libgcc_default = STATIC;
int __gnat_link_max = 2147483647;
unsigned char __gnat_objlist_file_supported = 0;
-unsigned char __gnat_using_gnu_linker = 0;
const char *__gnat_object_library_extension = ".olb";
unsigned char __gnat_separate_run_path_options = 0;
const char *__gnat_default_libgcc_subdir = "lib";
@@ -213,7 +190,6 @@
char __gnat_shared_libgcc_default = STATIC;
int __gnat_link_max = 2147483647;
unsigned char __gnat_objlist_file_supported = 0;
-unsigned char __gnat_using_gnu_linker = 0;
const char *__gnat_object_library_extension = ".a";
unsigned char __gnat_separate_run_path_options = 0;
#if defined (__sparc_v9__) || defined (__sparcv9)
@@ -231,7 +207,6 @@
char __gnat_shared_libgcc_default = STATIC;
int __gnat_link_max = 2147483647;
unsigned char __gnat_objlist_file_supported = 0;
-unsigned char __gnat_using_gnu_linker = 0;
const char *__gnat_object_library_extension = ".a";
unsigned char __gnat_separate_run_path_options = 0;
const char *__gnat_default_libgcc_subdir = "lib";
@@ -246,7 +221,6 @@
char __gnat_shared_libgcc_default = STATIC;
int __gnat_link_max = 2147483647;
unsigned char __gnat_objlist_file_supported = 0;
-unsigned char __gnat_using_gnu_linker = 0;
const char *__gnat_object_library_extension = ".a";
unsigned char __gnat_separate_run_path_options = 0;
const char *__gnat_default_libgcc_subdir = "lib";
===================================================================
@@ -0,0 +1,7 @@
+-- { dg-do link }
+-- { dg-options "-largs -f -margs -flto" { target lto } }
+
+procedure Lto13 is
+begin
+ null;
+end;