X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=rts%2FRaiseAsync.c;h=d3400d791d0829892484339d9937906e7e47f6ed;hp=b71e126f04020bf82ac3c8dd07a52519ebf1462a;hb=27de38efce6d73d2a0209f803cfa98c82773e773;hpb=45202530612593a0ba7a6c559a38dc1ff26670a4

diff --git a/rts/RaiseAsync.c b/rts/RaiseAsync.c
index b71e126..d3400d7 100644
--- a/rts/RaiseAsync.c
+++ b/rts/RaiseAsync.c
@@ -17,6 +17,7 @@
 #include "Updates.h"
 #include "STM.h"
 #include "Sanity.h"
+#include "Profiling.h"
 #if defined(mingw32_HOST_OS)
 #include "win32/IOManager.h"
 #endif
@@ -29,7 +30,7 @@ static void raiseAsync (Capability *cap,
 
 static void removeFromQueues(Capability *cap, StgTSO *tso);
 
-static void blockedThrowTo (StgTSO *source, StgTSO *target);
+static void blockedThrowTo (Capability *cap, StgTSO *source, StgTSO *target);
 
 static void performBlockedException (Capability *cap, 
 				     StgTSO *source, StgTSO *target);
@@ -151,7 +152,7 @@ throwTo (Capability *cap,	// the Capability we hold
 
     // follow ThreadRelocated links in the target first
     while (target->what_next == ThreadRelocated) {
-	target = target->link;
+	target = target->_link;
 	// No, it might be a WHITEHOLE:
 	// ASSERT(get_itbl(target)->type == TSO);
     }
@@ -260,10 +261,10 @@ check_target:
 	    // just moved this TSO.
 	    if (target->what_next == ThreadRelocated) {
 		unlockTSO(target);
-		target = target->link;
+		target = target->_link;
 		goto retry;
 	    }
-	    blockedThrowTo(source,target);
+	    blockedThrowTo(cap,source,target);
 	    *out = target;
 	    return THROWTO_BLOCKED;
 	}
@@ -282,12 +283,18 @@ check_target:
 
 	// 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);
 
 	if (target->what_next == ThreadRelocated) {
-	    target = target->link;
+	    target = target->_link;
 	    unlockClosure((StgClosure *)mvar,info);
 	    goto retry;
 	}
@@ -302,12 +309,12 @@ check_target:
 	if ((target->flags & TSO_BLOCKEX) &&
 	    ((target->flags & TSO_INTERRUPTIBLE) == 0)) {
 	    lockClosure((StgClosure *)target);
-	    blockedThrowTo(source,target);
+	    blockedThrowTo(cap,source,target);
 	    unlockClosure((StgClosure *)mvar, info);
 	    *out = target;
 	    return THROWTO_BLOCKED; // caller releases TSO
 	} else {
-	    removeThreadFromMVarQueue(mvar, target);
+	    removeThreadFromMVarQueue(cap, mvar, target);
 	    raiseAsync(cap, target, exception, rtsFalse, NULL);
 	    unblockOne(cap, target);
 	    unlockClosure((StgClosure *)mvar, info);
@@ -326,12 +333,12 @@ check_target:
 
 	if (target->flags & TSO_BLOCKEX) {
 	    lockTSO(target);
-	    blockedThrowTo(source,target);
+	    blockedThrowTo(cap,source,target);
 	    RELEASE_LOCK(&sched_mutex);
 	    *out = target;
 	    return THROWTO_BLOCKED; // caller releases TSO
 	} else {
-	    removeThreadFromQueue(&blackhole_queue, target);
+	    removeThreadFromQueue(cap, &blackhole_queue, target);
 	    raiseAsync(cap, target, exception, rtsFalse, NULL);
 	    unblockOne(cap, target);
 	    RELEASE_LOCK(&sched_mutex);
@@ -366,12 +373,12 @@ check_target:
 	    goto retry;
 	}
 	if (target->what_next == ThreadRelocated) {
-	    target = target->link;
+	    target = target->_link;
 	    unlockTSO(target2);
 	    goto retry;
 	}
 	if (target2->what_next == ThreadRelocated) {
-	    target->block_info.tso = target2->link;
+	    target->block_info.tso = target2->_link;
 	    unlockTSO(target2);
 	    goto retry;
 	}
@@ -390,12 +397,12 @@ check_target:
 	if ((target->flags & TSO_BLOCKEX) &&
 	    ((target->flags & TSO_INTERRUPTIBLE) == 0)) {
 	    lockTSO(target);
-	    blockedThrowTo(source,target);
+	    blockedThrowTo(cap,source,target);
 	    unlockTSO(target2);
 	    *out = target;
 	    return THROWTO_BLOCKED;
 	} else {
-	    removeThreadFromQueue(&target2->blocked_exceptions, target);
+	    removeThreadFromQueue(cap, &target2->blocked_exceptions, target);
 	    raiseAsync(cap, target, exception, rtsFalse, NULL);
 	    unblockOne(cap, target);
 	    unlockTSO(target2);
@@ -412,7 +419,7 @@ check_target:
 	}
 	if ((target->flags & TSO_BLOCKEX) &&
 	    ((target->flags & TSO_INTERRUPTIBLE) == 0)) {
-	    blockedThrowTo(source,target);
+	    blockedThrowTo(cap,source,target);
 	    *out = target;
 	    return THROWTO_BLOCKED;
 	} else {
@@ -429,7 +436,7 @@ check_target:
 	// thread is blocking exceptions, and block on its
 	// blocked_exception queue.
 	lockTSO(target);
-	blockedThrowTo(source,target);
+	blockedThrowTo(cap,source,target);
 	*out = target;
 	return THROWTO_BLOCKED;
 
@@ -442,7 +449,7 @@ check_target:
 #endif
 	if ((target->flags & TSO_BLOCKEX) &&
 	    ((target->flags & TSO_INTERRUPTIBLE) == 0)) {
-	    blockedThrowTo(source,target);
+	    blockedThrowTo(cap,source,target);
 	    return THROWTO_BLOCKED;
 	} else {
 	    removeFromQueues(cap,target);
@@ -462,12 +469,12 @@ check_target:
 // complex to achieve as there's no single lock on a TSO; see
 // throwTo()).
 static void
-blockedThrowTo (StgTSO *source, StgTSO *target)
+blockedThrowTo (Capability *cap, StgTSO *source, StgTSO *target)
 {
     debugTrace(DEBUG_sched, "throwTo: blocking on thread %lu", (unsigned long)target->id);
-    source->link = target->blocked_exceptions;
+    setTSOLink(cap, source, target->blocked_exceptions);
     target->blocked_exceptions = source;
-    dirtyTSO(target); // we modified the blocked_exceptions queue
+    dirty_TSO(cap,target); // we modified the blocked_exceptions queue
     
     source->block_info.tso = target;
     write_barrier(); // throwTo_exception *must* be visible if BlockedOnException is.
@@ -505,6 +512,11 @@ maybePerformBlockedException (Capability *cap, StgTSO *tso)
 {
     StgTSO *source;
     
+    if (tso->blocked_exceptions != END_TSO_QUEUE && 
+        (tso->flags & TSO_BLOCKEX) != 0) {
+        debugTrace(DEBUG_sched, "throwTo: thread %lu has blocked exceptions but is inside block", (unsigned long)tso->id);
+    }
+
     if (tso->blocked_exceptions != END_TSO_QUEUE
 	&& ((tso->flags & TSO_BLOCKEX) == 0
 	    || ((tso->flags & TSO_INTERRUPTIBLE) && interruptible(tso)))) {
@@ -708,7 +720,7 @@ removeFromQueues(Capability *cap, StgTSO *tso)
     }
 
   default:
-    barf("removeFromQueues");
+    barf("removeFromQueues: %d", tso->why_blocked);
   }
 
  done:
@@ -736,11 +748,11 @@ removeFromQueues(Capability *cap, StgTSO *tso)
     goto done;
 
   case BlockedOnMVar:
-      removeThreadFromMVarQueue((StgMVar *)tso->block_info.closure, tso);
+      removeThreadFromMVarQueue(cap, (StgMVar *)tso->block_info.closure, tso);
       goto done;
 
   case BlockedOnBlackHole:
-      removeThreadFromQueue(&blackhole_queue, tso);
+      removeThreadFromQueue(cap, &blackhole_queue, tso);
       goto done;
 
   case BlockedOnException:
@@ -753,10 +765,10 @@ removeFromQueues(Capability *cap, StgTSO *tso)
       // ASSERT(get_itbl(target)->type == TSO);
 
       while (target->what_next == ThreadRelocated) {
-	  target = target->link;
+	  target = target->_link;
       }
       
-      removeThreadFromQueue(&target->blocked_exceptions, tso);
+      removeThreadFromQueue(cap, &target->blocked_exceptions, tso);
       goto done;
     }
 
@@ -766,7 +778,7 @@ removeFromQueues(Capability *cap, StgTSO *tso)
 #if defined(mingw32_HOST_OS)
   case BlockedOnDoProc:
 #endif
-      removeThreadFromDeQueue(&blocked_queue_hd, &blocked_queue_tl, tso);
+      removeThreadFromDeQueue(cap, &blocked_queue_hd, &blocked_queue_tl, tso);
 #if defined(mingw32_HOST_OS)
       /* (Cooperatively) signal that the worker thread should abort
        * the request.
@@ -776,16 +788,16 @@ removeFromQueues(Capability *cap, StgTSO *tso)
       goto done;
 
   case BlockedOnDelay:
-	removeThreadFromQueue(&sleeping_queue, tso);
+        removeThreadFromQueue(cap, &sleeping_queue, tso);
 	goto done;
 #endif
 
   default:
-      barf("removeFromQueues");
+      barf("removeFromQueues: %d", tso->why_blocked);
   }
 
  done:
-  tso->link = END_TSO_QUEUE;
+  tso->_link = END_TSO_QUEUE; // no write barrier reqd
   tso->why_blocked = NotBlocked;
   tso->block_info.closure = NULL;
   appendToRunQueue(cap,tso);
@@ -846,8 +858,20 @@ raiseAsync(Capability *cap, StgTSO *tso, StgClosure *exception,
     debugTrace(DEBUG_sched,
 	       "raising exception in thread %ld.", (long)tso->id);
     
+#if defined(PROFILING)
+    /* 
+     * Debugging tool: on raising an  exception, show where we are.
+     * See also Exception.cmm:raisezh_fast.
+     * This wasn't done for asynchronous exceptions originally; see #1450 
+     */
+    if (RtsFlags.ProfFlags.showCCSOnException)
+    {
+        fprintCCS_stderr(tso->prof.CCCS);
+    }
+#endif
+
     // mark it dirty; we're about to change its stack.
-    dirtyTSO(tso);
+    dirty_TSO(cap, tso);
 
     sp = tso->sp;
     
@@ -920,21 +944,12 @@ raiseAsync(Capability *cap, StgTSO *tso, StgClosure *exception,
 	    //	     printObj((StgClosure *)ap);
 	    //	);
 
-	    // Replace the updatee with an indirection
-	    //
-	    // Warning: if we're in a loop, more than one update frame on
-	    // the stack may point to the same object.  Be careful not to
-	    // overwrite an IND_OLDGEN in this case, because we'll screw
-	    // up the mutable lists.  To be on the safe side, don't
-	    // overwrite any kind of indirection at all.  See also
-	    // threadSqueezeStack in GC.c, where we have to make a similar
-	    // check.
-	    //
-	    if (!closure_IND(((StgUpdateFrame *)frame)->updatee)) {
-		// revert the black hole
-		UPD_IND_NOLOCK(((StgUpdateFrame *)frame)->updatee,
-			       (StgClosure *)ap);
-	    }
+            // Perform the update
+            // TODO: this may waste some work, if the thunk has
+            // already been updated by another thread.
+            UPD_IND_NOLOCK(((StgUpdateFrame *)frame)->updatee,
+                           (StgClosure *)ap);
+
 	    sp += sizeofW(StgUpdateFrame) - 1;
 	    sp[0] = (W_)ap; // push onto stack
 	    frame = sp + 1;
@@ -995,17 +1010,7 @@ raiseAsync(Capability *cap, StgTSO *tso, StgClosure *exception,
 	    if (stop_at_atomically) {
 		ASSERT(stmGetEnclosingTRec(tso->trec) == NO_TREC);
 		stmCondemnTransaction(cap, tso -> trec);
-#ifdef REG_R1
 		tso->sp = frame;
-#else
-		// R1 is not a register: the return convention for IO in
-		// this case puts the return value on the stack, so we
-		// need to set up the stack to return to the atomically
-		// frame properly...
-		tso->sp = frame - 2;
-		tso->sp[1] = (StgWord) &stg_NO_FINALIZER_closure; // why not?
-		tso->sp[0] = (StgWord) &stg_ut_1_0_unreg_info;
-#endif
 		tso->what_next = ThreadRunGHC;
 		return;
 	    }