X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=rts%2FPrimOps.cmm;h=e17c6fb3f870b7b923c79570cfe45a087bd787ee;hb=b2bd63f99d643f6b3eb30bb72bb9ae26d4183252;hp=7a7942abcc9e9ec65f3b520572a0e7129f64b11c;hpb=1e8493b3646fcc568a11d502552710848d46aa41;p=ghc-hetmet.git diff --git a/rts/PrimOps.cmm b/rts/PrimOps.cmm index 7a7942a..e17c6fb 100644 --- a/rts/PrimOps.cmm +++ b/rts/PrimOps.cmm @@ -212,6 +212,7 @@ stg_unsafeThawArrayzh } } + /* ----------------------------------------------------------------------------- MutVar primitives -------------------------------------------------------------------------- */ @@ -230,6 +231,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,7 +651,7 @@ stg_threadStatuszh W_ tso; W_ why_blocked; W_ what_next; - W_ ret; + W_ ret, cap, locked; tso = R1; @@ -651,7 +671,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); } /* -----------------------------------------------------------------------------