[commit: ghc] master: Implement -rdynamic in Linux and Windows/MinGW32. (0138110)
git at git.haskell.org
git at git.haskell.org
Tue Aug 19 04:34:24 UTC 2014
Repository : ssh://git@git.haskell.org/ghc
On branch : master
Link : http://ghc.haskell.org/trac/ghc/changeset/0138110125400581dc9872dedfcb21bd50b372f1/ghc
>---------------------------------------------------------------
commit 0138110125400581dc9872dedfcb21bd50b372f1
Author: Facundo Domínguez <facundo.dominguez at tweag.io>
Date: Mon Aug 18 21:50:15 2014 -0500
Implement -rdynamic in Linux and Windows/MinGW32.
Summary:
In Linux, it is a synonym for -optl -rdynamic.
In Windows, it is a synonym for -optl -export-all-symbols.
Test Plan: validate
Reviewers: simonmar, austin
Reviewed By: simonmar, austin
Subscribers: mboes, phaskell, simonmar, relrod, ezyang, carter
Differential Revision: https://phabricator.haskell.org/D102
GHC Trac Issues: #9381
>---------------------------------------------------------------
0138110125400581dc9872dedfcb21bd50b372f1
compiler/main/DynFlags.hs | 9 +++++++-
docs/users_guide/flags.xml | 9 ++++++++
docs/users_guide/phases.xml | 15 ++++++++++++++
testsuite/tests/rts/all.T | 5 +++++
testsuite/tests/rts/rdynamic.hs | 41 +++++++++++++++++++++++++++++++++++++
testsuite/tests/rts/rdynamic.stdout | 1 +
6 files changed, 79 insertions(+), 1 deletion(-)
diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index 74bd139..f00ee46 100644
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -2175,8 +2175,15 @@ dynamic_flags = [
----- Linker --------------------------------------------------------
, Flag "static" (NoArg removeWayDyn)
, Flag "dynamic" (NoArg (addWay WayDyn))
+ , Flag "rdynamic" $ noArg $
+#ifdef linux_HOST_OS
+ addOptl "-rdynamic"
+#elif defined (mingw32_HOST_OS)
+ addOptl "-export-all-symbols"
+#else
-- ignored for compat w/ gcc:
- , Flag "rdynamic" (NoArg (return ()))
+ id
+#endif
, Flag "relative-dynlib-paths" (NoArg (setGeneralFlag Opt_RelativeDynlibPaths))
------- Specific phases --------------------------------------------
diff --git a/docs/users_guide/flags.xml b/docs/users_guide/flags.xml
index 8381ca1..dbad118 100644
--- a/docs/users_guide/flags.xml
+++ b/docs/users_guide/flags.xml
@@ -2429,6 +2429,15 @@
<entry>dynamic</entry>
<entry>-</entry>
</row>
+ <row>
+ <entry><option>-rdynamic</option></entry>
+ <entry>This instructs the linker to add all symbols, not only used ones, to the
+ dynamic symbol table. Currently Linux and Windows/MinGW32 only.
+ This is equivalent to using <literal>-optl -rdynamic</literal> in linux,
+ and <literal>-optl -export-all-symbols</literal> in Windows.</entry>
+ <entry>dynamic</entry>
+ <entry>-</entry>
+ </row>
</tbody>
</tgroup>
</informaltable>
diff --git a/docs/users_guide/phases.xml b/docs/users_guide/phases.xml
index 8a5589a..fb92fd3 100644
--- a/docs/users_guide/phases.xml
+++ b/docs/users_guide/phases.xml
@@ -1230,6 +1230,21 @@ $ cat foo.hspp</screen>
platforms.</para>
</listitem>
</varlistentry>
+
+ <varlistentry>
+ <term>
+ <option>-rdynamic</option>
+ <indexterm><primary><option>-rdynamic</option></primary>
+ </indexterm>
+ </term>
+ <listitem>
+ <para>
+ This instructs the linker to add all symbols, not only used ones, to the
+ dynamic symbol table. Currently Linux and Windows/MinGW32 only.
+ This is equivalent to using <literal>-optl -rdynamic</literal> in linux,
+ and <literal>-optl -export-all-symbols</literal> in Windows.</para>
+ </listitem>
+ </varlistentry>
</variablelist>
</sect2>
diff --git a/testsuite/tests/rts/all.T b/testsuite/tests/rts/all.T
index d7c74c5..e9d3ff9 100644
--- a/testsuite/tests/rts/all.T
+++ b/testsuite/tests/rts/all.T
@@ -231,6 +231,11 @@ test('T9045', [ omit_ways(['ghci']), extra_run_opts('10000 +RTS -A8k -RTS') ], c
# with the non-threaded one.
test('T9078', [ omit_ways(threaded_ways) ], compile_and_run, ['-with-rtsopts="-DS" -debug'])
+# -rdynamic is implemented in windows, but the RTS linker does
+# not pickup yet the symbols exported in executables.
+test('rdynamic', unless(opsys('linux'), skip),
+ compile_and_run, ['-rdynamic -package ghc'])
+
# 251 = RTS exit code for "out of memory"
test('overflow1', [ exit_code(251) ], compile_and_run, [''])
test('overflow2', [ exit_code(251) ], compile_and_run, [''])
diff --git a/testsuite/tests/rts/rdynamic.hs b/testsuite/tests/rts/rdynamic.hs
new file mode 100644
index 0000000..5fb4651
--- /dev/null
+++ b/testsuite/tests/rts/rdynamic.hs
@@ -0,0 +1,41 @@
+-- | A test to load symbols exposed with @-rdynamic at .
+--
+-- Exporting 'f' from Main is important, otherwise, the corresponding symbol
+-- wouldn't appear in symbol tables.
+--
+{-# LANGUAGE ForeignFunctionInterface #-}
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE UnboxedTuples #-}
+module Main(main, f) where
+
+import Foreign.C.String ( withCString, CString )
+import GHC.Exts ( addrToAny# )
+import GHC.Ptr ( Ptr(..), nullPtr )
+import System.Info ( os )
+import Encoding
+
+main = (loadFunction Nothing "Main" "f" :: IO (Maybe String)) >>= print
+
+f :: String
+f = "works"
+
+-- loadFunction__ taken from
+-- @plugins-1.5.4.0:System.Plugins.Load.loadFunction__@
+loadFunction :: Maybe String
+ -> String
+ -> String
+ -> IO (Maybe a)
+loadFunction mpkg m valsym = do
+ let symbol = prefixUnderscore
+ ++ maybe "" (\p -> zEncodeString p ++ "_") mpkg
+ ++ zEncodeString m ++ "_" ++ zEncodeString valsym
+ ++ "_closure"
+ ptr@(Ptr addr) <- withCString symbol c_lookupSymbol
+ if (ptr == nullPtr)
+ then return Nothing
+ else case addrToAny# addr of
+ (# hval #) -> return ( Just hval )
+ where
+ prefixUnderscore = if elem os ["darwin","mingw32","cygwin"] then "_" else ""
+
+foreign import ccall safe "lookupSymbol" c_lookupSymbol :: CString -> IO (Ptr a)
diff --git a/testsuite/tests/rts/rdynamic.stdout b/testsuite/tests/rts/rdynamic.stdout
new file mode 100644
index 0000000..fe9b7b1
--- /dev/null
+++ b/testsuite/tests/rts/rdynamic.stdout
@@ -0,0 +1 @@
+Just "works"
More information about the ghc-commits
mailing list