From: sof <unknown>
Date: Mon, 5 Jul 1999 19:26:42 +0000 (+0000)
Subject: [project @ 1999-07-05 19:26:42 by sof]
X-Git-Tag: Approximately_9120_patches~6033
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=60e60f66152de66f31d59f9a2c720552d13c0372;p=ghc-hetmet.git

[project @ 1999-07-05 19:26:42 by sof]
Temporary workaround for problem which caused the following program

  main = putStrLn ("aa" ++ IOExts.trace "bb" "cc")

to deadlock - when the (untouched) stderr is evaluated (which
IOExts.trace forces), it will touch stdout (see code for details of
why), but it has already been locked by putStrLn. Boom - game over.

This temporary 'fix' is, to put it kindly, in the fancy-footwork
category as it doesn't solve the problem, but merely turns it on its
head. Instead of stderr depending on stdout, stdout now depends on
stderr, so the following program will deadlock

  main = hPutStrLn stderr ("aa" ++ myTrace "bb" "cc")

  myTrace msg v = unsafePerformIO $ do
     putStrLn msg
     return v

The 'theory' is that this is far less likely to occur in practice than
the other way around.

The next step / real solution would be to give up the lock on an
output Handle while filling up its output buffer. However, that
requires ripping out / re-org'ing a fair bit of buffer management
code, which I'll delay doing.
---

diff --git a/ghc/lib/std/PrelHandle.lhs b/ghc/lib/std/PrelHandle.lhs
index 2e4460c..27c2143 100644
--- a/ghc/lib/std/PrelHandle.lhs
+++ b/ghc/lib/std/PrelHandle.lhs
@@ -242,7 +242,16 @@ stdout = unsafePerformIO (do
 	    (bm, bf_size)  <- getBMode__ fo
 	    mkBuffer__ fo bf_size
 #endif
-	    newHandle (Handle__ fo WriteHandle bm "stdout")
+	    hdl <- newHandle (Handle__ fo WriteHandle bm "stdout")
+	     -- when stdin and stdout are both connected to a terminal, ensure
+	     -- that anything buffered on stdout is flushed prior to reading from stdin.
+	     -- 
+	    hConnectTerms hdl stdin
+  	     -- when stderr and stdout are both connected to a terminal, ensure
+	     -- that anything buffered on stdout is flushed prior to writing to
+	     -- stderr.
+	    hConnectTo hdl stderr
+	    return hdl
        _ -> do ioError <- constructError "stdout"
                newHandle (mkErrorHandle__ ioError)
   )
@@ -268,12 +277,7 @@ stdin = unsafePerformIO (do
 #endif
 	    (bm, bf_size) <- getBMode__ fo
 	    mkBuffer__ fo bf_size
-	    hdl <- newHandle (Handle__ fo ReadHandle bm "stdin")
-	     -- when stdin and stdout are both connected to a terminal, ensure
-	     -- that anything buffered on stdout is flushed prior to reading from stdin.
-	     -- 
-	    hConnectTerms stdout hdl
-	    return hdl
+	    newHandle (Handle__ fo ReadHandle bm "stdin")
        _ -> do ioError <- constructError "stdin"
                newHandle (mkErrorHandle__ ioError)
   )
@@ -298,12 +302,7 @@ stderr = unsafePerformIO (do
             fo <- makeForeignObj fo
 	    addForeignFinalizer fo (freeStdFileObject fo)
 #endif
-            hdl <- newHandle (Handle__ fo WriteHandle NoBuffering "stderr")
-	    -- when stderr and stdout are both connected to a terminal, ensure
-	    -- that anything buffered on stdout is flushed prior to writing to
-	    -- stderr.
-	    hConnectTo stdout hdl
-	    return hdl
+            newHandle (Handle__ fo WriteHandle NoBuffering "stderr")
 
        _ -> do ioError <- constructError "stderr"
                newHandle (mkErrorHandle__ ioError)