From c4820158f5b080d4aadd9e0ec2ba0dc6377d7ca1 Mon Sep 17 00:00:00 2001 From: Nicolas Setton Date: Wed, 27 Oct 2004 14:27:53 +0200 Subject: [PATCH] mlib-tgt-darwin.adb: New file. 2004-10-26 Nicolas Setton * mlib-tgt-darwin.adb: New file. * mlib-tgt-tru64.adb, mlib-tgt-aix.adb, mlib-tgt-irix.adb, mlib-tgt-hpux.adb, mlib-tgt-linux.adb, mlib-tgt-solaris.adb, mlib-tgt-vms-alpha.adb, mlib-tgt-vms-ia64.adb, mlib-tgt-mingw.adb, mlib-tgt-vxworks.adb (Archive_Indexer_Options): New subprogram body. * Makefile.in: Add support for building shared libraries under Darwin. (EXTRA_GNATRTL_NONTASKING_OBJS, ppc-vxworks): Add s-vxwexc.o, containing the low level EH init subprogram to be called from __gnat_initialize. * mlib-tgt.ads, mlib-tgt.adb (Archive_Indexer_Options): New subprogram, indicates which options to pass to the archive indexer. * mlib-utl.adb: Add support for calling ranlib with additional options. This is needed for instance under Mac OS X. (Ranlib_Options): New global variable, used to store the potential options to pass to ranlib. (Ar): Use Ranlib_Options when spawning ranlib. (Initialize): Set the value of ranlib option. From-SVN: r89639 --- gcc/ada/Makefile.in | 32 ++- gcc/ada/mlib-tgt-aix.adb | 9 + gcc/ada/mlib-tgt-darwin.adb | 366 +++++++++++++++++++++++++++++++++ gcc/ada/mlib-tgt-hpux.adb | 9 + gcc/ada/mlib-tgt-irix.adb | 9 + gcc/ada/mlib-tgt-linux.adb | 9 + gcc/ada/mlib-tgt-mingw.adb | 9 + gcc/ada/mlib-tgt-solaris.adb | 9 + gcc/ada/mlib-tgt-tru64.adb | 9 + gcc/ada/mlib-tgt-vms-alpha.adb | 9 + gcc/ada/mlib-tgt-vms-ia64.adb | 9 + gcc/ada/mlib-tgt-vxworks.adb | 9 + gcc/ada/mlib-tgt.adb | 9 + gcc/ada/mlib-tgt.ads | 3 + gcc/ada/mlib-utl.adb | 21 +- 15 files changed, 511 insertions(+), 10 deletions(-) create mode 100644 gcc/ada/mlib-tgt-darwin.adb diff --git a/gcc/ada/Makefile.in b/gcc/ada/Makefile.in index 4c84b7c4ff29..45737fa0d0bb 100644 --- a/gcc/ada/Makefile.in +++ b/gcc/ada/Makefile.in @@ -559,7 +559,7 @@ ifeq ($(strip $(filter-out powerpc% wrs vxworks,$(targ))),) s-tfsetr.adb null); + Empty_Argument_List : constant Argument_List_Access := No_Arguments'Access; + + Wl_Init_String : aliased String := "-Wl,-init"; + Wl_Init : constant String_Access := Wl_Init_String'Access; + Wl_Fini_String : aliased String := "-Wl,-fini"; + Wl_Fini : constant String_Access := Wl_Fini_String'Access; + + Init_Fini_List : constant Argument_List_Access := + new Argument_List'(1 => Wl_Init, + 2 => null, + 3 => Wl_Fini, + 4 => null); + -- Used to put switches for automatic elaboration/finalization + + --------------------- + -- Archive_Builder -- + --------------------- + + function Archive_Builder return String is + begin + return "ar"; + end Archive_Builder; + + ----------------------------- + -- Archive_Builder_Options -- + ----------------------------- + + function Archive_Builder_Options return String_List_Access is + begin + return new String_List'(1 => new String'("cr")); + end Archive_Builder_Options; + + ----------------- + -- Archive_Ext -- + ----------------- + + function Archive_Ext return String is + begin + return "a"; + end Archive_Ext; + + --------------------- + -- Archive_Indexer -- + --------------------- + + function Archive_Indexer return String is + begin + return "ranlib"; + end Archive_Indexer; + + ----------------------------- + -- Archive_Indexer_Options -- + ----------------------------- + + function Archive_Indexer_Options return String_List_Access is + begin + return new String_List'(1 => new String'("-c")); + end Archive_Indexer_Options; + + --------------------------- + -- Build_Dynamic_Library -- + --------------------------- + + procedure Build_Dynamic_Library + (Ofiles : Argument_List; + Foreign : Argument_List; + Afiles : Argument_List; + Options : Argument_List; + Options_2 : Argument_List; + Interfaces : Argument_List; + Lib_Filename : String; + Lib_Dir : String; + Symbol_Data : Symbol_Record; + Driver_Name : Name_Id := No_Name; + Lib_Version : String := ""; + Auto_Init : Boolean := False) + is + pragma Unreferenced (Foreign); + pragma Unreferenced (Afiles); + pragma Unreferenced (Interfaces); + pragma Unreferenced (Symbol_Data); + + Lib_File : constant String := + Lib_Dir & Directory_Separator & "lib" & + Fil.Ext_To (Lib_Filename, DLL_Ext); + + Version_Arg : String_Access; + Symbolic_Link_Needed : Boolean := False; + + Init_Fini : Argument_List_Access := Empty_Argument_List; + + begin + if Opt.Verbose_Mode then + Write_Str ("building relocatable shared library "); + Write_Line (Lib_File); + end if; + + -- If specified, add automatic elaboration/finalization + + if Auto_Init then + Init_Fini := Init_Fini_List; + Init_Fini (2) := new String'("-Wl," & Lib_Filename & "init"); + Init_Fini (4) := new String'("-Wl," & Lib_Filename & "final"); + end if; + + if Lib_Version = "" then + Utl.Gcc + (Output_File => Lib_File, + Objects => Ofiles, + Options => Options & Init_Fini.all, + Driver_Name => Driver_Name, + Options_2 => Options_2); + + else + Version_Arg := new String'("-Wl,-flat_namespace"); -- ??? + + if Is_Absolute_Path (Lib_Version) then + Utl.Gcc + (Output_File => Lib_Version, + Objects => Ofiles, + Options => Options & Version_Arg & Init_Fini.all, + Driver_Name => Driver_Name, + Options_2 => Options_2); + Symbolic_Link_Needed := Lib_Version /= Lib_File; + + else + Utl.Gcc + (Output_File => Lib_Dir & Directory_Separator & Lib_Version, + Objects => Ofiles, + Options => Options & Version_Arg & Init_Fini.all, + Driver_Name => Driver_Name, + Options_2 => Options_2); + Symbolic_Link_Needed := + Lib_Dir & Directory_Separator & Lib_Version /= Lib_File; + end if; + + if Symbolic_Link_Needed then + declare + Success : Boolean; + Oldpath : String (1 .. Lib_Version'Length + 1); + Newpath : String (1 .. Lib_File'Length + 1); + + Result : Integer; + pragma Unreferenced (Result); + + function Symlink + (Oldpath : System.Address; + Newpath : System.Address) return Integer; + pragma Import (C, Symlink, "__gnat_symlink"); + + begin + Oldpath (1 .. Lib_Version'Length) := Lib_Version; + Oldpath (Oldpath'Last) := ASCII.NUL; + Newpath (1 .. Lib_File'Length) := Lib_File; + Newpath (Newpath'Last) := ASCII.NUL; + + Delete_File (Lib_File, Success); + + Result := Symlink (Oldpath'Address, Newpath'Address); + end; + end if; + end if; + end Build_Dynamic_Library; + + ------------- + -- DLL_Ext -- + ------------- + + function DLL_Ext return String is + begin + return "dylib"; + end DLL_Ext; + + -------------------- + -- Dynamic_Option -- + -------------------- + + function Dynamic_Option return String is + begin + return "-dynamiclib"; + end Dynamic_Option; + + ------------------- + -- Is_Object_Ext -- + ------------------- + + function Is_Object_Ext (Ext : String) return Boolean is + begin + return Ext = ".o"; + end Is_Object_Ext; + + -------------- + -- Is_C_Ext -- + -------------- + + function Is_C_Ext (Ext : String) return Boolean is + begin + return Ext = ".c"; + end Is_C_Ext; + + -------------------- + -- Is_Archive_Ext -- + -------------------- + + function Is_Archive_Ext (Ext : String) return Boolean is + begin + return Ext = ".a" or else Ext = ".dyld"; + end Is_Archive_Ext; + + ------------- + -- Libgnat -- + ------------- + + function Libgnat return String is + begin + return "libgnat.a"; + end Libgnat; + + ------------------------ + -- Library_Exists_For -- + ------------------------ + + function Library_Exists_For (Project : Project_Id) return Boolean is + begin + if not Projects.Table (Project).Library then + Prj.Com.Fail ("INTERNAL ERROR: Library_Exists_For called " & + "for non library project"); + return False; + + else + declare + Lib_Dir : constant String := + Get_Name_String (Projects.Table (Project).Library_Dir); + Lib_Name : constant String := + Get_Name_String (Projects.Table (Project).Library_Name); + + begin + if Projects.Table (Project).Library_Kind = Static then + return Is_Regular_File + (Lib_Dir & Directory_Separator & "lib" & + Fil.Ext_To (Lib_Name, Archive_Ext)); + + else + return Is_Regular_File + (Lib_Dir & Directory_Separator & "lib" & + Fil.Ext_To (Lib_Name, DLL_Ext)); + end if; + end; + end if; + end Library_Exists_For; + + --------------------------- + -- Library_File_Name_For -- + --------------------------- + + function Library_File_Name_For (Project : Project_Id) return Name_Id is + begin + if not Projects.Table (Project).Library then + Prj.Com.Fail ("INTERNAL ERROR: Library_File_Name_For called " & + "for non library project"); + return No_Name; + + else + declare + Lib_Name : constant String := + Get_Name_String (Projects.Table (Project).Library_Name); + + begin + Name_Len := 3; + Name_Buffer (1 .. Name_Len) := "lib"; + + if Projects.Table (Project).Library_Kind = Static then + Add_Str_To_Name_Buffer (Fil.Ext_To (Lib_Name, Archive_Ext)); + + else + Add_Str_To_Name_Buffer (Fil.Ext_To (Lib_Name, DLL_Ext)); + end if; + + return Name_Find; + end; + end if; + end Library_File_Name_For; + + ---------------- + -- Object_Ext -- + ---------------- + + function Object_Ext return String is + begin + return "o"; + end Object_Ext; + + ---------------- + -- PIC_Option -- + ---------------- + + function PIC_Option return String is + begin + return "-fPIC"; + end PIC_Option; + + ----------------------------------------------- + -- Standalone_Library_Auto_Init_Is_Supported -- + ----------------------------------------------- + + function Standalone_Library_Auto_Init_Is_Supported return Boolean is + begin + return True; + end Standalone_Library_Auto_Init_Is_Supported; + + --------------------------- + -- Support_For_Libraries -- + --------------------------- + + function Support_For_Libraries return Library_Support is + begin + return Full; + end Support_For_Libraries; + +end MLib.Tgt; diff --git a/gcc/ada/mlib-tgt-hpux.adb b/gcc/ada/mlib-tgt-hpux.adb index a438b762f6e2..d10becf04cb0 100644 --- a/gcc/ada/mlib-tgt-hpux.adb +++ b/gcc/ada/mlib-tgt-hpux.adb @@ -90,6 +90,15 @@ package body MLib.Tgt is return "ranlib"; end Archive_Indexer; + ----------------------------- + -- Archive_Indexer_Options -- + ----------------------------- + + function Archive_Indexer_Options return String_List_Access is + begin + return new String_List (1 .. 0); + end Archive_Indexer_Options; + --------------------------- -- Build_Dynamic_Library -- --------------------------- diff --git a/gcc/ada/mlib-tgt-irix.adb b/gcc/ada/mlib-tgt-irix.adb index 25fc1c13e15f..eee46a1febae 100644 --- a/gcc/ada/mlib-tgt-irix.adb +++ b/gcc/ada/mlib-tgt-irix.adb @@ -91,6 +91,15 @@ package body MLib.Tgt is return "ranlib"; end Archive_Indexer; + ----------------------------- + -- Archive_Indexer_Options -- + ----------------------------- + + function Archive_Indexer_Options return String_List_Access is + begin + return new String_List (1 .. 0); + end Archive_Indexer_Options; + --------------------------- -- Build_Dynamic_Library -- --------------------------- diff --git a/gcc/ada/mlib-tgt-linux.adb b/gcc/ada/mlib-tgt-linux.adb index a3b82a4cda6a..71584f26a3a2 100644 --- a/gcc/ada/mlib-tgt-linux.adb +++ b/gcc/ada/mlib-tgt-linux.adb @@ -94,6 +94,15 @@ package body MLib.Tgt is return "ranlib"; end Archive_Indexer; + ----------------------------- + -- Archive_Indexer_Options -- + ----------------------------- + + function Archive_Indexer_Options return String_List_Access is + begin + return new String_List (1 .. 0); + end Archive_Indexer_Options; + --------------------------- -- Build_Dynamic_Library -- --------------------------- diff --git a/gcc/ada/mlib-tgt-mingw.adb b/gcc/ada/mlib-tgt-mingw.adb index 0dddb89a6bdf..140bbccff997 100644 --- a/gcc/ada/mlib-tgt-mingw.adb +++ b/gcc/ada/mlib-tgt-mingw.adb @@ -82,6 +82,15 @@ package body MLib.Tgt is return "ranlib"; end Archive_Indexer; + ----------------------------- + -- Archive_Indexer_Options -- + ----------------------------- + + function Archive_Indexer_Options return String_List_Access is + begin + return new String_List (1 .. 0); + end Archive_Indexer_Options; + --------------------------- -- Build_Dynamic_Library -- --------------------------- diff --git a/gcc/ada/mlib-tgt-solaris.adb b/gcc/ada/mlib-tgt-solaris.adb index 4052debc4fc9..7f588dd8b6ab 100644 --- a/gcc/ada/mlib-tgt-solaris.adb +++ b/gcc/ada/mlib-tgt-solaris.adb @@ -88,6 +88,15 @@ package body MLib.Tgt is return "ranlib"; end Archive_Indexer; + ----------------------------- + -- Archive_Indexer_Options -- + ----------------------------- + + function Archive_Indexer_Options return String_List_Access is + begin + return new String_List (1 .. 0); + end Archive_Indexer_Options; + --------------------------- -- Build_Dynamic_Library -- --------------------------- diff --git a/gcc/ada/mlib-tgt-tru64.adb b/gcc/ada/mlib-tgt-tru64.adb index 89be1edac386..37f961ad4851 100644 --- a/gcc/ada/mlib-tgt-tru64.adb +++ b/gcc/ada/mlib-tgt-tru64.adb @@ -96,6 +96,15 @@ package body MLib.Tgt is return "ranlib"; end Archive_Indexer; + ----------------------------- + -- Archive_Indexer_Options -- + ----------------------------- + + function Archive_Indexer_Options return String_List_Access is + begin + return new String_List (1 .. 0); + end Archive_Indexer_Options; + --------------------------- -- Build_Dynamic_Library -- --------------------------- diff --git a/gcc/ada/mlib-tgt-vms-alpha.adb b/gcc/ada/mlib-tgt-vms-alpha.adb index 07f06cf59e01..bf96371c5151 100644 --- a/gcc/ada/mlib-tgt-vms-alpha.adb +++ b/gcc/ada/mlib-tgt-vms-alpha.adb @@ -118,6 +118,15 @@ package body MLib.Tgt is return "ranlib"; end Archive_Indexer; + ----------------------------- + -- Archive_Indexer_Options -- + ----------------------------- + + function Archive_Indexer_Options return String_List_Access is + begin + return new String_List (1 .. 0); + end Archive_Indexer_Options; + --------------------------- -- Build_Dynamic_Library -- --------------------------- diff --git a/gcc/ada/mlib-tgt-vms-ia64.adb b/gcc/ada/mlib-tgt-vms-ia64.adb index c4bd07039320..cad8ae1401b4 100644 --- a/gcc/ada/mlib-tgt-vms-ia64.adb +++ b/gcc/ada/mlib-tgt-vms-ia64.adb @@ -118,6 +118,15 @@ package body MLib.Tgt is return "ranlib"; end Archive_Indexer; + ----------------------------- + -- Archive_Indexer_Options -- + ----------------------------- + + function Archive_Indexer_Options return String_List_Access is + begin + return new String_List (1 .. 0); + end Archive_Indexer_Options; + --------------------------- -- Build_Dynamic_Library -- --------------------------- diff --git a/gcc/ada/mlib-tgt-vxworks.adb b/gcc/ada/mlib-tgt-vxworks.adb index a304b51a4abc..51b911afde59 100644 --- a/gcc/ada/mlib-tgt-vxworks.adb +++ b/gcc/ada/mlib-tgt-vxworks.adb @@ -81,6 +81,15 @@ package body MLib.Tgt is return "ranlib" & Get_Target_Suffix; end Archive_Indexer; + ----------------------------- + -- Archive_Indexer_Options -- + ----------------------------- + + function Archive_Indexer_Options return String_List_Access is + begin + return new String_List (1 .. 0); + end Archive_Indexer_Options; + --------------------------- -- Build_Dynamic_Library -- --------------------------- diff --git a/gcc/ada/mlib-tgt.adb b/gcc/ada/mlib-tgt.adb index a31adbd95bb5..267177ba91c6 100644 --- a/gcc/ada/mlib-tgt.adb +++ b/gcc/ada/mlib-tgt.adb @@ -67,6 +67,15 @@ package body MLib.Tgt is return "ranlib"; end Archive_Indexer; + ----------------------------- + -- Archive_Indexer_Options -- + ----------------------------- + + function Archive_Indexer_Options return String_List_Access is + begin + return new String_List (1 .. 0); + end Archive_Indexer_Options; + --------------------------- -- Build_Dynamic_Library -- --------------------------- diff --git a/gcc/ada/mlib-tgt.ads b/gcc/ada/mlib-tgt.ads index 9b1a71a8fc49..4373dee439d6 100644 --- a/gcc/ada/mlib-tgt.ads +++ b/gcc/ada/mlib-tgt.ads @@ -64,6 +64,9 @@ package MLib.Tgt is -- Returns the name of the program, if any, that generates an index -- to the contents of an archive, usually "ranlib". + function Archive_Indexer_Options return String_List_Access; + -- A list of options to invoke the Archive_Indexer, usually empty. + function Dynamic_Option return String; -- gcc option to create a dynamic library. -- For Unix, returns "-shared", for Windows returns "-mdll". diff --git a/gcc/ada/mlib-utl.adb b/gcc/ada/mlib-utl.adb index f61386af3cc4..4d21c2fa8ea7 100644 --- a/gcc/ada/mlib-utl.adb +++ b/gcc/ada/mlib-utl.adb @@ -36,17 +36,18 @@ with GNAT; use GNAT; package body MLib.Utl is - Initialized : Boolean := False; + Initialized : Boolean := False; - Gcc_Name : constant String := "gcc"; - Gcc_Exec : OS_Lib.String_Access; + Gcc_Name : constant String := "gcc"; + Gcc_Exec : OS_Lib.String_Access; - Ar_Name : OS_Lib.String_Access; - Ar_Exec : OS_Lib.String_Access; - Ar_Options : OS_Lib.String_List_Access; + Ar_Name : OS_Lib.String_Access; + Ar_Exec : OS_Lib.String_Access; + Ar_Options : OS_Lib.String_List_Access; - Ranlib_Name : OS_Lib.String_Access; - Ranlib_Exec : OS_Lib.String_Access := null; + Ranlib_Name : OS_Lib.String_Access; + Ranlib_Exec : OS_Lib.String_Access := null; + Ranlib_Options : OS_Lib.String_List_Access := null; procedure Initialize; -- Look for the tools in the path and record the full path for each one @@ -116,7 +117,7 @@ package body MLib.Utl is OS_Lib.Spawn (Ranlib_Exec.all, - (1 => Arguments (Ar_Options'Length + 1)), + Ranlib_Options.all & (Arguments (Ar_Options'Length + 1)), Success); if not Success then @@ -284,6 +285,8 @@ package body MLib.Utl is Write_Line (Ranlib_Exec.all); end if; end if; + + Ranlib_Options := Archive_Indexer_Options; end if; end Initialize;