don't make -ddump-if-trace imply -no-recomp

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

diff --git a/rts/Exception.cmm b/rts/Exception.cmm
index 346c949..75f2c15 100644 (file)
--- a/rts/Exception.cmm
+++ b/rts/Exception.cmm
@@ -13,6 +13,8 @@
 #include "Cmm.h"
 #include "RaiseAsync.h"
 
+import ghczmprim_GHCziBool_True_closure;
+
 /* -----------------------------------------------------------------------------
    Exception Primitives
 
@@ -47,8 +49,7 @@
 
    -------------------------------------------------------------------------- */
 
-INFO_TABLE_RET( stg_unblockAsyncExceptionszh_ret,
-               0/*framesize*/, 0/*bitmap*/, RET_SMALL )
+INFO_TABLE_RET( stg_unblockAsyncExceptionszh_ret, RET_SMALL )
 {
     CInt r;
 
@@ -72,8 +73,16 @@ INFO_TABLE_RET( stg_unblockAsyncExceptionszh_ret,
          */
         Sp_adj(1);
 #endif
+        STK_CHK_GEN( WDS(2), R1_PTR, stg_unblockAsyncExceptionszh_ret_info);
+        Sp_adj(-2);
+        Sp(1) = R1;
+#ifdef REG_R1
+        Sp(0) = stg_gc_unpt_r1_info;
+#else
+        Sp(0) = stg_ut_1_0_unreg_info;
+#endif
         SAVE_THREAD_STATE();
-        r = foreign "C" maybePerformBlockedException (MyCapability() "ptr", 
+        (r) = foreign "C" maybePerformBlockedException (MyCapability() "ptr", 
                                                      CurrentTSO "ptr") [R1];
 
         if (r != 0::CInt) {
@@ -106,8 +115,7 @@ INFO_TABLE_RET( stg_unblockAsyncExceptionszh_ret,
 #endif
 }
 
-INFO_TABLE_RET( stg_blockAsyncExceptionszh_ret,
-               0/*framesize*/, 0/*bitmap*/, RET_SMALL )
+INFO_TABLE_RET( stg_blockAsyncExceptionszh_ret, RET_SMALL )
 {
     StgTSO_flags(CurrentTSO) = 
        StgTSO_flags(CurrentTSO) | TSO_BLOCKEX::I32 | TSO_INTERRUPTIBLE::I32;
@@ -165,7 +173,7 @@ unblockAsyncExceptionszh_fast
              * thread, which might result in the thread being killed.
              */
             SAVE_THREAD_STATE();
-            r = foreign "C" maybePerformBlockedException (MyCapability() "ptr", 
+            (r) = foreign "C" maybePerformBlockedException (MyCapability() "ptr", 
                                                      CurrentTSO "ptr") [R1];
 
             if (r != 0::CInt) {
@@ -212,6 +220,11 @@ killThreadzh_fast
      * If the exception went to a catch frame, we'll just continue from
      * the handler.
      */
+  loop:
+    if (StgTSO_what_next(target) == ThreadRelocated::I16) {
+        target = StgTSO_link(target);
+        goto loop;
+    }
     if (target == CurrentTSO) {
        SAVE_THREAD_STATE();
        /* ToDo: what if the current thread is blocking exceptions? */
@@ -229,7 +242,7 @@ killThreadzh_fast
        W_ retcode;
        out = BaseReg + OFFSET_StgRegTable_rmp_tmp_w;
        
-       retcode = foreign "C" throwTo(MyCapability() "ptr",
+       (retcode) = foreign "C" throwTo(MyCapability() "ptr",
                                      CurrentTSO "ptr",
                                      target "ptr",
                                      exception "ptr",
@@ -260,22 +273,16 @@ killThreadzh_fast
 #define SP_OFF 1
 #endif
 
-#if defined(PROFILING)
-#define CATCH_FRAME_BITMAP 7
-#define CATCH_FRAME_WORDS  4
-#else
-#define CATCH_FRAME_BITMAP 1
-#define CATCH_FRAME_WORDS  2
-#endif
-
 /* Catch frames are very similar to update frames, but when entering
  * one we just pop the frame off the stack and perform the correct
  * kind of return to the activation record underneath us on the stack.
  */
 
-INFO_TABLE_RET(stg_catch_frame,
-              CATCH_FRAME_WORDS, CATCH_FRAME_BITMAP,
-              CATCH_FRAME)
+INFO_TABLE_RET(stg_catch_frame, CATCH_FRAME,
+#if defined(PROFILING)
+  W_ unused1, W_ unused2,
+#endif
+  W_ unused3, "ptr" W_ unused4)
 #ifdef REG_R1
    {
       Sp = Sp + SIZEOF_StgCatchFrame;
@@ -347,7 +354,7 @@ section "data" {
   no_break_on_exception: W_[1];
 }
 
-INFO_TABLE_RET(stg_raise_ret, 1, 0, RET_SMALL)
+INFO_TABLE_RET(stg_raise_ret, RET_SMALL, "ptr" W_ arg1)
 {
   R1 = Sp(1);
   Sp = Sp + WDS(2);
@@ -377,7 +384,7 @@ raisezh_fast
     
 retry_pop_stack:
     StgTSO_sp(CurrentTSO) = Sp;
-    frame_type = foreign "C" raiseExceptionHelper(BaseReg "ptr", CurrentTSO "ptr", exception "ptr") [];
+    (frame_type) = foreign "C" raiseExceptionHelper(BaseReg "ptr", CurrentTSO "ptr", exception "ptr") [];
     Sp = StgTSO_sp(CurrentTSO);
     if (frame_type == ATOMICALLY_FRAME) {
       /* The exception has reached the edge of a memory transaction.  Check that 
@@ -391,8 +398,8 @@ retry_pop_stack:
       W_ trec, outer;
       W_ r;
       trec = StgTSO_trec(CurrentTSO);
-      r = foreign "C" stmValidateNestOfTransactions(trec "ptr") [];
-      "ptr" outer = foreign "C" stmGetEnclosingTRec(trec "ptr") [];
+      (r) = foreign "C" stmValidateNestOfTransactions(trec "ptr") [];
+      ("ptr" outer) = foreign "C" stmGetEnclosingTRec(trec "ptr") [];
       foreign "C" stmAbortTransaction(MyCapability() "ptr", trec "ptr") [];
       foreign "C" stmFreeAbortedTRec(MyCapability() "ptr", trec "ptr") [];
 
@@ -409,7 +416,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(MyCapability() "ptr", NO_TREC "ptr") [];
+        ("ptr" trec) = foreign "C" stmStartTransaction(MyCapability() "ptr", NO_TREC "ptr") [];
         StgTSO_trec(CurrentTSO) = trec;
         R1 = StgAtomicallyFrame_code(Sp);
         jump stg_ap_v_fast;
@@ -433,15 +440,16 @@ retry_pop_stack:
             // 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;
+            ("ptr" ioAction) = foreign "C" deRefStablePtr (W_[rts_breakpoint_io_action] "ptr") [];
+            Sp = Sp - WDS(7);
+            Sp(6) = exception;
+            Sp(5) = stg_raise_ret_info;
+            Sp(4) = stg_noforceIO_info;    // required for unregisterised
             Sp(3) = exception;             // the AP_STACK
-            Sp(2) = base_GHCziBase_True_closure; // dummy breakpoint info
-            Sp(1) = base_GHCziBase_True_closure; // True <=> a breakpoint
+            Sp(2) = ghczmprim_GHCziBool_True_closure; // dummy breakpoint info
+            Sp(1) = ghczmprim_GHCziBool_True_closure; // True <=> a breakpoint
             R1 = ioAction;
-            jump stg_ap_pppv_info;
+            jump RET_LBL(stg_ap_pppv);
         }
     }
 
@@ -491,7 +499,7 @@ retry_pop_stack:
     } else {
       W_ trec, outer;
       trec = StgTSO_trec(CurrentTSO);
-      "ptr" outer = foreign "C" stmGetEnclosingTRec(trec "ptr") [];
+      ("ptr" outer) = foreign "C" stmGetEnclosingTRec(trec "ptr") [];
       foreign "C" stmAbortTransaction(MyCapability() "ptr", trec "ptr") [];
       foreign "C" stmFreeAbortedTRec(MyCapability() "ptr", trec "ptr") [];
       StgTSO_trec(CurrentTSO) = outer;