-- ---------------------------------------------------------------------------
-- 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),
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
-- 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.
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
)
-- 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
-- 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.
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)
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)
#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")
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_
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 ()
-- 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
projects / ghc-base.git / commitdiff