X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=rts%2FSchedule.c;h=afd8c28a08a65f6a7e6127cc2c22915c50ef7d64;hb=d4050431de1adddedb240e497f77f89301f77070;hp=6063fcdc41ebe119edfbf2b3bb7e91b4e9a75489;hpb=cbeb99efd4a117de5b028341dc41bc8f50717383;p=ghc-hetmet.git

diff --git a/rts/Schedule.c b/rts/Schedule.c
index 6063fcd..afd8c28 100644
--- a/rts/Schedule.c
+++ b/rts/Schedule.c
@@ -7,6 +7,7 @@
  * --------------------------------------------------------------------------*/
 
 #include "PosixSource.h"
+#define KEEP_LOCKCLOSURE
 #include "Rts.h"
 #include "SchedAPI.h"
 #include "RtsUtils.h"
@@ -1813,9 +1814,6 @@ scheduleHandleThreadFinished (Capability *cap STG_UNUSED, Task *task, StgTSO *t)
     debugTrace(DEBUG_sched, "--++ thread %lu (%s) finished", 
 	       (unsigned long)t->id, whatNext_strs[t->what_next]);
 
-    /* Inform the Hpc that a thread has finished */
-    hs_hpc_thread_finished_event(t);
-
 #if defined(GRAN)
       endThread(t, CurrentProc); // clean-up the thread
 #elif defined(PARALLEL_HASKELL)
@@ -2579,7 +2577,8 @@ initScheduler(void)
 }
 
 void
-exitScheduler( void )
+exitScheduler( rtsBool wait_foreign )
+               /* see Capability.c, shutdownCapability() */
 {
     Task *task = NULL;
 
@@ -2601,7 +2600,7 @@ exitScheduler( void )
 	nat i;
 	
 	for (i = 0; i < n_capabilities; i++) {
-	    shutdownCapability(&capabilities[i], task);
+	    shutdownCapability(&capabilities[i], task, wait_foreign);
 	}
 	boundTaskExiting(task);
 	stopTaskManager();
@@ -2761,7 +2760,12 @@ threadStackOverflow(Capability *cap, StgTSO *tso)
   // while we are moving the TSO:
   lockClosure((StgClosure *)tso);
 
-  if (tso->stack_size >= tso->max_stack_size) {
+  if (tso->stack_size >= tso->max_stack_size && !(tso->flags & TSO_BLOCKEX)) {
+      // NB. never raise a StackOverflow exception if the thread is
+      // inside Control.Exceptino.block.  It is impractical to protect
+      // against stack overflow exceptions, since virtually anything
+      // can raise one (even 'catch'), so this is the only sensible
+      // thing to do here.  See bug #767.
 
       debugTrace(DEBUG_gc,
 		 "threadStackOverflow of TSO %ld (%p): stack too large (now %ld; max is %ld)",