Capability stopping when waiting for GC

[ghc-hetmet.git] / rts / Capability.c

diff --git a/rts/Capability.c b/rts/Capability.c
index fa7f630..0f03621 100644 (file)
--- a/rts/Capability.c
+++ b/rts/Capability.c
@@ -40,6 +40,9 @@ Capability *capabilities = NULL;
 // locking, so we don't do that.
 Capability *last_free_capability;
 
+/* GC indicator, in scope for the scheduler, init'ed to false */
+volatile StgWord waiting_for_gc = 0;
+
 #if defined(THREADED_RTS)
 STATIC_INLINE rtsBool
 globalWorkToDo (void)
@@ -276,6 +279,21 @@ releaseCapability_ (Capability* cap)
        return;
     }
 
+    /* if waiting_for_gc was the reason to release the cap: thread
+       comes from yieldCap->releaseAndQueueWorker. Unconditionally set
+       cap. free and return (see default after the if-protected other
+       special cases). Thread will wait on cond.var and re-acquire the
+       same cap after GC (GC-triggering cap. calls releaseCap and
+       enters the spare_workers case)
+    */
+    if (waiting_for_gc) {
+      last_free_capability = cap; // needed?
+      trace(TRACE_sched | DEBUG_sched, 
+           "GC pending, set capability %d free", cap->no);
+      return;
+    } 
+
+
     // If the next thread on the run queue is a bound thread,
     // give this Capability to the appropriate Task.
     if (!emptyRunQueue(cap) && cap->run_queue_hd->bound) {
@@ -453,7 +471,14 @@ yieldCapability (Capability** pCap, Task *task)
 
     // The fast path has no locking, if we don't enter this while loop
 
-    while ( cap->returning_tasks_hd != NULL || !anyWorkForMe(cap,task) ) {
+    while ( waiting_for_gc
+           /* i.e. another capability triggered HeapOverflow, is busy
+              getting capabilities (stopping their owning tasks) */
+           || cap->returning_tasks_hd != NULL 
+               /* cap reserved for another task */
+           || !anyWorkForMe(cap,task) 
+               /* cap/task have no work */
+           ) {
        debugTrace(DEBUG_sched, "giving up capability %d", cap->no);
 
        // We must now release the capability and wait to be woken up
@@ -791,8 +816,12 @@ markSomeCapabilities (evac_fn evac, void *user, nat i0, nat delta)
                       "evac'ing suspended TSO %lu", (unsigned long)task->suspended_tso->id);
            evac(user, (StgClosure **)(void *)&task->suspended_tso);
        }
+
+#if defined(THREADED_RTS)
+        markSparkQueue (evac, user, cap);
+#endif
     }
-    
+
 #if !defined(THREADED_RTS)
     evac(user, (StgClosure **)(void *)&blocked_queue_hd);
     evac(user, (StgClosure **)(void *)&blocked_queue_tl);
@@ -800,20 +829,6 @@ markSomeCapabilities (evac_fn evac, void *user, nat i0, nat delta)
 #endif 
 }
 
-// Sparks are not roots for GC, so we don't mark them in
-// markSomeCapabilities().  Instead, we traverse the spark queues
-// after GC and throw away any that are unreachable.
-void
-updateCapabilitiesPostGC (void)
-{
-#if defined(THREADED_RTS)
-    nat i;
-    for (i = 0; i < n_capabilities; i++) {
-        updateSparkQueue (&capabilities[i]);
-    }
-#endif // THREADED_RTS
-}
-
 // This function is used by the compacting GC to thread all the
 // pointers from spark queues.
 void