X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=rts%2FSchedule.c;h=1bd68c22974e142074df3310e3a52d4f163b0094;hp=22e61203a3396441acf643fa016a0e355394f589;hb=b0ca990457eaf7991e72b13d0040d937b5759b36;hpb=442099ad2dbcc007b137745b9246116f06c8723d

diff --git a/rts/Schedule.c b/rts/Schedule.c
index 22e6120..1bd68c2 100644
--- a/rts/Schedule.c
+++ b/rts/Schedule.c
@@ -1634,7 +1634,16 @@ scheduleHandleHeapOverflow( Capability *cap, StgTSO *t )
     }
 #endif
       
-    pushOnRunQueue(cap,t);
+    if (context_switch) {
+        // Sometimes we miss a context switch, e.g. when calling
+        // primitives in a tight loop, MAYBE_GC() doesn't check the
+        // context switch flag, and we end up waiting for a GC.
+        // See #1984, and concurrent/should_run/1984
+        context_switch = 0;
+        addToRunQueue(cap,t);
+    } else {
+        pushOnRunQueue(cap,t);
+    }
     return rtsTrue;
     /* actual GC is done at the end of the while loop in schedule() */
 }
@@ -2143,6 +2152,7 @@ forkProcess(HsStablePtr *entry
     // inconsistent state in the child.  See also #1391.
     ACQUIRE_LOCK(&sched_mutex);
     ACQUIRE_LOCK(&cap->lock);
+    ACQUIRE_LOCK(&cap->running_task->lock);
 
     pid = fork();
     
@@ -2150,6 +2160,7 @@ forkProcess(HsStablePtr *entry
 	
         RELEASE_LOCK(&sched_mutex);
         RELEASE_LOCK(&cap->lock);
+        RELEASE_LOCK(&cap->running_task->lock);
 
 	// just return the pid
 	rts_unlock(cap);
@@ -2160,6 +2171,7 @@ forkProcess(HsStablePtr *entry
 #if defined(THREADED_RTS)
         initMutex(&sched_mutex);
         initMutex(&cap->lock);
+        initMutex(&cap->running_task->lock);
 #endif
 
 	// Now, all OS threads except the thread that forked are
@@ -2199,6 +2211,9 @@ forkProcess(HsStablePtr *entry
 	ACQUIRE_LOCK(&sched_mutex);
 	for (task = all_tasks; task != NULL; task=task->all_link) {
 	    if (task != cap->running_task) {
+#if defined(THREADED_RTS)
+                initMutex(&task->lock); // see #1391
+#endif
 		discardTask(task);
 	    }
 	}
@@ -2831,7 +2846,7 @@ threadStackOverflow(Capability *cap, StgTSO *tso)
 	     "increasing stack size from %ld words to %d.",
 	     (long)tso->stack_size, new_stack_size);
 
-  dest = (StgTSO *)allocate(new_tso_size);
+  dest = (StgTSO *)allocateLocal(cap,new_tso_size);
   TICK_ALLOC_TSO(new_stack_size,0);
 
   /* copy the TSO block and the old stack into the new area */
@@ -2943,7 +2958,7 @@ checkBlackHoles (Capability *cap)
     t = blackhole_queue;
     while (t != END_TSO_QUEUE) {
 	ASSERT(t->why_blocked == BlockedOnBlackHole);
-	type = get_itbl(t->block_info.closure)->type;
+	type = get_itbl(UNTAG_CLOSURE(t->block_info.closure))->type;
 	if (type != BLACKHOLE && type != CAF_BLACKHOLE) {
 	    IF_DEBUG(sanity,checkTSO(t));
 	    t = unblockOne(cap, t);