summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSimon Marlow <marlowsd@gmail.com>2011-02-15 20:43:34 +0000
committerSimon Marlow <marlowsd@gmail.com>2011-04-11 11:08:43 +0100
commit521b792553bacbdb0eec138b150ab0626ea6f36b (patch)
treed1e396b14c49bc0755b0c870f2ae183289b4a3ba
parent169dadd0e663507a18ad3254fc8e854e6dc7b77e (diff)
downloadhaskell-521b792553bacbdb0eec138b150ab0626ea6f36b.tar.gz
add casMutVar#
-rw-r--r--compiler/prelude/primops.txt.pp6
-rw-r--r--includes/stg/MiscClosures.h1
-rw-r--r--includes/stg/SMP.h3
-rw-r--r--rts/Linker.c1
-rw-r--r--rts/PrimOps.cmm19
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;