From 7d39e10019df33f1a19d65b3c58c4d01a7dc8d30 Mon Sep 17 00:00:00 2001 From: Simon Marlow Date: Wed, 5 Aug 2009 13:40:36 +0000 Subject: [PATCH] Tweak the BufferedIO class to enable a memory-mapped file implementation We have to eliminate the assumption that an empty write buffer can be constructed by setting the buffer pointers to zero: this isn't necessarily the case when the buffer corresponds to a memory-mapped file, or other in-memory device implementation. --- GHC/IO/Buffer.hs | 34 +++++++++++++++++----------------- GHC/IO/BufferedIO.hs | 27 ++++++++++++++++++++------- GHC/IO/FD.hs | 2 +- GHC/IO/Handle/Internals.hs | 7 ++++--- GHC/IO/Handle/Text.hs | 4 ++-- 5 files changed, 44 insertions(+), 30 deletions(-) diff --git a/GHC/IO/Buffer.hs b/GHC/IO/Buffer.hs index 65e7184..7096777 100644 --- a/GHC/IO/Buffer.hs +++ b/GHC/IO/Buffer.hs @@ -160,19 +160,21 @@ charSize = 4 -- --------------------------------------------------------------------------- -- Buffers --- The buffer is represented by a mutable variable containing a --- record, where the record contains the raw buffer and the start/end --- points of the filled portion. We use a mutable variable so that --- the common operation of writing (or reading) some data from (to) --- the buffer doesn't need to modify, and hence copy, the handle --- itself, it just updates the buffer. - --- There will be some allocation involved in a simple hPutChar in --- order to create the new Buffer structure (below), but this is --- relatively small, and this only has to be done once per write --- operation. - -- | A mutable array of bytes that can be passed to foreign functions. +-- +-- The buffer is represented by a record, where the record contains +-- the raw buffer and the start/end points of the filled portion. The +-- buffer contents itself is mutable, but the rest of the record is +-- immutable. This is a slightly odd mix, but it turns out to be +-- quite practical: by making all the buffer metadata immutable, we +-- can have operations on buffer metadata outside of the IO monad. +-- +-- The "live" elements of the buffer are those between the 'bufL' and +-- 'bufR' offsets. In an empty buffer, 'bufL' is equal to 'bufR', but +-- they might not be zero: for exmaple, the buffer might correspond to +-- a memory-mapped file and in which case 'bufL' will point to the +-- next location to be written, which is not necessarily the beginning +-- of the file. data Buffer e = Buffer { bufRaw :: !(RawBuffer e), @@ -197,7 +199,7 @@ withRawBuffer :: RawBuffer e -> (Ptr e -> IO a) -> IO a withRawBuffer raw f = withForeignPtr (castForeignPtr raw) f isEmptyBuffer :: Buffer e -> Bool -isEmptyBuffer Buffer{ bufR=w } = w == 0 +isEmptyBuffer Buffer{ bufL=l, bufR=r } = l == r isFullBuffer :: Buffer e -> Bool isFullBuffer Buffer{ bufR=w, bufSize=s } = s == w @@ -264,8 +266,7 @@ summaryBuffer buf = "buf" ++ show (bufSize buf) ++ "(" ++ show (bufL buf) ++ "-" -- INVARIANTS on Buffers: -- * r <= w --- * if r == w, then r == 0 && w == 0 --- * if state == WriteBuffer, then r == 0 +-- * if r == w, and the buffer is for reading, then r == 0 && w == 0 -- * a write buffer is never full. If an operation -- fills up the buffer, it will always flush it before -- returning. @@ -278,8 +279,7 @@ checkBuffer buf@Buffer{ bufState = state, bufL=r, bufR=w, bufSize=size } = do size > 0 && r <= w && w <= size - && ( r /= w || (r == 0 && w == 0) ) - && ( state /= WriteBuffer || r == 0 ) + && ( r /= w || state == WriteBuffer || (r == 0 && w == 0) ) && ( state /= WriteBuffer || w < size ) -- write buffer is never full ) diff --git a/GHC/IO/BufferedIO.hs b/GHC/IO/BufferedIO.hs index f5c874e..513bf9e 100644 --- a/GHC/IO/BufferedIO.hs +++ b/GHC/IO/BufferedIO.hs @@ -52,8 +52,21 @@ class BufferedIO dev where -- buffer. fillReadBuffer0 :: dev -> Buffer Word8 -> IO (Maybe Int, Buffer Word8) - -- | Flush all the data from the supplied write buffer out to the device - flushWriteBuffer :: dev -> Buffer Word8 -> IO () + -- | Prepares an empty write buffer. This lets the device decide + -- how to set up a write buffer: the buffer may need to point to a + -- specific location in memory, for example. This is typically used + -- by the client when switching from reading to writing on a + -- buffered read/write device. + -- + -- There is no corresponding operation for read buffers, because before + -- reading the client will always call 'fillReadBuffer'. + emptyWriteBuffer :: dev -> Buffer Word8 -> IO (Buffer Word8) + emptyWriteBuffer _dev buf + = return buf{ bufL=0, bufR=0, bufState = WriteBuffer } + + -- | Flush all the data from the supplied write buffer out to the device. + -- The returned buffer should be empty, and ready for writing. + flushWriteBuffer :: dev -> Buffer Word8 -> IO (Buffer Word8) -- | Flush data from the supplied write buffer out to the device -- without blocking. Returns the number of bytes written and the @@ -65,8 +78,8 @@ class BufferedIO dev where -- for a memory-mapped file, the buffer will be the whole file in -- memory. fillReadBuffer sets the pointers to encompass the whole --- file, and flushWriteBuffer will do nothing. A memory-mapped file --- has to maintain its own file pointer. +-- file, and flushWriteBuffer needs to do no I/O. A memory-mapped +-- file has to maintain its own file pointer. -- for a bytestring, again the buffer should match the bytestring in -- memory. @@ -98,11 +111,12 @@ readBufNonBlocking dev bbuf = do Nothing -> return (Nothing, bbuf) Just n -> return (Just n, bbuf{ bufR = bufR bbuf + fromIntegral n }) -writeBuf :: RawIO dev => dev -> Buffer Word8 -> IO () +writeBuf :: RawIO dev => dev -> Buffer Word8 -> IO (Buffer Word8) writeBuf dev bbuf = do let bytes = bufferElems bbuf withBuffer bbuf $ \ptr -> IODevice.write dev (ptr `plusPtr` bufL bbuf) (fromIntegral bytes) + return bbuf{ bufL=0, bufR=0 } -- XXX ToDo writeBufNonBlocking :: RawIO dev => dev -> Buffer Word8 -> IO (Int, Buffer Word8) @@ -111,5 +125,4 @@ writeBufNonBlocking dev bbuf = do res <- withBuffer bbuf $ \ptr -> IODevice.writeNonBlocking dev (ptr `plusPtr` bufL bbuf) (fromIntegral bytes) - return (res, bbuf{ bufL = bufL bbuf + res }) - + return (res, bufferAdjustL res bbuf) diff --git a/GHC/IO/FD.hs b/GHC/IO/FD.hs index d4d28bf..98eeeab 100644 --- a/GHC/IO/FD.hs +++ b/GHC/IO/FD.hs @@ -117,7 +117,7 @@ readBuf' fd buf = do #endif return (r,buf') -writeBuf' :: FD -> Buffer Word8 -> IO () +writeBuf' :: FD -> Buffer Word8 -> IO (Buffer Word8) writeBuf' fd buf = do #ifdef DEBUG_DUMP puts ("writeBuf fd=" ++ show fd ++ " " ++ summaryBuffer buf ++ "\n") diff --git a/GHC/IO/Handle/Internals.hs b/GHC/IO/Handle/Internals.hs index 0de07f4..403407f 100644 --- a/GHC/IO/Handle/Internals.hs +++ b/GHC/IO/Handle/Internals.hs @@ -205,7 +205,8 @@ checkWritableHandle act h_@Handle__{..} buf <- readIORef haCharBuffer writeIORef haCharBuffer buf{ bufState = WriteBuffer } buf <- readIORef haByteBuffer - writeIORef haByteBuffer buf{ bufState = WriteBuffer } + buf' <- Buffered.emptyWriteBuffer haDevice buf + writeIORef haByteBuffer buf' act h_ _other -> act h_ @@ -705,8 +706,8 @@ writeTextDevice h_@Handle__{..} cbuf = do debugIO ("writeTextDevice after encoding: cbuf=" ++ summaryBuffer cbuf' ++ " bbuf=" ++ summaryBuffer bbuf') - Buffered.flushWriteBuffer haDevice bbuf' - writeIORef haByteBuffer bbuf{bufL=0,bufR=0} + bbuf' <- Buffered.flushWriteBuffer haDevice bbuf' + writeIORef haByteBuffer bbuf' if not (isEmptyBuffer cbuf') then writeTextDevice h_ cbuf' else return () diff --git a/GHC/IO/Handle/Text.hs b/GHC/IO/Handle/Text.hs index 754be02..168a5a5 100644 --- a/GHC/IO/Handle/Text.hs +++ b/GHC/IO/Handle/Text.hs @@ -748,9 +748,9 @@ bufWrite h_@Handle__{..} ptr count can_block = -- else, we have to flush else do debugIO "hPutBuf: flushing first" - Buffered.flushWriteBuffer haDevice old_buf + old_buf' <- Buffered.flushWriteBuffer haDevice old_buf -- TODO: we should do a non-blocking flush here - writeIORef haByteBuffer old_buf{bufL=0,bufR=0} + writeIORef haByteBuffer old_buf' -- if we can fit in the buffer, then just loop if count < size then bufWrite h_ ptr count can_block -- 1.7.10.4