#include "Updates.h"
#include "Proftimer.h"
#include "ProfHeap.h"
+#include "GC.h"
/* PARALLEL_HASKELL includes go here */
*/
rtsBool blackholes_need_checking = rtsFalse;
+/* Set to true when the latest garbage collection failed to reclaim
+ * enough space, and the runtime should proceed to shut itself down in
+ * an orderly fashion (emitting profiling info etc.)
+ */
+rtsBool heap_overflow = rtsFalse;
+
/* flag that tracks whether we have done any execution in this time slice.
* LOCK: currently none, perhaps we should lock (but needs to be
* updated in the fast path of the scheduler).
+ *
+ * NB. must be StgWord, we do xchg() on it.
*/
-nat recent_activity = ACTIVITY_YES;
+volatile StgWord recent_activity = ACTIVITY_YES;
/* if this flag is set as well, give up execution
- * LOCK: none (changes once, from false->true)
+ * LOCK: none (changes monotonically)
*/
-rtsBool sched_state = SCHED_RUNNING;
+volatile StgWord sched_state = SCHED_RUNNING;
/* This is used in `TSO.h' and gcc 2.96 insists that this variable actually
* exists - earlier gccs apparently didn't.
#endif
/* scheduleDoGC() deletes all the threads */
cap = scheduleDoGC(cap,task,rtsFalse);
- break;
+
+ // after scheduleDoGC(), we must be shutting down. Either some
+ // other Capability did the final GC, or we did it above,
+ // either way we can fall through to the SCHED_SHUTTING_DOWN
+ // case now.
+ ASSERT(sched_state == SCHED_SHUTTING_DOWN);
+ // fall through
+
case SCHED_SHUTTING_DOWN:
debugTrace(DEBUG_sched, "SCHED_SHUTTING_DOWN");
// If we are a worker, just exit. If we're a bound thread
}
#endif
+ // If we're shutting down, and this thread has not yet been
+ // killed, kill it now. This sometimes happens when a finalizer
+ // thread is created by the final GC, or a thread previously
+ // in a foreign call returns.
+ if (sched_state >= SCHED_INTERRUPTING &&
+ !(t->what_next == ThreadComplete || t->what_next == ThreadKilled)) {
+ deleteThread(cap,t);
+ }
+
/* context switches are initiated by the timer signal, unless
* the user specified "context switch as often as possible", with
* +RTS -C0
scheduleCheckBlockedThreads(cap);
#if defined(THREADED_RTS) || defined(PARALLEL_HASKELL)
- // Try to activate one of our own sparks
if (emptyRunQueue(cap)) { scheduleActivateSpark(cap); }
#endif
-#if defined(THREADED_RTS)
- // Try to steak work if we don't have any
- if (emptyRunQueue(cap)) { stealWork(cap); }
-#endif
-
#if defined(PARALLEL_HASKELL)
// if messages have been buffered...
scheduleSendPendingMessages();
// - we need to yield this Capability to someone else
// (see shouldYieldCapability())
//
-// The return value indicates whether
+// Careful: the scheduler loop is quite delicate. Make sure you run
+// the tests in testsuite/concurrent (all ways) after modifying this,
+// and also check the benchmarks in nofib/parallel for regressions.
static void
scheduleYield (Capability **pcap, Task *task)
Capability *cap = *pcap;
// if we have work, and we don't need to give up the Capability, continue.
- if (!emptyRunQueue(cap) && !shouldYieldCapability(cap,task))
+ if (!shouldYieldCapability(cap,task) &&
+ (!emptyRunQueue(cap) ||
+ blackholes_need_checking ||
+ sched_state >= SCHED_INTERRUPTING))
return;
// otherwise yield (sleep), and keep yielding if necessary.
// Check whether we have more threads on our run queue, or sparks
// in our pool, that we could hand to another Capability.
- if ((emptyRunQueue(cap) || cap->run_queue_hd->_link == END_TSO_QUEUE)
- && sparkPoolSizeCap(cap) < 2) {
- return;
+ if (cap->run_queue_hd == END_TSO_QUEUE) {
+ if (sparkPoolSizeCap(cap) < 2) return;
+ } else {
+ if (cap->run_queue_hd->_link == END_TSO_QUEUE &&
+ sparkPoolSizeCap(cap) < 1) return;
}
// First grab as many free Capabilities as we can.
// they are unreachable and will therefore be sent an
// exception. Any threads thus released will be immediately
// runnable.
- cap = scheduleDoGC (cap, task, rtsTrue/*force major GC*/);
+ cap = scheduleDoGC (cap, task, rtsTrue/*force major GC*/);
+ // when force_major == rtsTrue. scheduleDoGC sets
+ // recent_activity to ACTIVITY_DONE_GC and turns off the timer
+ // signal.
- recent_activity = ACTIVITY_DONE_GC;
- // disable timer signals (see #1623)
- stopTimer();
-
if ( !emptyRunQueue(cap) ) return;
#if defined(RTS_USER_SIGNALS) && !defined(THREADED_RTS)
static void
scheduleActivateSpark(Capability *cap)
{
- StgClosure *spark;
-
-/* We only want to stay here if the run queue is empty and we want some
- work. We try to turn a spark into a thread, and add it to the run
- queue, from where it will be picked up in the next iteration of the
- scheduler loop.
-*/
- if (!emptyRunQueue(cap))
- /* In the threaded RTS, another task might have pushed a thread
- on our run queue in the meantime ? But would need a lock.. */
- return;
-
-
- // Really we should be using reclaimSpark() here, but
- // experimentally it doesn't seem to perform as well as just
- // stealing from our own spark pool:
- // spark = reclaimSpark(cap->sparks);
- spark = tryStealSpark(cap->sparks); // defined in Sparks.c
-
- if (spark != NULL) {
- debugTrace(DEBUG_sched,
- "turning spark of closure %p into a thread",
- (StgClosure *)spark);
- createSparkThread(cap,spark); // defined in Sparks.c
+ if (anySparks())
+ {
+ createSparkThread(cap);
+ debugTrace(DEBUG_sched, "creating a spark thread");
}
}
#endif // PARALLEL_HASKELL || THREADED_RTS
// ATOMICALLY_FRAME, aborting the (nested)
// transaction, and saving the stack of any
// partially-evaluated thunks on the heap.
- throwToSingleThreaded_(cap, t, NULL, rtsTrue, NULL);
+ throwToSingleThreaded_(cap, t, NULL, rtsTrue);
ASSERT(get_itbl((StgClosure *)t->sp)->type == ATOMICALLY_FRAME);
}
*(task->ret) = NULL;
}
if (sched_state >= SCHED_INTERRUPTING) {
- task->stat = Interrupted;
+ if (heap_overflow) {
+ task->stat = HeapExhausted;
+ } else {
+ task->stat = Interrupted;
+ }
} else {
task->stat = Killed;
}
#ifdef THREADED_RTS
/* extern static volatile StgWord waiting_for_gc;
lives inside capability.c */
- rtsBool was_waiting;
+ rtsBool gc_type, prev_pending_gc;
nat i;
#endif
+ if (sched_state == SCHED_SHUTTING_DOWN) {
+ // The final GC has already been done, and the system is
+ // shutting down. We'll probably deadlock if we try to GC
+ // now.
+ return cap;
+ }
+
#ifdef THREADED_RTS
+ if (sched_state < SCHED_INTERRUPTING
+ && RtsFlags.ParFlags.parGcEnabled
+ && N >= RtsFlags.ParFlags.parGcGen
+ && ! oldest_gen->steps[0].mark)
+ {
+ gc_type = PENDING_GC_PAR;
+ } else {
+ gc_type = PENDING_GC_SEQ;
+ }
+
// In order to GC, there must be no threads running Haskell code.
// Therefore, the GC thread needs to hold *all* the capabilities,
// and release them after the GC has completed.
// actually did the GC. But it's quite hard to arrange for all
// the other tasks to sleep and stay asleep.
//
-
+
/* Other capabilities are prevented from running yet more Haskell
threads if waiting_for_gc is set. Tested inside
yieldCapability() and releaseCapability() in Capability.c */
- was_waiting = cas(&waiting_for_gc, 0, 1);
- if (was_waiting) {
+ prev_pending_gc = cas(&waiting_for_gc, 0, gc_type);
+ if (prev_pending_gc) {
do {
- debugTrace(DEBUG_sched, "someone else is trying to GC...");
- if (cap) yieldCapability(&cap,task);
+ debugTrace(DEBUG_sched, "someone else is trying to GC (%d)...",
+ prev_pending_gc);
+ ASSERT(cap);
+ yieldCapability(&cap,task);
} while (waiting_for_gc);
return cap; // NOTE: task->cap might have changed here
}
setContextSwitches();
- for (i=0; i < n_capabilities; i++) {
- debugTrace(DEBUG_sched, "ready_to_gc, grabbing all the capabilies (%d/%d)", i, n_capabilities);
- if (cap != &capabilities[i]) {
- Capability *pcap = &capabilities[i];
- // we better hope this task doesn't get migrated to
- // another Capability while we're waiting for this one.
- // It won't, because load balancing happens while we have
- // all the Capabilities, but even so it's a slightly
- // unsavoury invariant.
- task->cap = pcap;
- waitForReturnCapability(&pcap, task);
- if (pcap != &capabilities[i]) {
- barf("scheduleDoGC: got the wrong capability");
- }
- }
+
+ // The final shutdown GC is always single-threaded, because it's
+ // possible that some of the Capabilities have no worker threads.
+
+ if (gc_type == PENDING_GC_SEQ)
+ {
+ // single-threaded GC: grab all the capabilities
+ for (i=0; i < n_capabilities; i++) {
+ debugTrace(DEBUG_sched, "ready_to_gc, grabbing all the capabilies (%d/%d)", i, n_capabilities);
+ if (cap != &capabilities[i]) {
+ Capability *pcap = &capabilities[i];
+ // we better hope this task doesn't get migrated to
+ // another Capability while we're waiting for this one.
+ // It won't, because load balancing happens while we have
+ // all the Capabilities, but even so it's a slightly
+ // unsavoury invariant.
+ task->cap = pcap;
+ waitForReturnCapability(&pcap, task);
+ if (pcap != &capabilities[i]) {
+ barf("scheduleDoGC: got the wrong capability");
+ }
+ }
+ }
}
+ else
+ {
+ // multi-threaded GC: make sure all the Capabilities donate one
+ // GC thread each.
+ debugTrace(DEBUG_sched, "ready_to_gc, grabbing GC threads");
- waiting_for_gc = rtsFalse;
+ waitForGcThreads(cap);
+ }
#endif
// so this happens periodically:
IF_DEBUG(scheduler, printAllThreads());
+delete_threads_and_gc:
/*
* We now have all the capabilities; if we're in an interrupting
* state, then we should take the opportunity to delete all the
* threads in the system.
*/
- if (sched_state >= SCHED_INTERRUPTING) {
- deleteAllThreads(&capabilities[0]);
+ if (sched_state == SCHED_INTERRUPTING) {
+ deleteAllThreads(cap);
sched_state = SCHED_SHUTTING_DOWN;
}
heap_census = scheduleNeedHeapProfile(rtsTrue);
- /* everybody back, start the GC.
- * Could do it in this thread, or signal a condition var
- * to do it in another thread. Either way, we need to
- * broadcast on gc_pending_cond afterward.
- */
#if defined(THREADED_RTS)
debugTrace(DEBUG_sched, "doing GC");
+ // reset waiting_for_gc *before* GC, so that when the GC threads
+ // emerge they don't immediately re-enter the GC.
+ waiting_for_gc = 0;
+ GarbageCollect(force_major || heap_census, gc_type, cap);
+#else
+ GarbageCollect(force_major || heap_census, 0, cap);
#endif
- GarbageCollect(force_major || heap_census);
-
+
if (heap_census) {
debugTrace(DEBUG_sched, "performing heap census");
heapCensus();
performHeapProfile = rtsFalse;
}
+ if (heap_overflow && sched_state < SCHED_INTERRUPTING) {
+ // GC set the heap_overflow flag, so we should proceed with
+ // an orderly shutdown now. Ultimately we want the main
+ // thread to return to its caller with HeapExhausted, at which
+ // point the caller should call hs_exit(). The first step is
+ // to delete all the threads.
+ //
+ // Another way to do this would be to raise an exception in
+ // the main thread, which we really should do because it gives
+ // the program a chance to clean up. But how do we find the
+ // main thread? It should presumably be the same one that
+ // gets ^C exceptions, but that's all done on the Haskell side
+ // (GHC.TopHandler).
+ sched_state = SCHED_INTERRUPTING;
+ goto delete_threads_and_gc;
+ }
+
#ifdef SPARKBALANCE
/* JB
Once we are all together... this would be the place to balance all
balanceSparkPoolsCaps(n_capabilities, capabilities);
#endif
+ if (force_major)
+ {
+ // We've just done a major GC and we don't need the timer
+ // signal turned on any more (#1623).
+ // NB. do this *before* releasing the Capabilities, to avoid
+ // deadlocks!
+ recent_activity = ACTIVITY_DONE_GC;
+ stopTimer();
+ }
+
#if defined(THREADED_RTS)
- // release our stash of capabilities.
- for (i = 0; i < n_capabilities; i++) {
- if (cap != &capabilities[i]) {
- task->cap = &capabilities[i];
- releaseCapability(&capabilities[i]);
- }
+ if (gc_type == PENDING_GC_SEQ) {
+ // release our stash of capabilities.
+ for (i = 0; i < n_capabilities; i++) {
+ if (cap != &capabilities[i]) {
+ task->cap = &capabilities[i];
+ releaseCapability(&capabilities[i]);
+ }
+ }
}
if (cap) {
task->cap = cap;
// schedule() runs without a lock.
cap = schedule(cap,task);
- // On exit from schedule(), we have a Capability.
- releaseCapability(cap);
+ // On exit from schedule(), we have a Capability, but possibly not
+ // the same one we started with.
+
+ // During shutdown, the requirement is that after all the
+ // Capabilities are shut down, all workers that are shutting down
+ // have finished workerTaskStop(). This is why we hold on to
+ // cap->lock until we've finished workerTaskStop() below.
+ //
+ // There may be workers still involved in foreign calls; those
+ // will just block in waitForReturnCapability() because the
+ // Capability has been shut down.
+ //
+ ACQUIRE_LOCK(&cap->lock);
+ releaseCapability_(cap,rtsFalse);
workerTaskStop(task);
+ RELEASE_LOCK(&cap->lock);
}
#endif
// If we haven't killed all the threads yet, do it now.
if (sched_state < SCHED_SHUTTING_DOWN) {
sched_state = SCHED_INTERRUPTING;
- scheduleDoGC(NULL,task,rtsFalse);
+#if defined(THREADED_RTS)
+ waitForReturnCapability(&task->cap,task);
+ scheduleDoGC(task->cap,task,rtsFalse);
+ releaseCapability(task->cap);
+#else
+ scheduleDoGC(&MainCapability,task,rtsFalse);
+#endif
}
sched_state = SCHED_SHUTTING_DOWN;
shutdownCapability(&capabilities[i], task, wait_foreign);
}
boundTaskExiting(task);
- stopTaskManager();
}
#endif
}
void
freeScheduler( void )
{
- freeCapabilities();
- freeTaskManager();
- if (n_capabilities != 1) {
- stgFree(capabilities);
+ nat still_running;
+
+ ACQUIRE_LOCK(&sched_mutex);
+ still_running = freeTaskManager();
+ // We can only free the Capabilities if there are no Tasks still
+ // running. We might have a Task about to return from a foreign
+ // call into waitForReturnCapability(), for example (actually,
+ // this should be the *only* thing that a still-running Task can
+ // do at this point, and it will block waiting for the
+ // Capability).
+ if (still_running == 0) {
+ freeCapabilities();
+ if (n_capabilities != 1) {
+ stgFree(capabilities);
+ }
}
+ RELEASE_LOCK(&sched_mutex);
#if defined(THREADED_RTS)
closeMutex(&sched_mutex);
#endif
performGC_(rtsBool force_major)
{
Task *task;
+
// We must grab a new Task here, because the existing Task may be
// associated with a particular Capability, and chained onto the
// suspended_ccalling_tasks queue.
ACQUIRE_LOCK(&sched_mutex);
task = newBoundTask();
RELEASE_LOCK(&sched_mutex);
- scheduleDoGC(NULL,task,force_major);
+
+ waitForReturnCapability(&task->cap,task);
+ scheduleDoGC(task->cap,task,force_major);
+ releaseCapability(task->cap);
boundTaskExiting(task);
}