Commit 9cf8e570 authored by Edward Z. Yang's avatar Edward Z. Yang
Browse files

Add atomicReadMVar to Control.Concurrent.MVar and friends.



Also renumber thread statuses as necessary.
Signed-off-by: Edward Z. Yang's avatarEdward Z. Yang <ezyang@mit.edu>
parent d3fbf77f
......@@ -142,6 +142,7 @@ module Control.Concurrent.MVar
, modifyMVarMasked_
, modifyMVarMasked
#ifndef __HUGS__
, atomicReadMVar
, mkWeakMVar
, addMVarFinalizer
#endif
......@@ -155,7 +156,7 @@ import Hugs.ConcBase ( MVar, newEmptyMVar, newMVar, takeMVar, putMVar,
#ifdef __GLASGOW_HASKELL__
import GHC.MVar ( MVar(..), newEmptyMVar, newMVar, takeMVar, putMVar,
tryTakeMVar, tryPutMVar, isEmptyMVar
tryTakeMVar, tryPutMVar, isEmptyMVar, atomicReadMVar
)
import qualified GHC.MVar
import GHC.Weak
......
......@@ -475,11 +475,13 @@ threadStatus (ThreadId t) = IO $ \s ->
-- NB. keep these in sync with includes/Constants.h
mk_stat 0 = ThreadRunning
mk_stat 1 = ThreadBlocked BlockedOnMVar
mk_stat 2 = ThreadBlocked BlockedOnBlackHole
mk_stat 6 = ThreadBlocked BlockedOnSTM
mk_stat 10 = ThreadBlocked BlockedOnForeignCall
mk_stat 2 = ThreadBlocked BlockedOnMVar -- XXX distinguish?
mk_stat 3 = ThreadBlocked BlockedOnBlackHole
mk_stat 7 = ThreadBlocked BlockedOnSTM
mk_stat 11 = ThreadBlocked BlockedOnForeignCall
mk_stat 12 = ThreadBlocked BlockedOnException
mk_stat 12 = ThreadBlocked BlockedOnForeignCall
mk_stat 13 = ThreadBlocked BlockedOnException
-- NB. these are hardcoded in rts/PrimOps.cmm
mk_stat 16 = ThreadFinished
mk_stat 17 = ThreadDied
mk_stat _ = ThreadBlocked BlockedOnOther
......
......@@ -23,6 +23,7 @@ module GHC.MVar (
, newMVar
, newEmptyMVar
, takeMVar
, atomicReadMVar
, putMVar
, tryTakeMVar
, tryPutMVar
......@@ -88,6 +89,15 @@ newMVar value =
takeMVar :: MVar a -> IO a
takeMVar (MVar mvar#) = IO $ \ s# -> takeMVar# mvar# s#
-- |Atomically read the contents of an 'MVar'. If the 'MVar' is
-- currently empty, 'atomicReadMVar' will wait until its full.
-- 'atomicReadMVar' is guaranteed to receive the next 'putMVar'.
--
-- 'atomicReadMVar' is multiple-wakeup, so when multiple readers are
-- blocked on an 'MVar', all of them are woken up at the same time.
atomicReadMVar :: MVar a -> IO a
atomicReadMVar (MVar mvar#) = IO $ \ s# -> atomicReadMVar# mvar# s#
-- |Put a value into an 'MVar'. If the 'MVar' is currently full,
-- 'putMVar' will wait until it becomes empty.
--
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment