X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=rts%2FSchedule.c;h=c61bbc7f183d1126f62c202b2a6ce0c3a5dd00e1;hb=bb7b45dcf16118fb03bf28aea08a168ac6598a33;hp=72086e83d45fccd94db8e915186fb2587997968e;hpb=5308c0423b613e0d6a22996e2052731f0a371475;p=ghc-hetmet.git

diff --git a/rts/Schedule.c b/rts/Schedule.c
index 72086e8..c61bbc7 100644
--- a/rts/Schedule.c
+++ b/rts/Schedule.c
@@ -709,7 +709,7 @@ schedulePushWork(Capability *cap USED_IF_THREADS,
     Capability *free_caps[n_capabilities], *cap0;
     nat i, n_free_caps;
 
-    // migration can be turned off with +RTS -qg
+    // migration can be turned off with +RTS -qm
     if (!RtsFlags.ParFlags.migrate) return;
 
     // Check whether we have more threads on our run queue, or sparks
@@ -779,7 +779,6 @@ schedulePushWork(Capability *cap USED_IF_THREADS,
 		    setTSOLink(cap, prev, t);
 		    prev = t;
 		} else {
-		    debugTrace(DEBUG_sched, "pushing thread %lu to capability %d", (unsigned long)t->id, free_caps[i]->no);
 		    appendToRunQueue(free_caps[i],t);
 
             traceEventMigrateThread (cap, t, free_caps[i]->no);
@@ -1332,6 +1331,17 @@ scheduleHandleThreadFinished (Capability *cap STG_UNUSED, Task *task, StgTSO *t)
 #ifdef DEBUG
 	  removeThreadLabel((StgWord)task->tso->id);
 #endif
+
+          // We no longer consider this thread and task to be bound to
+          // each other.  The TSO lives on until it is GC'd, but the
+          // task is about to be released by the caller, and we don't
+          // want anyone following the pointer from the TSO to the
+          // defunct task (which might have already been
+          // re-used). This was a real bug: the GC updated
+          // tso->bound->tso which lead to a deadlock.
+          t->bound = NULL;
+          task->tso = NULL;
+
 	  return rtsTrue; // tells schedule() to return
       }
 
@@ -1941,6 +1951,7 @@ Capability *
 scheduleWaitThread (StgTSO* tso, /*[out]*/HaskellObj* ret, Capability *cap)
 {
     Task *task;
+    StgThreadID id;
 
     // We already created/initialised the Task
     task = cap->running_task;
@@ -1956,14 +1967,15 @@ scheduleWaitThread (StgTSO* tso, /*[out]*/HaskellObj* ret, Capability *cap)
 
     appendToRunQueue(cap,tso);
 
-    debugTrace(DEBUG_sched, "new bound thread (%lu)", (unsigned long)tso->id);
+    id = tso->id;
+    debugTrace(DEBUG_sched, "new bound thread (%lu)", (unsigned long)id);
 
     cap = schedule(cap,task);
 
     ASSERT(task->stat != NoStatus);
     ASSERT_FULL_CAPABILITY_INVARIANTS(cap,task);
 
-    debugTrace(DEBUG_sched, "bound thread (%lu) finished", (unsigned long)task->tso->id);
+    debugTrace(DEBUG_sched, "bound thread (%lu) finished", (unsigned long)id);
     return cap;
 }
 
@@ -2093,7 +2105,8 @@ exitScheduler(
     if (sched_state < SCHED_SHUTTING_DOWN) {
 	sched_state = SCHED_INTERRUPTING;
         waitForReturnCapability(&task->cap,task);
-	scheduleDoGC(task->cap,task,rtsFalse);    
+	scheduleDoGC(task->cap,task,rtsFalse);
+        ASSERT(task->tso == NULL);
         releaseCapability(task->cap);
     }
     sched_state = SCHED_SHUTTING_DOWN;
@@ -2103,6 +2116,7 @@ exitScheduler(
 	nat i;
 	
 	for (i = 0; i < n_capabilities; i++) {
+            ASSERT(task->tso == NULL);
 	    shutdownCapability(&capabilities[i], task, wait_foreign);
 	}
     }
@@ -2550,7 +2564,8 @@ raiseExceptionHelper (StgRegTable *reg, StgTSO *tso, StgClosure *exception)
 		SET_HDR(raise_closure, &stg_raise_info, CCCS);
 		raise_closure->payload[0] = exception;
 	    }
-	    UPD_IND(((StgUpdateFrame *)p)->updatee,(StgClosure *)raise_closure);
+	    UPD_IND(cap, ((StgUpdateFrame *)p)->updatee,
+                    (StgClosure *)raise_closure);
 	    p = next;
 	    continue;