[project @ 2000-01-18 12:44:37 by simonmar]

Don't hold the lock on the Handle while we block waiting for data on a
read.  This is a partial solution to the general problem of holding a
lock on the Handle while in mayBlock.

diff --git a/ghc/lib/std/IO.lhs b/ghc/lib/std/IO.lhs
index 1a8d4b3..0ca2180 100644 (file)
--- a/ghc/lib/std/IO.lhs
+++ b/ghc/lib/std/IO.lhs
@@ -110,6 +110,7 @@ import PrelAddr             ( Addr(..), nullAddr )
 import PrelByteArr     ( ByteArray )
 import PrelPack                ( unpackNBytesAccST )
 import PrelException    ( ioError, catch )
+import PrelConc
 
 #ifndef __PARALLEL_HASKELL__
 import PrelForeign  ( ForeignObj )
@@ -157,13 +158,9 @@ blocking until a character is available.
 
 \begin{code}
 hGetChar :: Handle -> IO Char
-hGetChar handle = 
-    wantReadableHandle "hGetChar" handle $ \ handle_ -> do
-    let fo = haFO__ handle_
-    intc     <- mayBlock fo (fileGetc fo)  -- ConcHask: UNSAFE, may block
-    if intc /= ((-1)::Int)
-     then return (chr intc)
-     else constructErrorAndFail "hGetChar"
+hGetChar handle = do
+  c <- mayBlockRead "hGetChar" handle fileGetc
+  return (chr c)
 
 {-
   If EOF is reached before EOL is encountered, ignore the
@@ -202,14 +199,9 @@ character is available.
 
 \begin{code}
 hLookAhead :: Handle -> IO Char
-hLookAhead handle =
-    wantReadableHandle "hLookAhead" handle $ \ handle_ -> do
-    let fo = haFO__ handle_
-    intc    <- mayBlock fo (fileLookAhead fo)  -- ConcHask: UNSAFE, may block
-    if intc /= (-1)
-     then return (chr intc)
-     else constructErrorAndFail "hLookAhead"
-
+hLookAhead handle = do
+  rc <- mayBlockRead "hLookAhead" handle fileLookAhead
+  return (chr rc)
 \end{code}
 
 

diff --git a/ghc/lib/std/PrelHandle.lhs b/ghc/lib/std/PrelHandle.lhs
index d65c234..a1faf99 100644 (file)
--- a/ghc/lib/std/PrelHandle.lhs
+++ b/ghc/lib/std/PrelHandle.lhs
@@ -437,10 +437,8 @@ the file.  Otherwise, it returns @False@.
 
 \begin{code}
 hIsEOF :: Handle -> IO Bool
-hIsEOF handle =
-    wantReadableHandle "hIsEOF" handle $ \ handle_ -> do
-    let fo = haFO__ handle_
-    rc      <- mayBlock fo (fileEOF fo)  -- ConcHask: UNSAFE, may block
+hIsEOF handle = do
+    rc <- mayBlockRead "hIsEOF" handle fileEOF
     case rc of
       0 -> return False
       1 -> return True
@@ -905,12 +903,7 @@ hFillBufBA handle buf sz
                            "hFillBufBA"
                            ("illegal buffer size " ++ showsPrec 9 sz []))  -- 9 => should be parens'ified.
   | otherwise = 
-    wantReadableHandle "hFillBufBA" handle $ \ handle_ -> do
-    let fo  = haFO__ handle_
-    rc      <- mayBlock fo (readChunkBA fo buf sz)    -- ConcHask: UNSAFE, may block.
-    if rc >= (0::Int)
-     then return rc
-     else constructErrorAndFail "hFillBufBA"
+    mayBlockRead "hFillBufBA" handle (\fo -> readChunkBA fo buf sz)
 #endif
 
 hFillBuf :: Handle -> Addr -> Int -> IO Int
@@ -920,13 +913,7 @@ hFillBuf handle buf sz
                            "hFillBuf"
                            ("illegal buffer size " ++ showsPrec 9 sz []))  -- 9 => should be parens'ified.
   | otherwise = 
-    wantReadableHandle "hFillBuf" handle $ \ handle_ -> do
-    let fo  = haFO__ handle_
-    rc      <- mayBlock fo (readChunk fo buf sz)    -- ConcHask: UNSAFE, may block.
-    if rc >= 0
-     then return rc
-     else constructErrorAndFail "hFillBuf"
-
+    mayBlockRead "hFillBuf" handle (\fo -> readChunk fo buf sz)
 \end{code}
 
 The @hPutBuf hdl buf len@ action writes an already packed sequence of
@@ -1142,6 +1129,39 @@ mayBlock fo act = do
        mayBlock fo act  -- output possible
      _ -> do
         return rc
+
+data MayBlock
+  = BlockRead Int
+  | BlockWrite Int
+  | NoBlock Int
+
+mayBlockRead :: String -> Handle -> (ForeignObj -> IO Int) -> IO Int
+mayBlockRead fname handle fn = do
+    r <- wantReadableHandle fname handle $ \ handle_ -> do
+        let fo = haFO__ handle_
+         rc <- fn fo
+         case rc of
+           -5 -> do  -- (possibly blocking) read
+             fd <- getFileFd fo
+             return (BlockRead fd)
+          -6 -> do  -- (possibly blocking) write
+            fd <- getFileFd fo
+             return (BlockWrite fd)
+          -7 -> do  -- (possibly blocking) write on connected handle
+            fd <- getConnFileFd fo
+            return (BlockWrite fd)
+           _ ->
+             if rc >= 0
+                 then return (NoBlock rc)
+                 else constructErrorAndFail fname
+    case r of
+       BlockRead fd -> do
+          threadWaitRead fd
+          mayBlockRead fname handle fn
+       BlockWrite fd -> do
+          threadWaitWrite fd
+          mayBlockRead fname handle fn
+       NoBlock c -> return c
 \end{code}
 
 Foreign import declarations of helper functions: