X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=rts%2FSchedule.c;h=caa19b26b3bbc4bbf0894391d6f9e48f4d2fb70b;hb=fb1c3f4d3af3d361454f3e0d02d8ea1cb9fc1228;hp=cb2f7f3e870b3afe6755f5d974fc1ad69ff2a955;hpb=62cda22c8db50fc1e90efcf266d75ea4d3590697;p=ghc-hetmet.git

diff --git a/rts/Schedule.c b/rts/Schedule.c
index cb2f7f3..caa19b2 100644
--- a/rts/Schedule.c
+++ b/rts/Schedule.c
@@ -718,9 +718,6 @@ run_thread:
       cap = scheduleDoGC(cap,task,rtsFalse);
     }
   } /* end of while() */
-
-  debugTrace(PAR_DEBUG_verbose,
-	     "== Leaving schedule() after having received Finish");
 }
 
 /* ----------------------------------------------------------------------------
@@ -1634,7 +1631,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() */
 }
@@ -2664,87 +2670,6 @@ freeScheduler( void )
 #endif
 }
 
-/* ---------------------------------------------------------------------------
-   Where are the roots that we know about?
-
-        - all the threads on the runnable queue
-        - all the threads on the blocked queue
-        - all the threads on the sleeping queue
-	- all the thread currently executing a _ccall_GC
-        - all the "main threads"
-     
-   ------------------------------------------------------------------------ */
-
-/* This has to be protected either by the scheduler monitor, or by the
-	garbage collection monitor (probably the latter).
-	KH @ 25/10/99
-*/
-
-void
-GetRoots( evac_fn evac )
-{
-    nat i;
-    Capability *cap;
-    Task *task;
-
-#if defined(GRAN)
-    for (i=0; i<=RtsFlags.GranFlags.proc; i++) {
-	if ((run_queue_hds[i] != END_TSO_QUEUE) && ((run_queue_hds[i] != NULL)))
-	    evac((StgClosure **)&run_queue_hds[i]);
-	if ((run_queue_tls[i] != END_TSO_QUEUE) && ((run_queue_tls[i] != NULL)))
-	    evac((StgClosure **)&run_queue_tls[i]);
-	
-	if ((blocked_queue_hds[i] != END_TSO_QUEUE) && ((blocked_queue_hds[i] != NULL)))
-	    evac((StgClosure **)&blocked_queue_hds[i]);
-	if ((blocked_queue_tls[i] != END_TSO_QUEUE) && ((blocked_queue_tls[i] != NULL)))
-	    evac((StgClosure **)&blocked_queue_tls[i]);
-	if ((ccalling_threadss[i] != END_TSO_QUEUE) && ((ccalling_threadss[i] != NULL)))
-	    evac((StgClosure **)&ccalling_threads[i]);
-    }
-
-    markEventQueue();
-
-#else /* !GRAN */
-
-    for (i = 0; i < n_capabilities; i++) {
-	cap = &capabilities[i];
-	evac((StgClosure **)(void *)&cap->run_queue_hd);
-	evac((StgClosure **)(void *)&cap->run_queue_tl);
-#if defined(THREADED_RTS)
-	evac((StgClosure **)(void *)&cap->wakeup_queue_hd);
-	evac((StgClosure **)(void *)&cap->wakeup_queue_tl);
-#endif
-	for (task = cap->suspended_ccalling_tasks; task != NULL; 
-	     task=task->next) {
-	    debugTrace(DEBUG_sched,
-		       "evac'ing suspended TSO %lu", (unsigned long)task->suspended_tso->id);
-	    evac((StgClosure **)(void *)&task->suspended_tso);
-	}
-
-    }
-    
-
-#if !defined(THREADED_RTS)
-    evac((StgClosure **)(void *)&blocked_queue_hd);
-    evac((StgClosure **)(void *)&blocked_queue_tl);
-    evac((StgClosure **)(void *)&sleeping_queue);
-#endif 
-#endif
-
-    // evac((StgClosure **)&blackhole_queue);
-
-#if defined(THREADED_RTS) || defined(PARALLEL_HASKELL) || defined(GRAN)
-    markSparkQueue(evac);
-#endif
-    
-#if defined(RTS_USER_SIGNALS)
-    // mark the signal handlers (signals should be already blocked)
-    if (RtsFlags.MiscFlags.install_signal_handlers) {
-        markSignalHandlers(evac);
-    }
-#endif
-}
-
 /* -----------------------------------------------------------------------------
    performGC
 
@@ -2949,7 +2874,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);