mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-04-09 23:21:31 +08:00
Code Issues Packages Projects Releases Wiki Activity

gnatlink.adb (Process_Binder_File): If -shared is specified, invoke gcc to link with option -shared-libgcc.

Browse Source 
2006-02-13  Vincent Celier  <celier@adacore.com>

	* gnatlink.adb (Process_Binder_File): If -shared is specified, invoke
	gcc to link with option -shared-libgcc.
	(Gnatlink): Remove duplicate switches -shared-libgcc

From-SVN: r111046
This commit is contained in:
Vincent Celier 2006-02-15 10:35:23 +01:00 committed by Arnaud Charlet
parent 4430b48995
commit 003dd7a72f
1 changed files with 46 additions and 14 deletions

60
gcc/ada/gnatlink.adb

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1996-2005 Free Software Foundation, Inc. --
-- Copyright (C) 1996-2006, Free Software Foundation, Inc. --
-- --
-- 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- --
@ -52,6 +52,11 @@ with System.CRTL;
procedure Gnatlink is
pragma Ident (Gnatvsn.Gnat_Static_Version_String);
Shared_Libgcc_String : constant String := "-shared-libgcc";
Shared_Libgcc : constant String_Access :=
new String'(Shared_Libgcc_String);
-- Used to invoke gcc when the binder is invoked with -shared
package Gcc_Linker_Options is new Table.Table (
Table_Component_Type => String_Access,
Table_Index_Type => Integer,
@ -174,22 +179,22 @@ procedure Gnatlink is
Object_List_File_Required : Boolean := False;
-- Set to True to force generation of a response file
function Base_Name (File_Name : in String) return String;
function Base_Name (File_Name : String) return String;
-- Return just the file name part without the extension (if present)
procedure Delete (Name : in String);
procedure Delete (Name : String);
-- Wrapper to unlink as status is ignored by this application
procedure Error_Msg (Message : in String);
procedure Error_Msg (Message : String);
-- Output the error or warning Message
procedure Exit_With_Error (Error : in String);
procedure Exit_With_Error (Error : String);
-- Output Error and exit program with a fatal condition
procedure Process_Args;
-- Go through all the arguments and build option tables
procedure Process_Binder_File (Name : in String);
procedure Process_Binder_File (Name : String);
-- Reads the binder file and extracts linker arguments
procedure Write_Header;
@ -202,7 +207,7 @@ procedure Gnatlink is
-- Base_Name --
---------------
function Base_Name (File_Name : in String) return String is
function Base_Name (File_Name : String) return String is
Findex1 : Natural;
Findex2 : Natural;
@ -237,7 +242,7 @@ procedure Gnatlink is
-- Delete --
------------
procedure Delete (Name : in String) is
procedure Delete (Name : String) is
Status : int;
pragma Unreferenced (Status);
begin
@ -249,7 +254,7 @@ procedure Gnatlink is
-- Error_Msg --
---------------
procedure Error_Msg (Message : in String) is
procedure Error_Msg (Message : String) is
begin
Write_Str (Base_Name (Command_Name));
Write_Str (": ");
@ -261,7 +266,7 @@ procedure Gnatlink is
-- Exit_With_Error --
---------------------
procedure Exit_With_Error (Error : in String) is
procedure Exit_With_Error (Error : String) is
begin
Error_Msg (Error);
Exit_Program (E_Fatal);
@ -626,7 +631,7 @@ procedure Gnatlink is
-- Process_Binder_File --
-------------------------
procedure Process_Binder_File (Name : in String) is
procedure Process_Binder_File (Name : String) is
Fd : FILEs;
-- Binder file's descriptor
@ -729,7 +734,7 @@ procedure Gnatlink is
function Index (S, Pattern : String) return Natural;
-- Return the last occurrence of Pattern in S, or 0 if none
function Is_Option_Present (Opt : in String) return Boolean;
function Is_Option_Present (Opt : String) return Boolean;
-- Return true if the option Opt is already present in
-- Linker_Options table.
@ -791,7 +796,7 @@ procedure Gnatlink is
-- Is_Option_Present --
-----------------------
function Is_Option_Present (Opt : in String) return Boolean is
function Is_Option_Present (Opt : String) return Boolean is
begin
for I in 1 .. Linker_Options.Last loop
@ -931,7 +936,9 @@ procedure Gnatlink is
-- 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.
@ -999,6 +1006,7 @@ procedure Gnatlink is
declare
N : Integer;
begin
N := Objs_End - Objs_Begin + 1;
@ -1288,6 +1296,13 @@ procedure Gnatlink is
end loop;
end if;
-- If -shared was specified, invoke gcc with -shared-libgcc
if GNAT_Shared then
Linker_Options.Increment_Last;
Linker_Options.Table (Linker_Options.Last) := Shared_Libgcc;
end if;
Status := fclose (Fd);
end Process_Binder_File;
@ -1302,7 +1317,9 @@ procedure Gnatlink is
Write_Str ("GNATLINK ");
Write_Str (Gnat_Version_String);
Write_Eol;
Write_Str ("Copyright 1995-2005 Free Software Foundation, Inc");
Write_Str ("Copyright 1995-" &
Current_Year &
", Free Software Foundation, Inc");
Write_Eol;
end if;
end Write_Header;
@ -1710,6 +1727,7 @@ begin
Clean_Link_Option_Set : declare
J : Natural := Linker_Options.First;
Shared_Libgcc_Seen : Boolean := False;
begin
while J <= Linker_Options.Last loop
@ -1731,6 +1749,20 @@ begin
end if;
end if;
-- Remove duplicate -shared-libgcc switch
if Linker_Options.Table (J).all = Shared_Libgcc_String then
if Shared_Libgcc_Seen then
Linker_Options.Table (J .. Linker_Options.Last - 1) :=
Linker_Options.Table (J + 1 .. Linker_Options.Last);
Linker_Options.Decrement_Last;
Num_Args := Num_Args - 1;
else
Shared_Libgcc_Seen := True;
end if;
end if;
-- Here we just check for a canonical form that matches the
-- pragma Linker_Options set in the NT runtime.