X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=rts%2FPrimOps.cmm;h=5c9cfb75ad87ab00c3440bc4612993497a2db5f3;hb=6cec61d14a324285dbb8ce73d4c7215f1f8d6766;hp=0cf26b2b7fbd957a473aea1b86e7552510433f8e;hpb=608311e931b84dc49f6b57bbda85b83c4878baf4;p=ghc-hetmet.git diff --git a/rts/PrimOps.cmm b/rts/PrimOps.cmm index 0cf26b2..5c9cfb7 100644 --- a/rts/PrimOps.cmm +++ b/rts/PrimOps.cmm @@ -1,6 +1,6 @@ /* ----------------------------------------------------------------------------- * - * (c) The GHC Team, 1998-2004 + * (c) The GHC Team, 1998-2011 * * Out-of-line primitive operations * @@ -230,6 +230,25 @@ stg_newMutVarzh RET_P(mv); } +stg_casMutVarzh + /* MutVar# s a -> a -> a -> State# s -> (# State#, Int#, a #) */ +{ + W_ mv, old, new, h; + + mv = R1; + old = R2; + new = R3; + + (h) = foreign "C" cas(mv + SIZEOF_StgHeader + OFFSET_StgMutVar_var, + old, new) []; + if (h != old) { + RET_NP(1,h); + } else { + RET_NP(0,h); + } +} + + stg_atomicModifyMutVarzh { W_ mv, f, z, x, y, r, h; @@ -631,14 +650,9 @@ stg_threadStatuszh W_ tso; W_ why_blocked; W_ what_next; - W_ ret; + W_ ret, cap, locked; tso = R1; - loop: - if (TO_W_(StgTSO_what_next(tso)) == ThreadRelocated) { - tso = StgTSO__link(tso); - goto loop; - } what_next = TO_W_(StgTSO_what_next(tso)); why_blocked = TO_W_(StgTSO_why_blocked(tso)); @@ -656,7 +670,16 @@ stg_threadStatuszh ret = why_blocked; } } - RET_N(ret); + + cap = TO_W_(Capability_no(StgTSO_cap(tso))); + + if ((TO_W_(StgTSO_flags(tso)) & TSO_LOCKED) != 0) { + locked = 1; + } else { + locked = 0; + } + + RET_NNN(ret,cap,locked); } /* ----------------------------------------------------------------------------- @@ -939,9 +962,9 @@ stg_retryzh // Find the enclosing ATOMICALLY_FRAME or CATCH_RETRY_FRAME retry_pop_stack: - StgTSO_sp(CurrentTSO) = Sp; - (frame_type) = foreign "C" findRetryFrameHelper(CurrentTSO "ptr") []; - Sp = StgTSO_sp(CurrentTSO); + SAVE_THREAD_STATE(); + (frame_type) = foreign "C" findRetryFrameHelper(MyCapability(), CurrentTSO "ptr") []; + LOAD_THREAD_STATE(); frame = Sp; trec = StgTSO_trec(CurrentTSO); outer = StgTRecHeader_enclosing_trec(trec); @@ -1138,13 +1161,17 @@ stg_newMVarzh } -#define PerformTake(tso, value) \ - W_[StgTSO_sp(tso) + WDS(1)] = value; \ - W_[StgTSO_sp(tso) + WDS(0)] = stg_gc_unpt_r1_info; +#define PerformTake(stack, value) \ + W_ sp; \ + sp = StgStack_sp(stack); \ + W_[sp + WDS(1)] = value; \ + W_[sp + WDS(0)] = stg_gc_unpt_r1_info; -#define PerformPut(tso,lval) \ - StgTSO_sp(tso) = StgTSO_sp(tso) + WDS(3); \ - lval = W_[StgTSO_sp(tso) - WDS(1)]; +#define PerformPut(stack,lval) \ + W_ sp; \ + sp = StgStack_sp(stack) + WDS(3); \ + StgStack_sp(stack) = sp; \ + lval = W_[sp - WDS(1)]; stg_takeMVarzh { @@ -1224,24 +1251,20 @@ loop: StgMVar_tail(mvar) = stg_END_TSO_QUEUE_closure; } -loop2: - if (TO_W_(StgTSO_what_next(tso)) == ThreadRelocated) { - tso = StgTSO__link(tso); - goto loop2; - } - ASSERT(StgTSO_why_blocked(tso) == BlockedOnMVar::I16); ASSERT(StgTSO_block_info(tso) == mvar); // actually perform the putMVar for the thread that we just woke up - PerformPut(tso,StgMVar_value(mvar)); + W_ stack; + stack = StgTSO_stackobj(tso); + PerformPut(stack, StgMVar_value(mvar)); // indicate that the MVar operation has now completed. StgTSO__link(tso) = stg_END_TSO_QUEUE_closure; // no need to mark the TSO dirty, we have only written END_TSO_QUEUE. - foreign "C" tryWakeupThread_(MyCapability() "ptr", tso) []; + foreign "C" tryWakeupThread(MyCapability() "ptr", tso) []; unlockClosure(mvar, stg_MVAR_DIRTY_info); RET_P(val); @@ -1303,24 +1326,20 @@ loop: StgMVar_tail(mvar) = stg_END_TSO_QUEUE_closure; } -loop2: - if (TO_W_(StgTSO_what_next(tso)) == ThreadRelocated) { - tso = StgTSO__link(tso); - goto loop2; - } - ASSERT(StgTSO_why_blocked(tso) == BlockedOnMVar::I16); ASSERT(StgTSO_block_info(tso) == mvar); // actually perform the putMVar for the thread that we just woke up - PerformPut(tso,StgMVar_value(mvar)); + W_ stack; + stack = StgTSO_stackobj(tso); + PerformPut(stack, StgMVar_value(mvar)); // indicate that the MVar operation has now completed. StgTSO__link(tso) = stg_END_TSO_QUEUE_closure; // no need to mark the TSO dirty, we have only written END_TSO_QUEUE. - foreign "C" tryWakeupThread_(MyCapability() "ptr", tso) []; + foreign "C" tryWakeupThread(MyCapability() "ptr", tso) []; unlockClosure(mvar, stg_MVAR_DIRTY_info); RET_NP(1,val); @@ -1395,26 +1414,22 @@ loop: StgMVar_tail(mvar) = stg_END_TSO_QUEUE_closure; } -loop2: - if (TO_W_(StgTSO_what_next(tso)) == ThreadRelocated) { - tso = StgTSO__link(tso); - goto loop2; - } - ASSERT(StgTSO_why_blocked(tso) == BlockedOnMVar::I16); ASSERT(StgTSO_block_info(tso) == mvar); // actually perform the takeMVar - PerformTake(tso, val); + W_ stack; + stack = StgTSO_stackobj(tso); + PerformTake(stack, val); // indicate that the MVar operation has now completed. StgTSO__link(tso) = stg_END_TSO_QUEUE_closure; - - if (TO_W_(StgTSO_dirty(tso)) == 0) { - foreign "C" dirty_TSO(MyCapability() "ptr", tso "ptr") []; + + if (TO_W_(StgStack_dirty(stack)) == 0) { + foreign "C" dirty_STACK(MyCapability() "ptr", stack "ptr") []; } - foreign "C" tryWakeupThread_(MyCapability() "ptr", tso) []; + foreign "C" tryWakeupThread(MyCapability() "ptr", tso) []; unlockClosure(mvar, stg_MVAR_DIRTY_info); jump %ENTRY_CODE(Sp(0)); @@ -1468,26 +1483,22 @@ loop: StgMVar_tail(mvar) = stg_END_TSO_QUEUE_closure; } -loop2: - if (TO_W_(StgTSO_what_next(tso)) == ThreadRelocated) { - tso = StgTSO__link(tso); - goto loop2; - } - ASSERT(StgTSO_why_blocked(tso) == BlockedOnMVar::I16); ASSERT(StgTSO_block_info(tso) == mvar); // actually perform the takeMVar - PerformTake(tso, val); + W_ stack; + stack = StgTSO_stackobj(tso); + PerformTake(stack, val); // indicate that the MVar operation has now completed. StgTSO__link(tso) = stg_END_TSO_QUEUE_closure; - if (TO_W_(StgTSO_dirty(tso)) == 0) { - foreign "C" dirty_TSO(MyCapability() "ptr", tso "ptr") []; + if (TO_W_(StgStack_dirty(stack)) == 0) { + foreign "C" dirty_STACK(MyCapability() "ptr", stack "ptr") []; } - foreign "C" tryWakeupThread_(MyCapability() "ptr", tso) []; + foreign "C" tryWakeupThread(MyCapability() "ptr", tso) []; unlockClosure(mvar, stg_MVAR_DIRTY_info); RET_N(1); @@ -2052,7 +2063,20 @@ stg_traceEventzh // We should go through the macro HASKELLEVENT_USER_MSG_ENABLED from // RtsProbes.h, but that header file includes unistd.h, which doesn't // work in Cmm +#if !defined(solaris2_TARGET_OS) (enabled) = foreign "C" __dtrace_isenabled$HaskellEvent$user__msg$v1() []; +#else + // Solaris' DTrace can't handle the + // __dtrace_isenabled$HaskellEvent$user__msg$v1 + // call above. This call is just for testing whether the user__msg + // probe is enabled, and is here for just performance optimization. + // Since preparation for the probe is not that complex I disable usage of + // this test above for Solaris and enable the probe usage manually + // here. Please note that this does not mean that the probe will be + // used during the runtime! You still need to enable it by consumption + // in your dtrace script as you do with any other probe. + enabled = 1; +#endif if (enabled != 0) { foreign "C" dtraceUserMsgWrapper(MyCapability() "ptr", msg "ptr") []; }