X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=rts%2FRaiseAsync.c;h=d892e9563866a39e3f13fcd40e0274b87876735f;hb=0d88de0b114a391712bc117d42928b49fba4d66a;hp=c0cfd7b275126e02725ced2c224b9c93e9d79840;hpb=f9e1c2af8fdd112019a657e66b0cd685d8df66f6;p=ghc-hetmet.git

diff --git a/rts/RaiseAsync.c b/rts/RaiseAsync.c
index c0cfd7b..d892e95 100644
--- a/rts/RaiseAsync.c
+++ b/rts/RaiseAsync.c
@@ -13,11 +13,13 @@
 #include "RaiseAsync.h"
 #include "SMP.h"
 #include "Schedule.h"
-#include "Storage.h"
 #include "LdvProfile.h"
 #include "Updates.h"
 #include "STM.h"
 #include "Sanity.h"
+#if defined(mingw32_HOST_OS)
+#include "win32/IOManager.h"
+#endif
 
 static void raiseAsync (Capability *cap,
 			StgTSO *tso,
@@ -435,6 +437,9 @@ check_target:
     case BlockedOnRead:
     case BlockedOnWrite:
     case BlockedOnDelay:
+#if defined(mingw32_HOST_OS)
+    case BlockedOnDoProc:
+#endif
 	if ((target->flags & TSO_BLOCKEX) &&
 	    ((target->flags & TSO_INTERRUPTIBLE) == 0)) {
 	    blockedThrowTo(source,target);
@@ -491,9 +496,11 @@ throwToReleaseTarget (void *tso)
    queue, but not perform any throwTo() immediately.  This might be
    more appropriate when the target thread is the one actually running
    (see Exception.cmm).
+
+   Returns: non-zero if an exception was raised, zero otherwise.
    -------------------------------------------------------------------------- */
 
-void
+int
 maybePerformBlockedException (Capability *cap, StgTSO *tso)
 {
     StgTSO *source;
@@ -509,7 +516,7 @@ maybePerformBlockedException (Capability *cap, StgTSO *tso)
 	// locked it.
 	if (tso->blocked_exceptions == END_TSO_QUEUE) {
 	    unlockTSO(tso);
-	    return;
+	    return 0;
 	}
 
 	// We unblock just the first thread on the queue, and perform
@@ -519,7 +526,9 @@ maybePerformBlockedException (Capability *cap, StgTSO *tso)
 	tso->blocked_exceptions = unblockOne_(cap, source, 
 					      rtsFalse/*no migrate*/);
 	unlockTSO(tso);
+        return 1;
     }
+    return 0;
 }
 
 void
@@ -1014,6 +1023,7 @@ raiseAsync(Capability *cap, StgTSO *tso, StgClosure *exception,
             StgTRecHeader *trec = tso -> trec;
             StgTRecHeader *outer = stmGetEnclosingTRec(trec);
             stmAbortTransaction(cap, trec);
+	    stmFreeAbortedTRec(cap, trec);
             tso -> trec = outer;
 	    break;