Refactoring: extract platform-specific code from sm/MBlock.c
[ghc-hetmet.git] / rts / RaiseAsync.c
index 95e2492..bb244d8 100644 (file)
@@ -13,7 +13,6 @@
 #include "RaiseAsync.h"
 #include "SMP.h"
 #include "Schedule.h"
 #include "RaiseAsync.h"
 #include "SMP.h"
 #include "Schedule.h"
-#include "Storage.h"
 #include "LdvProfile.h"
 #include "Updates.h"
 #include "STM.h"
 #include "LdvProfile.h"
 #include "Updates.h"
 #include "STM.h"
@@ -283,7 +282,13 @@ check_target:
 
        // ASSUMPTION: tso->block_info must always point to a
        // closure.  In the threaded RTS it does.
 
        // ASSUMPTION: tso->block_info must always point to a
        // closure.  In the threaded RTS it does.
-       if (get_itbl(mvar)->type != MVAR) goto retry;
+        switch (get_itbl(mvar)->type) {
+        case MVAR_CLEAN:
+        case MVAR_DIRTY:
+            break;
+        default:
+            goto retry;
+        }
 
        info = lockClosure((StgClosure *)mvar);
 
 
        info = lockClosure((StgClosure *)mvar);
 
@@ -438,6 +443,9 @@ check_target:
     case BlockedOnRead:
     case BlockedOnWrite:
     case BlockedOnDelay:
     case BlockedOnRead:
     case BlockedOnWrite:
     case BlockedOnDelay:
+#if defined(mingw32_HOST_OS)
+    case BlockedOnDoProc:
+#endif
        if ((target->flags & TSO_BLOCKEX) &&
            ((target->flags & TSO_INTERRUPTIBLE) == 0)) {
            blockedThrowTo(source,target);
        if ((target->flags & TSO_BLOCKEX) &&
            ((target->flags & TSO_INTERRUPTIBLE) == 0)) {
            blockedThrowTo(source,target);
@@ -494,9 +502,11 @@ throwToReleaseTarget (void *tso)
    queue, but not perform any throwTo() immediately.  This might be
    more appropriate when the target thread is the one actually running
    (see Exception.cmm).
    queue, but not perform any throwTo() immediately.  This might be
    more appropriate when the target thread is the one actually running
    (see Exception.cmm).
+
+   Returns: non-zero if an exception was raised, zero otherwise.
    -------------------------------------------------------------------------- */
 
    -------------------------------------------------------------------------- */
 
-void
+int
 maybePerformBlockedException (Capability *cap, StgTSO *tso)
 {
     StgTSO *source;
 maybePerformBlockedException (Capability *cap, StgTSO *tso)
 {
     StgTSO *source;
@@ -512,7 +522,7 @@ maybePerformBlockedException (Capability *cap, StgTSO *tso)
        // locked it.
        if (tso->blocked_exceptions == END_TSO_QUEUE) {
            unlockTSO(tso);
        // locked it.
        if (tso->blocked_exceptions == END_TSO_QUEUE) {
            unlockTSO(tso);
-           return;
+           return 0;
        }
 
        // We unblock just the first thread on the queue, and perform
        }
 
        // We unblock just the first thread on the queue, and perform
@@ -522,7 +532,9 @@ maybePerformBlockedException (Capability *cap, StgTSO *tso)
        tso->blocked_exceptions = unblockOne_(cap, source, 
                                              rtsFalse/*no migrate*/);
        unlockTSO(tso);
        tso->blocked_exceptions = unblockOne_(cap, source, 
                                              rtsFalse/*no migrate*/);
        unlockTSO(tso);
+        return 1;
     }
     }
+    return 0;
 }
 
 void
 }
 
 void
@@ -936,10 +948,12 @@ raiseAsync(Capability *cap, StgTSO *tso, StgClosure *exception,
        }
 
        case STOP_FRAME:
        }
 
        case STOP_FRAME:
+       {
            // We've stripped the entire stack, the thread is now dead.
            tso->what_next = ThreadKilled;
            tso->sp = frame + sizeofW(StgStopFrame);
            return;
            // We've stripped the entire stack, the thread is now dead.
            tso->what_next = ThreadKilled;
            tso->sp = frame + sizeofW(StgStopFrame);
            return;
+       }
 
        case CATCH_FRAME:
            // If we find a CATCH_FRAME, and we've got an exception to raise,
 
        case CATCH_FRAME:
            // If we find a CATCH_FRAME, and we've got an exception to raise,
@@ -1011,14 +1025,17 @@ raiseAsync(Capability *cap, StgTSO *tso, StgClosure *exception,
            // whether the transaction is valid or not because its
            // possible validity cannot have caused the exception
            // and will not be visible after the abort.
            // whether the transaction is valid or not because its
            // possible validity cannot have caused the exception
            // and will not be visible after the abort.
-           debugTrace(DEBUG_stm, 
-                      "found atomically block delivering async exception");
 
 
+               {
             StgTRecHeader *trec = tso -> trec;
             StgTRecHeader *outer = stmGetEnclosingTRec(trec);
             StgTRecHeader *trec = tso -> trec;
             StgTRecHeader *outer = stmGetEnclosingTRec(trec);
+           debugTrace(DEBUG_stm, 
+                      "found atomically block delivering async exception");
             stmAbortTransaction(cap, trec);
             stmAbortTransaction(cap, trec);
+           stmFreeAbortedTRec(cap, trec);
             tso -> trec = outer;
            break;
             tso -> trec = outer;
            break;
+           };
            
        default:
            break;
            
        default:
            break;