X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=rts%2FException.cmm;h=346c9499eb4abd18925df64785aa3763b20fe538;hb=73637ad66b7f88e57dcd0e0ea93b3d7bf8fb0d78;hp=15b2c64d4fb0be10cf9e1cfef37f946ee0f3c37d;hpb=17f848e12faf8cf51aa58918522b6abe1e75dc51;p=ghc-hetmet.git

diff --git a/rts/Exception.cmm b/rts/Exception.cmm
index 15b2c64..346c949 100644
--- a/rts/Exception.cmm
+++ b/rts/Exception.cmm
@@ -43,10 +43,7 @@
    unsafePerformIO thunk will be updated with a stack object
    containing the unblockAsyncExceptions_ret frame.  Later, when
    someone else evaluates this thunk, the blocked exception state is
-   not restored, and the result is that unblockAsyncExceptions_ret
-   will attempt to unblock exceptions in the current thread, but it'll
-   find that the CurrentTSO->blocked_exceptions is NULL.  Hence, we
-   work around this by checking for NULL in awakenBlockedQueue().
+   not restored.
 
    -------------------------------------------------------------------------- */
 
@@ -55,9 +52,6 @@ INFO_TABLE_RET( stg_unblockAsyncExceptionszh_ret,
 {
     CInt r;
 
-    // Not true: see comments above
-    // ASSERT(StgTSO_blocked_exceptions(CurrentTSO) != NULL);
-
     StgTSO_flags(CurrentTSO) = StgTSO_flags(CurrentTSO) & 
 	~(TSO_BLOCKEX::I32|TSO_INTERRUPTIBLE::I32);
 
@@ -115,9 +109,6 @@ INFO_TABLE_RET( stg_unblockAsyncExceptionszh_ret,
 INFO_TABLE_RET( stg_blockAsyncExceptionszh_ret,
   		0/*framesize*/, 0/*bitmap*/, RET_SMALL )
 {
-    // Not true: see comments above
-    // ASSERT(StgTSO_blocked_exceptions(CurrentTSO) == NULL);
-
     StgTSO_flags(CurrentTSO) = 
 	StgTSO_flags(CurrentTSO) | TSO_BLOCKEX::I32 | TSO_INTERRUPTIBLE::I32;
 
@@ -384,32 +375,6 @@ raisezh_fast
     }
 #endif
     
-    if (W_[no_break_on_exception] != 0) {
-        W_[no_break_on_exception] = 0;
-    } else {
-        if (TO_W_(CInt[rts_stop_on_exception]) != 0) {
-            W_ ioAction;
-            // we don't want any further exceptions to be caught,
-            // until GHCi is ready to handle them.  This prevents
-            // deadlock if an exception is raised in InteractiveUI,
-            // for exmplae.  Perhaps the stop_on_exception flag should
-            // be per-thread.
-            W_[rts_stop_on_exception] = 0;
-            "ptr" ioAction = foreign "C" deRefStablePtr (W_[rts_breakpoint_io_action] "ptr") [];
-            Sp = Sp - WDS(6);
-            Sp(5) = exception;
-            Sp(4) = stg_raise_ret_info;
-            Sp(3) = exception;             // the AP_STACK
-            Sp(2) = base_GHCziBase_True_closure; // dummy breakpoint info
-            Sp(1) = base_GHCziBase_True_closure; // True <=> a breakpoint
-            R1 = ioAction;
-            jump stg_ap_pppv_info;
-        }
-    }
-
-    /* Inform the Hpc that an exception has been thrown */
-    foreign "C" hs_hpc_raise_event(CurrentTSO "ptr") [];
-
 retry_pop_stack:
     StgTSO_sp(CurrentTSO) = Sp;
     frame_type = foreign "C" raiseExceptionHelper(BaseReg "ptr", CurrentTSO "ptr", exception "ptr") [];
@@ -451,6 +416,35 @@ retry_pop_stack:
       }          
     }
 
+    // After stripping the stack, see whether we should break here for
+    // GHCi (c.f. the -fbreak-on-exception flag).  We do this after
+    // stripping the stack for a reason: we'll be inspecting values in
+    // GHCi, and it helps if all the thunks under evaluation have
+    // already been updated with the exception, rather than being left
+    // as blackholes.
+    if (W_[no_break_on_exception] != 0) {
+        W_[no_break_on_exception] = 0;
+    } else {
+        if (TO_W_(CInt[rts_stop_on_exception]) != 0) {
+            W_ ioAction;
+            // we don't want any further exceptions to be caught,
+            // until GHCi is ready to handle them.  This prevents
+            // deadlock if an exception is raised in InteractiveUI,
+            // for exmplae.  Perhaps the stop_on_exception flag should
+            // be per-thread.
+            W_[rts_stop_on_exception] = 0;
+            "ptr" ioAction = foreign "C" deRefStablePtr (W_[rts_breakpoint_io_action] "ptr") [];
+            Sp = Sp - WDS(6);
+            Sp(5) = exception;
+            Sp(4) = stg_raise_ret_info;
+            Sp(3) = exception;             // the AP_STACK
+            Sp(2) = base_GHCziBase_True_closure; // dummy breakpoint info
+            Sp(1) = base_GHCziBase_True_closure; // True <=> a breakpoint
+            R1 = ioAction;
+            jump stg_ap_pppv_info;
+        }
+    }
+
     if (frame_type == STOP_FRAME) {
 	/*
 	 * We've stripped the entire stack, the thread is now dead.