X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;ds=sidebyside;f=GHC%2FIO.hs;h=b3d590a02d455ee733c4f861f154a7da50a30590;hb=4c98224cdf6e5a1620721faea837656f429f4f27;hp=110ae688aea7197c89f75f40c0b56d58fdebc682;hpb=7de50399a42ee49b0473b7b6eea2b44a2f941a12;p=ghc-base.git diff --git a/GHC/IO.hs b/GHC/IO.hs index 110ae68..b3d590a 100644 --- a/GHC/IO.hs +++ b/GHC/IO.hs @@ -1,18 +1,30 @@ -{-# OPTIONS -fno-implicit-prelude -#include "HsCore.h" #-} +{-# OPTIONS -fno-implicit-prelude -#include "HsBase.h" #-} #undef DEBUG_DUMP --- ----------------------------------------------------------------------------- --- $Id: IO.hs,v 1.3 2002/02/05 17:32:26 simonmar Exp $ +----------------------------------------------------------------------------- +-- | +-- Module : GHC.IO +-- Copyright : (c) The University of Glasgow, 1992-2001 +-- License : see libraries/base/LICENSE +-- +-- Maintainer : libraries@haskell.org +-- Stability : internal +-- Portability : non-portable -- --- (c) The University of Glasgow, 1992-2001 +-- String I\/O functions -- +----------------------------------------------------------------------------- module GHC.IO ( hWaitForInput, hGetChar, hGetLine, hGetContents, hPutChar, hPutStr, commitBuffer', -- hack, see below hGetcBuffered, -- needed by ghc/compiler/utils/StringBuffer.lhs - hGetBuf, hPutBuf, slurpFile + hGetBuf, hPutBuf, slurpFile, + memcpy_ba_baoff, + memcpy_ptr_baoff, + memcpy_baoff_ba, + memcpy_baoff_ptr, ) where import Foreign @@ -156,10 +168,13 @@ hGetLineBufferedLoop handle_ ref #endif xs <- unpack raw r off + + -- 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 } + 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_) @@ -167,10 +182,12 @@ hGetLineBufferedLoop handle_ ref case maybe_buf of -- Nothing indicates we caught an EOF, and we may have a -- partial line to return. - Nothing -> let str = concat (reverse (xs:xss)) in - if not (null str) - then return str - else ioe_EOF + 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) @@ -304,7 +321,7 @@ lazyReadHaveBuffer h handle_ fd ref buf = do unpackAcc :: RawBuffer -> Int -> Int -> [Char] -> IO [Char] -unpackAcc buf r 0 acc = return "" +unpackAcc buf r 0 acc = return acc unpackAcc buf (I# r) (I# len) acc = IO $ \s -> unpack acc (len -# 1#) s where unpack acc i s @@ -595,7 +612,8 @@ hPutBuf :: Handle -- handle to write to -> Int -- number of bytes of data in buffer -> IO () hPutBuf handle ptr count - | count <= 0 = illegalBufferSize handle "hPutBuf" count + | count == 0 = return () + | count < 0 = illegalBufferSize handle "hPutBuf" count | otherwise = wantWritableHandle "hPutBuf" handle $ \ handle_@Handle__{ haFD=fd, haBuffer=ref, haIsStream=is_stream } -> do @@ -635,7 +653,8 @@ writeChunk fd ptr bytes = loop 0 bytes hGetBuf :: Handle -> Ptr a -> Int -> IO Int hGetBuf handle ptr count - | count <= 0 = illegalBufferSize handle "hGetBuf" count + | count == 0 = return 0 + | count < 0 = illegalBufferSize handle "hGetBuf" count | otherwise = wantReadableHandle "hGetBuf" handle $ \ handle_@Handle__{ haFD=fd, haBuffer=ref } -> do @@ -682,6 +701,7 @@ slurpFile fname = do ioError (userError "slurpFile: file too big") else do let sz_i = fromIntegral sz + if sz_i == 0 then return (nullPtr, 0) else do chunk <- mallocBytes sz_i r <- hGetBuf handle chunk sz_i hClose handle