Hadrian: bump Cabal submodule, install extra dynamic flavours of RTS
[ghc.git] / rts / RaiseAsync.c
index 10585c8..72f5dff 100644 (file)
 #include "win32/IOManager.h"
 #endif
 
-static StgTSO* raiseAsync (Capability *cap,
-                           StgTSO *tso,
-                           StgClosure *exception,
-                           rtsBool stop_at_atomically,
-                           StgUpdateFrame *stop_here);
+static void blockedThrowTo (Capability *cap,
+                            StgTSO *target, MessageThrowTo *msg);
 
 static void removeFromQueues(Capability *cap, StgTSO *tso);
 
@@ -56,7 +53,7 @@ static void throwToSendMsg (Capability *cap USED_IF_THREADS,
 
 static void
 throwToSingleThreaded__ (Capability *cap, StgTSO *tso, StgClosure *exception,
-                         rtsBool stop_at_atomically, StgUpdateFrame *stop_here)
+                         bool stop_at_atomically, StgUpdateFrame *stop_here)
 {
     // Thread already dead?
     if (tso->what_next == ThreadComplete || tso->what_next == ThreadKilled) {
@@ -72,12 +69,12 @@ throwToSingleThreaded__ (Capability *cap, StgTSO *tso, StgClosure *exception,
 void
 throwToSingleThreaded (Capability *cap, StgTSO *tso, StgClosure *exception)
 {
-    throwToSingleThreaded__(cap, tso, exception, rtsFalse, NULL);
+    throwToSingleThreaded__(cap, tso, exception, false, NULL);
 }
 
 void
 throwToSingleThreaded_ (Capability *cap, StgTSO *tso, StgClosure *exception,
-                        rtsBool stop_at_atomically)
+                        bool stop_at_atomically)
 {
     throwToSingleThreaded__ (cap, tso, exception, stop_at_atomically, NULL);
 }
@@ -85,7 +82,61 @@ throwToSingleThreaded_ (Capability *cap, StgTSO *tso, StgClosure *exception,
 void // cannot return a different TSO
 suspendComputation (Capability *cap, StgTSO *tso, StgUpdateFrame *stop_here)
 {
-    throwToSingleThreaded__ (cap, tso, NULL, rtsFalse, stop_here);
+    throwToSingleThreaded__ (cap, tso, NULL, false, stop_here);
+}
+
+/* -----------------------------------------------------------------------------
+   throwToSelf
+
+   Useful for throwing an async exception in a thread from the
+   runtime.  It handles unlocking the throwto message returned by
+   throwTo().
+
+   Note [Throw to self when masked]
+   
+   When a StackOverflow occurs when the thread is masked, we want to
+   defer the exception to when the thread becomes unmasked/hits an
+   interruptible point.  We already have a mechanism for doing this,
+   the blocked_exceptions list, but the use here is a bit unusual,
+   because an exception is normally only added to this list upon
+   an asynchronous 'throwTo' call (with all of the relevant
+   multithreaded nonsense). Morally, a stack overflow should be an
+   asynchronous exception sent by a thread to itself, and it should
+   have the same semantics.  But there are a few key differences:
+   
+   - If you actually tried to send an asynchronous exception to
+     yourself using throwTo, the exception would actually immediately
+     be delivered.  This is because throwTo itself is considered an
+     interruptible point, so the exception is always deliverable. Thus,
+     ordinarily, we never end up with a message to oneself in the
+     blocked_exceptions queue.
+   
+   - In the case of a StackOverflow, we don't actually care about the
+     wakeup semantics; when an exception is delivered, the thread that
+     originally threw the exception should be woken up, since throwTo
+     blocks until the exception is successfully thrown.  Fortunately,
+     it is harmless to wakeup a thread that doesn't actually need waking
+     up, e.g. ourselves.
+   
+   - No synchronization is necessary, because we own the TSO and the
+     capability.  You can observe this by tracing through the execution
+     of throwTo.  We skip synchronizing the message and inter-capability
+     communication.
+   
+   We think this doesn't break any invariants, but do be careful!
+   -------------------------------------------------------------------------- */
+
+void
+throwToSelf (Capability *cap, StgTSO *tso, StgClosure *exception)
+{
+    MessageThrowTo *m;
+
+    m = throwTo(cap, tso, tso, exception);
+
+    if (m != NULL) {
+        // throwTo leaves it locked
+        unlockClosure((StgClosure*)m, &stg_MSG_THROWTO_info);
+    }
 }
 
 /* -----------------------------------------------------------------------------
@@ -177,7 +228,7 @@ throwTo (Capability *cap,       // the Capability we hold
 }
 
 
-nat
+uint32_t
 throwToMsg (Capability *cap, MessageThrowTo *msg)
 {
     StgWord status;
@@ -204,7 +255,7 @@ check_target:
                   (unsigned long)msg->source->id,
                   (unsigned long)msg->target->id);
 
-#ifdef DEBUG
+#if defined(DEBUG)
     traceThreadStatus(DEBUG_sched, target);
 #endif
 
@@ -221,7 +272,7 @@ check_target:
     {
         if ((target->flags & TSO_BLOCKEX) == 0) {
             // It's on our run queue and not blocking exceptions
-            raiseAsync(cap, target, msg->exception, rtsFalse, NULL);
+            raiseAsync(cap, target, msg->exception, false, NULL);
             return THROWTO_SUCCESS;
         } else {
             blockedThrowTo(cap,target,msg);
@@ -286,7 +337,7 @@ check_target:
         // nobody else can wake up this TSO after we claim the message
         doneWithMsgThrowTo(m);
 
-        raiseAsync(cap, target, msg->exception, rtsFalse, NULL);
+        raiseAsync(cap, target, msg->exception, false, NULL);
         return THROWTO_SUCCESS;
     }
 
@@ -340,7 +391,7 @@ check_target:
         } else {
             // revoke the MVar operation
             removeFromMVarBlockedQueue(target);
-            raiseAsync(cap, target, msg->exception, rtsFalse, NULL);
+            raiseAsync(cap, target, msg->exception, false, NULL);
             unlockClosure((StgClosure *)mvar, info);
             return THROWTO_SUCCESS;
         }
@@ -359,32 +410,23 @@ check_target:
             // 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);
+            raiseAsync(cap, target, msg->exception, false, NULL);
             return THROWTO_SUCCESS;
         }
     }
 
     case BlockedOnSTM:
-        lockTSO(target);
-        // Unblocking BlockedOnSTM threads requires the TSO to be
-        // locked; see STM.c:unpark_tso().
-        if (target->why_blocked != BlockedOnSTM) {
-            unlockTSO(target);
-            goto retry;
-        }
         if ((target->flags & TSO_BLOCKEX) &&
             ((target->flags & TSO_INTERRUPTIBLE) == 0)) {
             blockedThrowTo(cap,target,msg);
-            unlockTSO(target);
             return THROWTO_BLOCKED;
         } else {
-            raiseAsync(cap, target, msg->exception, rtsFalse, NULL);
-            unlockTSO(target);
+            raiseAsync(cap, target, msg->exception, false, NULL);
             return THROWTO_SUCCESS;
         }
 
     case BlockedOnCCall_Interruptible:
-#ifdef THREADED_RTS
+#if defined(THREADED_RTS)
     {
         Task *task = NULL;
         // walk suspended_ccalls to find the correct worker thread
@@ -407,12 +449,13 @@ check_target:
         }
         // fall to next
     }
+    FALLTHROUGH;
 #endif
     case BlockedOnCCall:
         blockedThrowTo(cap,target,msg);
         return THROWTO_BLOCKED;
 
-#ifndef THREADEDED_RTS
+#if !defined(THREADEDED_RTS)
     case BlockedOnRead:
     case BlockedOnWrite:
     case BlockedOnDelay:
@@ -425,13 +468,13 @@ check_target:
             return THROWTO_BLOCKED;
         } else {
             removeFromQueues(cap,target);
-            raiseAsync(cap, target, msg->exception, rtsFalse, NULL);
+            raiseAsync(cap, target, msg->exception, false, NULL);
             return THROWTO_SUCCESS;
         }
 #endif
 
     case ThreadMigrating:
-        // if is is ThreadMigrating and tso->cap is ours, then it
+        // if it is ThreadMigrating and tso->cap is ours, then it
         // *must* be migrating *to* this capability.  If it were
         // migrating away from the capability, then tso->cap would
         // point to the destination.
@@ -454,7 +497,7 @@ throwToSendMsg (Capability *cap STG_UNUSED,
                 MessageThrowTo *msg USED_IF_THREADS)
 
 {
-#ifdef THREADED_RTS
+#if defined(THREADED_RTS)
     debugTraceCap(DEBUG_sched, cap, "throwTo: sending a throwto message to cap %lu", (unsigned long)target_cap->no);
 
     sendMessage(cap, target_cap, (Message*)msg);
@@ -723,14 +766,14 @@ removeFromQueues(Capability *cap, StgTSO *tso)
  *
  * -------------------------------------------------------------------------- */
 
-static StgTSO *
+StgTSO *
 raiseAsync(Capability *cap, StgTSO *tso, StgClosure *exception,
-           rtsBool stop_at_atomically, StgUpdateFrame *stop_here)
+           bool stop_at_atomically, StgUpdateFrame *stop_here)
 {
-    StgRetInfoTable *info;
+    const StgRetInfoTable *info;
     StgPtr sp, frame;
     StgClosure *updatee;
-    nat i;
+    uint32_t i;
     StgStack *stack;
 
     debugTraceCap(DEBUG_sched, cap,
@@ -810,7 +853,7 @@ raiseAsync(Capability *cap, StgTSO *tso, StgClosure *exception,
         case UPDATE_FRAME:
         {
             StgAP_STACK * ap;
-            nat words;
+            uint32_t words;
 
             // First build an AP_STACK consisting of the stack chunk above the
             // current update frame, with the top word on the stack as the
@@ -821,8 +864,9 @@ raiseAsync(Capability *cap, StgTSO *tso, StgClosure *exception,
 
             ap->size = words;
             ap->fun  = (StgClosure *)sp[0];
+
             sp++;
-            for(i=0; i < (nat)words; ++i) {
+            for(i=0; i < words; ++i) {
                 ap->payload[i] = (StgClosure *)*sp++;
             }
 
@@ -861,7 +905,7 @@ raiseAsync(Capability *cap, StgTSO *tso, StgClosure *exception,
         case UNDERFLOW_FRAME:
         {
             StgAP_STACK * ap;
-            nat words;
+            uint32_t words;
 
             // First build an AP_STACK consisting of the stack chunk above the
             // current update frame, with the top word on the stack as the
@@ -873,7 +917,7 @@ raiseAsync(Capability *cap, StgTSO *tso, StgClosure *exception,
             ap->size = words;
             ap->fun  = (StgClosure *)sp[0];
             sp++;
-            for(i=0; i < (nat)words; ++i) {
+            for(i=0; i < words; ++i) {
                 ap->payload[i] = (StgClosure *)*sp++;
             }