Repository : ssh://darcs.haskell.org//srv/darcs/packages/base On branch : master
http://hackage.haskell.org/trac/ghc/changeset/2cc5a65eb6463bb92b84cc4416a410ab80cda950 >--------------------------------------------------------------- commit 2cc5a65eb6463bb92b84cc4416a410ab80cda950 Author: Simon Marlow <[email protected]> Date: Fri Nov 4 15:27:39 2011 +0000 use MVar to define fixIO, for thread-safety (see #5421) >--------------------------------------------------------------- Foreign.hs | 4 ++-- System/IO.hs | 19 +++++++++++++++---- 2 files changed, 17 insertions(+), 6 deletions(-) diff --git a/Foreign.hs b/Foreign.hs index fc32835..caad104 100644 --- a/Foreign.hs +++ b/Foreign.hs @@ -45,11 +45,11 @@ import Foreign.Storable import Foreign.Marshal import GHC.IO (IO) -import qualified System.IO.Unsafe (unsafePerformIO) +import qualified GHC.IO (unsafePerformIO) {-# DEPRECATED unsafePerformIO "Use System.IO.Unsafe.unsafePerformIO instead; This function will be removed in the next release" #-} {-# INLINE unsafePerformIO #-} unsafePerformIO :: IO a -> a -unsafePerformIO = System.IO.Unsafe.unsafePerformIO +unsafePerformIO = GHC.IO.unsafePerformIO diff --git a/System/IO.hs b/System/IO.hs index 9cd96eb..1fbdaf5 100644 --- a/System/IO.hs +++ b/System/IO.hs @@ -253,12 +253,12 @@ import GHC.IO.Handle.FD import qualified GHC.IO.FD as FD import GHC.IO.Handle import GHC.IO.Handle.Text ( hGetBufSome, hPutStrLn ) -import GHC.IORef import GHC.IO.Exception ( userError ) import GHC.IO.Encoding import GHC.Num import Text.Read import GHC.Show +import GHC.MVar #endif #ifdef __HUGS__ @@ -462,15 +462,26 @@ withBinaryFile name mode = bracket (openBinaryFile name mode) hClose #if defined(__GLASGOW_HASKELL__) || defined(__HUGS__) fixIO :: (a -> IO a) -> IO a fixIO k = do - ref <- newIORef (throw NonTermination) - ans <- unsafeInterleaveIO (readIORef ref) + m <- newEmptyMVar + ans <- unsafeInterleaveIO (takeMVar m) result <- k ans - writeIORef ref result + putMVar m result return result -- NOTE: we do our own explicit black holing here, because GHC's lazy -- blackholing isn't enough. In an infinite loop, GHC may run the IO -- computation a few times before it notices the loop, which is wrong. +-- +-- NOTE2: the explicit black-holing with an IORef ran into trouble +-- with multiple threads (see #5421), so now we use an MVar. I'm +-- actually wondering whether we should use readMVar rather than +-- takeMVar, just in case it ends up being executed multiple times, +-- but even then it would have to be masked to protect against async +-- exceptions. Ugh. What we really need here is an IVar, or an +-- atomic readMVar, or even STM. All these seem like overkill. +-- +-- See also System.IO.Unsafe.unsafeFixIO. +-- #endif #if defined(__NHC__) _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
