[commit: base] master: use MVar to define fixIO, for thread-safety (see #5421) (2cc5a65)

[Simon Marlow]

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 <marlowsd at gmail.com>
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__)