1 {-# OPTIONS_GHC -XNoImplicitPrelude -#include "HsBase.h" #-}
2 {-# OPTIONS_HADDOCK hide #-}
6 -----------------------------------------------------------------------------
9 -- Copyright : (c) The University of Glasgow, 1992-2001
10 -- License : see libraries/base/LICENSE
12 -- Maintainer : libraries@haskell.org
13 -- Stability : internal
14 -- Portability : non-portable
16 -- String I\/O functions
18 -----------------------------------------------------------------------------
22 hWaitForInput, hGetChar, hGetLine, hGetContents, hPutChar, hPutStr,
23 commitBuffer', -- hack, see below
24 hGetcBuffered, -- needed by ghc/compiler/utils/StringBuffer.lhs
25 hGetBuf, hGetBufNonBlocking, hPutBuf, hPutBufNonBlocking, slurpFile,
35 import System.IO.Error
38 import System.Posix.Internals
43 import GHC.Handle -- much of the real stuff is in here
49 #ifdef mingw32_HOST_OS
53 -- ---------------------------------------------------------------------------
54 -- Simple input operations
56 -- If hWaitForInput finds anything in the Handle's buffer, it
57 -- immediately returns. If not, it tries to read from the underlying
58 -- OS handle. Notice that for buffered Handles connected to terminals
59 -- this means waiting until a complete line is available.
61 -- | Computation 'hWaitForInput' @hdl t@
62 -- waits until input is available on handle @hdl@.
63 -- It returns 'True' as soon as input is available on @hdl@,
64 -- or 'False' if no input is available within @t@ milliseconds.
66 -- If @t@ is less than zero, then @hWaitForInput@ waits indefinitely.
68 -- This operation may fail with:
70 -- * 'isEOFError' if the end of file has been reached.
72 -- NOTE for GHC users: unless you use the @-threaded@ flag,
73 -- @hWaitForInput t@ where @t >= 0@ will block all other Haskell
74 -- threads for the duration of the call. It behaves like a
75 -- @safe@ foreign call in this respect.
77 hWaitForInput :: Handle -> Int -> IO Bool
78 hWaitForInput h msecs = do
79 wantReadableHandle "hWaitForInput" h $ \ handle_ -> do
80 let ref = haBuffer handle_
83 if not (bufferEmpty buf)
88 then do buf' <- fillReadBuffer (haFD handle_) True
89 (haIsStream handle_) buf
92 else do r <- throwErrnoIfMinus1Retry "hWaitForInput" $
93 fdReady (haFD handle_) 0 {- read -}
95 (fromIntegral $ fromEnum $ haIsStream handle_)
96 if r /= 0 then do -- Call hLookAhead' to throw an EOF
97 -- exception if appropriate
102 foreign import ccall safe "fdReady"
103 fdReady :: CInt -> CInt -> CInt -> CInt -> IO CInt
105 -- ---------------------------------------------------------------------------
108 -- | Computation 'hGetChar' @hdl@ reads a character from the file or
109 -- channel managed by @hdl@, blocking until a character is available.
111 -- This operation may fail with:
113 -- * 'isEOFError' if the end of file has been reached.
115 hGetChar :: Handle -> IO Char
117 wantReadableHandle "hGetChar" handle $ \handle_ -> do
119 let fd = haFD handle_
120 ref = haBuffer handle_
123 if not (bufferEmpty buf)
124 then hGetcBuffered fd ref buf
128 case haBufferMode handle_ of
130 new_buf <- fillReadBuffer fd True (haIsStream handle_) buf
131 hGetcBuffered fd ref new_buf
132 BlockBuffering _ -> do
133 new_buf <- fillReadBuffer fd True (haIsStream handle_) buf
135 -- don't wait for a completely full buffer.
136 hGetcBuffered fd ref new_buf
138 -- make use of the minimal buffer we already have
140 r <- readRawBuffer "hGetChar" fd (haIsStream handle_) raw 0 1
143 else do (c,_) <- readCharFromBuffer raw 0
146 hGetcBuffered :: FD -> IORef Buffer -> Buffer -> IO Char
147 hGetcBuffered _ ref buf@Buffer{ bufBuf=b, bufRPtr=r0, bufWPtr=w }
148 = do (c, r) <- readCharFromBuffer b r0
149 let new_buf | r == w = buf{ bufRPtr=0, bufWPtr=0 }
150 | otherwise = buf{ bufRPtr=r }
151 writeIORef ref new_buf
154 -- ---------------------------------------------------------------------------
157 -- ToDo: the unbuffered case is wrong: it doesn't lock the handle for
160 -- | Computation 'hGetLine' @hdl@ reads a line from the file or
161 -- channel managed by @hdl@.
163 -- This operation may fail with:
165 -- * 'isEOFError' if the end of file is encountered when reading
166 -- the /first/ character of the line.
168 -- If 'hGetLine' encounters end-of-file at any other point while reading
169 -- in a line, it is treated as a line terminator and the (partial)
172 hGetLine :: Handle -> IO String
174 m <- wantReadableHandle "hGetLine" h $ \ handle_ -> do
175 case haBufferMode handle_ of
176 NoBuffering -> return Nothing
178 l <- hGetLineBuffered handle_
180 BlockBuffering _ -> do
181 l <- hGetLineBuffered handle_
184 Nothing -> hGetLineUnBuffered h
187 hGetLineBuffered :: Handle__ -> IO String
188 hGetLineBuffered handle_ = do
189 let ref = haBuffer handle_
191 hGetLineBufferedLoop handle_ ref buf []
193 hGetLineBufferedLoop :: Handle__ -> IORef Buffer -> Buffer -> [String]
195 hGetLineBufferedLoop handle_ ref
196 buf@Buffer{ bufRPtr=r0, bufWPtr=w, bufBuf=raw0 } xss =
198 -- find the end-of-line character, if there is one
200 | r == w = return (False, w)
202 (c,r') <- readCharFromBuffer raw r
204 then return (True, r) -- NB. not r': don't include the '\n'
207 (eol, off) <- loop raw0 r0
210 puts ("hGetLineBufferedLoop: r=" ++ show r0 ++ ", w=" ++ show w ++ ", off=" ++ show off ++ "\n")
213 xs <- unpack raw0 r0 off
215 -- if eol == True, then off is the offset of the '\n'
216 -- otherwise off == w and the buffer is now empty.
218 then do if (w == off + 1)
219 then writeIORef ref buf{ bufRPtr=0, bufWPtr=0 }
220 else writeIORef ref buf{ bufRPtr = off + 1 }
221 return (concat (reverse (xs:xss)))
223 maybe_buf <- maybeFillReadBuffer (haFD handle_) True (haIsStream handle_)
224 buf{ bufWPtr=0, bufRPtr=0 }
226 -- Nothing indicates we caught an EOF, and we may have a
227 -- partial line to return.
229 writeIORef ref buf{ bufRPtr=0, bufWPtr=0 }
230 let str = concat (reverse (xs:xss))
235 hGetLineBufferedLoop handle_ ref new_buf (xs:xss)
237 maybeFillReadBuffer :: FD -> Bool -> Bool -> Buffer -> IO (Maybe Buffer)
238 maybeFillReadBuffer fd is_line is_stream buf
240 (do buf' <- fillReadBuffer fd is_line is_stream buf
243 (\e -> do if isEOFError e
248 unpack :: RawBuffer -> Int -> Int -> IO [Char]
249 unpack _ _ 0 = return ""
250 unpack buf (I# r) (I# len) = IO $ \s -> unpackRB [] (len -# 1#) s
253 | i <# r = (# s, acc #)
255 case readCharArray# buf i s of
256 (# s', ch #) -> unpackRB (C# ch : acc) (i -# 1#) s'
259 hGetLineUnBuffered :: Handle -> IO String
260 hGetLineUnBuffered h = do
273 if isEOFError err then
283 -- -----------------------------------------------------------------------------
286 -- hGetContents on a DuplexHandle only affects the read side: you can
287 -- carry on writing to it afterwards.
289 -- | Computation 'hGetContents' @hdl@ returns the list of characters
290 -- corresponding to the unread portion of the channel or file managed
291 -- by @hdl@, which is put into an intermediate state, /semi-closed/.
292 -- In this state, @hdl@ is effectively closed,
293 -- but items are read from @hdl@ on demand and accumulated in a special
294 -- list returned by 'hGetContents' @hdl@.
296 -- Any operation that fails because a handle is closed,
297 -- also fails if a handle is semi-closed. The only exception is 'hClose'.
298 -- A semi-closed handle becomes closed:
300 -- * if 'hClose' is applied to it;
302 -- * if an I\/O error occurs when reading an item from the handle;
304 -- * or once the entire contents of the handle has been read.
306 -- Once a semi-closed handle becomes closed, the contents of the
307 -- associated list becomes fixed. The contents of this final list is
308 -- only partially specified: it will contain at least all the items of
309 -- the stream that were evaluated prior to the handle becoming closed.
311 -- Any I\/O errors encountered while a handle is semi-closed are simply
314 -- This operation may fail with:
316 -- * 'isEOFError' if the end of file has been reached.
318 hGetContents :: Handle -> IO String
319 hGetContents handle =
320 withHandle "hGetContents" handle $ \handle_ ->
321 case haType handle_ of
322 ClosedHandle -> ioe_closedHandle
323 SemiClosedHandle -> ioe_closedHandle
324 AppendHandle -> ioe_notReadable
325 WriteHandle -> ioe_notReadable
326 _ -> do xs <- lazyRead handle
327 return (handle_{ haType=SemiClosedHandle}, xs )
329 -- Note that someone may close the semi-closed handle (or change its
330 -- buffering), so each time these lazy read functions are pulled on,
331 -- they have to check whether the handle has indeed been closed.
333 lazyRead :: Handle -> IO String
336 withHandle "lazyRead" handle $ \ handle_ -> do
337 case haType handle_ of
338 ClosedHandle -> return (handle_, "")
339 SemiClosedHandle -> lazyRead' handle handle_
341 (IOError (Just handle) IllegalOperation "lazyRead"
342 "illegal handle type" Nothing)
344 lazyRead' :: Handle -> Handle__ -> IO (Handle__, [Char])
345 lazyRead' h handle_ = do
346 let ref = haBuffer handle_
349 -- even a NoBuffering handle can have a char in the buffer...
352 if not (bufferEmpty buf)
353 then lazyReadHaveBuffer h handle_ fd ref buf
356 case haBufferMode handle_ of
358 -- make use of the minimal buffer we already have
360 r <- readRawBuffer "lazyRead" fd (haIsStream handle_) raw 0 1
362 then do (handle_', _) <- hClose_help handle_
363 return (handle_', "")
364 else do (c,_) <- readCharFromBuffer raw 0
366 return (handle_, c : rest)
368 LineBuffering -> lazyReadBuffered h handle_ fd ref buf
369 BlockBuffering _ -> lazyReadBuffered h handle_ fd ref buf
371 -- we never want to block during the read, so we call fillReadBuffer with
372 -- is_line==True, which tells it to "just read what there is".
373 lazyReadBuffered :: Handle -> Handle__ -> FD -> IORef Buffer -> Buffer
374 -> IO (Handle__, [Char])
375 lazyReadBuffered h handle_ fd ref buf = do
377 (do buf' <- fillReadBuffer fd True{-is_line-} (haIsStream handle_) buf
378 lazyReadHaveBuffer h handle_ fd ref buf'
380 -- all I/O errors are discarded. Additionally, we close the handle.
381 (\_ -> do (handle_', _) <- hClose_help handle_
382 return (handle_', "")
385 lazyReadHaveBuffer :: Handle -> Handle__ -> FD -> IORef Buffer -> Buffer -> IO (Handle__, [Char])
386 lazyReadHaveBuffer h handle_ _ ref buf = do
388 writeIORef ref buf{ bufRPtr=0, bufWPtr=0 }
389 s <- unpackAcc (bufBuf buf) (bufRPtr buf) (bufWPtr buf) more
393 unpackAcc :: RawBuffer -> Int -> Int -> [Char] -> IO [Char]
394 unpackAcc _ _ 0 acc = return acc
395 unpackAcc buf (I# r) (I# len) acc0 = IO $ \s -> unpackRB acc0 (len -# 1#) s
398 | i <# r = (# s, acc #)
400 case readCharArray# buf i s of
401 (# s', ch #) -> unpackRB (C# ch : acc) (i -# 1#) s'
403 -- ---------------------------------------------------------------------------
406 -- | Computation 'hPutChar' @hdl ch@ writes the character @ch@ to the
407 -- file or channel managed by @hdl@. Characters may be buffered if
408 -- buffering is enabled for @hdl@.
410 -- This operation may fail with:
412 -- * 'isFullError' if the device is full; or
414 -- * 'isPermissionError' if another system resource limit would be exceeded.
416 hPutChar :: Handle -> Char -> IO ()
417 hPutChar handle c = do
419 wantWritableHandle "hPutChar" handle $ \ handle_ -> do
420 let fd = haFD handle_
421 case haBufferMode handle_ of
422 LineBuffering -> hPutcBuffered handle_ True c
423 BlockBuffering _ -> hPutcBuffered handle_ False c
425 with (castCharToCChar c) $ \buf -> do
426 writeRawBufferPtr "hPutChar" fd (haIsStream handle_) buf 0 1
429 hPutcBuffered :: Handle__ -> Bool -> Char -> IO ()
430 hPutcBuffered handle_ is_line c = do
431 let ref = haBuffer handle_
434 w' <- writeCharIntoBuffer (bufBuf buf) w c
435 let new_buf = buf{ bufWPtr = w' }
436 if bufferFull new_buf || is_line && c == '\n'
438 flushed_buf <- flushWriteBuffer (haFD handle_) (haIsStream handle_) new_buf
439 writeIORef ref flushed_buf
441 writeIORef ref new_buf
444 hPutChars :: Handle -> [Char] -> IO ()
445 hPutChars _ [] = return ()
446 hPutChars handle (c:cs) = hPutChar handle c >> hPutChars handle cs
448 -- ---------------------------------------------------------------------------
451 -- We go to some trouble to avoid keeping the handle locked while we're
452 -- evaluating the string argument to hPutStr, in case doing so triggers another
453 -- I/O operation on the same handle which would lead to deadlock. The classic
456 -- putStr (trace "hello" "world")
458 -- so the basic scheme is this:
460 -- * copy the string into a fresh buffer,
461 -- * "commit" the buffer to the handle.
463 -- Committing may involve simply copying the contents of the new
464 -- buffer into the handle's buffer, flushing one or both buffers, or
465 -- maybe just swapping the buffers over (if the handle's buffer was
466 -- empty). See commitBuffer below.
468 -- | Computation 'hPutStr' @hdl s@ writes the string
469 -- @s@ to the file or channel managed by @hdl@.
471 -- This operation may fail with:
473 -- * 'isFullError' if the device is full; or
475 -- * 'isPermissionError' if another system resource limit would be exceeded.
477 hPutStr :: Handle -> String -> IO ()
478 hPutStr handle str = do
479 buffer_mode <- wantWritableHandle "hPutStr" handle
480 (\ handle_ -> do getSpareBuffer handle_)
482 (NoBuffering, _) -> do
483 hPutChars handle str -- v. slow, but we don't care
484 (LineBuffering, buf) -> do
485 writeLines handle buf str
486 (BlockBuffering _, buf) -> do
487 writeBlocks handle buf str
490 getSpareBuffer :: Handle__ -> IO (BufferMode, Buffer)
491 getSpareBuffer Handle__{haBuffer=ref,
496 NoBuffering -> return (mode, error "no buffer!")
498 bufs <- readIORef spare_ref
501 BufferListCons b rest -> do
502 writeIORef spare_ref rest
503 return ( mode, newEmptyBuffer b WriteBuffer (bufSize buf))
505 new_buf <- allocateBuffer (bufSize buf) WriteBuffer
506 return (mode, new_buf)
509 writeLines :: Handle -> Buffer -> String -> IO ()
510 writeLines hdl Buffer{ bufBuf=raw, bufSize=len } s =
512 shoveString :: Int -> [Char] -> IO ()
513 -- check n == len first, to ensure that shoveString is strict in n.
514 shoveString n cs | n == len = do
515 new_buf <- commitBuffer hdl raw len n True{-needs flush-} False
516 writeLines hdl new_buf cs
517 shoveString n [] = do
518 commitBuffer hdl raw len n False{-no flush-} True{-release-}
520 shoveString n (c:cs) = do
521 n' <- writeCharIntoBuffer raw n c
524 new_buf <- commitBuffer hdl raw len n' True{-needs flush-} False
525 writeLines hdl new_buf cs
531 writeBlocks :: Handle -> Buffer -> String -> IO ()
532 writeBlocks hdl Buffer{ bufBuf=raw, bufSize=len } s =
534 shoveString :: Int -> [Char] -> IO ()
535 -- check n == len first, to ensure that shoveString is strict in n.
536 shoveString n cs | n == len = do
537 new_buf <- commitBuffer hdl raw len n True{-needs flush-} False
538 writeBlocks hdl new_buf cs
539 shoveString n [] = do
540 commitBuffer hdl raw len n False{-no flush-} True{-release-}
542 shoveString n (c:cs) = do
543 n' <- writeCharIntoBuffer raw n c
548 -- -----------------------------------------------------------------------------
549 -- commitBuffer handle buf sz count flush release
551 -- Write the contents of the buffer 'buf' ('sz' bytes long, containing
552 -- 'count' bytes of data) to handle (handle must be block or line buffered).
556 -- for block/line buffering,
557 -- 1. If there isn't room in the handle buffer, flush the handle
560 -- 2. If the handle buffer is empty,
562 -- then write buf directly to the device.
563 -- else swap the handle buffer with buf.
565 -- 3. If the handle buffer is non-empty, copy buf into the
566 -- handle buffer. Then, if flush != 0, flush
570 :: Handle -- handle to commit to
571 -> RawBuffer -> Int -- address and size (in bytes) of buffer
572 -> Int -- number of bytes of data in buffer
573 -> Bool -- True <=> flush the handle afterward
574 -> Bool -- release the buffer?
577 commitBuffer hdl raw sz@(I# _) count@(I# _) flush release = do
578 wantWritableHandle "commitAndReleaseBuffer" hdl $
579 commitBuffer' raw sz count flush release
581 -- Explicitly lambda-lift this function to subvert GHC's full laziness
582 -- optimisations, which otherwise tends to float out subexpressions
583 -- past the \handle, which is really a pessimisation in this case because
584 -- that lambda is a one-shot lambda.
586 -- Don't forget to export the function, to stop it being inlined too
587 -- (this appears to be better than NOINLINE, because the strictness
588 -- analyser still gets to worker-wrapper it).
590 -- This hack is a fairly big win for hPutStr performance. --SDM 18/9/2001
592 commitBuffer' :: RawBuffer -> Int -> Int -> Bool -> Bool -> Handle__
594 commitBuffer' raw sz@(I# _) count@(I# _) flush release
595 handle_@Handle__{ haFD=fd, haBuffer=ref, haBuffers=spare_buf_ref } = do
598 puts ("commitBuffer: sz=" ++ show sz ++ ", count=" ++ show count
599 ++ ", flush=" ++ show flush ++ ", release=" ++ show release ++"\n")
602 old_buf@Buffer{ bufBuf=old_raw, bufWPtr=w, bufSize=size }
606 -- enough room in handle buffer?
607 if (not flush && (size - w > count))
608 -- The > is to be sure that we never exactly fill
609 -- up the buffer, which would require a flush. So
610 -- if copying the new data into the buffer would
611 -- make the buffer full, we just flush the existing
612 -- buffer and the new data immediately, rather than
613 -- copying before flushing.
615 -- not flushing, and there's enough room in the buffer:
616 -- just copy the data in and update bufWPtr.
617 then do memcpy_baoff_ba old_raw (fromIntegral w) raw (fromIntegral count)
618 writeIORef ref old_buf{ bufWPtr = w + count }
619 return (newEmptyBuffer raw WriteBuffer sz)
621 -- else, we have to flush
622 else do flushed_buf <- flushWriteBuffer fd (haIsStream handle_) old_buf
625 Buffer{ bufBuf=raw, bufState=WriteBuffer,
626 bufRPtr=0, bufWPtr=count, bufSize=sz }
628 -- if: (a) we don't have to flush, and
629 -- (b) size(new buffer) == size(old buffer), and
630 -- (c) new buffer is not full,
631 -- we can just just swap them over...
632 if (not flush && sz == size && count /= sz)
634 writeIORef ref this_buf
637 -- otherwise, we have to flush the new data too,
638 -- and start with a fresh buffer
640 flushWriteBuffer fd (haIsStream handle_) this_buf
641 writeIORef ref flushed_buf
642 -- if the sizes were different, then allocate
643 -- a new buffer of the correct size.
645 then return (newEmptyBuffer raw WriteBuffer sz)
646 else allocateBuffer size WriteBuffer
648 -- release the buffer if necessary
650 Buffer{ bufSize=buf_ret_sz, bufBuf=buf_ret_raw } -> do
651 if release && buf_ret_sz == size
653 spare_bufs <- readIORef spare_buf_ref
654 writeIORef spare_buf_ref
655 (BufferListCons buf_ret_raw spare_bufs)
660 -- ---------------------------------------------------------------------------
661 -- Reading/writing sequences of bytes.
663 -- ---------------------------------------------------------------------------
666 -- | 'hPutBuf' @hdl buf count@ writes @count@ 8-bit bytes from the
667 -- buffer @buf@ to the handle @hdl@. It returns ().
669 -- This operation may fail with:
671 -- * 'ResourceVanished' if the handle is a pipe or socket, and the
672 -- reading end is closed. (If this is a POSIX system, and the program
673 -- has not asked to ignore SIGPIPE, then a SIGPIPE may be delivered
674 -- instead, whose default action is to terminate the program).
676 hPutBuf :: Handle -- handle to write to
677 -> Ptr a -- address of buffer
678 -> Int -- number of bytes of data in buffer
680 hPutBuf h ptr count = do hPutBuf' h ptr count True; return ()
683 :: Handle -- handle to write to
684 -> Ptr a -- address of buffer
685 -> Int -- number of bytes of data in buffer
686 -> IO Int -- returns: number of bytes written
687 hPutBufNonBlocking h ptr count = hPutBuf' h ptr count False
689 hPutBuf':: Handle -- handle to write to
690 -> Ptr a -- address of buffer
691 -> Int -- number of bytes of data in buffer
692 -> Bool -- allow blocking?
694 hPutBuf' handle ptr count can_block
695 | count == 0 = return 0
696 | count < 0 = illegalBufferSize handle "hPutBuf" count
698 wantWritableHandle "hPutBuf" handle $
699 \ Handle__{ haFD=fd, haBuffer=ref, haIsStream=is_stream } ->
700 bufWrite fd ref is_stream ptr count can_block
702 bufWrite :: FD -> IORef Buffer -> Bool -> Ptr a -> Int -> Bool -> IO Int
703 bufWrite fd ref is_stream ptr count can_block =
704 seq count $ seq fd $ do -- strictness hack
705 old_buf@Buffer{ bufBuf=old_raw, bufWPtr=w, bufSize=size }
708 -- enough room in handle buffer?
709 if (size - w > count)
710 -- There's enough room in the buffer:
711 -- just copy the data in and update bufWPtr.
712 then do memcpy_baoff_ptr old_raw (fromIntegral w) ptr (fromIntegral count)
713 writeIORef ref old_buf{ bufWPtr = w + count }
716 -- else, we have to flush
717 else do flushed_buf <- flushWriteBuffer fd is_stream old_buf
718 -- TODO: we should do a non-blocking flush here
719 writeIORef ref flushed_buf
720 -- if we can fit in the buffer, then just loop
722 then bufWrite fd ref is_stream ptr count can_block
724 then do writeChunk fd is_stream (castPtr ptr) count
726 else writeChunkNonBlocking fd is_stream ptr count
728 writeChunk :: FD -> Bool -> Ptr CChar -> Int -> IO ()
729 writeChunk fd is_stream ptr bytes0 = loop 0 bytes0
731 loop :: Int -> Int -> IO ()
732 loop _ bytes | bytes <= 0 = return ()
734 r <- fromIntegral `liftM`
735 writeRawBufferPtr "writeChunk" fd is_stream ptr
736 off (fromIntegral bytes)
737 -- write can't return 0
738 loop (off + r) (bytes - r)
740 writeChunkNonBlocking :: FD -> Bool -> Ptr a -> Int -> IO Int
741 writeChunkNonBlocking fd
742 #ifndef mingw32_HOST_OS
747 ptr bytes0 = loop 0 bytes0
749 loop :: Int -> Int -> IO Int
750 loop off bytes | bytes <= 0 = return off
752 #ifndef mingw32_HOST_OS
753 ssize <- c_write fd (ptr `plusPtr` off) (fromIntegral bytes)
754 let r = fromIntegral ssize :: Int
756 then do errno <- getErrno
757 if (errno == eAGAIN || errno == eWOULDBLOCK)
759 else throwErrno "writeChunk"
760 else loop (off + r) (bytes - r)
762 (ssize, rc) <- asyncWrite (fromIntegral fd)
763 (fromIntegral $ fromEnum is_stream)
766 let r = fromIntegral ssize :: Int
768 then ioError (errnoToIOError "hPutBufNonBlocking" (Errno (fromIntegral rc)) Nothing Nothing)
769 else loop (off + r) (bytes - r)
772 -- ---------------------------------------------------------------------------
775 -- | 'hGetBuf' @hdl buf count@ reads data from the handle @hdl@
776 -- into the buffer @buf@ until either EOF is reached or
777 -- @count@ 8-bit bytes have been read.
778 -- It returns the number of bytes actually read. This may be zero if
779 -- EOF was reached before any data was read (or if @count@ is zero).
781 -- 'hGetBuf' never raises an EOF exception, instead it returns a value
782 -- smaller than @count@.
784 -- If the handle is a pipe or socket, and the writing end
785 -- is closed, 'hGetBuf' will behave as if EOF was reached.
787 hGetBuf :: Handle -> Ptr a -> Int -> IO Int
789 | count == 0 = return 0
790 | count < 0 = illegalBufferSize h "hGetBuf" count
792 wantReadableHandle "hGetBuf" h $
793 \ Handle__{ haFD=fd, haBuffer=ref, haIsStream=is_stream } -> do
794 bufRead fd ref is_stream ptr 0 count
796 -- small reads go through the buffer, large reads are satisfied by
797 -- taking data first from the buffer and then direct from the file
799 bufRead :: FD -> IORef Buffer -> Bool -> Ptr a -> Int -> Int -> IO Int
800 bufRead fd ref is_stream ptr so_far count =
801 seq fd $ seq so_far $ seq count $ do -- strictness hack
802 buf@Buffer{ bufBuf=raw, bufWPtr=w, bufRPtr=r, bufSize=sz } <- readIORef ref
804 then if count > sz -- small read?
805 then do rest <- readChunk fd is_stream ptr count
806 return (so_far + rest)
807 else do mb_buf <- maybeFillReadBuffer fd True is_stream buf
809 Nothing -> return so_far -- got nothing, we're done
812 bufRead fd ref is_stream ptr so_far count
817 memcpy_ptr_baoff ptr raw (fromIntegral r) (fromIntegral count)
818 writeIORef ref buf{ bufWPtr=0, bufRPtr=0 }
819 return (so_far + count)
823 memcpy_ptr_baoff ptr raw (fromIntegral r) (fromIntegral count)
824 writeIORef ref buf{ bufRPtr = r + count }
825 return (so_far + count)
828 memcpy_ptr_baoff ptr raw (fromIntegral r) (fromIntegral avail)
829 writeIORef ref buf{ bufWPtr=0, bufRPtr=0 }
830 let remaining = count - avail
831 so_far' = so_far + avail
832 ptr' = ptr `plusPtr` avail
835 then bufRead fd ref is_stream ptr' so_far' remaining
838 rest <- readChunk fd is_stream ptr' remaining
839 return (so_far' + rest)
841 readChunk :: FD -> Bool -> Ptr a -> Int -> IO Int
842 readChunk fd is_stream ptr bytes0 = loop 0 bytes0
844 loop :: Int -> Int -> IO Int
845 loop off bytes | bytes <= 0 = return off
847 r <- fromIntegral `liftM`
848 readRawBufferPtr "readChunk" fd is_stream
849 (castPtr ptr) off (fromIntegral bytes)
852 else loop (off + r) (bytes - r)
855 -- | 'hGetBufNonBlocking' @hdl buf count@ reads data from the handle @hdl@
856 -- into the buffer @buf@ until either EOF is reached, or
857 -- @count@ 8-bit bytes have been read, or there is no more data available
858 -- to read immediately.
860 -- 'hGetBufNonBlocking' is identical to 'hGetBuf', except that it will
861 -- never block waiting for data to become available, instead it returns
862 -- only whatever data is available. To wait for data to arrive before
863 -- calling 'hGetBufNonBlocking', use 'hWaitForInput'.
865 -- If the handle is a pipe or socket, and the writing end
866 -- is closed, 'hGetBufNonBlocking' will behave as if EOF was reached.
868 hGetBufNonBlocking :: Handle -> Ptr a -> Int -> IO Int
869 hGetBufNonBlocking h ptr count
870 | count == 0 = return 0
871 | count < 0 = illegalBufferSize h "hGetBufNonBlocking" count
873 wantReadableHandle "hGetBufNonBlocking" h $
874 \ Handle__{ haFD=fd, haBuffer=ref, haIsStream=is_stream } -> do
875 bufReadNonBlocking fd ref is_stream ptr 0 count
877 bufReadNonBlocking :: FD -> IORef Buffer -> Bool -> Ptr a -> Int -> Int
879 bufReadNonBlocking fd ref is_stream ptr so_far count =
880 seq fd $ seq so_far $ seq count $ do -- strictness hack
881 buf@Buffer{ bufBuf=raw, bufWPtr=w, bufRPtr=r, bufSize=sz } <- readIORef ref
883 then if count > sz -- large read?
884 then do rest <- readChunkNonBlocking fd is_stream ptr count
885 return (so_far + rest)
886 else do buf' <- fillReadBufferWithoutBlocking fd is_stream buf
887 case buf' of { Buffer{ bufWPtr=w' } ->
890 else do writeIORef ref buf'
891 bufReadNonBlocking fd ref is_stream ptr
892 so_far (min count w')
893 -- NOTE: new count is min count w'
894 -- so we will just copy the contents of the
895 -- buffer in the recursive call, and not
902 memcpy_ptr_baoff ptr raw (fromIntegral r) (fromIntegral count)
903 writeIORef ref buf{ bufWPtr=0, bufRPtr=0 }
904 return (so_far + count)
908 memcpy_ptr_baoff ptr raw (fromIntegral r) (fromIntegral count)
909 writeIORef ref buf{ bufRPtr = r + count }
910 return (so_far + count)
913 memcpy_ptr_baoff ptr raw (fromIntegral r) (fromIntegral avail)
914 writeIORef ref buf{ bufWPtr=0, bufRPtr=0 }
915 let remaining = count - avail
916 so_far' = so_far + avail
917 ptr' = ptr `plusPtr` avail
919 -- we haven't attempted to read anything yet if we get to here.
921 then bufReadNonBlocking fd ref is_stream ptr' so_far' remaining
924 rest <- readChunkNonBlocking fd is_stream ptr' remaining
925 return (so_far' + rest)
928 readChunkNonBlocking :: FD -> Bool -> Ptr a -> Int -> IO Int
929 readChunkNonBlocking fd is_stream ptr bytes = do
931 readRawBufferPtrNoBlock "readChunkNonBlocking" fd is_stream
932 (castPtr ptr) 0 (fromIntegral bytes)
934 -- we don't have non-blocking read support on Windows, so just invoke
935 -- the ordinary low-level read which will block until data is available,
936 -- but won't wait for the whole buffer to fill.
938 slurpFile :: FilePath -> IO (Ptr (), Int)
940 handle <- openFile fname ReadMode
941 sz <- hFileSize handle
942 if sz > fromIntegral (maxBound::Int) then
943 ioError (userError "slurpFile: file too big")
945 let sz_i = fromIntegral sz
946 if sz_i == 0 then return (nullPtr, 0) else do
947 chunk <- mallocBytes sz_i
948 r <- hGetBuf handle chunk sz_i
952 -- ---------------------------------------------------------------------------
955 foreign import ccall unsafe "__hscore_memcpy_src_off"
956 memcpy_ba_baoff :: RawBuffer -> RawBuffer -> CInt -> CSize -> IO (Ptr ())
957 foreign import ccall unsafe "__hscore_memcpy_src_off"
958 memcpy_ptr_baoff :: Ptr a -> RawBuffer -> CInt -> CSize -> IO (Ptr ())
959 foreign import ccall unsafe "__hscore_memcpy_dst_off"
960 memcpy_baoff_ba :: RawBuffer -> CInt -> RawBuffer -> CSize -> IO (Ptr ())
961 foreign import ccall unsafe "__hscore_memcpy_dst_off"
962 memcpy_baoff_ptr :: RawBuffer -> CInt -> Ptr a -> CSize -> IO (Ptr ())
964 -----------------------------------------------------------------------------
967 illegalBufferSize :: Handle -> String -> Int -> IO a
968 illegalBufferSize handle fn sz =
969 ioException (IOError (Just handle)
971 ("illegal buffer size " ++ showsPrec 9 sz [])