X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Frts%2FPrimOps.cmm;h=01b4138bcdccfbb1845699df8c659d9cbbfa1996;hb=da69fa9c5047c5b0d05bdb05eaddefa1eb5d5a36;hp=b25a1e563d1ab382cbed617e0416aaf9c6addecf;hpb=afd08a9c06ae4b15e33e26e5a2818801c7fee429;p=ghc-hetmet.git diff --git a/ghc/rts/PrimOps.cmm b/ghc/rts/PrimOps.cmm index b25a1e5..01b4138 100644 --- a/ghc/rts/PrimOps.cmm +++ b/ghc/rts/PrimOps.cmm @@ -100,7 +100,7 @@ newArrayzh_fast "ptr" arr = foreign "C" allocateLocal(MyCapability() "ptr",words) []; TICK_ALLOC_PRIM(SIZEOF_StgMutArrPtrs, WDS(n), 0); - SET_HDR(arr, stg_MUT_ARR_PTRS_info, W_[CCCS]); + SET_HDR(arr, stg_MUT_ARR_PTRS_DIRTY_info, W_[CCCS]); StgMutArrPtrs_ptrs(arr) = n; // Initialise all elements of the the array with the value in R2 @@ -137,12 +137,12 @@ unsafeThawArrayzh_fast // multiple times during GC, which would be unnecessarily slow. // if (StgHeader_info(R1) != stg_MUT_ARR_PTRS_FROZEN0_info) { - SET_INFO(R1,stg_MUT_ARR_PTRS_info); + SET_INFO(R1,stg_MUT_ARR_PTRS_DIRTY_info); foreign "C" recordMutableLock(R1 "ptr") [R1]; // must be done after SET_INFO, because it ASSERTs closure_MUTABLE() RET_P(R1); } else { - SET_INFO(R1,stg_MUT_ARR_PTRS_info); + SET_INFO(R1,stg_MUT_ARR_PTRS_DIRTY_info); RET_P(R1); } } @@ -1021,11 +1021,11 @@ ATOMICALLY_FRAME_ERROR(stg_atomically_frame_7_ret) #endif #if defined(PROFILING) -#define ATOMICALLY_FRAME_BITMAP 7 -#define ATOMICALLY_FRAME_WORDS 4 +#define ATOMICALLY_FRAME_BITMAP 3 +#define ATOMICALLY_FRAME_WORDS 3 #else -#define ATOMICALLY_FRAME_BITMAP 1 -#define ATOMICALLY_FRAME_WORDS 2 +#define ATOMICALLY_FRAME_BITMAP 0 +#define ATOMICALLY_FRAME_WORDS 1 #endif @@ -1041,50 +1041,66 @@ INFO_TABLE_RET(stg_atomically_frame, stg_atomically_frame_6_ret, stg_atomically_frame_7_ret) { - W_ frame, trec, valid; - IF_NOT_REG_R1(W_ rval; rval = Sp(0); Sp_adj(1); ) + 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(MyCapability() "ptr", CurrentTSO "ptr"); - if (valid) { - /* Previous attempt is still valid: no point trying again yet */ + frame = Sp; + trec = StgTSO_trec(CurrentTSO); + + /* The TSO is not currently waiting: try to commit the transaction */ + valid = foreign "C" stmCommitTransaction(MyCapability() "ptr", 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(MyCapability() "ptr", NO_TREC "ptr"); + StgTSO_trec(CurrentTSO) = trec; + R1 = StgAtomicallyFrame_code(frame); + Sp_adj(-1); + jump RET_LBL(stg_ap_v); + } +} + +INFO_TABLE_RET(stg_atomically_waiting_frame, + ATOMICALLY_FRAME_WORDS, ATOMICALLY_FRAME_BITMAP, + ATOMICALLY_FRAME, + stg_atomically_frame_0_ret, + stg_atomically_frame_1_ret, + stg_atomically_frame_2_ret, + stg_atomically_frame_3_ret, + stg_atomically_frame_4_ret, + stg_atomically_frame_5_ret, + stg_atomically_frame_6_ret, + stg_atomically_frame_7_ret) +{ + W_ frame, trec, valid; + IF_NOT_REG_R1(W_ rval; rval = Sp(0); Sp_adj(1); ) + + frame = Sp; + + /* The TSO is currently waiting: should we stop waiting? */ + valid = foreign "C" stmReWait(MyCapability() "ptr", 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(MyCapability() "ptr", 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(MyCapability() "ptr", 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(MyCapability() "ptr", NO_TREC "ptr"); - StgTSO_trec(CurrentTSO) = trec; - R1 = StgAtomicallyFrame_code(frame); - Sp_adj(-1); - jump RET_LBL(stg_ap_v); - } - } + jump stg_block_noregs; + } else { + /* Previous attempt is no longer valid: try again */ + "ptr" trec = foreign "C" stmStartTransaction(MyCapability() "ptr", NO_TREC "ptr"); + StgTSO_trec(CurrentTSO) = trec; + StgHeader_info(frame) = stg_atomically_frame_info; + R1 = StgAtomicallyFrame_code(frame); + Sp_adj(-1); + jump RET_LBL(stg_ap_v); + } } - // STM catch frame -------------------------------------------------------------- #define CATCH_STM_FRAME_ENTRY_TEMPLATE(label,ret) \ @@ -1156,17 +1172,22 @@ atomicallyzh_fast /* Args: R1 = m :: STM a */ STK_CHK_GEN(SIZEOF_StgAtomicallyFrame + WDS(1), R1_PTR, atomicallyzh_fast); + old_trec = StgTSO_trec(CurrentTSO); + + /* Nested transactions are not allowed; raise an exception */ + if (old_trec != NO_TREC) { + R1 = GHCziIOBase_NestedAtomically_closure; + jump raisezh_fast; + } + /* Set up the atomically frame */ Sp = Sp - SIZEOF_StgAtomicallyFrame; frame = Sp; SET_HDR(frame,stg_atomically_frame_info, W_[CCCS]); - StgAtomicallyFrame_waiting(frame) = 0 :: CInt; // False StgAtomicallyFrame_code(frame) = R1; /* Start the memory transcation */ - old_trec = StgTSO_trec(CurrentTSO); - ASSERT(old_trec == NO_TREC); "ptr" new_trec = foreign "C" stmStartTransaction(MyCapability() "ptr", old_trec "ptr"); StgTSO_trec(CurrentTSO) = new_trec; @@ -1296,7 +1317,7 @@ retry_pop_stack: r = foreign "C" stmWait(MyCapability() "ptr", CurrentTSO "ptr", trec "ptr"); if (r) { // Transaction was valid: stmWait put us on the TVars' queues, we now block - StgAtomicallyFrame_waiting(frame) = 1 :: CInt; // true + StgHeader_info(frame) = stg_atomically_waiting_frame_info; Sp = frame; // Fix up the stack in the unregisterised case: the return convention is different. IF_NOT_REG_R1(Sp_adj(-2);