From: Simon Marlow <marlowsd@gmail.com>
Date: Fri, 10 Oct 2008 13:15:45 +0000 (+0000)
Subject: add readTVarIO :: TVar a -> IO a
X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=commitdiff_plain;h=b69843467459d43168519ced8d0cf45227c4c7be

add readTVarIO :: TVar a -> IO a
---

diff --git a/compiler/prelude/primops.txt.pp b/compiler/prelude/primops.txt.pp
index 39ae85d..417d42e 100644
--- a/compiler/prelude/primops.txt.pp
+++ b/compiler/prelude/primops.txt.pp
@@ -1340,6 +1340,13 @@ primop	ReadTVarOp "readTVar#" GenPrimOp
    with
    out_of_line	= True
 
+primop ReadTVarIOOp "readTVarIO#" GenPrimOp
+       TVar# s a
+    -> State# s -> (# State# s, a #)
+   {Read contents of {\tt TVar\#} outside an STM transaction}
+   with
+   out_of_line	= True
+
 primop	WriteTVarOp "writeTVar#" GenPrimOp
        TVar# s a
     -> a
diff --git a/includes/StgMiscClosures.h b/includes/StgMiscClosures.h
index 16cd476..f69a4ae 100644
--- a/includes/StgMiscClosures.h
+++ b/includes/StgMiscClosures.h
@@ -600,6 +600,7 @@ RTS_FUN(catchSTMzh_fast);
 RTS_FUN(atomicallyzh_fast);
 RTS_FUN(newTVarzh_fast);
 RTS_FUN(readTVarzh_fast);
+RTS_FUN(readTVarIOzh_fast);
 RTS_FUN(writeTVarzh_fast);
 RTS_FUN(checkzh_fast);
 
diff --git a/includes/mkDerivedConstants.c b/includes/mkDerivedConstants.c
index aaa4531..3aa7625 100644
--- a/includes/mkDerivedConstants.c
+++ b/includes/mkDerivedConstants.c
@@ -353,6 +353,8 @@ main(int argc, char *argv[])
     closure_field(StgTVarWatchQueue, next_queue_entry);
     closure_field(StgTVarWatchQueue, prev_queue_entry);
 
+    closure_field(StgTVar, current_value);
+
     closure_size(StgWeak);
     closure_field(StgWeak,link);
     closure_field(StgWeak,key);
diff --git a/rts/Linker.c b/rts/Linker.c
index 69b21a2..0b556b7 100644
--- a/rts/Linker.c
+++ b/rts/Linker.c
@@ -643,6 +643,7 @@ typedef struct _RtsSymbolVal {
       SymX(raisezh_fast)			\
       SymX(raiseIOzh_fast)			\
       SymX(readTVarzh_fast)			\
+      SymX(readTVarIOzh_fast)			\
       SymX(remIntegerzh_fast)			\
       SymX(resetNonBlockingFd)			\
       SymX(resumeThread)			\
diff --git a/rts/PrimOps.cmm b/rts/PrimOps.cmm
index c666a42..e65cbc4 100644
--- a/rts/PrimOps.cmm
+++ b/rts/PrimOps.cmm
@@ -1455,6 +1455,17 @@ readTVarzh_fast
   RET_P(result);
 }
 
+readTVarIOzh_fast
+{
+    W_ result;
+
+again:
+    result = StgTVar_current_value(R1);
+    if (%INFO_PTR(result) == stg_TREC_HEADER_info) {
+        goto again;
+    }
+    RET_P(result);
+}
 
 writeTVarzh_fast
 {