X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=rts%2FException.cmm;h=daa8e4fd7ffa1f83cdddc603496db009ebc5af34;hb=9d03becc597e5b1ab6c8466209a1263bf8ba6f29;hp=a0a6db4fc7c9ef2c8d3bbdac58a63b5421a501a0;hpb=d31dfb32ea936c22628b508c28a36c12e631430a;p=ghc-hetmet.git diff --git a/rts/Exception.cmm b/rts/Exception.cmm index a0a6db4..daa8e4f 100644 --- 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 @@ -210,6 +212,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? */ @@ -426,14 +433,15 @@ retry_pop_stack: // 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 = 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); } }