[commit: ghc] master: rts: Make StablePtr derefs thread-safe (#10296) (90d7d60)
git at git.haskell.org
git at git.haskell.org
Mon Apr 4 09:30:22 UTC 2016
Repository : ssh://git@git.haskell.org/ghc
On branch : master
Link : http://ghc.haskell.org/trac/ghc/changeset/90d7d6086ed6f271a352e784c3bc1d5ecac6052c/ghc
>---------------------------------------------------------------
commit 90d7d6086ed6f271a352e784c3bc1d5ecac6052c
Author: Jason Eisenberg <jasoneisenberg at gmail.com>
Date: Mon Apr 4 10:57:39 2016 +0200
rts: Make StablePtr derefs thread-safe (#10296)
Stable pointers can now be safely dereferenced while the stable pointer
table is simultaneously being enlarged.
Test Plan: ./validate
Reviewers: ezyang, austin, bgamari, simonmar
Subscribers: carter, thomie
Differential Revision: https://phabricator.haskell.org/D2031
GHC Trac Issues: #10296
>---------------------------------------------------------------
90d7d6086ed6f271a352e784c3bc1d5ecac6052c
rts/Stable.c | 76 ++++++++++++++++++++++++++++++++++++++---
testsuite/tests/rts/Makefile | 6 ++++
testsuite/tests/rts/T10296a.hs | 33 ++++++++++++++++++
testsuite/tests/rts/T10296a_c.c | 13 +++++++
testsuite/tests/rts/T10296b.hs | 19 +++++++++++
testsuite/tests/rts/all.T | 6 ++++
6 files changed, 149 insertions(+), 4 deletions(-)
diff --git a/rts/Stable.c b/rts/Stable.c
index bd09a9f..695c11d 100644
--- a/rts/Stable.c
+++ b/rts/Stable.c
@@ -17,6 +17,8 @@
#include "Trace.h"
#include "Stable.h"
+#include <string.h>
+
/* Comment from ADR's implementation in old RTS:
This files (together with @ghc/runtime/storage/PerformIO.lhc@ and a
@@ -96,6 +98,23 @@ static spEntry *stable_ptr_free = NULL;
static unsigned int SPT_size = 0;
#define INIT_SPT_SIZE 64
+/* Each time the stable pointer table is enlarged, we temporarily retain the old
+ * version to ensure dereferences are thread-safe (see Note [Enlarging the
+ * stable pointer table]). Since we double the size of the table each time, we
+ * can (theoretically) enlarge it at most N times on an N-bit machine. Thus,
+ * there will never be more than N old versions of the table.
+ */
+#if SIZEOF_VOID_P == 4
+#define MAX_N_OLD_SPTS 32
+#elif SIZEOF_VOID_P == 8
+#define MAX_N_OLD_SPTS 64
+#else
+#error unknown SIZEOF_VOID_P
+#endif
+
+static spEntry *old_SPTs[MAX_N_OLD_SPTS];
+static nat n_old_SPTs = 0;
+
#ifdef THREADED_RTS
Mutex stable_mutex;
#endif
@@ -205,21 +224,63 @@ static void
enlargeStablePtrTable(void)
{
nat old_SPT_size = SPT_size;
+ spEntry *new_stable_ptr_table;
// 2nd and subsequent times
SPT_size *= 2;
- stable_ptr_table =
- stgReallocBytes(stable_ptr_table,
- SPT_size * sizeof *stable_ptr_table,
- "enlargeStablePtrTable");
+
+ /* We temporarily retain the old version instead of freeing it; see Note
+ * [Enlarging the stable pointer table].
+ */
+ new_stable_ptr_table =
+ stgMallocBytes(SPT_size * sizeof *stable_ptr_table,
+ "enlargeStablePtrTable");
+ memcpy(new_stable_ptr_table,
+ stable_ptr_table,
+ old_SPT_size * sizeof *stable_ptr_table);
+ ASSERT(n_old_SPTs < MAX_N_OLD_SPTS);
+ old_SPTs[n_old_SPTs++] = stable_ptr_table;
+
+ /* When using the threaded RTS, the update of stable_ptr_table is assumed to
+ * be atomic, so that another thread simultaneously dereferencing a stable
+ * pointer will always read a valid address.
+ */
+ stable_ptr_table = new_stable_ptr_table;
initSpEntryFreeList(stable_ptr_table + old_SPT_size, old_SPT_size, NULL);
}
+/* Note [Enlarging the stable pointer table]
+ *
+ * To enlarge the stable pointer table, we allocate a new table, copy the
+ * existing entries, and then store the old version of the table in old_SPTs
+ * until we free it during GC. By not immediately freeing the old version
+ * (or equivalently by not growing the table using realloc()), we ensure that
+ * another thread simultaneously dereferencing a stable pointer using the old
+ * version can safely access the table without causing a segfault (see Trac
+ * #10296).
+ *
+ * Note that because the stable pointer table is doubled in size each time it is
+ * enlarged, the total memory needed to store the old versions is always less
+ * than that required to hold the current version.
+ */
+
+
/* -----------------------------------------------------------------------------
* Freeing entries and tables
* -------------------------------------------------------------------------- */
+static void
+freeOldSPTs(void)
+{
+ nat i;
+
+ for (i = 0; i < n_old_SPTs; i++) {
+ stgFree(old_SPTs[i]);
+ }
+ n_old_SPTs = 0;
+}
+
void
exitStableTables(void)
{
@@ -237,6 +298,8 @@ exitStableTables(void)
stable_ptr_table = NULL;
SPT_size = 0;
+ freeOldSPTs();
+
#ifdef THREADED_RTS
closeMutex(&stable_mutex);
#endif
@@ -424,6 +487,11 @@ rememberOldStableNameAddresses(void)
void
markStableTables(evac_fn evac, void *user)
{
+ /* Since no other thread can currently be dereferencing a stable pointer, it
+ * is safe to free the old versions of the table.
+ */
+ freeOldSPTs();
+
markStablePtrTable(evac, user);
rememberOldStableNameAddresses();
}
diff --git a/testsuite/tests/rts/Makefile b/testsuite/tests/rts/Makefile
index 6181f87..e9cce90 100644
--- a/testsuite/tests/rts/Makefile
+++ b/testsuite/tests/rts/Makefile
@@ -111,6 +111,12 @@ T7037:
T7040_ghci_setup :
'$(TEST_HC)' $(TEST_HC_OPTS) $(ghciWayFlags) -c T7040_ghci_c.c
+.PHONY: T10296a
+T10296a:
+ $(RM) T10296a_c.o T10296a.o T10296a.hi T10296a_stub.h
+ '$(TEST_HC)' $(TEST_HC_OPTS) -v0 -threaded T10296a.hs T10296a_c.c -o T10296a
+ ./T10296a +RTS -N2
+
.PHONY: linker_unload
linker_unload:
$(RM) Test.o Test.hi
diff --git a/testsuite/tests/rts/T10296a.hs b/testsuite/tests/rts/T10296a.hs
new file mode 100644
index 0000000..136508f
--- /dev/null
+++ b/testsuite/tests/rts/T10296a.hs
@@ -0,0 +1,33 @@
+-- A reduced version of the original test case
+
+{-# LANGUAGE ForeignFunctionInterface #-}
+
+
+import Control.Concurrent
+import Control.Monad
+import Foreign.C.Types
+import Foreign.Ptr
+
+
+main :: IO ()
+main = do
+ mv <- newEmptyMVar
+ -- Fork a thread to continually dereference a stable pointer...
+ void $ forkIO $ f 1 1000000 >> putMVar mv ()
+ -- ...while we keep enlarging the stable pointer table
+ f 65536 1
+ void $ takeMVar mv
+ where
+ f nWraps nApplies = replicateM_ nWraps $ do
+ -- Each call to wrap creates a stable pointer
+ wrappedPlus <- wrap (+)
+ c_applyFun nApplies wrappedPlus 1 2
+
+
+type CIntFun = CInt -> CInt -> CInt
+
+foreign import ccall "wrapper"
+ wrap :: CIntFun -> IO (FunPtr CIntFun)
+
+foreign import ccall "apply_fun"
+ c_applyFun :: CInt -> FunPtr CIntFun -> CInt -> CInt -> IO CInt
diff --git a/testsuite/tests/rts/T10296a_c.c b/testsuite/tests/rts/T10296a_c.c
new file mode 100644
index 0000000..6103874
--- /dev/null
+++ b/testsuite/tests/rts/T10296a_c.c
@@ -0,0 +1,13 @@
+typedef int (* IntFun)(int a, int b);
+
+int apply_fun(int n, IntFun f, int a, int b) {
+ int s = 0;
+ int i;
+
+ for (i = 0; i < n; i++) {
+ // Each call back into Haskell using f dereferences a stable pointer
+ s += f(a, b + i);
+ }
+
+ return s;
+}
diff --git a/testsuite/tests/rts/T10296b.hs b/testsuite/tests/rts/T10296b.hs
new file mode 100644
index 0000000..e5828df
--- /dev/null
+++ b/testsuite/tests/rts/T10296b.hs
@@ -0,0 +1,19 @@
+-- A variant of the T10296a.hs test case in which
+-- - the FFI machinery has been eliminated
+-- - a primop (deRefStablePtr#) is used to dereference the stable pointer
+-- - the stable pointers are explicitly freed at the end
+
+
+import Control.Concurrent
+import Control.Monad
+import Foreign.StablePtr
+
+
+main :: IO ()
+main = do
+ sp <- newStablePtr ()
+ _ <- forkIO $ forever $ deRefStablePtr sp >> threadDelay 0
+ sps <- replicateM 1048576 $ newStablePtr ()
+ ----------------------------------------------------------
+ mapM_ freeStablePtr sps
+ freeStablePtr sp
diff --git a/testsuite/tests/rts/all.T b/testsuite/tests/rts/all.T
index 269bc55..720ebfb 100644
--- a/testsuite/tests/rts/all.T
+++ b/testsuite/tests/rts/all.T
@@ -333,3 +333,9 @@ test('T10728', [extra_run_opts('+RTS -maxN3 -RTS'), only_ways(['threaded2'])],
test('T9405', [extra_clean(['T9405.ticky'])],
run_command, ['$MAKE -s --no-print-directory T9405'])
+
+test('T10296a', [extra_clean(['T10296a.o','T10296a_c.o','T10296a'])],
+ run_command,
+ ['$MAKE -s --no-print-directory T10296a'])
+
+test('T10296b', [only_ways('threaded2')], compile_and_run, [''])
More information about the ghc-commits
mailing list