From 003dd7a72fac48ef8dad290770e75d2adc58ee25 Mon Sep 17 00:00:00 2001 From: Vincent Celier Date: Wed, 15 Feb 2006 10:35:23 +0100 Subject: [PATCH] gnatlink.adb (Process_Binder_File): If -shared is specified, invoke gcc to link with option -shared-libgcc. 2006-02-13 Vincent Celier * 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 --- gcc/ada/gnatlink.adb | 60 +++++++++++++++++++++++++++++++++----------- 1 file changed, 46 insertions(+), 14 deletions(-) diff --git a/gcc/ada/gnatlink.adb b/gcc/ada/gnatlink.adb index a099217f4ac..a2e63823846 100644 --- a/gcc/ada/gnatlink.adb +++ b/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. -- 2.30.2