[commit: ghc] master: Implement tryAtomicReadMVar#. (db8d4a3)

[Edward Z. Yang]

Repository : http://darcs.haskell.org/ghc.git/

On branch  : master

https://github.com/ghc/ghc/commit/db8d4a345ef77bc6832e9496e0ba38c8e36cadff

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

commit db8d4a345ef77bc6832e9496e0ba38c8e36cadff
Author: Edward Z. Yang <ezyang at mit.edu>
Date:   Wed Jul 10 13:32:15 2013 -0700

    Implement tryAtomicReadMVar#.
    
    Signed-off-by: Edward Z. Yang <ezyang at mit.edu>

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

 compiler/prelude/primops.txt.pp |  8 ++++++++
 includes/stg/MiscClosures.h     |  1 +
 rts/Linker.c                    |  1 +
 rts/PrimOps.cmm                 | 16 ++++++++++++++++
 4 files changed, 26 insertions(+)

diff --git a/compiler/prelude/primops.txt.pp b/compiler/prelude/primops.txt.pp
index 739092d..e5a3e21 100644
--- a/compiler/prelude/primops.txt.pp
+++ b/compiler/prelude/primops.txt.pp
@@ -1726,6 +1726,14 @@ primop  AtomicReadMVarOp "atomicReadMVar#" GenPrimOp
    out_of_line      = True
    has_side_effects = True
 
+primop  TryAtomicReadMVarOp "tryAtomicReadMVar#" GenPrimOp
+   MVar# s a -> State# s -> (# State# s, Int#, a #)
+   {If {\tt MVar\#} is empty, immediately return with integer 0 and value undefined.
+   Otherwise, return wtih integer 1 and contents of {\tt MVar\#}.}
+   with
+   out_of_line      = True
+   has_side_effects = True
+
 primop  SameMVarOp "sameMVar#" GenPrimOp
    MVar# s a -> MVar# s a -> Bool
 
diff --git a/includes/stg/MiscClosures.h b/includes/stg/MiscClosures.h
index 88cee59..287fce9 100644
--- a/includes/stg/MiscClosures.h
+++ b/includes/stg/MiscClosures.h
@@ -381,6 +381,7 @@ RTS_FUN_DECL(stg_putMVarzh);
 RTS_FUN_DECL(stg_atomicReadMVarzh);
 RTS_FUN_DECL(stg_tryTakeMVarzh);
 RTS_FUN_DECL(stg_tryPutMVarzh);
+RTS_FUN_DECL(stg_tryAtomicReadMVarzh);
 
 RTS_FUN_DECL(stg_waitReadzh);
 RTS_FUN_DECL(stg_waitWritezh);
diff --git a/rts/Linker.c b/rts/Linker.c
index 9129b46..1389b4f 100644
--- a/rts/Linker.c
+++ b/rts/Linker.c
@@ -1319,6 +1319,7 @@ typedef struct _RtsSymbolVal {
       SymI_HasProto(stg_threadStatuszh)                                 \
       SymI_HasProto(stg_tryPutMVarzh)                                   \
       SymI_HasProto(stg_tryTakeMVarzh)                                  \
+      SymI_HasProto(stg_tryAtomicReadMVarzh)                            \
       SymI_HasProto(stg_unmaskAsyncExceptionszh)                        \
       SymI_HasProto(unloadObj)                                          \
       SymI_HasProto(stg_unsafeThawArrayzh)                              \
diff --git a/rts/PrimOps.cmm b/rts/PrimOps.cmm
index abe54c8..6bb938e 100644
--- a/rts/PrimOps.cmm
+++ b/rts/PrimOps.cmm
@@ -1567,6 +1567,22 @@ stg_atomicReadMVarzh ( P_ mvar, /* :: MVar a */ )
     return (val);
 }
 
+stg_tryAtomicReadMVarzh ( P_ mvar, /* :: MVar a */ )
+{
+    W_ val, info, tso, q;
+
+    LOCK_CLOSURE(mvar, info);
+
+    if (StgMVar_value(mvar) == stg_END_TSO_QUEUE_closure) {
+        return (0, stg_NO_FINALIZER_closure);
+    }
+
+    val = StgMVar_value(mvar);
+
+    unlockClosure(mvar, stg_MVAR_DIRTY_info);
+    return (1, val);
+}
+
 /* -----------------------------------------------------------------------------
    Stable pointer primitives
    -------------------------------------------------------------------------  */