Allow "INLINEABLE" as a synonym

[ghc-hetmet.git] / rts / RaiseAsync.c

diff --git a/rts/RaiseAsync.c b/rts/RaiseAsync.c
index df7429a..ad830cf 100644 (file)
--- 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:
@@ -834,9 +840,7 @@ raiseAsync(Capability *cap, StgTSO *tso, StgClosure *exception,
            // top of the CATCH_FRAME ready to enter.
            //
        {
-#ifdef PROFILING
            StgCatchFrame *cf = (StgCatchFrame *)frame;
-#endif
            StgThunk *raise;
            
            if (exception == NULL) break;
@@ -857,7 +861,12 @@ raiseAsync(Capability *cap, StgTSO *tso, StgClosure *exception,
             * a surprise exception before we get around to executing the
             * handler.
             */
-           tso->flags |= TSO_BLOCKEX | TSO_INTERRUPTIBLE;
+            tso->flags |= TSO_BLOCKEX;
+            if ((cf->exceptions_blocked & TSO_INTERRUPTIBLE) == 0) {
+                tso->flags &= ~TSO_INTERRUPTIBLE;
+            } else {
+                tso->flags |= TSO_INTERRUPTIBLE;
+            }
 
            /* Put the newly-built THUNK on top of the stack, ready to execute
             * when the thread restarts.