[project @ 2002-06-27 17:19:01 by sof]

[ghc-base.git] / GHC / IO.hs

diff --git a/GHC/IO.hs b/GHC/IO.hs
index 9a488b5..b3d590a 100644 (file)
--- a/GHC/IO.hs
+++ b/GHC/IO.hs
@@ -1,23 +1,36 @@
-{-# OPTIONS -fno-implicit-prelude -#include "HsCore.h" #-}
+{-# OPTIONS -fno-implicit-prelude -#include "HsBase.h" #-}
 
 #undef DEBUG_DUMP
 
--- -----------------------------------------------------------------------------
--- $Id: IO.hs,v 1.2 2002/01/02 14:40:10 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
 import Foreign.C
 
+import System.IO.Error
 import Data.Maybe
 import Control.Monad
 
@@ -58,7 +71,7 @@ hWaitForInput h msecs = do
          (inputReady (fromIntegral (haFD handle_)) (fromIntegral msecs) (haIsStream handle_))
   return (r /= 0)
 
-foreign import "inputReady" unsafe
+foreign import ccall unsafe "inputReady"
   inputReady :: CInt -> CInt -> Bool -> IO CInt
 
 -- ---------------------------------------------------------------------------
@@ -91,7 +104,7 @@ hGetChar handle =
        -- make use of the minimal buffer we already have
        let raw = bufBuf buf
        r <- throwErrnoIfMinus1RetryMayBlock "hGetChar"
-               (read_off (fromIntegral fd) (haIsStream handle_) raw 0 1)
+               (read_off_ba (fromIntegral fd) (haIsStream handle_) raw 0 1)
                (threadWaitRead fd)
        if r == 0
           then ioe_EOF
@@ -155,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_)
@@ -166,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)
 
@@ -271,7 +289,7 @@ lazyRead' h handle_ = do
        -- make use of the minimal buffer we already have
        let raw = bufBuf buf
        r <- throwErrnoIfMinus1RetryMayBlock "lazyRead"
-               (read_off (fromIntegral fd) (haIsStream handle_) raw 0 1)
+               (read_off_ba (fromIntegral fd) (haIsStream handle_) raw 0 1)
                (threadWaitRead fd)
        if r == 0
           then do handle_ <- hClose_help handle_ 
@@ -303,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
@@ -330,7 +348,7 @@ hPutChar handle c =
        NoBuffering      ->
                withObject (castCharToCChar c) $ \buf ->
                throwErrnoIfMinus1RetryMayBlock_ "hPutChar"
-                  (c_write (fromIntegral fd) buf 1)
+                  (write_off (fromIntegral fd) (haIsStream handle_) buf 0 1)
                   (threadWaitWrite fd)
 
 
@@ -594,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
@@ -634,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
@@ -681,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
@@ -689,13 +710,13 @@ slurpFile fname = do
 -- ---------------------------------------------------------------------------
 -- memcpy wrappers
 
-foreign import "__hscore_memcpy_src_off" unsafe 
+foreign import ccall unsafe "__hscore_memcpy_src_off"
    memcpy_ba_baoff :: RawBuffer -> RawBuffer -> Int -> CSize -> IO (Ptr ())
-foreign import "__hscore_memcpy_src_off" unsafe 
+foreign import ccall unsafe "__hscore_memcpy_src_off"
    memcpy_ptr_baoff :: Ptr a -> RawBuffer -> Int -> CSize -> IO (Ptr ())
-foreign import "__hscore_memcpy_dst_off" unsafe 
+foreign import ccall unsafe "__hscore_memcpy_dst_off"
    memcpy_baoff_ba :: RawBuffer -> Int -> RawBuffer -> CSize -> IO (Ptr ())
-foreign import "__hscore_memcpy_dst_off" unsafe 
+foreign import ccall unsafe "__hscore_memcpy_dst_off"
    memcpy_baoff_ptr :: RawBuffer -> Int -> Ptr a -> CSize -> IO (Ptr ())
 
 -----------------------------------------------------------------------------