From: Simon Marlow Date: Thu, 24 Jun 2010 13:04:25 +0000 (+0000) Subject: make the hGetBuf/hPutBuf family work with non-FD Handles (#4144) X-Git-Url: http://git.megacz.com/?p=ghc-base.git;a=commitdiff_plain;h=59d4a6667ff3b378a008858952b82f49d8104f74 make the hGetBuf/hPutBuf family work with non-FD Handles (#4144) --- diff --git a/GHC/IO/Handle/Text.hs b/GHC/IO/Handle/Text.hs index e74371e..0bd3550 100644 --- a/GHC/IO/Handle/Text.hs +++ b/GHC/IO/Handle/Text.hs @@ -810,34 +810,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 +836,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 = 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) -- --------------------------------------------------------------------------- @@ -940,49 +936,46 @@ 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, False, + 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 @@ -997,17 +990,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