add Outputable instance for OccIfaceEq

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

diff --git a/rts/RaiseAsync.c b/rts/RaiseAsync.c
index b71e126..73c4429 100644 (file)
--- 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);
 
@@ -846,6 +853,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);