Improve runghc's argument handling

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

diff --git a/rts/RaiseAsync.c b/rts/RaiseAsync.c
index c0cfd7b..d892e95 100644 (file)
--- a/rts/RaiseAsync.c
+++ b/rts/RaiseAsync.c
@@ -13,11 +13,13 @@
 #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 "Sanity.h"
 #include "LdvProfile.h"
 #include "Updates.h"
 #include "STM.h"
 #include "Sanity.h"

+#if defined(mingw32_HOST_OS)
+#include "win32/IOManager.h"
+#endif

 
 static void raiseAsync (Capability *cap,
                        StgTSO *tso,
 
 static void raiseAsync (Capability *cap,
                        StgTSO *tso,

@@ -435,6 +437,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);

@@ -491,9 +496,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;

@@ -509,7 +516,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

@@ -519,7 +526,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

@@ -1014,6 +1023,7 @@ raiseAsync(Capability *cap, StgTSO *tso, StgClosure *exception,
             StgTRecHeader *trec = tso -> trec;
             StgTRecHeader *outer = stmGetEnclosingTRec(trec);
             stmAbortTransaction(cap, trec);
             StgTRecHeader *trec = tso -> trec;
             StgTRecHeader *outer = stmGetEnclosingTRec(trec);
             stmAbortTransaction(cap, trec);

+           stmFreeAbortedTRec(cap, trec);

             tso -> trec = outer;
            break;
            
             tso -> trec = outer;
            break;