[Git][ghc/ghc][wip/ghc-debug] 4 commits: Replace uint with unsigned int. Needed for validate-x86_64-darwin build.
David Eichmann
gitlab at gitlab.haskell.org
Wed Sep 23 17:00:46 UTC 2020
David Eichmann pushed to branch wip/ghc-debug at Glasgow Haskell Compiler / GHC
Commits:
9e427210 by David Eichmann at 2020-09-23T11:52:10+01:00
Replace uint with unsigned int. Needed for validate-x86_64-darwin build.
- - - - -
cde7ebbd by David Eichmann at 2020-09-23T11:59:33+01:00
Fix warnings
- - - - -
7198d60e by David Eichmann at 2020-09-23T17:16:25+01:00
Error instead of deadlock when calling rts_lock after rts_pause
- - - - -
fcd2bb45 by David Eichmann at 2020-09-23T18:00:15+01:00
Move and rewrite NOTE on RtsAPI thread safety
- - - - -
13 changed files:
- includes/RtsAPI.h
- rts/RtsAPI.c
- testsuite/tests/rts/ghc-debug/all.T
- testsuite/tests/rts/ghc-debug/shouldfail/all.T
- + testsuite/tests/rts/ghc-debug/shouldfail/deadlock.c
- + testsuite/tests/rts/ghc-debug/shouldfail/deadlock.h
- + testsuite/tests/rts/ghc-debug/shouldfail/rts_lock_when_paused_deadlock.hs
- + testsuite/tests/rts/ghc-debug/shouldfail/rts_lock_when_paused_deadlock.stderr
- + testsuite/tests/rts/ghc-debug/shouldfail/rts_lock_when_paused_deadlock.stdout
- + testsuite/tests/rts/ghc-debug/shouldfail/rts_pause_when_locked_deadlock.hs
- + testsuite/tests/rts/ghc-debug/shouldfail/rts_pause_when_locked_deadlock.stderr
- + testsuite/tests/rts/ghc-debug/shouldfail/rts_pause_when_locked_deadlock.stdout
- testsuite/tests/rts/ghc-debug/shouldfail/unsafe_rts_pause.hs
Changes:
=====================================
includes/RtsAPI.h
=====================================
@@ -487,13 +487,13 @@ void rts_checkSchedStatus (char* site, Capability *);
SchedulerStatus rts_getSchedStatus (Capability *cap);
// Halt execution of all Haskell threads by acquiring all capabilities (safe FFI
-// calls may continue). rts_resume() must later be called on the same thread to
+// calls may continue). rts_resume must later be called on the same thread to
// resume the RTS. Only one thread at a time can keep the rts paused. The
// rts_pause function will block until the current thread is given exclusive
-// permission to pause the RTS. If the RTS was already paused by the current OS
+// permission to pause the RTS. If the RTS is already paused by the current OS
// thread, then rts_pause will return immediately and have no effect. Returns a
// token which may be used to create new objects and evaluate them (like
-// rts_lock) .This is different to rts_lock() which only pauses a single
+// rts_lock) .This is different to rts_lock which only pauses a single
// capability. Calling rts_pause in between rts_lock/rts_unlock will cause a
// deadlock.
Capability * rts_pause (void);
=====================================
rts/RtsAPI.c
=====================================
@@ -578,6 +578,12 @@ rts_getSchedStatus (Capability *cap)
return cap->running_task->incall->rstat;
}
+#if defined(THREADED_RTS)
+// The task that paused the RTS. The rts_pausing_task variable is owned by the
+// task that owns all capabilities (there is at most one such task).
+Task * rts_pausing_task = NULL;
+#endif
+
Capability *
rts_lock (void)
{
@@ -594,6 +600,14 @@ rts_lock (void)
stg_exit(EXIT_FAILURE);
}
+#if defined(THREADED_RTS)
+ if (rts_pausing_task == task) {
+ errorBelch("error: rts_lock: The RTS is already paused by this thread.\n"
+ " There is no need to call rts_lock if you have already call rts_pause.");
+ stg_exit(EXIT_FAILURE);
+ }
+#endif
+
cap = NULL;
waitForCapability(&cap, task);
@@ -647,9 +661,37 @@ rts_unlock (Capability *cap)
}
#if defined(THREADED_RTS)
-// The task that paused the RTS. The rts_pausing_task variable is owned by the
-// task that owns all capabilities (there is at most one such task).
-Task * rts_pausing_task = NULL;
+
+/*
+ * NOTE RtsAPI thread safety:
+ *
+ * Although it's likely sufficient for many use cases to call RtsAPI.h functions
+ * from a single thread, we still want to ensure that the API is thread safe.
+ * This is achieved almost entirely by the mechanism of acquiring and releasing
+ * Capabilities, resulting in a sort of mutex / critical section pattern.
+ * Correct usage of this API requires that you surround API calls in
+ * rts_lock/rts_unlock or rts_pause/rts_resume. These ensure that the thread
+ * owns a capability while calling other RtsAPI functions (in the case of
+ * rts_pause/rts_resume the thread owns *all* capabilities).
+ *
+ * With the capability(s) acquired GC cannot run. That allows access to the heap
+ * without objects unexpectedly moving, which is important for many of the
+ * functions in RtsAPI.
+ *
+ * Another important consequence is:
+ *
+ * * There are at most `n_capabilities` threads currently in a
+ * rts_lock/rts_unlock section.
+ * * There is at most 1 threads in a rts_pause/rts_resume section. In that case
+ * there will be no threads in a rts_lock/rts_unlock section.
+ * * rts_pause and rts_lock may block in order to enforce the above 2
+ * invariants.
+ *
+ * In particular, by ensuring that that code does not block indefinitely in a
+ * rts_lock/rts_unlock or rts_pause/rts_resume section, we can be confident that
+ * the RtsAPI functions will not cause a deadlock even when many threads are
+ * attempting to use the RtsAPI concurrently.
+ */
// See RtsAPI.h
Capability * rts_pause (void)
@@ -679,62 +721,6 @@ Capability * rts_pause (void)
stg_exit(EXIT_FAILURE);
}
- // NOTE ghc-debug deadlock:
- //
- // stopAllCapabilities attempts to acquire all capabilities and will only
- // block if an existing thread/task:
- //
- // 1. Owns a capability and
- // 2. Is deadlocked i.e. refuses to yield/release its capability.
- //
- // Let's assume the rest of the RTS is deadlock free (tasks will eventually
- // yield their capability) outside of using the ghc-debug API:
- //
- // * rts_pause
- // * rts_resume
- // * rts_isPaused
- // * rts_listThreads
- // * rts_listMiscRoots
- //
- // Except rts_pause, none of these functions acquire a lock and so cannot
- // block. rts_pause may block on stopAllCapabilities, but we ensure that the
- // current task does not own a capability before calling
- // stopAllCapabilities. Hence, (1) does not hold given an isolated call to
- // rts_pause. The only lose end is that after rts_pause, we now have a task
- // that (by design) owns all capabilities (point (1) above) and is refusing
- // to yield them (point (2) above). Indeed, if 2 threads concurrently call
- // rts_pause, one will block until the other calls rts_resume. As "correct
- // usage" of this API requires calling rts_resume, this case is a non-issue,
- // but does imply the awkward quirk that if you call rts_pause on many
- // threads, they will all "take turns" pausing the rts, blocking until it is
- // their turn. In adition, any API function that attempts to acquire a
- // capability (e.g. rts_lock), will block until rts_resume is called. Of
- // course, all ghc-debug API functions besides rts_pause do not attempt to
- // acquire a capability.
- //
- // The moral to this story is that you will not dealock as long as you, on
- // the same thread:
- //
- // * First call rts_pause
- // * Then avoid rts functions other than:
- // * rts_isPaused
- // * rts_listThreads
- // * rts_listMiscRoots
- // * AND dereferencing/inspect the heap directly e.g. using
- // rts_listThreads/rts_listMiscRoots and the ghc-heap library.
- // * Finally call rts_resume
- //
- // TODO
- //
- // I think we should return Capability*. We should be able to use the rest
- // of the rts API with that token. There are a few functions that take
- // `Capability **` implying that it may change capabilities. I need to
- // confirm, but I think that in our case, we'll just end up with the same
- // capability since all others are acquired already. These other API
- // functions may change the heap, but it is up to the caller to account for
- // that. Is it possible that the API can be used to start executing a
- // haskell thread?!?!?! That's perhaps ok as long as we reacquire the
- // capability at the end so we're paused.
task = newBoundTask(); // TODO I'm not sure why we need this. rts_lock does this.
stopAllCapabilities(NULL, task);
@@ -763,7 +749,7 @@ void rts_resume (Capability * cap STG_UNUSED)
}
// Check that we own all capabilities.
- for (uint i = 0; i < n_capabilities; i++)
+ for (unsigned int i = 0; i < n_capabilities; i++)
{
Capability *cap = capabilities[i];
if (cap->running_task != task)
@@ -791,7 +777,7 @@ bool rts_isPaused(void)
// Check that the rts_pause was called on this thread/task. If not, outputs an
// error and exits with EXIT_FAILURE.
-void assert_isPausedOnMyTask(void)
+static void assert_isPausedOnMyTask(void)
{
if (rts_pausing_task == NULL)
{
@@ -848,14 +834,16 @@ void rts_listMiscRoots (ListRootsCb cb, void *user)
}
#else
-Capability * rts_pause (void)
+Capability * GNU_ATTRIBUTE(__noreturn__)
+rts_pause (void)
{
errorBelch("Warning: Pausing the RTS is only possible for "
"multithreaded RTS.");
stg_exit(EXIT_FAILURE);
}
-void rts_resume (Capability * cap)
+void GNU_ATTRIBUTE(__noreturn__)
+rts_resume (Capability * cap STG_UNUSED)
{
errorBelch("Warning: Unpausing the RTS is only possible for "
"multithreaded RTS.");
=====================================
testsuite/tests/rts/ghc-debug/all.T
=====================================
@@ -1,8 +1,12 @@
-test('ghc_debug_01', [extra_files(['ghc_debug.c','ghc_debug.h'])],
- multi_compile_and_run, ['ghc_debug_01', [('ghc_debug.c','')], '-threaded '])
-test('ghc_debug_02', [extra_files(['ghc_debug.c','ghc_debug.h'])],
- multi_compile_and_run, ['ghc_debug_02', [('ghc_debug.c','')], '-threaded '])
-test('ghc_debug_03', [extra_files(['ghc_debug.c','ghc_debug.h'])],
- multi_compile_and_run, ['ghc_debug_03', [('ghc_debug.c','')], '-threaded '])
-test('ghc_debug_04', [extra_files(['ghc_debug.c','ghc_debug.h'])],
- multi_compile_and_run, ['ghc_debug_04', [('ghc_debug.c','')], '-threaded '])
+test('ghc_debug_01', [only_ways(['threaded1', 'threaded2']), extra_ways(['threaded1', 'threaded2']),
+ extra_files(['ghc_debug.c','ghc_debug.h'])],
+ multi_compile_and_run, ['ghc_debug_01', [('ghc_debug.c','')], ''])
+test('ghc_debug_02', [only_ways(['threaded1', 'threaded2']), extra_ways(['threaded1', 'threaded2']),
+ extra_files(['ghc_debug.c','ghc_debug.h'])],
+ multi_compile_and_run, ['ghc_debug_02', [('ghc_debug.c','')], ''])
+test('ghc_debug_03', [only_ways(['threaded1', 'threaded2']), extra_ways(['threaded1', 'threaded2']),
+ extra_files(['ghc_debug.c','ghc_debug.h'])],
+ multi_compile_and_run, ['ghc_debug_03', [('ghc_debug.c','')], ''])
+test('ghc_debug_04', [only_ways(['threaded1', 'threaded2']), extra_ways(['threaded1', 'threaded2']),
+ extra_files(['ghc_debug.c','ghc_debug.h'])],
+ multi_compile_and_run, ['ghc_debug_04', [('ghc_debug.c','')], ''])
=====================================
testsuite/tests/rts/ghc-debug/shouldfail/all.T
=====================================
@@ -1 +1,16 @@
-test('unsafe_rts_pause', [exit_code(1)], compile_and_run, ['-threaded '])
\ No newline at end of file
+
+test('unsafe_rts_pause', [only_ways(['threaded1']), exit_code(1)], compile_and_run, [''])
+test('rts_lock_when_paused_deadlock',
+ [ only_ways(['threaded1', 'threaded2']),
+ extra_ways(['threaded1', 'threaded2']),
+ exit_code(1),
+ extra_files(['deadlock.c','deadlock.h'])
+ ],
+ multi_compile_and_run, ['rts_lock_when_paused_deadlock', [('deadlock.c','')], ''])
+test('rts_pause_when_locked_deadlock',
+ [ only_ways(['threaded1', 'threaded2']),
+ extra_ways(['threaded1', 'threaded2']),
+ exit_code(1),
+ extra_files(['deadlock.c','deadlock.h'])
+ ],
+ multi_compile_and_run, ['rts_pause_when_locked_deadlock', [('deadlock.c','')], ''])
\ No newline at end of file
=====================================
testsuite/tests/rts/ghc-debug/shouldfail/deadlock.c
=====================================
@@ -0,0 +1,59 @@
+#include <stdio.h>
+#include <unistd.h>
+
+#include "Rts.h"
+#include "RtsAPI.h"
+
+#include "deadlock.h"
+
+// Although we expect errors rather than deadlock, we don't want a failed test
+// to be a deadlocked test. Hence we use this as a 1 second timeout mechanism.
+void assertDoneAfterOneSecond(int * done)
+{
+ sleep(1);
+ if (!*done)
+ {
+ printf("Deadlock detected.");
+ exit(1);
+ }
+}
+
+void lockThenPause (int * done) {
+ printf("Locking...");
+ Capability * lockCap = rts_lock();
+ printf("Locked\n");
+
+ printf("Pausing...");
+ Capability * pauseCap = rts_pause();
+ printf("Paused\n");
+
+ printf("Resuming...");
+ rts_resume(pauseCap);
+ printf("Resumed\n");
+
+ printf("Unlocking...");
+ rts_unlock(lockCap);
+ printf("Unlocked\n");
+
+ *done = 1;
+}
+
+void pauseThenLock (int * done) {
+ printf("Pausing...");
+ Capability * pauseCap = rts_pause();
+ printf("Paused\n");
+
+ printf("Locking...");
+ Capability * lockCap = rts_lock();
+ printf("Locked\n");
+
+ printf("Unlocking...");
+ rts_unlock(lockCap);
+ printf("Unlocked\n");
+
+ printf("Resuming...");
+ rts_resume(pauseCap);
+ printf("Resumed\n");
+
+ *done = 1;
+}
=====================================
testsuite/tests/rts/ghc-debug/shouldfail/deadlock.h
=====================================
@@ -0,0 +1,4 @@
+
+void assertDoneAfterOneSecond(int * done);
+void lockThenPause (int * done);
+void pauseThenLock (int * done);
=====================================
testsuite/tests/rts/ghc-debug/shouldfail/rts_lock_when_paused_deadlock.hs
=====================================
@@ -0,0 +1,19 @@
+{-# LANGUAGE ForeignFunctionInterface #-}
+
+import Control.Concurrent
+import Foreign
+import Foreign.C
+import System.Exit
+import System.Timeout
+
+foreign import ccall safe "deadlock.h assertDoneAfterOneSecond"
+ safe_assertDoneAfterOneSecond_c :: Ptr CInt -> IO ()
+
+foreign import ccall safe "deadlock.h lockThenPause"
+ safe_lockThenPause_c :: Ptr CInt -> IO ()
+
+main :: IO ()
+main = alloca $ \donePtr -> do
+ poke donePtr 0
+ forkOS $ safe_assertDoneAfterOneSecond_c donePtr
+ safe_lockThenPause_c donePtr
=====================================
testsuite/tests/rts/ghc-debug/shouldfail/rts_lock_when_paused_deadlock.stderr
=====================================
@@ -0,0 +1,2 @@
+rts_lock_when_paused_deadlock: error: rts_pause: attempting to pause from a Task that owns a capability.
+ Have you already acquired a capability e.g. with rts_lock?
=====================================
testsuite/tests/rts/ghc-debug/shouldfail/rts_lock_when_paused_deadlock.stdout
=====================================
@@ -0,0 +1,2 @@
+Locking...Locked
+Pausing...
\ No newline at end of file
=====================================
testsuite/tests/rts/ghc-debug/shouldfail/rts_pause_when_locked_deadlock.hs
=====================================
@@ -0,0 +1,19 @@
+{-# LANGUAGE ForeignFunctionInterface #-}
+
+import Control.Concurrent
+import Foreign
+import Foreign.C
+import System.Exit
+import System.Timeout
+
+foreign import ccall safe "deadlock.h assertDoneAfterOneSecond"
+ safe_assertDoneAfterOneSecond_c :: Ptr CInt -> IO ()
+
+foreign import ccall safe "deadlock.h pauseThenLock"
+ safe_pauseThenLock_c :: Ptr CInt -> IO ()
+
+main :: IO ()
+main = alloca $ \donePtr -> do
+ poke donePtr 0
+ forkOS $ safe_assertDoneAfterOneSecond_c donePtr
+ safe_pauseThenLock_c donePtr
=====================================
testsuite/tests/rts/ghc-debug/shouldfail/rts_pause_when_locked_deadlock.stderr
=====================================
@@ -0,0 +1,2 @@
+rts_pause_when_locked_deadlock: error: rts_lock: The RTS is already paused by this thread.
+ There is no need to call rts_lock if you have already call rts_pause.
=====================================
testsuite/tests/rts/ghc-debug/shouldfail/rts_pause_when_locked_deadlock.stdout
=====================================
@@ -0,0 +1,2 @@
+Pausing...Paused
+Locking...
\ No newline at end of file
=====================================
testsuite/tests/rts/ghc-debug/shouldfail/unsafe_rts_pause.hs
=====================================
@@ -8,10 +8,10 @@ import Foreign.Ptr
import System.Mem
import Control.Monad
-data RtsPause
+data Capability
foreign import ccall unsafe "RtsAPI.h rts_pause"
- unsafe_rts_pause_c :: IO (Ptr RtsPause)
+ unsafe_rts_pause_c :: IO (Ptr Capability)
main :: IO ()
main = do
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/daddf2b184bc79fd51823aae83a790acf76020d5...fcd2bb45fa2cbd1de83a7d233d87d0655b4cca7d
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/daddf2b184bc79fd51823aae83a790acf76020d5...fcd2bb45fa2cbd1de83a7d233d87d0655b4cca7d
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20200923/a4b320c5/attachment-0001.html>
More information about the ghc-commits
mailing list