Commit 382ca27d authored by simonmar's avatar simonmar
Browse files

[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.
parent 246dc73c
......@@ -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}
......
......@@ -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:
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment