X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=GHC%2FIO%2FHandle%2FText.hs;h=cf2541f65e1072c9723bc507ebdc6004e17c20d4;hb=ed8788054ed764f873d43a88fd3ea4ab74373dc1;hp=b0f3a24fb80dd85cec25a1334bf77291eba0638a;hpb=a2c9e6e2854a04c0959bb6879549bc7513f79de9;p=ghc-base.git diff --git a/GHC/IO/Handle/Text.hs b/GHC/IO/Handle/Text.hs index b0f3a24..cf2541f 100644 --- a/GHC/IO/Handle/Text.hs +++ b/GHC/IO/Handle/Text.hs @@ -73,6 +73,7 @@ import GHC.List -- This operation may fail with: -- -- * 'isEOFError' if the end of file has been reached. +-- -- * a decoding error, if the input begins with an invalid byte sequence -- in this Handle's encoding. -- @@ -95,7 +96,7 @@ hWaitForInput h msecs = do return True else do -- there might be bytes in the byte buffer waiting to be decoded - cbuf' <- readTextDeviceNonBlocking handle_ cbuf + cbuf' <- decodeByteBuf handle_ cbuf writeIORef haCharBuffer cbuf' if not (isEmptyBuffer cbuf') then return True else do @@ -810,34 +811,24 @@ hGetBuf h ptr count | count == 0 = return 0 | count < 0 = illegalBufferSize h "hGetBuf" count | otherwise = - wantReadableHandle_ "hGetBuf" h $ \ h_ -> do + wantReadableHandle_ "hGetBuf" h $ \ h_@Handle__{..} -> do flushCharReadBuffer h_ - bufRead h_ (castPtr ptr) 0 count + buf@Buffer{ bufRaw=raw, bufR=w, bufL=r, bufSize=sz } + <- readIORef haByteBuffer + if isEmptyBuffer buf + then bufReadEmpty h_ buf (castPtr ptr) 0 count + else bufReadNonEmpty h_ buf (castPtr ptr) 0 count -- small reads go through the buffer, large reads are satisfied by -- taking data first from the buffer and then direct from the file -- descriptor. -bufRead :: Handle__ -> Ptr Word8 -> Int -> Int -> IO Int -bufRead h_@Handle__{..} ptr so_far count = - seq so_far $ seq count $ do -- strictness hack - buf@Buffer{ bufRaw=raw, bufR=w, bufL=r, bufSize=sz } <- readIORef haByteBuffer - if isEmptyBuffer buf - then if count > sz -- small read? - then do rest <- readChunk h_ ptr count - return (so_far + rest) - else do (r,buf') <- Buffered.fillReadBuffer haDevice buf - if r == 0 - then return so_far - else do writeIORef haByteBuffer buf' - bufRead h_ ptr so_far count - else do + +bufReadNonEmpty :: Handle__ -> Buffer Word8 -> Ptr Word8 -> Int -> Int -> IO Int +bufReadNonEmpty h_@Handle__{..} + buf@Buffer{ bufRaw=raw, bufR=w, bufL=r, bufSize=sz } + ptr !so_far !count + = do let avail = w - r - if (count == avail) - then do - copyFromRawBuffer ptr raw r count - writeIORef haByteBuffer buf{ bufR=0, bufL=0 } - return (so_far + count) - else do if (count < avail) then do copyFromRawBuffer ptr raw r count @@ -846,29 +837,35 @@ bufRead h_@Handle__{..} ptr so_far count = else do copyFromRawBuffer ptr raw (fromIntegral r) (fromIntegral avail) - writeIORef haByteBuffer buf{ bufR=0, bufL=0 } + let buf' = buf{ bufR=0, bufL=0 } + writeIORef haByteBuffer buf' let remaining = count - avail so_far' = so_far + avail ptr' = ptr `plusPtr` avail - if remaining < sz - then bufRead h_ ptr' so_far' remaining - else do - - rest <- readChunk h_ ptr' remaining - return (so_far' + rest) - -readChunk :: Handle__ -> Ptr a -> Int -> IO Int -readChunk h_@Handle__{..} ptr bytes - | Just fd <- cast haDevice = loop fd 0 bytes - | otherwise = error "ToDo: hGetBuf" + if remaining == 0 + then return so_far' + else bufReadEmpty h_ buf' ptr' so_far' remaining + + +bufReadEmpty :: Handle__ -> Buffer Word8 -> Ptr Word8 -> Int -> Int -> IO Int +bufReadEmpty h_@Handle__{..} + buf@Buffer{ bufRaw=raw, bufR=w, bufL=r, bufSize=sz } + ptr so_far count + | count > sz, Just fd <- cast haDevice = loop fd 0 count + | otherwise = do + (r,buf') <- Buffered.fillReadBuffer haDevice buf + if r == 0 + then return so_far + else do writeIORef haByteBuffer buf' + bufReadNonEmpty h_ buf' ptr so_far count where loop :: FD -> Int -> Int -> IO Int - loop fd off bytes | bytes <= 0 = return off + loop fd off bytes | bytes <= 0 = return (so_far + off) loop fd off bytes = do r <- RawIO.read (fd::FD) (ptr `plusPtr` off) (fromIntegral bytes) if r == 0 - then return off + then return (so_far + off) else loop fd (off + r) (bytes - r) -- --------------------------------------------------------------------------- @@ -894,9 +891,9 @@ readChunk h_@Handle__{..} ptr bytes hGetBufSome :: Handle -> Ptr a -> Int -> IO Int hGetBufSome h ptr count | count == 0 = return 0 - | count < 0 = illegalBufferSize h "hGetBuf" count + | count < 0 = illegalBufferSize h "hGetBufSome" count | otherwise = - wantReadableHandle_ "hGetBuf" h $ \ h_@Handle__{..} -> do + wantReadableHandle_ "hGetBufSome" h $ \ h_@Handle__{..} -> do flushCharReadBuffer h_ buf@Buffer{ bufSize=sz } <- readIORef haByteBuffer if isEmptyBuffer buf @@ -906,7 +903,10 @@ hGetBufSome h ptr count if r == 0 then return 0 else do writeIORef haByteBuffer buf' - bufReadNBNonEmpty h_ buf' (castPtr ptr) 0 count + bufReadNBNonEmpty h_ buf' (castPtr ptr) 0 (min r count) + -- new count is (min r count), so + -- that bufReadNBNonEmpty will not + -- issue another read. else bufReadNBEmpty h_ buf (castPtr ptr) 0 count @@ -931,55 +931,55 @@ haFD h_@Handle__{..} = -- -- 'hGetBufNonBlocking' ignores the prevailing 'TextEncoding' and -- 'NewlineMode' on the 'Handle', and reads bytes directly. +-- +-- NOTE: on Windows, this function does not work correctly; it +-- behaves identically to 'hGetBuf'. hGetBufNonBlocking :: Handle -> Ptr a -> Int -> IO Int hGetBufNonBlocking h ptr count | count == 0 = return 0 | count < 0 = illegalBufferSize h "hGetBufNonBlocking" count | otherwise = - wantReadableHandle_ "hGetBufNonBlocking" h $ \ h_ -> do + wantReadableHandle_ "hGetBufNonBlocking" h $ \ h_@Handle__{..} -> do flushCharReadBuffer h_ - bufReadNonBlocking h_ (castPtr ptr) 0 count - -bufReadNonBlocking :: Handle__ -> Ptr Word8 -> Int -> Int -> IO Int -bufReadNonBlocking h_@Handle__{..} ptr so_far count = - seq so_far $ seq count $ do -- strictness hack - buf@Buffer{ bufRaw=raw, bufR=w, bufL=r, bufSize=sz } <- readIORef haByteBuffer - if isEmptyBuffer buf - then bufReadNBEmpty h_ buf ptr so_far count - else bufReadNBNonEmpty h_ buf ptr so_far count + buf@Buffer{ bufRaw=raw, bufR=w, bufL=r, bufSize=sz } + <- readIORef haByteBuffer + if isEmptyBuffer buf + then bufReadNBEmpty h_ buf (castPtr ptr) 0 count + else bufReadNBNonEmpty h_ buf (castPtr ptr) 0 count bufReadNBEmpty :: Handle__ -> Buffer Word8 -> Ptr Word8 -> Int -> Int -> IO Int bufReadNBEmpty h_@Handle__{..} buf@Buffer{ bufRaw=raw, bufR=w, bufL=r, bufSize=sz } ptr so_far count - = if count > sz -- large read? - then do rest <- readChunkNonBlocking h_ ptr count - return (so_far + rest) - else do (r,buf') <- Buffered.fillReadBuffer0 haDevice buf - case r of - Nothing -> return so_far - Just 0 -> return so_far - Just r -> do - writeIORef haByteBuffer buf' - bufReadNBNonEmpty h_ buf' ptr so_far (min count r) - -- NOTE: new count is min count w' + | count > sz, + Just fd <- cast haDevice = do + m <- RawIO.readNonBlocking (fd::FD) ptr count + case m of + Nothing -> return so_far + Just n -> return (so_far + n) + + | otherwise = do + buf <- readIORef haByteBuffer + (r,buf') <- Buffered.fillReadBuffer0 haDevice buf + case r of + Nothing -> return so_far + Just 0 -> return so_far + Just r -> do + writeIORef haByteBuffer buf' + bufReadNBNonEmpty h_ buf' ptr so_far (min count r) + -- NOTE: new count is min count r -- so we will just copy the contents of the -- buffer in the recursive call, and not -- loop again. + bufReadNBNonEmpty :: Handle__ -> Buffer Word8 -> Ptr Word8 -> Int -> Int -> IO Int bufReadNBNonEmpty h_@Handle__{..} buf@Buffer{ bufRaw=raw, bufR=w, bufL=r, bufSize=sz } ptr so_far count = do let avail = w - r - if (count == avail) - then do - copyFromRawBuffer ptr raw r count - writeIORef haByteBuffer buf{ bufR=0, bufL=0 } - return (so_far + count) - else do if (count < avail) then do copyFromRawBuffer ptr raw r count @@ -994,17 +994,9 @@ bufReadNBNonEmpty h_@Handle__{..} so_far' = so_far + avail ptr' = ptr `plusPtr` avail - bufReadNBEmpty h_ buf' ptr' so_far' remaining - - -readChunkNonBlocking :: Handle__ -> Ptr Word8 -> Int -> IO Int -readChunkNonBlocking h_@Handle__{..} ptr bytes - | Just fd <- cast haDevice = do - m <- RawIO.readNonBlocking (fd::FD) ptr bytes - case m of - Nothing -> return 0 - Just n -> return n - | otherwise = error "ToDo: hGetBuf" + if remaining == 0 + then return so_far' + else bufReadNBEmpty h_ buf' ptr' so_far' remaining -- --------------------------------------------------------------------------- -- memcpy wrappers