X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=rts%2FException.cmm;h=af846928b5e22ea5e1ce906be9bc2e26672a81ed;hb=d6d7fe4976d4265dbfd6b1ad048339b8ff8f9120;hp=16b5d92b304e7eacaab452e90f0fe71d933114c5;hpb=3ce4cf858bbcae18ffc6989ca19522cb8887aab9;p=ghc-hetmet.git

diff --git a/rts/Exception.cmm b/rts/Exception.cmm
index 16b5d92..af84692 100644
--- a/rts/Exception.cmm
+++ b/rts/Exception.cmm
@@ -49,12 +49,14 @@ import ghczmprim_GHCziBool_True_closure;
 
    -------------------------------------------------------------------------- */
 
+STRING(stg_unblockAsync_err_str, "unblockAsyncExceptions#_ret")
+
 INFO_TABLE_RET( stg_unblockAsyncExceptionszh_ret, RET_SMALL )
 {
     CInt r;
 
     StgTSO_flags(CurrentTSO) = StgTSO_flags(CurrentTSO) & 
-	~(TSO_BLOCKEX::I32|TSO_INTERRUPTIBLE::I32);
+	%lobits32(~(TSO_BLOCKEX|TSO_INTERRUPTIBLE));
 
     /* Eagerly raise a blocked exception, if there is one */
     if (StgTSO_blocked_exceptions(CurrentTSO) != END_TSO_QUEUE) {
@@ -81,6 +83,14 @@ INFO_TABLE_RET( stg_unblockAsyncExceptionszh_ret, RET_SMALL )
                 jump %ENTRY_CODE(Sp(0));
             }
         }
+        else {
+            /*
+               the thread might have been removed from the
+               blocked_exception list by someone else in the meantime.
+               Just restore the stack pointer and continue.  
+            */   
+            Sp_adj(2);
+        }
     }
 
     Sp_adj(1);
