Commit 9bd3b5f3 authored by simonmar's avatar simonmar
Browse files

[project @ 2001-11-14 11:39:29 by simonmar]

Change the way we do finalization for duplex handles.  Previously, we
arranged that the read side pointed to the right side via a special
handle type (ReadSideHandle _), and the finalizer points to the write
side.  This turned out to interact badly with hGetContents, which
likes to explicitly close the read side of the handle after it reads
EOF or gets an error, which resulted in double-closes for duplex
handles.

Now we store the pointer from the read side to the write side in the
Handle structure itself, so it doesn't get lost when hGetContents
changes the handle type to SemiClosedHandle.  Furthermore, in hClose
we no longer close the file descriptor associated with the read side
of a duplex handle - the actual close will have to wait until the
finalizer runs, because someone might still be using the write side.

Thanks to Volker Stolz for pointing out the problem.
parent 01bd67ae
......@@ -4,7 +4,7 @@
#undef DEBUG
-- -----------------------------------------------------------------------------
-- $Id: PrelHandle.hs,v 1.2 2001/11/07 19:36:11 sof Exp $
-- $Id: PrelHandle.hs,v 1.3 2001/11/14 11:39:29 simonmar Exp $
--
-- (c) The University of Glasgow, 1994-2001
--
......@@ -292,14 +292,9 @@ ioe_bufsiz n = ioException
-- For a duplex handle, we arrange that the read side points to the write side
-- (and hence keeps it alive if the read side is alive). This is done by
-- having the haType field of the read side be ReadSideHandle with a pointer
-- to the write side. The finalizer is then placed on the write side, and
-- the handle only gets finalized once, when both sides are no longer
-- required.
addFinalizer :: Handle -> IO ()
addFinalizer (FileHandle m) = addMVarFinalizer m (handleFinalizer m)
addFinalizer (DuplexHandle _ w) = addMVarFinalizer w (handleFinalizer w)
-- having the haOtherSide field of the read side point to the read side.
-- The finalizer is then placed on the write side, and the handle only gets
-- finalized once, when both sides are no longer required.
stdHandleFinalizer :: MVar Handle__ -> IO ()
stdHandleFinalizer m = do
......@@ -493,16 +488,7 @@ stdin = unsafePerformIO $ do
-- ToDo: acquire lock
setNonBlockingFD fd_stdin
(buf, bmode) <- getBuffer fd_stdin ReadBuffer
spares <- newIORef BufferListNil
newFileHandle stdHandleFinalizer
(Handle__ { haFD = fd_stdin,
haType = ReadHandle,
haIsBin = dEFAULT_OPEN_IN_BINARY_MODE,
haBufferMode = bmode,
haFilePath = "<stdin>",
haBuffer = buf,
haBuffers = spares
})
mkStdHandle fd_stdin "<stdin>" ReadHandle buf bmode
stdout :: Handle
stdout = unsafePerformIO $ do
......@@ -511,16 +497,7 @@ stdout = unsafePerformIO $ do
-- some shells don't recover properly.
-- setNonBlockingFD fd_stdout
(buf, bmode) <- getBuffer fd_stdout WriteBuffer
spares <- newIORef BufferListNil
newFileHandle stdHandleFinalizer
(Handle__ { haFD = fd_stdout,
haType = WriteHandle,
haIsBin = dEFAULT_OPEN_IN_BINARY_MODE,
haBufferMode = bmode,
haFilePath = "<stdout>",
haBuffer = buf,
haBuffers = spares
})
mkStdHandle fd_stdout "<stdout>" WriteHandle buf bmode
stderr :: Handle
stderr = unsafePerformIO $ do
......@@ -528,17 +505,8 @@ stderr = unsafePerformIO $ do
-- We don't set non-blocking mode on stdout or sterr, because
-- some shells don't recover properly.
-- setNonBlockingFD fd_stderr
buffer <- mkUnBuffer
spares <- newIORef BufferListNil
newFileHandle stdHandleFinalizer
(Handle__ { haFD = fd_stderr,
haType = WriteHandle,
haIsBin = dEFAULT_OPEN_IN_BINARY_MODE,
haBufferMode = NoBuffering,
haFilePath = "<stderr>",
haBuffer = buffer,
haBuffers = spares
})
buf <- mkUnBuffer
mkStdHandle fd_stderr "<stderr>" WriteHandle buf NoBuffering
-- ---------------------------------------------------------------------------
-- Opening and Closing Files
......@@ -690,6 +658,21 @@ foreign import "lockFile" unsafe
foreign import "unlockFile" unsafe
unlockFile :: CInt -> IO CInt
mkStdHandle :: FD -> FilePath -> HandleType -> IORef Buffer -> BufferMode
-> IO Handle
mkStdHandle fd filepath ha_type buf bmode = do
spares <- newIORef BufferListNil
newFileHandle stdHandleFinalizer
(Handle__ { haFD = fd,
haType = ha_type,
haIsBin = dEFAULT_OPEN_IN_BINARY_MODE,
haBufferMode = bmode,
haFilePath = filepath,
haBuffer = buf,
haBuffers = spares,
haOtherSide = Nothing
})
mkFileHandle :: FD -> FilePath -> HandleType -> Bool -> IO Handle
mkFileHandle fd filepath ha_type binary = do
(buf, bmode) <- getBuffer fd (initBufferState ha_type)
......@@ -701,7 +684,8 @@ mkFileHandle fd filepath ha_type binary = do
haBufferMode = bmode,
haFilePath = filepath,
haBuffer = buf,
haBuffers = spares
haBuffers = spares,
haOtherSide = Nothing
})
mkDuplexHandle :: FD -> FilePath -> Bool -> IO Handle
......@@ -715,7 +699,8 @@ mkDuplexHandle fd filepath binary = do
haBufferMode = w_bmode,
haFilePath = filepath,
haBuffer = w_buf,
haBuffers = w_spares
haBuffers = w_spares,
haOtherSide = Nothing
}
write_side <- newMVar w_handle_
......@@ -723,16 +708,17 @@ mkDuplexHandle fd filepath binary = do
r_spares <- newIORef BufferListNil
let r_handle_ =
Handle__ { haFD = fd,
haType = ReadSideHandle write_side,
haType = ReadHandle,
haIsBin = binary,
haBufferMode = r_bmode,
haFilePath = filepath,
haBuffer = r_buf,
haBuffers = r_spares
haBuffers = r_spares,
haOtherSide = Just write_side
}
read_side <- newMVar r_handle_
addMVarFinalizer write_side (handleFinalizer write_side)
addMVarFinalizer read_side (handleFinalizer read_side)
return (DuplexHandle read_side write_side)
......@@ -751,22 +737,27 @@ initBufferState _ = WriteBuffer
hClose :: Handle -> IO ()
hClose h@(FileHandle m) = hClose' h m
hClose h@(DuplexHandle r w) = do
hClose' h w
withHandle__' "hClose" h r $ \ handle_ -> do
return handle_{ haFD = -1,
haType = ClosedHandle
}
hClose h@(DuplexHandle r w) = hClose' h w >> hClose' h r
hClose' h m = withHandle__' "hClose" h m $ hClose_help
-- hClose_help is also called by lazyRead (in PrelIO) when EOF is read
-- or an IO error occurs on a lazy stream. The semi-closed Handle is
-- then closed immediately. We have to be careful with DuplexHandles
-- though: we have to leave the closing to the finalizer in that case,
-- because the write side may still be in use.
hClose_help handle_ =
case haType handle_ of
ClosedHandle -> return handle_
_ -> do
let fd = fromIntegral (haFD handle_)
flushWriteBufferOnly handle_
throwErrnoIfMinus1Retry_ "hClose" (c_close fd)
-- close the file descriptor, but not when this is the read side
-- of a duplex handle.
case haOtherSide handle_ of
Nothing -> throwErrnoIfMinus1Retry_ "hClose" (c_close fd)
Just _ -> return ()
-- free the spare buffers
writeIORef (haBuffers handle_) BufferListNil
......
% ------------------------------------------------------------------------------
% $Id: PrelIOBase.lhs,v 1.43 2001/10/11 22:27:04 sof Exp $
% $Id: PrelIOBase.lhs,v 1.44 2001/11/14 11:39:29 simonmar Exp $
%
% (c) The University of Glasgow, 1994-2001
%
......@@ -149,13 +149,15 @@ type FD = Int -- XXX ToDo: should be CInt
data Handle__
= Handle__ {
haFD :: !FD,
haType :: HandleType,
haIsBin :: Bool,
haBufferMode :: BufferMode,
haFilePath :: FilePath,
haBuffer :: !(IORef Buffer),
haBuffers :: !(IORef BufferList)
haFD :: !FD, -- file descriptor
haType :: HandleType, -- type (read/write/append etc.)
haIsBin :: Bool, -- binary mode?
haBufferMode :: BufferMode, -- buffer contains read/write data?
haFilePath :: FilePath, -- file name, possibly
haBuffer :: !(IORef Buffer), -- the current buffer
haBuffers :: !(IORef BufferList), -- spare buffers
haOtherSide :: Maybe (MVar Handle__) -- ptr to the write side of a
-- duplex handle.
}
-- ---------------------------------------------------------------------------
......@@ -233,11 +235,9 @@ data HandleType
| WriteHandle
| AppendHandle
| ReadWriteHandle
| ReadSideHandle !(MVar Handle__) -- read side of a duplex handle
isReadableHandleType ReadHandle = True
isReadableHandleType ReadWriteHandle = True
isReadableHandleType (ReadSideHandle _) = True
isReadableHandleType _ = False
isWritableHandleType AppendHandle = True
......@@ -331,13 +331,12 @@ instance Show HandleType where
WriteHandle -> showString "writable"
AppendHandle -> showString "writable (append)"
ReadWriteHandle -> showString "read-writable"
ReadSideHandle _ -> showString "read-writable (duplex)"
instance Show Handle where
showsPrec p (FileHandle h) = showHandle p h
showsPrec p (DuplexHandle h _) = showHandle p h
showsPrec p (FileHandle h) = showHandle p h False
showsPrec p (DuplexHandle _ h) = showHandle p h True
showHandle p h =
showHandle p h duplex =
let
-- (Big) SIGH: unfolded defn of takeMVar to avoid
-- an (oh-so) unfortunate module loop with PrelConc.
......@@ -346,14 +345,18 @@ showHandle p h =
case takeMVar# h# s# of { (# s2# , r #) ->
case putMVar# h# r s2# of { s3# ->
(# s3#, r #) }}})
showType | duplex = showString "duplex (read-write)"
| otherwise = showsPrec p (haType hdl_)
in
showChar '{' .
showHdl (haType hdl_)
(showString "loc=" . showString (haFilePath hdl_) . showChar ',' .
showString "type=" . showsPrec p (haType hdl_) . showChar ',' .
showString "type=" . showType . showChar ',' .
showString "binary=" . showsPrec p (haIsBin hdl_) . showChar ',' .
showString "buffering=" . showBufMode (unsafePerformIO (readIORef (haBuffer hdl_))) (haBufferMode hdl_) . showString "}" )
where
showHdl :: HandleType -> ShowS -> ShowS
showHdl ht cont =
case ht of
......
Markdown is supported
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