From: berthold@mathematik.uni-marburg.de <unknown>
Date: Tue, 19 Aug 2008 15:18:42 +0000 (+0000)
Subject: Capability stopping when waiting for GC
X-Git-Tag: 2008-09-12~45
X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=commitdiff_plain;h=4753cf734c79ad196ef4411393a1516465302f71

Capability stopping when waiting for GC
---

diff --git a/rts/Capability.c b/rts/Capability.c
index 4445324..0f03621 100644
--- 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
diff --git a/rts/Capability.h b/rts/Capability.h
index 959ab50..f13afe2 100644
--- a/rts/Capability.h
+++ b/rts/Capability.h
@@ -162,6 +162,9 @@ extern Capability *capabilities;
 //
 extern Capability *last_free_capability;
 
+// GC indicator, in scope for the scheduler
+extern volatile StgWord waiting_for_gc;
+
 // Acquires a capability at a return point.  If *cap is non-NULL, then
 // this is taken as a preference for the Capability we wish to
 // acquire.
diff --git a/rts/Schedule.c b/rts/Schedule.c
index 94aac6c..1b5afef 100644
--- a/rts/Schedule.c
+++ b/rts/Schedule.c
@@ -1405,7 +1405,8 @@ scheduleDoGC (Capability *cap, Task *task USED_IF_THREADS, rtsBool force_major)
     StgTSO *t;
     rtsBool heap_census;
 #ifdef THREADED_RTS
-    static volatile StgWord waiting_for_gc;
+    /* extern static volatile StgWord waiting_for_gc; 
+       lives inside capability.c */
     rtsBool was_waiting;
     nat i;
 #endif
@@ -1422,6 +1423,10 @@ scheduleDoGC (Capability *cap, Task *task USED_IF_THREADS, rtsBool force_major)
     // 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) {
 	do {