1 {-# OPTIONS -fno-implicit-prelude -#include "HsBase.h" #-}
5 -----------------------------------------------------------------------------
8 -- Copyright : (c) The University of Glasgow, 1992-2001
9 -- License : see libraries/base/LICENSE
11 -- Maintainer : libraries@haskell.org
12 -- Stability : internal
13 -- Portability : non-portable
15 -- String I\/O functions
17 -----------------------------------------------------------------------------
20 hWaitForInput, hGetChar, hGetLine, hGetContents, hPutChar, hPutStr,
21 commitBuffer', -- hack, see below
22 hGetcBuffered, -- needed by ghc/compiler/utils/StringBuffer.lhs
23 hGetBuf, hGetBufNonBlocking, hPutBuf, hPutBufNonBlocking, slurpFile,
24 createPipe, createPipeEx,
36 import System.IO.Error
39 import System.Posix.Internals
44 import GHC.Handle -- much of the real stuff is in here
49 import GHC.Exception ( ioError, catch )
52 -- ---------------------------------------------------------------------------
53 -- Simple input operations
55 -- If hWaitForInput finds anything in the Handle's buffer, it
56 -- immediately returns. If not, it tries to read from the underlying
57 -- OS handle. Notice that for buffered Handles connected to terminals
58 -- this means waiting until a complete line is available.
60 -- | Computation 'hWaitForInput' @hdl t@
61 -- waits until input is available on handle @hdl@.
62 -- It returns 'True' as soon as input is available on @hdl@,
63 -- or 'False' if no input is available within @t@ milliseconds.
65 -- This operation may fail with:
67 -- * 'isEOFError' if the end of file has been reached.
69 hWaitForInput :: Handle -> Int -> IO Bool
70 hWaitForInput h msecs = do
71 wantReadableHandle "hWaitForInput" h $ \ handle_ -> do
72 let ref = haBuffer handle_
75 if not (bufferEmpty buf)
79 r <- throwErrnoIfMinus1Retry "hWaitForInput"
80 (inputReady (fromIntegral (haFD handle_)) (fromIntegral msecs) (haIsStream handle_))
83 foreign import ccall unsafe "inputReady"
84 inputReady :: CInt -> CInt -> Bool -> IO CInt
86 -- ---------------------------------------------------------------------------
89 -- | Computation 'hGetChar' @hdl@ reads a character from the file or
90 -- channel managed by @hdl@, blocking until a character is available.
92 -- This operation may fail with:
94 -- * 'isEOFError' if the end of file has been reached.
96 hGetChar :: Handle -> IO Char
98 wantReadableHandle "hGetChar" handle $ \handle_ -> do
100 let fd = haFD handle_
101 ref = haBuffer handle_
104 if not (bufferEmpty buf)
105 then hGetcBuffered fd ref buf
109 case haBufferMode handle_ of
111 new_buf <- fillReadBuffer fd True (haIsStream handle_) buf
112 hGetcBuffered fd ref new_buf
113 BlockBuffering _ -> do
114 new_buf <- fillReadBuffer fd True (haIsStream handle_) buf
116 -- don't wait for a completely full buffer.
117 hGetcBuffered fd ref new_buf
119 -- make use of the minimal buffer we already have
121 r <- readRawBuffer "hGetChar" (fromIntegral fd) (haIsStream handle_) raw 0 1
124 else do (c,_) <- readCharFromBuffer raw 0
127 hGetcBuffered fd ref buf@Buffer{ bufBuf=b, bufRPtr=r, bufWPtr=w }
128 = do (c,r) <- readCharFromBuffer b r
129 let new_buf | r == w = buf{ bufRPtr=0, bufWPtr=0 }
130 | otherwise = buf{ bufRPtr=r }
131 writeIORef ref new_buf
134 -- ---------------------------------------------------------------------------
137 -- ToDo: the unbuffered case is wrong: it doesn't lock the handle for
140 -- | Computation 'hGetLine' @hdl@ reads a line from the file or
141 -- channel managed by @hdl@.
143 -- This operation may fail with:
145 -- * 'isEOFError' if the end of file is encountered when reading
146 -- the /first/ character of the line.
148 -- If 'hGetLine' encounters end-of-file at any other point while reading
149 -- in a line, it is treated as a line terminator and the (partial)
152 hGetLine :: Handle -> IO String
154 m <- wantReadableHandle "hGetLine" h $ \ handle_ -> do
155 case haBufferMode handle_ of
156 NoBuffering -> return Nothing
158 l <- hGetLineBuffered handle_
160 BlockBuffering _ -> do
161 l <- hGetLineBuffered handle_
164 Nothing -> hGetLineUnBuffered h
168 hGetLineBuffered handle_ = do
169 let ref = haBuffer handle_
171 hGetLineBufferedLoop handle_ ref buf []
174 hGetLineBufferedLoop handle_ ref
175 buf@Buffer{ bufRPtr=r, bufWPtr=w, bufBuf=raw } xss =
177 -- find the end-of-line character, if there is one
179 | r == w = return (False, w)
181 (c,r') <- readCharFromBuffer raw r
183 then return (True, r) -- NB. not r': don't include the '\n'
186 (eol, off) <- loop raw r
189 puts ("hGetLineBufferedLoop: r=" ++ show r ++ ", w=" ++ show w ++ ", off=" ++ show off ++ "\n")
192 xs <- unpack raw r off
194 -- if eol == True, then off is the offset of the '\n'
195 -- otherwise off == w and the buffer is now empty.
197 then do if (w == off + 1)
198 then writeIORef ref buf{ bufRPtr=0, bufWPtr=0 }
199 else writeIORef ref buf{ bufRPtr = off + 1 }
200 return (concat (reverse (xs:xss)))
202 maybe_buf <- maybeFillReadBuffer (haFD handle_) True (haIsStream handle_)
203 buf{ bufWPtr=0, bufRPtr=0 }
205 -- Nothing indicates we caught an EOF, and we may have a
206 -- partial line to return.
208 writeIORef ref buf{ bufRPtr=0, bufWPtr=0 }
209 let str = concat (reverse (xs:xss))
214 hGetLineBufferedLoop handle_ ref new_buf (xs:xss)
217 maybeFillReadBuffer fd is_line is_stream buf
219 (do buf <- fillReadBuffer fd is_line is_stream buf
222 (\e -> do if isEOFError e
227 unpack :: RawBuffer -> Int -> Int -> IO [Char]
228 unpack buf r 0 = return ""
229 unpack buf (I# r) (I# len) = IO $ \s -> unpack [] (len -# 1#) s
232 | i <# r = (# s, acc #)
234 case readCharArray# buf i s of
235 (# s, ch #) -> unpack (C# ch : acc) (i -# 1#) s
238 hGetLineUnBuffered :: Handle -> IO String
239 hGetLineUnBuffered h = do
252 if isEOFError err then
262 -- -----------------------------------------------------------------------------
265 -- hGetContents on a DuplexHandle only affects the read side: you can
266 -- carry on writing to it afterwards.
268 -- | Computation 'hGetContents' @hdl@ returns the list of characters
269 -- corresponding to the unread portion of the channel or file managed
270 -- by @hdl@, which is put into an intermediate state, /semi-closed/.
271 -- In this state, @hdl@ is effectively closed,
272 -- but items are read from @hdl@ on demand and accumulated in a special
273 -- list returned by 'hGetContents' @hdl@.
275 -- Any operation that fails because a handle is closed,
276 -- also fails if a handle is semi-closed. The only exception is 'hClose'.
277 -- A semi-closed handle becomes closed:
279 -- * if 'hClose' is applied to it;
281 -- * if an I\/O error occurs when reading an item from the handle;
283 -- * or once the entire contents of the handle has been read.
285 -- Once a semi-closed handle becomes closed, the contents of the
286 -- associated list becomes fixed. The contents of this final list is
287 -- only partially specified: it will contain at least all the items of
288 -- the stream that were evaluated prior to the handle becoming closed.
290 -- Any I\/O errors encountered while a handle is semi-closed are simply
293 -- This operation may fail with:
295 -- * 'isEOFError' if the end of file has been reached.
297 hGetContents :: Handle -> IO String
298 hGetContents handle =
299 withHandle "hGetContents" handle $ \handle_ ->
300 case haType handle_ of
301 ClosedHandle -> ioe_closedHandle
302 SemiClosedHandle -> ioe_closedHandle
303 AppendHandle -> ioe_notReadable
304 WriteHandle -> ioe_notReadable
305 _ -> do xs <- lazyRead handle
306 return (handle_{ haType=SemiClosedHandle}, xs )
308 -- Note that someone may close the semi-closed handle (or change its
309 -- buffering), so each time these lazy read functions are pulled on,
310 -- they have to check whether the handle has indeed been closed.
312 lazyRead :: Handle -> IO String
315 withHandle "lazyRead" handle $ \ handle_ -> do
316 case haType handle_ of
317 ClosedHandle -> return (handle_, "")
318 SemiClosedHandle -> lazyRead' handle handle_
320 (IOError (Just handle) IllegalOperation "lazyRead"
321 "illegal handle type" Nothing)
323 lazyRead' h handle_ = do
324 let ref = haBuffer handle_
327 -- even a NoBuffering handle can have a char in the buffer...
330 if not (bufferEmpty buf)
331 then lazyReadHaveBuffer h handle_ fd ref buf
334 case haBufferMode handle_ of
336 -- make use of the minimal buffer we already have
338 r <- readRawBuffer "lazyRead" (fromIntegral fd) (haIsStream handle_) raw 0 1
340 then do handle_ <- hClose_help handle_
342 else do (c,_) <- readCharFromBuffer raw 0
344 return (handle_, c : rest)
346 LineBuffering -> lazyReadBuffered h handle_ fd ref buf
347 BlockBuffering _ -> lazyReadBuffered h handle_ fd ref buf
349 -- we never want to block during the read, so we call fillReadBuffer with
350 -- is_line==True, which tells it to "just read what there is".
351 lazyReadBuffered h handle_ fd ref buf = do
353 (do buf <- fillReadBuffer fd True{-is_line-} (haIsStream handle_) buf
354 lazyReadHaveBuffer h handle_ fd ref buf
356 -- all I/O errors are discarded. Additionally, we close the handle.
357 (\e -> do handle_ <- hClose_help handle_
361 lazyReadHaveBuffer h handle_ fd ref buf = do
363 writeIORef ref buf{ bufRPtr=0, bufWPtr=0 }
364 s <- unpackAcc (bufBuf buf) (bufRPtr buf) (bufWPtr buf) more
368 unpackAcc :: RawBuffer -> Int -> Int -> [Char] -> IO [Char]
369 unpackAcc buf r 0 acc = return acc
370 unpackAcc buf (I# r) (I# len) acc = IO $ \s -> unpack acc (len -# 1#) s
373 | i <# r = (# s, acc #)
375 case readCharArray# buf i s of
376 (# s, ch #) -> unpack (C# ch : acc) (i -# 1#) s
378 -- ---------------------------------------------------------------------------
381 -- | Computation 'hPutChar' @hdl ch@ writes the character @ch@ to the
382 -- file or channel managed by @hdl@. Characters may be buffered if
383 -- buffering is enabled for @hdl@.
385 -- This operation may fail with:
387 -- * 'isFullError' if the device is full; or
389 -- * 'isPermissionError' if another system resource limit would be exceeded.
391 hPutChar :: Handle -> Char -> IO ()
393 c `seq` do -- must evaluate c before grabbing the handle lock
394 wantWritableHandle "hPutChar" handle $ \ handle_ -> do
395 let fd = haFD handle_
396 case haBufferMode handle_ of
397 LineBuffering -> hPutcBuffered handle_ True c
398 BlockBuffering _ -> hPutcBuffered handle_ False c
400 withObject (castCharToCChar c) $ \buf -> do
401 writeRawBufferPtr "hPutChar" (fromIntegral fd) (haIsStream handle_) buf 0 1
404 hPutcBuffered handle_ is_line c = do
405 let ref = haBuffer handle_
408 w' <- writeCharIntoBuffer (bufBuf buf) w c
409 let new_buf = buf{ bufWPtr = w' }
410 if bufferFull new_buf || is_line && c == '\n'
412 flushed_buf <- flushWriteBuffer (haFD handle_) (haIsStream handle_) new_buf
413 writeIORef ref flushed_buf
415 writeIORef ref new_buf
418 hPutChars :: Handle -> [Char] -> IO ()
419 hPutChars handle [] = return ()
420 hPutChars handle (c:cs) = hPutChar handle c >> hPutChars handle cs
422 -- ---------------------------------------------------------------------------
425 -- We go to some trouble to avoid keeping the handle locked while we're
426 -- evaluating the string argument to hPutStr, in case doing so triggers another
427 -- I/O operation on the same handle which would lead to deadlock. The classic
430 -- putStr (trace "hello" "world")
432 -- so the basic scheme is this:
434 -- * copy the string into a fresh buffer,
435 -- * "commit" the buffer to the handle.
437 -- Committing may involve simply copying the contents of the new
438 -- buffer into the handle's buffer, flushing one or both buffers, or
439 -- maybe just swapping the buffers over (if the handle's buffer was
440 -- empty). See commitBuffer below.
442 -- | Computation 'hPutStr' @hdl s@ writes the string
443 -- @s@ to the file or channel managed by @hdl@.
445 -- This operation may fail with:
447 -- * 'isFullError' if the device is full; or
449 -- * 'isPermissionError' if another system resource limit would be exceeded.
451 hPutStr :: Handle -> String -> IO ()
452 hPutStr handle str = do
453 buffer_mode <- wantWritableHandle "hPutStr" handle
454 (\ handle_ -> do getSpareBuffer handle_)
456 (NoBuffering, _) -> do
457 hPutChars handle str -- v. slow, but we don't care
458 (LineBuffering, buf) -> do
459 writeLines handle buf str
460 (BlockBuffering _, buf) -> do
461 writeBlocks handle buf str
464 getSpareBuffer :: Handle__ -> IO (BufferMode, Buffer)
465 getSpareBuffer Handle__{haBuffer=ref,
470 NoBuffering -> return (mode, error "no buffer!")
472 bufs <- readIORef spare_ref
475 BufferListCons b rest -> do
476 writeIORef spare_ref rest
477 return ( mode, newEmptyBuffer b WriteBuffer (bufSize buf))
479 new_buf <- allocateBuffer (bufSize buf) WriteBuffer
480 return (mode, new_buf)
483 writeLines :: Handle -> Buffer -> String -> IO ()
484 writeLines hdl Buffer{ bufBuf=raw, bufSize=len } s =
486 shoveString :: Int -> [Char] -> IO ()
487 -- check n == len first, to ensure that shoveString is strict in n.
488 shoveString n cs | n == len = do
489 new_buf <- commitBuffer hdl raw len n True{-needs flush-} False
490 writeLines hdl new_buf cs
491 shoveString n [] = do
492 commitBuffer hdl raw len n False{-no flush-} True{-release-}
494 shoveString n (c:cs) = do
495 n' <- writeCharIntoBuffer raw n c
498 new_buf <- commitBuffer hdl raw len n' True{-needs flush-} False
499 writeLines hdl new_buf cs
505 writeBlocks :: Handle -> Buffer -> String -> IO ()
506 writeBlocks hdl Buffer{ bufBuf=raw, bufSize=len } s =
508 shoveString :: Int -> [Char] -> IO ()
509 -- check n == len first, to ensure that shoveString is strict in n.
510 shoveString n cs | n == len = do
511 new_buf <- commitBuffer hdl raw len n True{-needs flush-} False
512 writeBlocks hdl new_buf cs
513 shoveString n [] = do
514 commitBuffer hdl raw len n False{-no flush-} True{-release-}
516 shoveString n (c:cs) = do
517 n' <- writeCharIntoBuffer raw n c
522 -- -----------------------------------------------------------------------------
523 -- commitBuffer handle buf sz count flush release
525 -- Write the contents of the buffer 'buf' ('sz' bytes long, containing
526 -- 'count' bytes of data) to handle (handle must be block or line buffered).
530 -- for block/line buffering,
531 -- 1. If there isn't room in the handle buffer, flush the handle
534 -- 2. If the handle buffer is empty,
536 -- then write buf directly to the device.
537 -- else swap the handle buffer with buf.
539 -- 3. If the handle buffer is non-empty, copy buf into the
540 -- handle buffer. Then, if flush != 0, flush
544 :: Handle -- handle to commit to
545 -> RawBuffer -> Int -- address and size (in bytes) of buffer
546 -> Int -- number of bytes of data in buffer
547 -> Bool -- True <=> flush the handle afterward
548 -> Bool -- release the buffer?
551 commitBuffer hdl raw sz@(I# _) count@(I# _) flush release = do
552 wantWritableHandle "commitAndReleaseBuffer" hdl $
553 commitBuffer' hdl raw sz count flush release
555 -- Explicitly lambda-lift this function to subvert GHC's full laziness
556 -- optimisations, which otherwise tends to float out subexpressions
557 -- past the \handle, which is really a pessimisation in this case because
558 -- that lambda is a one-shot lambda.
560 -- Don't forget to export the function, to stop it being inlined too
561 -- (this appears to be better than NOINLINE, because the strictness
562 -- analyser still gets to worker-wrapper it).
564 -- This hack is a fairly big win for hPutStr performance. --SDM 18/9/2001
566 commitBuffer' hdl raw sz@(I# _) count@(I# _) flush release
567 handle_@Handle__{ haFD=fd, haBuffer=ref, haBuffers=spare_buf_ref } = do
570 puts ("commitBuffer: sz=" ++ show sz ++ ", count=" ++ show count
571 ++ ", flush=" ++ show flush ++ ", release=" ++ show release ++"\n")
574 old_buf@Buffer{ bufBuf=old_raw, bufRPtr=r, bufWPtr=w, bufSize=size }
578 -- enough room in handle buffer?
579 if (not flush && (size - w > count))
580 -- The > is to be sure that we never exactly fill
581 -- up the buffer, which would require a flush. So
582 -- if copying the new data into the buffer would
583 -- make the buffer full, we just flush the existing
584 -- buffer and the new data immediately, rather than
585 -- copying before flushing.
587 -- not flushing, and there's enough room in the buffer:
588 -- just copy the data in and update bufWPtr.
589 then do memcpy_baoff_ba old_raw w raw (fromIntegral count)
590 writeIORef ref old_buf{ bufWPtr = w + count }
591 return (newEmptyBuffer raw WriteBuffer sz)
593 -- else, we have to flush
594 else do flushed_buf <- flushWriteBuffer fd (haIsStream handle_) old_buf
597 Buffer{ bufBuf=raw, bufState=WriteBuffer,
598 bufRPtr=0, bufWPtr=count, bufSize=sz }
600 -- if: (a) we don't have to flush, and
601 -- (b) size(new buffer) == size(old buffer), and
602 -- (c) new buffer is not full,
603 -- we can just just swap them over...
604 if (not flush && sz == size && count /= sz)
606 writeIORef ref this_buf
609 -- otherwise, we have to flush the new data too,
610 -- and start with a fresh buffer
612 flushWriteBuffer fd (haIsStream handle_) this_buf
613 writeIORef ref flushed_buf
614 -- if the sizes were different, then allocate
615 -- a new buffer of the correct size.
617 then return (newEmptyBuffer raw WriteBuffer sz)
618 else allocateBuffer size WriteBuffer
620 -- release the buffer if necessary
622 Buffer{ bufSize=buf_ret_sz, bufBuf=buf_ret_raw } -> do
623 if release && buf_ret_sz == size
625 spare_bufs <- readIORef spare_buf_ref
626 writeIORef spare_buf_ref
627 (BufferListCons buf_ret_raw spare_bufs)
632 -- ---------------------------------------------------------------------------
633 -- Reading/writing sequences of bytes.
635 -- ---------------------------------------------------------------------------
638 -- | 'hPutBuf' @hdl buf count@ writes @count@ 8-bit bytes from the
639 -- buffer @buf@ to the handle @hdl@. It returns ().
641 -- This operation may fail with:
643 -- * 'ResourceVanished' if the handle is a pipe or socket, and the
644 -- reading end is closed. (If this is a POSIX system, and the program
645 -- has not asked to ignore SIGPIPE, then a SIGPIPE may be delivered
646 -- instead, whose default action is to terminate the program).
648 hPutBuf :: Handle -- handle to write to
649 -> Ptr a -- address of buffer
650 -> Int -- number of bytes of data in buffer
652 hPutBuf h ptr count = do hPutBuf' h ptr count True; return ()
655 :: Handle -- handle to write to
656 -> Ptr a -- address of buffer
657 -> Int -- number of bytes of data in buffer
658 -> IO Int -- returns: number of bytes written
659 hPutBufNonBlocking h ptr count = hPutBuf' h ptr count False
661 hPutBuf':: Handle -- handle to write to
662 -> Ptr a -- address of buffer
663 -> Int -- number of bytes of data in buffer
664 -> Bool -- allow blocking?
666 hPutBuf' handle ptr count can_block
667 | count == 0 = return 0
668 | count < 0 = illegalBufferSize handle "hPutBuf" count
670 wantWritableHandle "hPutBuf" handle $
671 \ handle_@Handle__{ haFD=fd, haBuffer=ref, haIsStream=is_stream } ->
672 bufWrite fd ref is_stream ptr count can_block
674 bufWrite fd ref is_stream ptr count can_block =
675 seq count $ seq fd $ do -- strictness hack
676 old_buf@Buffer{ bufBuf=old_raw, bufRPtr=r, bufWPtr=w, bufSize=size }
679 -- enough room in handle buffer?
680 if (size - w > count)
681 -- There's enough room in the buffer:
682 -- just copy the data in and update bufWPtr.
683 then do memcpy_baoff_ptr old_raw w ptr (fromIntegral count)
684 writeIORef ref old_buf{ bufWPtr = w + count }
687 -- else, we have to flush
688 else do flushed_buf <- flushWriteBuffer fd is_stream old_buf
689 writeIORef ref flushed_buf
690 -- if we can fit in the buffer, then just loop
692 then bufWrite fd ref is_stream ptr count can_block
694 then do writeChunk fd is_stream (castPtr ptr) count
696 else writeChunkNonBlocking fd ptr count
698 writeChunk :: FD -> Bool -> Ptr CChar -> Int -> IO ()
699 writeChunk fd is_stream ptr bytes = loop 0 bytes
701 loop :: Int -> Int -> IO ()
702 loop _ bytes | bytes <= 0 = return ()
704 r <- fromIntegral `liftM`
705 writeRawBufferPtr "writeChunk" (fromIntegral fd) is_stream ptr
706 off (fromIntegral bytes)
707 -- write can't return 0
708 loop (off + r) (bytes - r)
710 writeChunkNonBlocking :: FD -> Ptr a -> Int -> IO Int
711 writeChunkNonBlocking fd ptr bytes = loop 0 bytes
713 loop :: Int -> Int -> IO Int
714 loop off bytes | bytes <= 0 = return off
716 ssize <- c_write (fromIntegral fd) (ptr `plusPtr` off) (fromIntegral bytes)
717 let r = fromIntegral ssize :: Int
719 then do errno <- getErrno
720 if (errno == eAGAIN || errno == eWOULDBLOCK)
722 else throwErrno "writeChunk"
723 else loop (off + r) (bytes - r)
725 -- ---------------------------------------------------------------------------
728 -- | 'hGetBuf' @hdl buf count@ reads data from the handle @hdl@
729 -- into the buffer @buf@ until either EOF is reached or
730 -- @count@ 8-bit bytes have been read.
731 -- It returns the number of bytes actually read. This may be zero if
732 -- EOF was reached before any data was read (or if @count@ is zero).
734 -- 'hGetBuf' never raises an EOF exception, instead it returns a value
735 -- smaller than @count@.
737 -- If the handle is a pipe or socket, and the writing end
738 -- is closed, 'hGetBuf' will behave as if EOF was reached.
740 hGetBuf :: Handle -> Ptr a -> Int -> IO Int
741 hGetBuf h ptr count = hGetBuf' h ptr count True
743 hGetBufNonBlocking :: Handle -> Ptr a -> Int -> IO Int
744 hGetBufNonBlocking h ptr count = hGetBuf' h ptr count False
746 hGetBuf' :: Handle -> Ptr a -> Int -> Bool -> IO Int
747 hGetBuf' handle ptr count can_block
748 | count == 0 = return 0
749 | count < 0 = illegalBufferSize handle "hGetBuf" count
751 wantReadableHandle "hGetBuf" handle $
752 \ handle_@Handle__{ haFD=fd, haBuffer=ref, haIsStream=is_stream } -> do
753 bufRead fd ref is_stream ptr 0 count can_block
755 bufRead fd ref is_stream ptr so_far count can_block =
756 seq fd $ seq so_far $ seq count $ do -- strictness hack
757 buf@Buffer{ bufBuf=raw, bufWPtr=w, bufRPtr=r, bufSize=sz } <- readIORef ref
761 mb_buf <- maybeFillReadBuffer fd (not can_block) is_stream buf
765 writeIORef ref new_buf
766 bufRead fd ref is_stream ptr so_far count can_block
768 then readChunk fd is_stream ptr count
769 else readChunkNonBlocking fd is_stream ptr count
774 memcpy_ptr_baoff ptr raw r (fromIntegral count)
775 writeIORef ref buf{ bufWPtr=0, bufRPtr=0 }
776 return (so_far + count)
780 memcpy_ptr_baoff ptr raw r (fromIntegral count)
781 writeIORef ref buf{ bufRPtr = r + count }
782 return (so_far + count)
785 memcpy_ptr_baoff ptr raw r (fromIntegral avail)
786 writeIORef ref buf{ bufWPtr=0, bufRPtr=0 }
788 let remaining = count - avail
789 so_far' = so_far + avail
790 ptr' = ptr `plusPtr` avail
793 then bufRead fd ref is_stream ptr' so_far' remaining can_block
797 then readChunk fd is_stream ptr' remaining
798 else readChunkNonBlocking fd is_stream ptr' remaining
799 return (so_far' + rest)
801 readChunk :: FD -> Bool -> Ptr a -> Int -> IO Int
802 readChunk fd is_stream ptr bytes = loop 0 bytes
804 loop :: Int -> Int -> IO Int
805 loop off bytes | bytes <= 0 = return off
807 r <- fromIntegral `liftM`
808 readRawBufferPtr "readChunk" (fromIntegral fd) is_stream
809 (castPtr ptr) off (fromIntegral bytes)
812 else loop (off + r) (bytes - r)
814 readChunkNonBlocking :: FD -> Bool -> Ptr a -> Int -> IO Int
815 readChunkNonBlocking fd is_stream ptr bytes = loop 0 bytes
817 loop :: Int -> Int -> IO Int
818 loop off bytes | bytes <= 0 = return off
820 ssize <- c_read (fromIntegral fd) (ptr `plusPtr` off) (fromIntegral bytes)
821 let r = fromIntegral ssize :: Int
823 then do errno <- getErrno
824 if (errno == eAGAIN || errno == eWOULDBLOCK)
826 else throwErrno "readChunk"
829 else loop (off + r) (bytes - r)
831 slurpFile :: FilePath -> IO (Ptr (), Int)
833 handle <- openFile fname ReadMode
834 sz <- hFileSize handle
835 if sz > fromIntegral (maxBound::Int) then
836 ioError (userError "slurpFile: file too big")
838 let sz_i = fromIntegral sz
839 if sz_i == 0 then return (nullPtr, 0) else do
840 chunk <- mallocBytes sz_i
841 r <- hGetBuf handle chunk sz_i
845 -- ---------------------------------------------------------------------------
848 foreign import ccall unsafe "__hscore_memcpy_src_off"
849 memcpy_ba_baoff :: RawBuffer -> RawBuffer -> Int -> CSize -> IO (Ptr ())
850 foreign import ccall unsafe "__hscore_memcpy_src_off"
851 memcpy_ptr_baoff :: Ptr a -> RawBuffer -> Int -> CSize -> IO (Ptr ())
852 foreign import ccall unsafe "__hscore_memcpy_dst_off"
853 memcpy_baoff_ba :: RawBuffer -> Int -> RawBuffer -> CSize -> IO (Ptr ())
854 foreign import ccall unsafe "__hscore_memcpy_dst_off"
855 memcpy_baoff_ptr :: RawBuffer -> Int -> Ptr a -> CSize -> IO (Ptr ())
857 -----------------------------------------------------------------------------
860 illegalBufferSize :: Handle -> String -> Int -> IO a
861 illegalBufferSize handle fn (sz :: Int) =
862 ioException (IOError (Just handle)
864 ("illegal buffer size " ++ showsPrec 9 sz [])