X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=rts%2FRaiseAsync.c;h=2ff916a70ad6c2f94a9d523c382285aaf338b883;hb=de75026f5a48d3d052135a973ab4dff76c5b20f5;hp=10c9b7c3c17e28f940436a90600b39227069c28c;hpb=fef4deb4d99cf3351f4e1a199267ed0860352f75;p=ghc-hetmet.git

diff --git a/rts/RaiseAsync.c b/rts/RaiseAsync.c
index 10c9b7c..2ff916a 100644
--- a/rts/RaiseAsync.c
+++ b/rts/RaiseAsync.c
@@ -18,6 +18,7 @@
 #include "STM.h"
 #include "Sanity.h"
 #include "Profiling.h"
+#include "EventLog.h"
 #if defined(mingw32_HOST_OS)
 #include "win32/IOManager.h"
 #endif
@@ -264,6 +265,15 @@ check_target:
 		target = target->_link;
 		goto retry;
 	    }
+            // check again for ThreadComplete and ThreadKilled.  This
+            // cooperates with scheduleHandleThreadFinished to ensure
+            // that we never miss any threads that are throwing an
+            // exception to a thread in the process of terminating.
+            if (target->what_next == ThreadComplete
+                || target->what_next == ThreadKilled) {
+		unlockTSO(target);
+                return THROWTO_SUCCESS;
+            }
 	    blockedThrowTo(cap,source,target);
 	    *out = target;
 	    return THROWTO_BLOCKED;
@@ -415,6 +425,7 @@ check_target:
 	// Unblocking BlockedOnSTM threads requires the TSO to be
 	// locked; see STM.c:unpark_tso().
 	if (target->why_blocked != BlockedOnSTM) {
+	    unlockTSO(target);
 	    goto retry;
 	}
 	if ((target->flags & TSO_BLOCKEX) &&
@@ -436,6 +447,11 @@ check_target:
 	// thread is blocking exceptions, and block on its
 	// blocked_exception queue.
 	lockTSO(target);
+	if (target->why_blocked != BlockedOnCCall &&
+ 	    target->why_blocked != BlockedOnCCall_NoUnblockExc) {
+	    unlockTSO(target);
+            goto retry;
+	}
 	blockedThrowTo(cap,source,target);
 	*out = target;
 	return THROWTO_BLOCKED;
@@ -552,15 +568,16 @@ maybePerformBlockedException (Capability *cap, StgTSO *tso)
     return 0;
 }
 
+// awakenBlockedExceptionQueue(): Just wake up the whole queue of
+// blocked exceptions and let them try again.
+
 void
 awakenBlockedExceptionQueue (Capability *cap, StgTSO *tso)
 {
-    if (tso->blocked_exceptions != END_TSO_QUEUE) {
-	lockTSO(tso);
-	awakenBlockedQueue(cap, tso->blocked_exceptions);
-	tso->blocked_exceptions = END_TSO_QUEUE;
-	unlockTSO(tso);
-    }
+    lockTSO(tso);
+    awakenBlockedQueue(cap, tso->blocked_exceptions);
+    tso->blocked_exceptions = END_TSO_QUEUE;
+    unlockTSO(tso);
 }    
 
 static void
@@ -656,16 +673,7 @@ removeFromQueues(Capability *cap, StgTSO *tso)
   }
 
  done:
-  tso->_link = END_TSO_QUEUE; // no write barrier reqd
-  tso->why_blocked = NotBlocked;
-  tso->block_info.closure = NULL;
-  appendToRunQueue(cap,tso);
-
-  // We might have just migrated this TSO to our Capability:
-  if (tso->bound) {
-      tso->bound->cap = cap;
-  }
-  tso->cap = cap;
+  unblockOne(cap, tso);
 }
 
 /* -----------------------------------------------------------------------------