--- commitBuffer handle buf sz count flush release
---
--- Write the contents of the buffer 'buf' ('sz' bytes long, containing
--- 'count' bytes of data) to handle (handle must be block or line buffered).
---
--- Implementation:
---
--- for block/line buffering,
--- 1. If there isn't room in the handle buffer, flush the handle
--- buffer.
---
--- 2. If the handle buffer is empty,
--- if flush,
--- then write buf directly to the device.
--- else swap the handle buffer with buf.
---
--- 3. If the handle buffer is non-empty, copy buf into the
--- handle buffer. Then, if flush != 0, flush
--- the buffer.
-
-commitBuffer
- :: Handle -- handle to commit to
- -> RawBuffer -> Int -- address and size (in bytes) of buffer
- -> Int -- number of bytes of data in buffer
- -> Bool -- True <=> flush the handle afterward
- -> Bool -- release the buffer?
- -> IO Buffer
-
-commitBuffer hdl raw sz@(I# _) count@(I# _) flush release = do
- wantWritableHandle "commitAndReleaseBuffer" hdl $
- commitBuffer' hdl raw sz count flush release
-
--- Explicitly lambda-lift this function to subvert GHC's full laziness
--- optimisations, which otherwise tends to float out subexpressions
--- past the \handle, which is really a pessimisation in this case because
--- that lambda is a one-shot lambda.
---
--- Don't forget to export the function, to stop it being inlined too
--- (this appears to be better than NOINLINE, because the strictness
--- analyser still gets to worker-wrapper it).
---
--- This hack is a fairly big win for hPutStr performance. --SDM 18/9/2001
---
-commitBuffer' hdl raw sz@(I# _) count@(I# _) flush release
- handle_@Handle__{ haFD=fd, haBuffer=ref, haBuffers=spare_buf_ref } = do
-
-#ifdef DEBUG_DUMP
- puts ("commitBuffer: sz=" ++ show sz ++ ", count=" ++ show count
- ++ ", flush=" ++ show flush ++ ", release=" ++ show release ++"\n")
-#endif
-
- old_buf@Buffer{ bufBuf=old_raw, bufRPtr=r, bufWPtr=w, bufSize=size }
- <- readIORef ref
-
- buf_ret <-
- -- enough room in handle buffer?
- if (not flush && (size - w > count))
- -- The > is to be sure that we never exactly fill
- -- up the buffer, which would require a flush. So
- -- if copying the new data into the buffer would
- -- make the buffer full, we just flush the existing
- -- buffer and the new data immediately, rather than
- -- copying before flushing.
-
- -- not flushing, and there's enough room in the buffer:
- -- just copy the data in and update bufWPtr.
- then do memcpy_baoff_ba old_raw w raw (fromIntegral count)
- writeIORef ref old_buf{ bufWPtr = w + count }
- return (newEmptyBuffer raw WriteBuffer sz)
-
- -- else, we have to flush
- else do flushed_buf <- flushWriteBuffer fd (haIsStream handle_) old_buf
-
- let this_buf =
- Buffer{ bufBuf=raw, bufState=WriteBuffer,
- bufRPtr=0, bufWPtr=count, bufSize=sz }
-
- -- if: (a) we don't have to flush, and
- -- (b) size(new buffer) == size(old buffer), and
- -- (c) new buffer is not full,
- -- we can just just swap them over...
- if (not flush && sz == size && count /= sz)
- then do
- writeIORef ref this_buf
- return flushed_buf
-
- -- otherwise, we have to flush the new data too,
- -- and start with a fresh buffer
- else do
- flushWriteBuffer fd (haIsStream handle_) this_buf
- writeIORef ref flushed_buf
- -- if the sizes were different, then allocate
- -- a new buffer of the correct size.
- if sz == size
- then return (newEmptyBuffer raw WriteBuffer sz)
- else allocateBuffer size WriteBuffer
-
- -- release the buffer if necessary
- case buf_ret of
- Buffer{ bufSize=buf_ret_sz, bufBuf=buf_ret_raw } -> do
- if release && buf_ret_sz == size
- then do
- spare_bufs <- readIORef spare_buf_ref
- writeIORef spare_buf_ref
- (BufferListCons buf_ret_raw spare_bufs)
- return buf_ret
- else
- return buf_ret
-
--- ---------------------------------------------------------------------------
--- Reading/writing sequences of bytes.