[project @ 2005-07-12 14:23:51 by simonmar]

[ghc-hetmet.git] / ghc / rts / Exception.cmm

diff --git a/ghc/rts/Exception.cmm b/ghc/rts/Exception.cmm
index edabf54..f35a9c7 100644 (file)
--- a/ghc/rts/Exception.cmm
+++ b/ghc/rts/Exception.cmm
@@ -35,12 +35,25 @@
    it.  The action of unblocking exceptions in a thread will release all
    the threads waiting to deliver exceptions to that thread.
 
+   NB. there's a bug in here.  If a thread is inside an
+   unsafePerformIO, and inside blockAsyncExceptions# (there is an
+   unblockAsyncExceptions_ret on the stack), and it is blocked in an
+   interruptible operation, and it receives an exception, then the
+   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().
+
    -------------------------------------------------------------------------- */
 
 INFO_TABLE_RET( stg_unblockAsyncExceptionszh_ret,
                0/*framesize*/, 0/*bitmap*/, RET_SMALL )
 {
-    ASSERT(StgTSO_blocked_exceptions(CurrentTSO) != NULL);
+    // Not true: see comments above
+    // ASSERT(StgTSO_blocked_exceptions(CurrentTSO) != NULL);
 #if defined(GRAN) || defined(PAR)
     foreign "C" awakenBlockedQueue(StgTSO_blocked_exceptions(CurrentTSO) "ptr", 
                                   NULL "ptr"); 
@@ -61,7 +74,8 @@ INFO_TABLE_RET( stg_unblockAsyncExceptionszh_ret,
 INFO_TABLE_RET( stg_blockAsyncExceptionszh_ret,
                0/*framesize*/, 0/*bitmap*/, RET_SMALL )
 {
-    ASSERT(StgTSO_blocked_exceptions(CurrentTSO) == NULL);
+    // Not true: see comments above
+    // ASSERT(StgTSO_blocked_exceptions(CurrentTSO) == NULL);
     StgTSO_blocked_exceptions(CurrentTSO) = END_TSO_QUEUE;
 #ifdef REG_R1
     Sp_adj(1);
@@ -311,7 +325,7 @@ catchzh_fast
 
 INFO_TABLE(stg_raise,1,0,THUNK,"raise","raise")
 {
-  R1 = StgClosure_payload(R1,0);
+  R1 = StgThunk_payload(R1,0);
   jump raisezh_fast;
 }
 
@@ -330,7 +344,7 @@ raisezh_fast
      * the info was only displayed for an *uncaught* exception.
      */
     if (RtsFlags_ProfFlags_showCCSOnException(RtsFlags)) {
-      foreign "C" fprintCCS(stderr,W_[CCCS]);
+      foreign "C" fprintCCS_stderr(W_[CCCS] "ptr");
     }
 #endif
 
@@ -345,7 +359,7 @@ retry_pop_stack:
       W_ trec;
       W_ r;
       trec = StgTSO_trec(CurrentTSO);
-      r = foreign "C" stmValidateTransaction(trec "ptr");
+      r = foreign "C" stmValidateNestOfTransactions(trec "ptr");
       foreign "C" stmAbortTransaction(trec "ptr");
       StgTSO_trec(CurrentTSO) = NO_TREC;
       if (r) {
@@ -355,7 +369,7 @@ retry_pop_stack:
       } else {
         // Transaction was not valid: we retry the exception (otherwise continue
         // with a further call to raiseExceptionHelper)
-        "ptr" trec = foreign "C" stmStartTransaction(NO_TREC "ptr");
+        "ptr" trec = foreign "C" stmStartTransaction(BaseReg "ptr", NO_TREC "ptr");
         StgTSO_trec(CurrentTSO) = trec;
         R1 = StgAtomicallyFrame_code(Sp);
         Sp_adj(-1);