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

diff --git a/rts/RaiseAsync.c b/rts/RaiseAsync.c
index b71e126..21bc78e 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
@@ -282,7 +283,13 @@ 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);
 
@@ -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:
@@ -781,7 +793,7 @@ removeFromQueues(Capability *cap, StgTSO *tso)
 #endif
 
   default:
-      barf("removeFromQueues");
+      barf("removeFromQueues: %d", tso->why_blocked);
   }
 
  done:
@@ -846,6 +858,18 @@ 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);
 
@@ -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;