/* ---------------------------------------------------------------------------
- * $Id: Schedule.c,v 1.128 2002/02/15 20:58:14 sof Exp $
+ * $Id: Schedule.c,v 1.134 2002/03/12 13:57:11 simonmar Exp $
*
* (c) The GHC Team, 1998-2000
*
//@node Variables and Data structures, Prototypes, Includes, Main scheduling code
//@subsection Variables and Data structures
-/* Main threads:
- *
- * These are the threads which clients have requested that we run.
- *
- * In a 'threaded' build, we might have several concurrent clients all
- * waiting for results, and each one will wait on a condition variable
- * until the result is available.
- *
- * In non-SMP, clients are strictly nested: the first client calls
- * into the RTS, which might call out again to C with a _ccall_GC, and
- * eventually re-enter the RTS.
- *
- * Main threads information is kept in a linked list:
- */
-//@cindex StgMainThread
-typedef struct StgMainThread_ {
- StgTSO * tso;
- SchedulerStatus stat;
- StgClosure ** ret;
-#if defined(RTS_SUPPORTS_THREADS)
- Condition wakeup;
-#endif
- struct StgMainThread_ *link;
-} StgMainThread;
-
/* Main thread queue.
* Locks required: sched_mutex.
*/
-static StgMainThread *main_threads;
+StgMainThread *main_threads;
/* Thread queues.
* Locks required: sched_mutex.
* inform all the main threads.
*/
#ifndef PAR
- if ( EMPTY_RUN_QUEUE()
- && EMPTY_QUEUE(blocked_queue_hd)
- && EMPTY_QUEUE(sleeping_queue)
+ if ( EMPTY_THREAD_QUEUES()
#if defined(RTS_SUPPORTS_THREADS)
&& EMPTY_QUEUE(suspended_ccalling_threads)
#endif
/* and SMP mode ..? */
releaseCapability(cap);
#endif
- RELEASE_LOCK(&sched_mutex);
+ // Garbage collection can release some new threads due to
+ // either (a) finalizers or (b) threads resurrected because
+ // they are about to be send BlockedOnDeadMVar. Any threads
+ // thus released will be immediately runnable.
GarbageCollect(GetRoots,rtsTrue);
- ACQUIRE_LOCK(&sched_mutex);
- if ( EMPTY_QUEUE(blocked_queue_hd)
- && EMPTY_RUN_QUEUE()
- && EMPTY_QUEUE(sleeping_queue) ) {
-
- IF_DEBUG(scheduler, sched_belch("still deadlocked, checking for black holes..."));
- detectBlackHoles();
-
- /* No black holes, so probably a real deadlock. Send the
- * current main thread the Deadlock exception (or in the SMP
- * build, send *all* main threads the deadlock exception,
- * since none of them can make progress).
- */
- if ( EMPTY_RUN_QUEUE() ) {
- StgMainThread *m;
+
+ if ( !EMPTY_RUN_QUEUE() ) { goto not_deadlocked; }
+
+ IF_DEBUG(scheduler,
+ sched_belch("still deadlocked, checking for black holes..."));
+ detectBlackHoles();
+
+ if ( !EMPTY_RUN_QUEUE() ) { goto not_deadlocked; }
+
+#ifndef mingw32_TARGET_OS
+ /* If we have user-installed signal handlers, then wait
+ * for signals to arrive rather then bombing out with a
+ * deadlock.
+ */
+ if ( anyUserHandlers() ) {
+ IF_DEBUG(scheduler,
+ sched_belch("still deadlocked, waiting for signals..."));
+
+ awaitUserSignals();
+
+ // we might be interrupted...
+ if (interrupted) { continue; }
+
+ if (signals_pending()) {
+ startSignalHandlers();
+ }
+ ASSERT(!EMPTY_RUN_QUEUE());
+ goto not_deadlocked;
+ }
+#endif
+
+ /* Probably a real deadlock. Send the current main thread the
+ * Deadlock exception (or in the SMP build, send *all* main
+ * threads the deadlock exception, since none of them can make
+ * progress).
+ */
+ {
+ StgMainThread *m;
#if defined(RTS_SUPPORTS_THREADS)
- for (m = main_threads; m != NULL; m = m->link) {
- switch (m->tso->why_blocked) {
- case BlockedOnBlackHole:
- raiseAsync(m->tso, (StgClosure *)NonTermination_closure);
- break;
- case BlockedOnException:
- case BlockedOnMVar:
- raiseAsync(m->tso, (StgClosure *)Deadlock_closure);
- break;
- default:
- barf("deadlock: main thread blocked in a strange way");
- }
- }
-#else
- m = main_threads;
+ for (m = main_threads; m != NULL; m = m->link) {
switch (m->tso->why_blocked) {
case BlockedOnBlackHole:
raiseAsync(m->tso, (StgClosure *)NonTermination_closure);
default:
barf("deadlock: main thread blocked in a strange way");
}
-#endif
}
-#if defined(RTS_SUPPORTS_THREADS)
- /* ToDo: revisit conditions (and mechanism) for shutting
- down a multi-threaded world */
- if ( EMPTY_RUN_QUEUE() ) {
- IF_DEBUG(scheduler, sched_belch("all done, i think...shutting down."));
- shutdownHaskellAndExit(0);
+#else
+ m = main_threads;
+ switch (m->tso->why_blocked) {
+ case BlockedOnBlackHole:
+ raiseAsync(m->tso, (StgClosure *)NonTermination_closure);
+ break;
+ case BlockedOnException:
+ case BlockedOnMVar:
+ raiseAsync(m->tso, (StgClosure *)Deadlock_closure);
+ break;
+ default:
+ barf("deadlock: main thread blocked in a strange way");
}
#endif
- ASSERT( !EMPTY_RUN_QUEUE() );
}
+
+#if defined(RTS_SUPPORTS_THREADS)
+ /* ToDo: revisit conditions (and mechanism) for shutting
+ down a multi-threaded world */
+ IF_DEBUG(scheduler, sched_belch("all done, i think...shutting down."));
+ shutdownHaskellAndExit(0);
+#endif
}
+ not_deadlocked:
+
#elif defined(PAR)
/* ToDo: add deadlock detection in GUM (similar to SMP) -- HWL */
#endif
{
StgTSO* t, *next;
IF_DEBUG(scheduler,sched_belch("deleting all threads"));
- for (t = run_queue_hd; t != END_TSO_QUEUE; t = next) {
- next = t->link;
- deleteThread(t);
- }
- for (t = blocked_queue_hd; t != END_TSO_QUEUE; t = next) {
- next = t->link;
+ for (t = all_threads; t != END_TSO_QUEUE; t = next) {
+ next = t->global_link;
deleteThread(t);
- }
- for (t = sleeping_queue; t != END_TSO_QUEUE; t = next) {
- next = t->link;
- deleteThread(t);
- }
+ }
run_queue_hd = run_queue_tl = END_TSO_QUEUE;
blocked_queue_hd = blocked_queue_tl = END_TSO_QUEUE;
sleeping_queue = END_TSO_QUEUE;
* ------------------------------------------------------------------------- */
StgInt
-suspendThread( StgRegTable *reg )
+suspendThread( StgRegTable *reg,
+ rtsBool concCall
+#if !defined(RTS_SUPPORTS_THREADS)
+ STG_UNUSED
+#endif
+ )
{
nat tok;
Capability *cap;
/* Hand back capability */
releaseCapability(cap);
-#if defined(RTS_SUPPORTS_THREADS) && !defined(SMP)
+#if defined(RTS_SUPPORTS_THREADS)
/* Preparing to leave the RTS, so ensure there's a native thread/task
waiting to take over.
there's no need to create a new task).
*/
IF_DEBUG(scheduler, sched_belch("worker thread (%d): leaving RTS", tok));
- startTask(taskStart);
+ if (concCall) {
+ startTask(taskStart);
+ }
#endif
/* Other threads _might_ be available for execution; signal this */
}
StgRegTable *
-resumeThread( StgInt tok )
+resumeThread( StgInt tok,
+ rtsBool concCall
+#if !defined(RTS_SUPPORTS_THREADS)
+ STG_UNUSED
+#endif
+ )
{
StgTSO *tso, **prev;
Capability *cap;
#if defined(RTS_SUPPORTS_THREADS)
/* Wait for permission to re-enter the RTS with the result. */
- grabReturnCapability(&sched_mutex, &cap);
+ if ( concCall ) {
+ grabReturnCapability(&sched_mutex, &cap);
+ } else {
+ grabCapability(&cap);
+ }
#else
grabCapability(&cap);
#endif
}
#endif
- for (m = main_threads; m != NULL; m = m->link) {
- evac((StgClosure **)&m->tso);
- }
if (suspended_ccalling_threads != END_TSO_QUEUE) {
evac((StgClosure **)&suspended_ccalling_threads);
}
void
performGC(void)
{
+ /* Obligated to hold this lock upon entry */
+ ACQUIRE_LOCK(&sched_mutex);
GarbageCollect(GetRoots,rtsFalse);
+ RELEASE_LOCK(&sched_mutex);
}
void
performMajorGC(void)
{
+ ACQUIRE_LOCK(&sched_mutex);
GarbageCollect(GetRoots,rtsTrue);
+ RELEASE_LOCK(&sched_mutex);
}
static void
void
performGCWithRoots(void (*get_roots)(evac_fn))
{
+ ACQUIRE_LOCK(&sched_mutex);
extra_roots = get_roots;
GarbageCollect(AllRoots,rtsFalse);
+ RELEASE_LOCK(&sched_mutex);
}
/* -----------------------------------------------------------------------------