add casMutVar#

ghc · Apr 11, 2011 · 521b792 · 521b792
1 parent 169dadd
commit 521b792
Show file tree

Hide file tree

Showing 5 changed files with 29 additions and 1 deletion.
diff --git a/compiler/prelude/primops.txt.pp b/compiler/prelude/primops.txt.pp
@@ -1121,6 +1121,12 @@
    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
@@ -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
@@ -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
@@ -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
@@ -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;