X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=GHC%2FIO.hs;h=0a7416f461ec484a91483387a9011ffa15935d59;hb=74bc2d04fdbae494bcf4839c4ec5e6ec1d0bf600;hp=096cff0c857c4c01b41bb61164690f56f76d6b50;hpb=e0243d8af333996441d6fb814f3c74bbf99b8dc3;p=haskell-directory.git diff --git a/GHC/IO.hs b/GHC/IO.hs index 096cff0..0a7416f 100644 --- a/GHC/IO.hs +++ b/GHC/IO.hs @@ -90,12 +90,13 @@ hWaitForInput h msecs = do writeIORef ref buf' return True else do r <- throwErrnoIfMinus1Retry "hWaitForInput" $ - inputReady (fromIntegral (haFD handle_)) - (fromIntegral msecs) (haIsStream handle_) + inputReady (haFD handle_) + (fromIntegral msecs) + (fromIntegral $ fromEnum $ haIsStream handle_) return (r /= 0) foreign import ccall safe "inputReady" - inputReady :: CInt -> CInt -> Bool -> IO CInt + inputReady :: CInt -> CInt -> CInt -> IO CInt -- --------------------------------------------------------------------------- -- hGetChar @@ -132,7 +133,7 @@ hGetChar handle = NoBuffering -> do -- make use of the minimal buffer we already have let raw = bufBuf buf - r <- readRawBuffer "hGetChar" (fromIntegral fd) (haIsStream handle_) raw 0 1 + r <- readRawBuffer "hGetChar" fd (haIsStream handle_) raw 0 1 if r == 0 then ioe_EOF else do (c,_) <- readCharFromBuffer raw 0 @@ -178,24 +179,25 @@ hGetLine h = do Nothing -> hGetLineUnBuffered h Just l -> return l - +hGetLineBuffered :: Handle__ -> IO String hGetLineBuffered handle_ = do let ref = haBuffer handle_ buf <- readIORef ref hGetLineBufferedLoop handle_ ref buf [] - -hGetLineBufferedLoop handle_ ref - buf@Buffer{ bufRPtr=r, bufWPtr=w, bufBuf=raw } xss = - let - -- find the end-of-line character, if there is one - loop raw r - | r == w = return (False, w) - | otherwise = do - (c,r') <- readCharFromBuffer raw r - if c == '\n' - then return (True, r) -- NB. not r': don't include the '\n' - else loop raw r' +hGetLineBufferedLoop :: Handle__ -> IORef Buffer -> Buffer -> [String] + -> IO String +hGetLineBufferedLoop handle_ ref + buf@Buffer{ bufRPtr=r, bufWPtr=w, bufBuf=raw } xss = + let + -- find the end-of-line character, if there is one + loop raw r + | r == w = return (False, w) + | otherwise = do + (c,r') <- readCharFromBuffer raw r + if c == '\n' + then return (True, r) -- NB. not r': don't include the '\n' + else loop raw r' in do (eol, off) <- loop raw r @@ -208,24 +210,24 @@ hGetLineBufferedLoop handle_ ref -- if eol == True, then off is the offset of the '\n' -- otherwise off == w and the buffer is now empty. if eol - then do if (w == off + 1) - then writeIORef ref buf{ bufRPtr=0, bufWPtr=0 } - else writeIORef ref buf{ bufRPtr = off + 1 } - return (concat (reverse (xs:xss))) - else do - maybe_buf <- maybeFillReadBuffer (haFD handle_) True (haIsStream handle_) - buf{ bufWPtr=0, bufRPtr=0 } - case maybe_buf of - -- Nothing indicates we caught an EOF, and we may have a - -- partial line to return. - Nothing -> do - writeIORef ref buf{ bufRPtr=0, bufWPtr=0 } - let str = concat (reverse (xs:xss)) - if not (null str) - then return str - else ioe_EOF - Just new_buf -> - hGetLineBufferedLoop handle_ ref new_buf (xs:xss) + then do if (w == off + 1) + then writeIORef ref buf{ bufRPtr=0, bufWPtr=0 } + else writeIORef ref buf{ bufRPtr = off + 1 } + return (concat (reverse (xs:xss))) + else do + maybe_buf <- maybeFillReadBuffer (haFD handle_) True (haIsStream handle_) + buf{ bufWPtr=0, bufRPtr=0 } + case maybe_buf of + -- Nothing indicates we caught an EOF, and we may have a + -- partial line to return. + Nothing -> do + writeIORef ref buf{ bufRPtr=0, bufWPtr=0 } + let str = concat (reverse (xs:xss)) + if not (null str) + then return str + else ioe_EOF + Just new_buf -> + hGetLineBufferedLoop handle_ ref new_buf (xs:xss) maybeFillReadBuffer fd is_line is_stream buf @@ -349,7 +351,7 @@ lazyRead' h handle_ = do NoBuffering -> do -- make use of the minimal buffer we already have let raw = bufBuf buf - r <- readRawBuffer "lazyRead" (fromIntegral fd) (haIsStream handle_) raw 0 1 + r <- readRawBuffer "lazyRead" fd (haIsStream handle_) raw 0 1 if r == 0 then do handle_ <- hClose_help handle_ return (handle_, "") @@ -412,7 +414,7 @@ hPutChar handle c = do BlockBuffering _ -> hPutcBuffered handle_ False c NoBuffering -> with (castCharToCChar c) $ \buf -> do - writeRawBufferPtr "hPutChar" (fromIntegral fd) (haIsStream handle_) buf 0 1 + writeRawBufferPtr "hPutChar" fd (haIsStream handle_) buf 0 1 return () hPutcBuffered handle_ is_line c = do @@ -600,7 +602,7 @@ commitBuffer' raw sz@(I# _) count@(I# _) flush release -- 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) + then do memcpy_baoff_ba old_raw (fromIntegral w) raw (fromIntegral count) writeIORef ref old_buf{ bufWPtr = w + count } return (newEmptyBuffer raw WriteBuffer sz) @@ -694,7 +696,7 @@ bufWrite fd ref is_stream ptr count can_block = if (size - w > count) -- There's enough room in the buffer: -- just copy the data in and update bufWPtr. - then do memcpy_baoff_ptr old_raw w ptr (fromIntegral count) + then do memcpy_baoff_ptr old_raw (fromIntegral w) ptr (fromIntegral count) writeIORef ref old_buf{ bufWPtr = w + count } return count @@ -717,7 +719,7 @@ writeChunk fd is_stream ptr bytes = loop 0 bytes loop _ bytes | bytes <= 0 = return () loop off bytes = do r <- fromIntegral `liftM` - writeRawBufferPtr "writeChunk" (fromIntegral fd) is_stream ptr + writeRawBufferPtr "writeChunk" fd is_stream ptr off (fromIntegral bytes) -- write can't return 0 loop (off + r) (bytes - r) @@ -729,7 +731,7 @@ writeChunkNonBlocking fd is_stream ptr bytes = loop 0 bytes loop off bytes | bytes <= 0 = return off loop off bytes = do #ifndef mingw32_HOST_OS - ssize <- c_write (fromIntegral fd) (ptr `plusPtr` off) (fromIntegral bytes) + ssize <- c_write fd (ptr `plusPtr` off) (fromIntegral bytes) let r = fromIntegral ssize :: Int if (r == -1) then do errno <- getErrno @@ -738,7 +740,8 @@ writeChunkNonBlocking fd is_stream ptr bytes = loop 0 bytes else throwErrno "writeChunk" else loop (off + r) (bytes - r) #else - (ssize, rc) <- asyncWrite fd (fromIntegral $ fromEnum is_stream) + (ssize, rc) <- asyncWrite (fromIntegral fd) + (fromIntegral $ fromEnum is_stream) (fromIntegral bytes) (ptr `plusPtr` off) let r = fromIntegral ssize :: Int @@ -791,18 +794,18 @@ bufRead fd ref is_stream ptr so_far count = let avail = w - r if (count == avail) then do - memcpy_ptr_baoff ptr raw r (fromIntegral count) + memcpy_ptr_baoff ptr raw (fromIntegral r) (fromIntegral count) writeIORef ref buf{ bufWPtr=0, bufRPtr=0 } return (so_far + count) else do if (count < avail) then do - memcpy_ptr_baoff ptr raw r (fromIntegral count) + memcpy_ptr_baoff ptr raw (fromIntegral r) (fromIntegral count) writeIORef ref buf{ bufRPtr = r + count } return (so_far + count) else do - memcpy_ptr_baoff ptr raw r (fromIntegral avail) + memcpy_ptr_baoff ptr raw (fromIntegral r) (fromIntegral avail) writeIORef ref buf{ bufWPtr=0, bufRPtr=0 } let remaining = count - avail so_far' = so_far + avail @@ -822,7 +825,7 @@ readChunk fd is_stream ptr bytes = loop 0 bytes loop off bytes | bytes <= 0 = return off loop off bytes = do r <- fromIntegral `liftM` - readRawBufferPtr "readChunk" (fromIntegral fd) is_stream + readRawBufferPtr "readChunk" fd is_stream (castPtr ptr) off (fromIntegral bytes) if r == 0 then return off @@ -874,18 +877,18 @@ bufReadNonBlocking fd ref is_stream ptr so_far count = let avail = w - r if (count == avail) then do - memcpy_ptr_baoff ptr raw r (fromIntegral count) + memcpy_ptr_baoff ptr raw (fromIntegral r) (fromIntegral count) writeIORef ref buf{ bufWPtr=0, bufRPtr=0 } return (so_far + count) else do if (count < avail) then do - memcpy_ptr_baoff ptr raw r (fromIntegral count) + memcpy_ptr_baoff ptr raw (fromIntegral r) (fromIntegral count) writeIORef ref buf{ bufRPtr = r + count } return (so_far + count) else do - memcpy_ptr_baoff ptr raw r (fromIntegral avail) + memcpy_ptr_baoff ptr raw (fromIntegral r) (fromIntegral avail) writeIORef ref buf{ bufWPtr=0, bufRPtr=0 } let remaining = count - avail so_far' = so_far + avail @@ -903,7 +906,7 @@ bufReadNonBlocking fd ref is_stream ptr so_far count = readChunkNonBlocking :: FD -> Bool -> Ptr a -> Int -> IO Int readChunkNonBlocking fd is_stream ptr bytes = do #ifndef mingw32_HOST_OS - ssize <- c_read (fromIntegral fd) (castPtr ptr) (fromIntegral bytes) + ssize <- c_read fd (castPtr ptr) (fromIntegral bytes) let r = fromIntegral ssize :: Int if (r == -1) then do errno <- getErrno @@ -913,7 +916,7 @@ readChunkNonBlocking fd is_stream ptr bytes = do else return r #else fromIntegral `liftM` - readRawBufferPtr "readChunkNonBlocking" (fromIntegral fd) is_stream + readRawBufferPtr "readChunkNonBlocking" fd is_stream (castPtr ptr) 0 (fromIntegral bytes) -- we don't have non-blocking read support on Windows, so just invoke @@ -939,13 +942,13 @@ slurpFile fname = do -- memcpy wrappers foreign import ccall unsafe "__hscore_memcpy_src_off" - memcpy_ba_baoff :: RawBuffer -> RawBuffer -> Int -> CSize -> IO (Ptr ()) + memcpy_ba_baoff :: RawBuffer -> RawBuffer -> CInt -> CSize -> IO (Ptr ()) foreign import ccall unsafe "__hscore_memcpy_src_off" - memcpy_ptr_baoff :: Ptr a -> RawBuffer -> Int -> CSize -> IO (Ptr ()) + memcpy_ptr_baoff :: Ptr a -> RawBuffer -> CInt -> CSize -> IO (Ptr ()) foreign import ccall unsafe "__hscore_memcpy_dst_off" - memcpy_baoff_ba :: RawBuffer -> Int -> RawBuffer -> CSize -> IO (Ptr ()) + memcpy_baoff_ba :: RawBuffer -> CInt -> RawBuffer -> CSize -> IO (Ptr ()) foreign import ccall unsafe "__hscore_memcpy_dst_off" - memcpy_baoff_ptr :: RawBuffer -> Int -> Ptr a -> CSize -> IO (Ptr ()) + memcpy_baoff_ptr :: RawBuffer -> CInt -> Ptr a -> CSize -> IO (Ptr ()) ----------------------------------------------------------------------------- -- Internal Utils