Repository : ssh://darcs.haskell.org//srv/darcs/packages/base On branch : master
http://hackage.haskell.org/trac/ghc/changeset/e18035d84b274b9f617bc8f1eb74b29ef49e58f8 >--------------------------------------------------------------- commit e18035d84b274b9f617bc8f1eb74b29ef49e58f8 Author: Simon Marlow <[email protected]> Date: Thu Apr 12 11:04:54 2012 +0100 move mkWeakThreadId to GHC.Conc.Sync; export it from Control.Concurrent >--------------------------------------------------------------- Control/Concurrent.hs | 3 +++ GHC/Conc.lhs | 1 + GHC/Conc/Sync.lhs | 22 ++++++++++++++++++++++ GHC/TopHandler.lhs | 8 -------- 4 files changed, 26 insertions(+), 8 deletions(-) diff --git a/Control/Concurrent.hs b/Control/Concurrent.hs index 55861fc..770d9c3 100644 --- a/Control/Concurrent.hs +++ b/Control/Concurrent.hs @@ -89,6 +89,9 @@ module Control.Concurrent ( runInUnboundThread, #endif + -- * Weak references to ThreadIds + mkWeakThreadId, + -- * GHC's implementation of concurrency -- |This section describes features specific to GHC's diff --git a/GHC/Conc.lhs b/GHC/Conc.lhs index a6ee11a..ad8cfc4 100644 --- a/GHC/Conc.lhs +++ b/GHC/Conc.lhs @@ -51,6 +51,7 @@ module GHC.Conc , runSparks , yield -- :: IO () , labelThread -- :: ThreadId -> String -> IO () + , mkWeakThreadId -- :: ThreadId -> IO (Weak ThreadId) , ThreadStatus(..), BlockReason(..) , threadStatus -- :: ThreadId -> IO ThreadStatus diff --git a/GHC/Conc/Sync.lhs b/GHC/Conc/Sync.lhs index aa0ae07..928fbf1 100644 --- a/GHC/Conc/Sync.lhs +++ b/GHC/Conc/Sync.lhs @@ -61,6 +61,7 @@ module GHC.Conc.Sync , runSparks , yield -- :: IO () , labelThread -- :: ThreadId -> String -> IO () + , mkWeakThreadId -- :: ThreadId -> IO (Weak ThreadId) , ThreadStatus(..), BlockReason(..) , threadStatus -- :: ThreadId -> IO ThreadStatus @@ -119,6 +120,7 @@ import GHC.MVar import GHC.Real ( fromIntegral ) import GHC.Pack ( packCString# ) import GHC.Show ( Show(..), showString ) +import GHC.Weak infixr 0 `par`, `pseq` \end{code} @@ -514,6 +516,26 @@ threadCapability :: ThreadId -> IO (Int, Bool) threadCapability (ThreadId t) = IO $ \s -> case threadStatus# t s of (# s', _, cap#, locked# #) -> (# s', (I# cap#, locked# /=# 0#) #) + +-- | make a weak pointer to a 'ThreadId'. It can be important to do +-- this if you want to hold a reference to a 'ThreadId' while still +-- allowing the thread to receive the @BlockedIndefinitely@ family of +-- exceptions (e.g. 'BlockedIndefinitelyOnMVar'). Holding a normal +-- 'ThreadId' reference will prevent the delivery of +-- @BlockedIndefinitely@ exceptions because the reference could be +-- used as the target of 'throwTo' at any time, which would unblock +-- the thread. +-- +-- Holding a @Weak ThreadId@, on the other hand, will not prevent the +-- thread from receiving @BlockedIndefinitely@ exceptions. It is +-- still possible to throw an exception to a @Weak ThreadId@, but the +-- caller must use @deRefWeak@ first to determine whether the thread +-- still exists. +-- +mkWeakThreadId :: ThreadId -> IO (Weak ThreadId) +mkWeakThreadId t@(ThreadId t#) = IO $ \s -> + case mkWeak# t# t (unsafeCoerce# 0#) s of + (# s1, w #) -> (# s1, Weak w #) \end{code} diff --git a/GHC/TopHandler.lhs b/GHC/TopHandler.lhs index 419edff..f1b0cbf 100644 --- a/GHC/TopHandler.lhs +++ b/GHC/TopHandler.lhs @@ -104,14 +104,6 @@ foreign import ccall unsafe -> IO CInt -- (ret) old action code #endif --- make a weak pointer to a ThreadId: holding the weak pointer doesn't --- keep the thread alive and prevent it from being identified as --- deadlocked. Vitally important for the main thread. -mkWeakThreadId :: ThreadId -> IO (Weak ThreadId) -mkWeakThreadId t@(ThreadId t#) = IO $ \s -> - case mkWeak# t# t (unsafeCoerce# 0#) s of - (# s1, w #) -> (# s1, Weak w #) - -- | 'runIO' is wrapped around every @foreign export@ and @foreign -- import \"wrapper\"@ to mop up any uncaught exceptions. Thus, the -- result of running 'System.Exit.exitWith' in a foreign-exported _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
