From 539d3adec64f51a3fb13bb65b7a494d7eded01a0 Mon Sep 17 00:00:00 2001
From: "Edward Z. Yang" <ezyang@mit.edu>
Date: Sat, 25 Sep 2010 03:30:26 +0000
Subject: [PATCH] Don't interrupt when task blocks exceptions, don't
 immediately start exception.

---
 rts/Interpreter.c |    7 +++++++
 rts/RaiseAsync.c  |   16 +++++++++++++---
 rts/Schedule.c    |    2 +-
 rts/sm/MarkWeak.c |    3 ++-
 4 files changed, 23 insertions(+), 5 deletions(-)

diff --git a/rts/Interpreter.c b/rts/Interpreter.c
index da7ee21..58ffd25 100644
--- a/rts/Interpreter.c
+++ b/rts/Interpreter.c
@@ -1454,6 +1454,13 @@ run_BCO:
 	    cap = (Capability *)((void *)((unsigned char*)resumeThread(tok) - STG_FIELD_OFFSET(Capability,r)));
 	    LOAD_STACK_POINTERS;
 
+            if (Sp[0] == (W_)&stg_enter_info) {
+                // Sp got clobbered due to an exception; so we should
+                // go run it instead.
+                Sp++;
+                goto eval;
+            }
+
             // Re-load the pointer to the BCO from the RET_DYN frame,
             // it might have moved during the call.  Also reload the
             // pointers to the components of the BCO.
diff --git a/rts/RaiseAsync.c b/rts/RaiseAsync.c
index b94ccea..cbbdc95 100644
--- a/rts/RaiseAsync.c
+++ b/rts/RaiseAsync.c
@@ -405,9 +405,11 @@ check_target:
             }
         }
         if (task != NULL) {
-            raiseAsync(cap, target, msg->exception, rtsFalse, NULL);
-            interruptWorkerTask(task);
-            return THROWTO_SUCCESS;
+            blockedThrowTo(cap, target, msg);
+            if (!((target->flags & TSO_BLOCKEX) && ((target->flags & TSO_INTERRUPTIBLE) == 0))) {
+                interruptWorkerTask(task);
+            }
+            return THROWTO_BLOCKED;
         } else {
             debugTraceCap(DEBUG_sched, cap, "throwTo: could not find worker thread to kill");
         }
@@ -665,6 +667,14 @@ removeFromQueues(Capability *cap, StgTSO *tso)
 	goto done;
 #endif
 
+  case BlockedOnCCall_Interruptible:
+  case BlockedOnCCall:
+      // ccall shouldn't be put on the run queue, because whenever
+      // we raise an exception for such a blocked thread, it's only
+      // when we're /exiting/ the call.
+      tso->why_blocked = NotBlocked;
+      return;
+
   default:
       barf("removeFromQueues: %d", tso->why_blocked);
   }
diff --git a/rts/Schedule.c b/rts/Schedule.c
index 0850749..456258c 100644
--- a/rts/Schedule.c
+++ b/rts/Schedule.c
@@ -1820,7 +1820,7 @@ resumeThread (void *task_)
     if ((tso->flags & TSO_BLOCKEX) == 0) {
         // avoid locking the TSO if we don't have to
         if (tso->blocked_exceptions != END_BLOCKED_EXCEPTIONS_QUEUE) {
-            awakenBlockedExceptionQueue(cap,tso);
+            maybePerformBlockedException(cap,tso);
         }
     }
     
diff --git a/rts/sm/MarkWeak.c b/rts/sm/MarkWeak.c
index d4d708e..aadd575 100644
--- a/rts/sm/MarkWeak.c
+++ b/rts/sm/MarkWeak.c
@@ -271,9 +271,10 @@ static rtsBool tidyThreadList (generation *gen)
         // if the thread is not masking exceptions but there are
         // pending exceptions on its queue, then something has gone
         // wrong.  However, pending exceptions are OK if there is an
-        // uninterruptible FFI call.
+        // FFI call.
         ASSERT(t->blocked_exceptions == END_BLOCKED_EXCEPTIONS_QUEUE
                || t->why_blocked == BlockedOnCCall
+               || t->why_blocked == BlockedOnCCall_Interruptible
                || (t->flags & TSO_BLOCKEX));
         
         if (tmp == NULL) {
-- 
1.7.10.4