add casMutVar#

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"
 ------------------------------------------------------------------------

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);

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;

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)                           \

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;