[commit: ghc] master: add casMutVar# (521b792)

[Simon Marlow]

Repository : ssh://darcs.haskell.org//srv/darcs/ghc

On branch  : master

http://hackage.haskell.org/trac/ghc/changeset/521b792553bacbdb0eec138b150ab0626ea6f36b

>---------------------------------------------------------------

commit 521b792553bacbdb0eec138b150ab0626ea6f36b
Author: Simon Marlow <marlowsd at gmail.com>
Date:   Tue Feb 15 20:43:34 2011 +0000

    add casMutVar#

>---------------------------------------------------------------

 compiler/prelude/primops.txt.pp |    6 ++++++
 includes/stg/MiscClosures.h     |    1 +
 includes/stg/SMP.h              |    3 ++-
 rts/Linker.c                    |    1 +
 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 777e83f..7d80db4 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 e6cfc47..ed0bf65 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 ad8c0ba..f1b0422 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 2acefc3..5285ec6 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 701654a..5c9cfb7 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;