New syntax for GADT-style record declarations, and associated refactoring

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

diff --git a/rts/Exception.cmm b/rts/Exception.cmm
index 479c9c9..f0eae98 100644 (file)
--- a/rts/Exception.cmm
+++ b/rts/Exception.cmm
@@ -124,20 +124,43 @@ unblockAsyncExceptionszh_fast
     CInt r;
 
     /* Args: R1 :: IO a */
-    STK_CHK_GEN( WDS(2), R1_PTR, unblockAsyncExceptionszh_fast);
+    STK_CHK_GEN( WDS(4), R1_PTR, unblockAsyncExceptionszh_fast);
+    /* 4 words: one for the unblock frame, 3 for setting up the
+     * stack to call maybePerformBlockedException() below.
+     */
 
+    /* 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);
 
+       /* avoid growing the stack unnecessarily */
+       if (Sp(0) == stg_unblockAsyncExceptionszh_ret_info) {
+           Sp_adj(1);
+       } else {
+           Sp_adj(-1);
+           Sp(0) = stg_blockAsyncExceptionszh_ret_info;
+       }
+
         /* Eagerly raise a blocked exception, if there is one */
         if (StgTSO_blocked_exceptions(CurrentTSO) != END_TSO_QUEUE) {
             /* 
              * We have to be very careful here, as in killThread#, since
              * we are about to raise an async exception in the current
              * thread, which might result in the thread being killed.
+             *
+             * Now, if we are to raise an exception in the current
+             * thread, there might be an update frame above us on the
+             * stack due to unsafePerformIO.  Hence, the stack must
+             * make sense, because it is about to be snapshotted into
+             * an AP_STACK.
              */
+            Sp_adj(-3);
+            Sp(2) = stg_ap_v_info;
+            Sp(1) = R1;
+            Sp(0) = stg_enter_info;
+
             SAVE_THREAD_STATE();
             (r) = foreign "C" maybePerformBlockedException (MyCapability() "ptr", 
                                                      CurrentTSO "ptr") [R1];
@@ -150,16 +173,12 @@ unblockAsyncExceptionszh_fast
                    ASSERT(StgTSO_what_next(CurrentTSO) == ThreadRunGHC::I16);
                    jump %ENTRY_CODE(Sp(0));
                }
+            } else {
+                /* we'll just call R1 directly, below */
+                Sp_adj(3);
             }
         }
 
-       /* avoid growing the stack unnecessarily */
-       if (Sp(0) == stg_unblockAsyncExceptionszh_ret_info) {
-           Sp_adj(1);
-       } else {
-           Sp_adj(-1);
-           Sp(0) = stg_blockAsyncExceptionszh_ret_info;
-       }
     }
     TICK_UNKNOWN_CALL();
     TICK_SLOW_CALL_v();
@@ -187,6 +206,7 @@ killThreadzh_fast
     target = R1;
     exception = R2;
     
+    /* Needs 3 words because throwToSingleThreaded uses some stack */
     STK_CHK_GEN( WDS(3), R1_PTR & R2_PTR, killThreadzh_fast);
 
     /* 
@@ -201,6 +221,14 @@ killThreadzh_fast
         goto loop;
     }
     if (target == CurrentTSO) {
+        /*
+         * So what should happen if a thread calls "throwTo self" inside
+         * unsafePerformIO, and later the closure is evaluated by another
+         * thread?  Presumably it should behave as if throwTo just returned,
+         * and then continue from there.  See #3279, #3288.  This is what
+         * happens: on resumption, we will just jump to the next frame on
+         * the stack, which is the return point for killThreadzh_fast.
+         */
        SAVE_THREAD_STATE();
        /* ToDo: what if the current thread is blocking exceptions? */
        foreign "C" throwToSingleThreaded(MyCapability() "ptr", 
@@ -215,8 +243,8 @@ killThreadzh_fast
     } else {
        W_ out;
        W_ retcode;
-       out = BaseReg + OFFSET_StgRegTable_rmp_tmp_w;
-       
+       out = Sp - WDS(1); /* ok to re-use stack space here */
+
        (retcode) = foreign "C" throwTo(MyCapability() "ptr",
                                      CurrentTSO "ptr",
                                      target "ptr",
@@ -253,7 +281,7 @@ INFO_TABLE_RET(stg_catch_frame, CATCH_FRAME,
 #if defined(PROFILING)
   W_ unused1, W_ unused2,
 #endif
-  W_ unused3, "ptr" W_ unused4)
+  W_ unused3, P_ unused4)
    {
       Sp = Sp + SIZEOF_StgCatchFrame;
       jump %ENTRY_CODE(Sp(SP_OFF));
@@ -315,7 +343,7 @@ section "data" {
   no_break_on_exception: W_[1];
 }
 
-INFO_TABLE_RET(stg_raise_ret, RET_SMALL, "ptr" W_ arg1)
+INFO_TABLE_RET(stg_raise_ret, RET_SMALL, P_ arg1)
 {
   R1 = Sp(1);
   Sp = Sp + WDS(2);