Fix for interruptible FFI handling

Set tso->why_blocked before calling maybePerformBlockedException(), so
that throwToSingleThreaded() doesn't try to unblock the current thread
(it is already unblocked).

diff --git a/rts/RaiseAsync.c b/rts/RaiseAsync.c
index cbbdc95..c4c3f1d 100644 (file)
--- a/rts/RaiseAsync.c
+++ b/rts/RaiseAsync.c
@@ -667,14 +667,6 @@ 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 456258c..f6a9ef2 100644 (file)
--- a/rts/Schedule.c
+++ b/rts/Schedule.c
@@ -1817,6 +1817,9 @@ resumeThread (void *task_)
 
     traceEventRunThread(cap, tso);
     
+    /* Reset blocking status */
+    tso->why_blocked  = NotBlocked;
+
     if ((tso->flags & TSO_BLOCKEX) == 0) {
         // avoid locking the TSO if we don't have to
         if (tso->blocked_exceptions != END_BLOCKED_EXCEPTIONS_QUEUE) {
@@ -1824,9 +1827,6 @@ resumeThread (void *task_)
         }
     }
     
-    /* Reset blocking status */
-    tso->why_blocked  = NotBlocked;
-    
     cap->r.rCurrentTSO = tso;
     cap->in_haskell = rtsTrue;
     errno = saved_errno;