-- --
-- 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- --
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,
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;
-- 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;
-- Delete --
------------
- procedure Delete (Name : in String) is
+ procedure Delete (Name : String) is
Status : int;
pragma Unreferenced (Status);
begin
-- Error_Msg --
---------------
- procedure Error_Msg (Message : in String) is
+ procedure Error_Msg (Message : String) is
begin
Write_Str (Base_Name (Command_Name));
Write_Str (": ");
-- 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);
-- Process_Binder_File --
-------------------------
- procedure Process_Binder_File (Name : in String) is
+ procedure Process_Binder_File (Name : String) is
Fd : FILEs;
-- Binder file's descriptor
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.
-- 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
-- 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.
declare
N : Integer;
+
begin
N := Objs_End - Objs_Begin + 1;
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;
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;
Clean_Link_Option_Set : declare
J : Natural := Linker_Options.First;
+ Shared_Libgcc_Seen : Boolean := False;
begin
while J <= Linker_Options.Last loop
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.