diff --git a/libraries/base/System/IO.hs b/libraries/base/System/IO.hs
index 877623a54f9cccb1fe04171cb2fc67973fd12ad6..f2a412c98d9eaa7cf49c2639b2612086eb95d443 100644
--- a/libraries/base/System/IO.hs
+++ b/libraries/base/System/IO.hs
@@ -375,8 +375,17 @@ hPrint hdl 	=  hPutStrLn hdl . show
 -- fixIO
 
 #ifdef __GLASGOW_HASKELL__
-fixIO 		:: (a -> IO a) -> IO a
-fixIO m         = stToIO (fixST (ioToST . m))
+fixIO :: (a -> IO a) -> IO a
+fixIO k = do
+    ref <- newIORef (throw NonTermination)
+    ans <- unsafeInterleaveIO (readIORef ref)
+    result <- k ans
+    writeIORef ref 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.
 #endif
 
 -- $locking