From 9bd3b5f37a3eda096e575f21b3c746acf5ace7ca Mon Sep 17 00:00:00 2001 From: simonmar Date: Wed, 14 Nov 2001 11:39:29 +0000 Subject: [PATCH] [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. --- ghc/lib/std/PrelHandle.hs | 95 ++++++++++++++++++++------------------------ ghc/lib/std/PrelIOBase.lhs | 33 ++++++++------- 2 files changed, 61 insertions(+), 67 deletions(-) diff --git a/ghc/lib/std/PrelHandle.hs b/ghc/lib/std/PrelHandle.hs index efcb675..57f85a1 100644 --- a/ghc/lib/std/PrelHandle.hs +++ b/ghc/lib/std/PrelHandle.hs @@ -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 = "", - haBuffer = buf, - haBuffers = spares - }) + mkStdHandle fd_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 = "", - haBuffer = buf, - haBuffers = spares - }) + mkStdHandle fd_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 = "", - haBuffer = buffer, - haBuffers = spares - }) + buf <- mkUnBuffer + mkStdHandle fd_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 diff --git a/ghc/lib/std/PrelIOBase.lhs b/ghc/lib/std/PrelIOBase.lhs index 3179a5e..0a8f8c2 100644 --- a/ghc/lib/std/PrelIOBase.lhs +++ b/ghc/lib/std/PrelIOBase.lhs @@ -1,5 +1,5 @@ % ------------------------------------------------------------------------------ -% $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 -- 1.7.10.4