@@ -89,8 +99,8 @@ INFO_TABLE_RET( stg_unblockAsyncExceptionszh_ret, RET_SMALL )
 
 INFO_TABLE_RET( stg_blockAsyncExceptionszh_ret, RET_SMALL )
 {
-    StgTSO_flags(CurrentTSO) = 
-	StgTSO_flags(CurrentTSO) | TSO_BLOCKEX::I32 | TSO_INTERRUPTIBLE::I32;
+    StgTSO_flags(CurrentTSO) = %lobits32(
+	TO_W_(StgTSO_flags(CurrentTSO)) | TSO_BLOCKEX | TSO_INTERRUPTIBLE);
 
     Sp_adj(1);
     jump %ENTRY_CODE(Sp(0));
@@ -103,8 +113,8 @@ stg_blockAsyncExceptionszh
 
     if ((TO_W_(StgTSO_flags(CurrentTSO)) & TSO_BLOCKEX) == 0) {
 	
-	StgTSO_flags(CurrentTSO) = 
-	   StgTSO_flags(CurrentTSO) | TSO_BLOCKEX::I32 | TSO_INTERRUPTIBLE::I32;
+	StgTSO_flags(CurrentTSO) = %lobits32(
+	   TO_W_(StgTSO_flags(CurrentTSO)) | TSO_BLOCKEX | TSO_INTERRUPTIBLE);
 
 	/* avoid growing the stack unnecessarily */
 	if (Sp(0) == stg_blockAsyncExceptionszh_ret_info) {
@@ -132,8 +142,8 @@ stg_unblockAsyncExceptionszh
     /* If exceptions are already unblocked, there's nothing to do */
     if ((TO_W_(StgTSO_flags(CurrentTSO)) & TSO_BLOCKEX) != 0) {
 
-	StgTSO_flags(CurrentTSO) = StgTSO_flags(CurrentTSO) & 
-	   ~(TSO_BLOCKEX::I32|TSO_INTERRUPTIBLE::I32);
+	StgTSO_flags(CurrentTSO) = %lobits32(
+           TO_W_(StgTSO_flags(CurrentTSO)) & ~(TSO_BLOCKEX|TSO_INTERRUPTIBLE));
 
 	/* avoid growing the stack unnecessarily */
 	if (Sp(0) == stg_unblockAsyncExceptionszh_ret_info) {
@@ -208,6 +218,8 @@ stg_killThreadzh
     
     /* Needs 3 words because throwToSingleThreaded uses some stack */
     STK_CHK_GEN( WDS(3), R1_PTR & R2_PTR, stg_killThreadzh);
+    /* We call allocate in throwTo(), so better check for GC */
+    MAYBE_GC(R1_PTR & R2_PTR, stg_killThreadzh);
 
     /* 
      * We might have killed ourselves.  In which case, better be *very*
@@ -242,27 +254,22 @@ stg_killThreadzh
 	}
     } else {
 	W_ out;
-	W_ retcode;
+	W_ msg;
 	out = Sp - WDS(1); /* ok to re-use stack space here */
 
-	(retcode) = foreign "C" throwTo(MyCapability() "ptr",
-				      CurrentTSO "ptr",
-				      target "ptr",
-				      exception "ptr",
-				      out "ptr") [R1,R2];
+	(msg) = foreign "C" throwTo(MyCapability() "ptr",
+                                    CurrentTSO "ptr",
+                                    target "ptr",
+                                    exception "ptr") [R1,R2];
 	
-	switch [THROWTO_SUCCESS .. THROWTO_BLOCKED] (retcode) {
-
-	case THROWTO_SUCCESS: {
+        if (msg == NULL) {
 	    jump %ENTRY_CODE(Sp(0));
-	}
-
-	case THROWTO_BLOCKED: {
-	    R3 = W_[out];
-	    // we must block, and call throwToReleaseTarget() before returning
+	} else {
+            StgTSO_why_blocked(CurrentTSO) = BlockedOnMsgThrowTo;
+            StgTSO_block_info(CurrentTSO) = msg;
+	    // we must block, and unlock the message before returning
 	    jump stg_block_throwto;
 	}
-	}
     }
 }
 
@@ -388,7 +395,7 @@ retry_pop_stack:
       W_ r;
       trec = StgTSO_trec(CurrentTSO);
       (r) = foreign "C" stmValidateNestOfTransactions(trec "ptr") [];
-      ("ptr" outer) = foreign "C" stmGetEnclosingTRec(trec "ptr") [];
+      outer  = StgTRecHeader_enclosing_trec(trec);
       foreign "C" stmAbortTransaction(MyCapability() "ptr", trec "ptr") [];
       foreign "C" stmFreeAbortedTRec(MyCapability() "ptr", trec "ptr") [];
 
@@ -488,7 +495,7 @@ retry_pop_stack:
     } else {
       W_ trec, outer;
       trec = StgTSO_trec(CurrentTSO);
-      ("ptr" outer) = foreign "C" stmGetEnclosingTRec(trec "ptr") [];
+      outer  = StgTRecHeader_enclosing_trec(trec);
       foreign "C" stmAbortTransaction(MyCapability() "ptr", trec "ptr") [];
       foreign "C" stmFreeAbortedTRec(MyCapability() "ptr", trec "ptr") [];
       StgTSO_trec(CurrentTSO) = outer;
@@ -497,8 +504,8 @@ retry_pop_stack:
 
     /* Ensure that async excpetions are blocked when running the handler.
     */
-    StgTSO_flags(CurrentTSO) = 
-	StgTSO_flags(CurrentTSO) | TSO_BLOCKEX::I32 | TSO_INTERRUPTIBLE::I32;
+    StgTSO_flags(CurrentTSO) = %lobits32(
+	TO_W_(StgTSO_flags(CurrentTSO)) | TSO_BLOCKEX | TSO_INTERRUPTIBLE);
 
     /* Call the handler, passing the exception value and a realworld
      * token as arguments.