X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=rts%2FRaiseAsync.c;h=d8ab08ab131bc09681675abf4de31d482ab92b74;hb=661c97c65e5fa47177502e592bb763f752b487ac;hp=df7429a48a3d1b6d7759904a12710e4893fadeda;hpb=ef6e8211dee59eb7fa80a242391b89b52bd57f80;p=ghc-hetmet.git

diff --git a/rts/RaiseAsync.c b/rts/RaiseAsync.c
index df7429a..d8ab08a 100644
--- a/rts/RaiseAsync.c
+++ b/rts/RaiseAsync.c
@@ -357,14 +357,20 @@ check_target:
 
     case BlockedOnBlackHole:
     {
-        // Revoke the message by replacing it with IND. We're not
-        // locking anything here, so we might still get a TRY_WAKEUP
-        // message from the owner of the blackhole some time in the
-        // future, but that doesn't matter.
-        ASSERT(target->block_info.bh->header.info == &stg_MSG_BLACKHOLE_info);
-        OVERWRITE_INFO(target->block_info.bh, &stg_IND_info);
-        raiseAsync(cap, target, msg->exception, rtsFalse, NULL);
-        return THROWTO_SUCCESS;
+	if (target->flags & TSO_BLOCKEX) {
+            // BlockedOnBlackHole is not interruptible.
+            blockedThrowTo(cap,target,msg);
+	    return THROWTO_BLOCKED;
+	} else {
+            // Revoke the message by replacing it with IND. We're not
+            // locking anything here, so we might still get a TRY_WAKEUP
+            // message from the owner of the blackhole some time in the
+            // future, but that doesn't matter.
+            ASSERT(target->block_info.bh->header.info == &stg_MSG_BLACKHOLE_info);
+            OVERWRITE_INFO(target->block_info.bh, &stg_IND_info);
+            raiseAsync(cap, target, msg->exception, rtsFalse, NULL);
+            return THROWTO_SUCCESS;
+        }
     }
 
     case BlockedOnSTM: