From 3145ceb37bf202a276206d76a7b86ff74a45afed Mon Sep 17 00:00:00 2001 From: simonmar Date: Thu, 13 Jan 2005 16:08:23 +0000 Subject: [PATCH] [project @ 2005-01-13 16:08:22 by simonmar] Fix up STM when compiling unregisterised. There were a few wibbles with the stack layout. --- ghc/rts/PrimOps.cmm | 194 ++++++++++++++++++++++++++------------------------- ghc/rts/Schedule.c | 14 +++- 2 files changed, 112 insertions(+), 96 deletions(-) diff --git a/ghc/rts/PrimOps.cmm b/ghc/rts/PrimOps.cmm index e50b17f..c647b48 100644 --- a/ghc/rts/PrimOps.cmm +++ b/ghc/rts/PrimOps.cmm @@ -915,47 +915,17 @@ isCurrentThreadBoundzh_fast // Catch retry frame ------------------------------------------------------------ - -#define CATCH_RETRY_FRAME_ENTRY_TEMPLATE(label,ret) \ - label \ - { \ - W_ r, frame, trec, outer; \ - IF_NOT_REG_R1(W_ rval; rval = Sp(0); Sp_adj(1); ) \ - \ - frame = Sp; \ - trec = StgTSO_trec(CurrentTSO); \ - "ptr" outer = foreign "C" stmGetEnclosingTRec(trec "ptr"); \ - r = foreign "C" stmCommitTransaction(trec "ptr"); \ - if (r) { \ - /* Succeeded (either first branch or second branch) */ \ - StgTSO_trec(CurrentTSO) = outer; \ - Sp = Sp + SIZEOF_StgCatchRetryFrame; \ - IF_NOT_REG_R1(Sp_adj(-1); Sp(0) = rval;) \ - jump ret; \ - } else { \ - /* Did not commit: retry */ \ - W_ new_trec; \ - "ptr" new_trec = foreign "C" stmStartTransaction(outer "ptr"); \ - StgTSO_trec(CurrentTSO) = new_trec; \ - if (StgCatchRetryFrame_running_alt_code(frame)) { \ - R1 = StgCatchRetryFrame_alt_code(frame); \ - } else { \ - R1 = StgCatchRetryFrame_first_code(frame); \ - StgCatchRetryFrame_first_code_trec(frame) = new_trec; \ - } \ - Sp_adj(-1); \ - jump RET_LBL(stg_ap_v); \ - } \ - } - -CATCH_RETRY_FRAME_ENTRY_TEMPLATE(stg_catch_retry_frame_0_ret,%RET_VEC(Sp(SP_OFF),0)) -CATCH_RETRY_FRAME_ENTRY_TEMPLATE(stg_catch_retry_frame_1_ret,%RET_VEC(Sp(SP_OFF),1)) -CATCH_RETRY_FRAME_ENTRY_TEMPLATE(stg_catch_retry_frame_2_ret,%RET_VEC(Sp(SP_OFF),2)) -CATCH_RETRY_FRAME_ENTRY_TEMPLATE(stg_catch_retry_frame_3_ret,%RET_VEC(Sp(SP_OFF),3)) -CATCH_RETRY_FRAME_ENTRY_TEMPLATE(stg_catch_retry_frame_4_ret,%RET_VEC(Sp(SP_OFF),4)) -CATCH_RETRY_FRAME_ENTRY_TEMPLATE(stg_catch_retry_frame_5_ret,%RET_VEC(Sp(SP_OFF),5)) -CATCH_RETRY_FRAME_ENTRY_TEMPLATE(stg_catch_retry_frame_6_ret,%RET_VEC(Sp(SP_OFF),6)) -CATCH_RETRY_FRAME_ENTRY_TEMPLATE(stg_catch_retry_frame_7_ret,%RET_VEC(Sp(SP_OFF),7)) +#define CATCH_RETRY_FRAME_ERROR(label) \ + label { foreign "C" barf("catch_retry_frame incorrectly entered!"); } + +CATCH_RETRY_FRAME_ERROR(stg_catch_retry_frame_0_ret) +CATCH_RETRY_FRAME_ERROR(stg_catch_retry_frame_1_ret) +CATCH_RETRY_FRAME_ERROR(stg_catch_retry_frame_2_ret) +CATCH_RETRY_FRAME_ERROR(stg_catch_retry_frame_3_ret) +CATCH_RETRY_FRAME_ERROR(stg_catch_retry_frame_4_ret) +CATCH_RETRY_FRAME_ERROR(stg_catch_retry_frame_5_ret) +CATCH_RETRY_FRAME_ERROR(stg_catch_retry_frame_6_ret) +CATCH_RETRY_FRAME_ERROR(stg_catch_retry_frame_7_ret) #if MAX_VECTORED_RTN > 8 #error MAX_VECTORED_RTN has changed: please modify stg_catch_retry_frame too. @@ -980,64 +950,51 @@ INFO_TABLE_RET(stg_catch_retry_frame, stg_catch_retry_frame_5_ret, stg_catch_retry_frame_6_ret, stg_catch_retry_frame_7_ret) -CATCH_RETRY_FRAME_ENTRY_TEMPLATE(,%ENTRY_CODE(Sp(SP_OFF))) - +{ + W_ r, frame, trec, outer; + IF_NOT_REG_R1(W_ rval; rval = Sp(0); Sp_adj(1); ) + + frame = Sp; + trec = StgTSO_trec(CurrentTSO); + "ptr" outer = foreign "C" stmGetEnclosingTRec(trec "ptr"); + r = foreign "C" stmCommitTransaction(trec "ptr"); + if (r) { + /* Succeeded (either first branch or second branch) */ + StgTSO_trec(CurrentTSO) = outer; + Sp = Sp + SIZEOF_StgCatchRetryFrame; + IF_NOT_REG_R1(Sp_adj(-1); Sp(0) = rval;) + jump %ENTRY_CODE(Sp(SP_OFF)); + } else { + /* Did not commit: retry */ + W_ new_trec; + "ptr" new_trec = foreign "C" stmStartTransaction(outer "ptr"); + StgTSO_trec(CurrentTSO) = new_trec; + if (StgCatchRetryFrame_running_alt_code(frame)) { + R1 = StgCatchRetryFrame_alt_code(frame); + } else { + R1 = StgCatchRetryFrame_first_code(frame); + StgCatchRetryFrame_first_code_trec(frame) = new_trec; + } + Sp_adj(-1); + jump RET_LBL(stg_ap_v); + } +} // Atomically frame ------------------------------------------------------------- -#define ATOMICALLY_FRAME_ENTRY_TEMPLATE(label,ret) \ - label \ - { \ - W_ frame, trec, valid; \ - IF_NOT_REG_R1(W_ rval; rval = Sp(0); Sp_adj(1); ) \ - \ - frame = Sp; \ - trec = StgTSO_trec(CurrentTSO); \ - if (StgAtomicallyFrame_waiting(frame)) { \ - /* The TSO is currently waiting: should we stop waiting? */ \ - valid = foreign "C" stmReWait(CurrentTSO "ptr"); \ - if (valid) { \ - /* Previous attempt is still valid: no point trying again yet */ \ - IF_NOT_REG_R1(Sp_adj(-1); Sp(0) = rval;) \ - jump stg_block_noregs; \ - } else { \ - /* Previous attempt is no longer valid: try again */ \ - "ptr" trec = foreign "C" stmStartTransaction(NO_TREC "ptr"); \ - StgTSO_trec(CurrentTSO) = trec; \ - StgAtomicallyFrame_waiting(frame) = 0 :: CInt; /* false; */ \ - R1 = StgAtomicallyFrame_code(frame); \ - Sp_adj(-1); \ - jump RET_LBL(stg_ap_v); \ - } \ - } else { \ - /* The TSO is not currently waiting: try to commit the transaction */ \ - valid = foreign "C" stmCommitTransaction(trec "ptr"); \ - if (valid) { \ - /* Transaction was valid: commit succeeded */ \ - StgTSO_trec(CurrentTSO) = NO_TREC; \ - Sp = Sp + SIZEOF_StgAtomicallyFrame; \ - IF_NOT_REG_R1(Sp_adj(-1); Sp(0) = rval;) \ - jump ret; \ - } else { \ - /* Transaction was not valid: try again */ \ - "ptr" trec = foreign "C" stmStartTransaction(NO_TREC "ptr"); \ - StgTSO_trec(CurrentTSO) = trec; \ - R1 = StgAtomicallyFrame_code(frame); \ - Sp_adj(-1); \ - jump RET_LBL(stg_ap_v); \ - } \ - } \ - } -ATOMICALLY_FRAME_ENTRY_TEMPLATE(stg_atomically_frame_0_ret,%RET_VEC(Sp(SP_OFF),0)) -ATOMICALLY_FRAME_ENTRY_TEMPLATE(stg_atomically_frame_1_ret,%RET_VEC(Sp(SP_OFF),1)) -ATOMICALLY_FRAME_ENTRY_TEMPLATE(stg_atomically_frame_2_ret,%RET_VEC(Sp(SP_OFF),2)) -ATOMICALLY_FRAME_ENTRY_TEMPLATE(stg_atomically_frame_3_ret,%RET_VEC(Sp(SP_OFF),3)) -ATOMICALLY_FRAME_ENTRY_TEMPLATE(stg_atomically_frame_4_ret,%RET_VEC(Sp(SP_OFF),4)) -ATOMICALLY_FRAME_ENTRY_TEMPLATE(stg_atomically_frame_5_ret,%RET_VEC(Sp(SP_OFF),5)) -ATOMICALLY_FRAME_ENTRY_TEMPLATE(stg_atomically_frame_6_ret,%RET_VEC(Sp(SP_OFF),6)) -ATOMICALLY_FRAME_ENTRY_TEMPLATE(stg_atomically_frame_7_ret,%RET_VEC(Sp(SP_OFF),7)) +#define ATOMICALLY_FRAME_ERROR(label) \ + label { foreign "C" barf("atomically_frame incorrectly entered!"); } + +ATOMICALLY_FRAME_ERROR(stg_atomically_frame_0_ret) +ATOMICALLY_FRAME_ERROR(stg_atomically_frame_1_ret) +ATOMICALLY_FRAME_ERROR(stg_atomically_frame_2_ret) +ATOMICALLY_FRAME_ERROR(stg_atomically_frame_3_ret) +ATOMICALLY_FRAME_ERROR(stg_atomically_frame_4_ret) +ATOMICALLY_FRAME_ERROR(stg_atomically_frame_5_ret) +ATOMICALLY_FRAME_ERROR(stg_atomically_frame_6_ret) +ATOMICALLY_FRAME_ERROR(stg_atomically_frame_7_ret) #if MAX_VECTORED_RTN > 8 #error MAX_VECTORED_RTN has changed: please modify stg_atomically_frame too. @@ -1051,6 +1008,7 @@ ATOMICALLY_FRAME_ENTRY_TEMPLATE(stg_atomically_frame_7_ret,%RET_VEC(Sp(SP_OFF),7 #define ATOMICALLY_FRAME_WORDS 2 #endif + INFO_TABLE_RET(stg_atomically_frame, ATOMICALLY_FRAME_WORDS, ATOMICALLY_FRAME_BITMAP, ATOMICALLY_FRAME, @@ -1062,7 +1020,49 @@ INFO_TABLE_RET(stg_atomically_frame, stg_atomically_frame_5_ret, stg_atomically_frame_6_ret, stg_atomically_frame_7_ret) -ATOMICALLY_FRAME_ENTRY_TEMPLATE(,%ENTRY_CODE(Sp(SP_OFF))) +{ + W_ frame, trec, valid; + IF_NOT_REG_R1(W_ rval; rval = Sp(0); Sp_adj(1); ) + + frame = Sp; + trec = StgTSO_trec(CurrentTSO); + if (StgAtomicallyFrame_waiting(frame)) { + /* The TSO is currently waiting: should we stop waiting? */ + valid = foreign "C" stmReWait(CurrentTSO "ptr"); + if (valid) { + /* Previous attempt is still valid: no point trying again yet */ + IF_NOT_REG_R1(Sp_adj(-2); + Sp(1) = stg_NO_FINALIZER_closure; + Sp(0) = stg_ut_1_0_unreg_info;) + jump stg_block_noregs; + } else { + /* Previous attempt is no longer valid: try again */ + "ptr" trec = foreign "C" stmStartTransaction(NO_TREC "ptr"); + StgTSO_trec(CurrentTSO) = trec; + StgAtomicallyFrame_waiting(frame) = 0 :: CInt; /* false; */ + R1 = StgAtomicallyFrame_code(frame); + Sp_adj(-1); + jump RET_LBL(stg_ap_v); + } + } else { + /* The TSO is not currently waiting: try to commit the transaction */ + valid = foreign "C" stmCommitTransaction(trec "ptr"); + if (valid) { + /* Transaction was valid: commit succeeded */ + StgTSO_trec(CurrentTSO) = NO_TREC; + Sp = Sp + SIZEOF_StgAtomicallyFrame; + IF_NOT_REG_R1(Sp_adj(-1); Sp(0) = rval;) + jump %ENTRY_CODE(Sp(SP_OFF)); + } else { + /* Transaction was not valid: try again */ + "ptr" trec = foreign "C" stmStartTransaction(NO_TREC "ptr"); + StgTSO_trec(CurrentTSO) = trec; + R1 = StgAtomicallyFrame_code(frame); + Sp_adj(-1); + jump RET_LBL(stg_ap_v); + } + } +} // STM catch frame -------------------------------------------------------------- @@ -1269,6 +1269,10 @@ retry_pop_stack: // Transaction was valid: stmWait put us on the TVars' queues, we now block StgAtomicallyFrame_waiting(frame) = 1 :: CInt; // true Sp = frame; + // Fix up the stack in the unregisterised case: the return convention is different. + IF_NOT_REG_R1(Sp_adj(-2); + Sp(1) = stg_NO_FINALIZER_closure; + Sp(0) = stg_ut_1_0_unreg_info;) jump stg_block_noregs; } else { // Transaction was not valid: retry immediately diff --git a/ghc/rts/Schedule.c b/ghc/rts/Schedule.c index 4615c88..6aedb8f 100644 --- a/ghc/rts/Schedule.c +++ b/ghc/rts/Schedule.c @@ -1343,7 +1343,9 @@ run_thread: // partially-evaluated thunks on the heap. raiseAsync_(t, NULL, rtsTrue); +#ifdef REG_R1 ASSERT(get_itbl((StgClosure *)t->sp)->type == ATOMICALLY_FRAME); +#endif } } } @@ -3110,7 +3112,17 @@ raiseAsync_(StgTSO *tso, StgClosure *exception, rtsBool stop_at_atomically) ASSERT(stop_at_atomically); ASSERT(stmGetEnclosingTRec(tso->trec) == NO_TREC); stmCondemnTransaction(tso -> trec); +#ifdef REG_R1 tso->sp = frame; +#else + // R1 is not a register: the return convention for IO in + // this case puts the return value on the stack, so we + // need to set up the stack to return to the atomically + // frame properly... + tso->sp = frame - 2; + tso->sp[1] = (StgWord) &stg_NO_FINALIZER_closure; // why not? + tso->sp[0] = (StgWord) &stg_ut_1_0_unreg_info; +#endif tso->what_next = ThreadRunGHC; return; @@ -3352,7 +3364,7 @@ findRetryFrameHelper (StgTSO *tso) } } } - + /* ----------------------------------------------------------------------------- resurrectThreads is called after garbage collection on the list of threads found to be garbage. Each of these threads will be woken -- 1.7.10.4