diff options
author | Simon Marlow <marlowsd@gmail.com> | 2011-02-15 20:43:34 +0000 |
---|---|---|
committer | Simon Marlow <marlowsd@gmail.com> | 2011-04-11 11:08:43 +0100 |
commit | 521b792553bacbdb0eec138b150ab0626ea6f36b (patch) | |
tree | d1e396b14c49bc0755b0c870f2ae183289b4a3ba | |
parent | 169dadd0e663507a18ad3254fc8e854e6dc7b77e (diff) | |
download | haskell-521b792553bacbdb0eec138b150ab0626ea6f36b.tar.gz |
add casMutVar#
-rw-r--r-- | compiler/prelude/primops.txt.pp | 6 | ||||
-rw-r--r-- | includes/stg/MiscClosures.h | 1 | ||||
-rw-r--r-- | includes/stg/SMP.h | 3 | ||||
-rw-r--r-- | rts/Linker.c | 1 | ||||
-rw-r--r-- | rts/PrimOps.cmm | 19 |
5 files changed, 29 insertions, 1 deletions
diff --git a/compiler/prelude/primops.txt.pp b/compiler/prelude/primops.txt.pp index 777e83fe74..7d80db4fcc 100644 --- a/compiler/prelude/primops.txt.pp +++ b/compiler/prelude/primops.txt.pp @@ -1121,6 +1121,12 @@ primop AtomicModifyMutVarOp "atomicModifyMutVar#" GenPrimOp out_of_line = True has_side_effects = True +primop CasMutVarOp "casMutVar#" GenPrimOp + MutVar# s a -> a -> a -> State# s -> (# State# s, Int#, a #) + with + out_of_line = True + has_side_effects = True + ------------------------------------------------------------------------ section "Exceptions" ------------------------------------------------------------------------ diff --git a/includes/stg/MiscClosures.h b/includes/stg/MiscClosures.h index e6cfc47bfa..ed0bf655e1 100644 --- a/includes/stg/MiscClosures.h +++ b/includes/stg/MiscClosures.h @@ -383,6 +383,7 @@ RTS_FUN_DECL(stg_newArrayzh); RTS_FUN_DECL(stg_newMutVarzh); RTS_FUN_DECL(stg_atomicModifyMutVarzh); +RTS_FUN_DECL(stg_casMutVarzh); RTS_FUN_DECL(stg_isEmptyMVarzh); RTS_FUN_DECL(stg_newMVarzh); diff --git a/includes/stg/SMP.h b/includes/stg/SMP.h index ad8c0baef9..f1b0422009 100644 --- a/includes/stg/SMP.h +++ b/includes/stg/SMP.h @@ -314,7 +314,8 @@ xchg(StgPtr p, StgWord w) return old; } -STATIC_INLINE StgWord +EXTERN_INLINE StgWord cas(StgVolatilePtr p, StgWord o, StgWord n); +EXTERN_INLINE StgWord cas(StgVolatilePtr p, StgWord o, StgWord n) { StgWord result; diff --git a/rts/Linker.c b/rts/Linker.c index 2acefc3967..5285ec6d55 100644 --- a/rts/Linker.c +++ b/rts/Linker.c @@ -832,6 +832,7 @@ typedef struct _RtsSymbolVal { SymI_HasProto(stg_newTVarzh) \ SymI_HasProto(stg_noDuplicatezh) \ SymI_HasProto(stg_atomicModifyMutVarzh) \ + SymI_HasProto(stg_casMutVarzh) \ SymI_HasProto(stg_newPinnedByteArrayzh) \ SymI_HasProto(stg_newAlignedPinnedByteArrayzh) \ SymI_HasProto(newSpark) \ diff --git a/rts/PrimOps.cmm b/rts/PrimOps.cmm index 701654af49..5c9cfb75ad 100644 --- a/rts/PrimOps.cmm +++ b/rts/PrimOps.cmm @@ -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; |