Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse code

use MVar to define fixIO, for thread-safety (see #5421)

  • Loading branch information...
commit 2cc5a65eb6463bb92b84cc4416a410ab80cda950 1 parent 2e445e5
Simon Marlow authored November 04, 2011

Showing 2 changed files with 17 additions and 6 deletions. Show diff stats Hide diff stats

  1. 4  Foreign.hs
  2. 19  System/IO.hs
4  Foreign.hs
@@ -45,11 +45,11 @@ import Foreign.Storable
45 45
 import Foreign.Marshal
46 46
 
47 47
 import GHC.IO (IO)
48  
-import qualified System.IO.Unsafe (unsafePerformIO)
  48
+import qualified GHC.IO (unsafePerformIO)
49 49
 
50 50
 {-# DEPRECATED unsafePerformIO "Use System.IO.Unsafe.unsafePerformIO instead; This function will be removed in the next release" #-}
51 51
 
52 52
 {-# INLINE unsafePerformIO #-}
53 53
 unsafePerformIO :: IO a -> a
54  
-unsafePerformIO = System.IO.Unsafe.unsafePerformIO
  54
+unsafePerformIO = GHC.IO.unsafePerformIO
55 55
 
19  System/IO.hs
@@ -253,12 +253,12 @@ import GHC.IO.Handle.FD
253 253
 import qualified GHC.IO.FD as FD
254 254
 import GHC.IO.Handle
255 255
 import GHC.IO.Handle.Text ( hGetBufSome, hPutStrLn )
256  
-import GHC.IORef
257 256
 import GHC.IO.Exception ( userError )
258 257
 import GHC.IO.Encoding
259 258
 import GHC.Num
260 259
 import Text.Read
261 260
 import GHC.Show
  261
+import GHC.MVar
262 262
 #endif
263 263
 
264 264
 #ifdef __HUGS__
@@ -462,15 +462,26 @@ withBinaryFile name mode = bracket (openBinaryFile name mode) hClose
462 462
 #if defined(__GLASGOW_HASKELL__) || defined(__HUGS__)
463 463
 fixIO :: (a -> IO a) -> IO a
464 464
 fixIO k = do
465  
-    ref <- newIORef (throw NonTermination)
466  
-    ans <- unsafeInterleaveIO (readIORef ref)
  465
+    m <- newEmptyMVar
  466
+    ans <- unsafeInterleaveIO (takeMVar m)
467 467
     result <- k ans
468  
-    writeIORef ref result
  468
+    putMVar m result
469 469
     return result
470 470
 
471 471
 -- NOTE: we do our own explicit black holing here, because GHC's lazy
472 472
 -- blackholing isn't enough.  In an infinite loop, GHC may run the IO
473 473
 -- computation a few times before it notices the loop, which is wrong.
  474
+--
  475
+-- NOTE2: the explicit black-holing with an IORef ran into trouble
  476
+-- with multiple threads (see #5421), so now we use an MVar.  I'm
  477
+-- actually wondering whether we should use readMVar rather than
  478
+-- takeMVar, just in case it ends up being executed multiple times,
  479
+-- but even then it would have to be masked to protect against async
  480
+-- exceptions.  Ugh.  What we really need here is an IVar, or an
  481
+-- atomic readMVar, or even STM.  All these seem like overkill.
  482
+--
  483
+-- See also System.IO.Unsafe.unsafeFixIO.
  484
+--
474 485
 #endif
475 486
 
476 487
 #if defined(__NHC__)

0 notes on commit 2cc5a65

Please sign in to comment.
Something went wrong with that request. Please try again.