diff options
| -rw-r--r-- | rts/PrimOps.cmm | 54 | ||||
| -rw-r--r-- | rts/Schedule.c | 66 | ||||
| -rw-r--r-- | rts/Schedule.h | 3 |
3 files changed, 103 insertions, 20 deletions
diff --git a/rts/PrimOps.cmm b/rts/PrimOps.cmm index d06cde05d9..ec35ee42b4 100644 --- a/rts/PrimOps.cmm +++ b/rts/PrimOps.cmm @@ -1032,6 +1032,37 @@ stg_threadStatuszh ( gcptr tso ) * TVar primitives * -------------------------------------------------------------------------- */ +stg_abort /* no arg list: explicit stack layout */ +{ + W_ frame_type; + W_ frame; + W_ trec; + W_ outer; + W_ r; + + // STM operations may allocate + MAYBE_GC_ (stg_abort); // NB. not MAYBE_GC(), we cannot make a + // function call in an explicit-stack proc + + // Find the enclosing ATOMICALLY_FRAME + SAVE_THREAD_STATE(); + (frame_type) = ccall findAtomicallyFrameHelper(MyCapability(), CurrentTSO "ptr"); + LOAD_THREAD_STATE(); + frame = Sp; + trec = StgTSO_trec(CurrentTSO); + outer = StgTRecHeader_enclosing_trec(trec); + + // We've reached the ATOMICALLY_FRAME + ASSERT(frame_type == ATOMICALLY_FRAME); + ASSERT(outer == NO_TREC); + + // Restart the transaction. + ("ptr" trec) = ccall stmStartTransaction(MyCapability() "ptr", outer "ptr"); + StgTSO_trec(CurrentTSO) = trec; + Sp = frame; + R1 = StgAtomicallyFrame_code(frame); + jump stg_ap_v_fast [R1]; +} // Catch retry frame ----------------------------------------------------------- #define CATCH_RETRY_FRAME_FIELDS(w_,p_,info_ptr, \ @@ -1066,26 +1097,9 @@ INFO_TABLE_RET(stg_catch_retry_frame, CATCH_RETRY_FRAME, StgTSO_trec(CurrentTSO) = outer; return (ret); } else { - // Did not commit: re-execute - P_ new_trec; - ("ptr" new_trec) = ccall stmStartTransaction(MyCapability() "ptr", - outer "ptr"); - StgTSO_trec(CurrentTSO) = new_trec; - if (running_alt_code != 0) { - jump stg_ap_v_fast - (CATCH_RETRY_FRAME_FIELDS(,,info_ptr, p1, p2, - running_alt_code, - first_code, - alt_code)) - (alt_code); - } else { - jump stg_ap_v_fast - (CATCH_RETRY_FRAME_FIELDS(,,info_ptr, p1, p2, - running_alt_code, - first_code, - alt_code)) - (first_code); - } + // Did not commit: abort and restart. + StgTSO_trec(CurrentTSO) = outer; + jump stg_abort(); } } diff --git a/rts/Schedule.c b/rts/Schedule.c index 7ffd44d22f..eced4d4fb6 100644 --- a/rts/Schedule.c +++ b/rts/Schedule.c @@ -2999,6 +2999,72 @@ findRetryFrameHelper (Capability *cap, StgTSO *tso) } /* ----------------------------------------------------------------------------- + findAtomicallyFrameHelper + + This function is called by stg_abort via catch_retry_frame primitive. It is + like findRetryFrameHelper but it will only stop at ATOMICALLY_FRAME. + -------------------------------------------------------------------------- */ + +StgWord +findAtomicallyFrameHelper (Capability *cap, StgTSO *tso) +{ + const StgRetInfoTable *info; + StgPtr p, next; + + p = tso->stackobj->sp; + while (1) { + info = get_ret_itbl((const StgClosure *)p); + next = p + stack_frame_sizeW((StgClosure *)p); + switch (info->i.type) { + + case ATOMICALLY_FRAME: + debugTrace(DEBUG_stm, + "found ATOMICALLY_FRAME at %p while aborting after orElse", p); + tso->stackobj->sp = p; + return ATOMICALLY_FRAME; + + case CATCH_RETRY_FRAME: { + StgTRecHeader *trec = tso -> trec; + StgTRecHeader *outer = trec -> enclosing_trec; + debugTrace(DEBUG_stm, + "found CATCH_RETRY_FRAME at %p while aborting after orElse", p); + debugTrace(DEBUG_stm, "trec=%p outer=%p", trec, outer); + stmAbortTransaction(cap, trec); + stmFreeAbortedTRec(cap, trec); + tso -> trec = outer; + p = next; + continue; + } + + case CATCH_STM_FRAME: { + StgTRecHeader *trec = tso -> trec; + StgTRecHeader *outer = trec -> enclosing_trec; + debugTrace(DEBUG_stm, + "found CATCH_STM_FRAME at %p while aborting after orElse", p); + debugTrace(DEBUG_stm, "trec=%p outer=%p", trec, outer); + stmAbortTransaction(cap, trec); + stmFreeAbortedTRec(cap, trec); + tso -> trec = outer; + p = next; + continue; + } + + case UNDERFLOW_FRAME: + tso->stackobj->sp = p; + threadStackUnderflow(cap,tso); + p = tso->stackobj->sp; + continue; + + default: + ASSERT(info->i.type != CATCH_FRAME); + ASSERT(info->i.type != STOP_FRAME); + p = next; + continue; + } + } +} + +/* ----------------------------------------------------------------------------- resurrectThreads is called after garbage collection on the list of threads found to be garbage. Each of these threads will be woken up and sent a signal: BlockedOnDeadMVar if the thread was blocked diff --git a/rts/Schedule.h b/rts/Schedule.h index 66cf8391f3..3197980041 100644 --- a/rts/Schedule.h +++ b/rts/Schedule.h @@ -46,6 +46,9 @@ StgWord raiseExceptionHelper (StgRegTable *reg, StgTSO *tso, StgClosure *excepti /* findRetryFrameHelper */ StgWord findRetryFrameHelper (Capability *cap, StgTSO *tso); +/* findAtomicallyFrameHelper */ +StgWord findAtomicallyFrameHelper (Capability *cap, StgTSO *tso); + /* Entry point for a new worker */ void scheduleWorker (Capability *cap, Task *task); |