[project @ 2005-01-11 16:04:08 by simonmar]
[packages/old-time.git] / GHC / IO.hs
index c4c9143..9959914 100644 (file)
--- a/GHC/IO.hs
+++ b/GHC/IO.hs
@@ -1,4 +1,4 @@
-{-# OPTIONS -fno-implicit-prelude -#include "HsBase.h" #-}
+{-# OPTIONS_GHC -fno-implicit-prelude -#include "HsBase.h" #-}
 
 #undef DEBUG_DUMP
 
@@ -27,7 +27,7 @@ module GHC.IO (
    memcpy_baoff_ptr,
  ) where
 
-#include "config.h"
+#include "ghcconfig.h"
 
 import Foreign
 import Foreign.C
@@ -47,6 +47,10 @@ import GHC.Show
 import GHC.List
 import GHC.Exception    ( ioError, catch )
 
+#ifdef mingw32_TARGET_OS
+import GHC.Conc
+#endif
+
 -- ---------------------------------------------------------------------------
 -- Simple input operations
 
@@ -89,7 +93,7 @@ hWaitForInput h msecs = do
                           (fromIntegral msecs) (haIsStream handle_)
                return (r /= 0)
 
-foreign import ccall unsafe "inputReady"
+foreign import ccall safe "inputReady"
   inputReady :: CInt -> CInt -> Bool -> IO CInt
 
 -- ---------------------------------------------------------------------------
@@ -406,7 +410,7 @@ hPutChar handle c =
        LineBuffering    -> hPutcBuffered handle_ True  c
        BlockBuffering _ -> hPutcBuffered handle_ False c
        NoBuffering      ->
-               withObject (castCharToCChar c) $ \buf -> do
+               with (castCharToCChar c) $ \buf -> do
                  writeRawBufferPtr "hPutChar" (fromIntegral fd) (haIsStream handle_) buf 0 1
                  return ()
 
@@ -559,7 +563,7 @@ commitBuffer
 
 commitBuffer hdl raw sz@(I# _) count@(I# _) flush release = do
   wantWritableHandle "commitAndReleaseBuffer" hdl $
-     commitBuffer' hdl raw sz count flush release
+     commitBuffer' raw sz count flush release
 
 -- Explicitly lambda-lift this function to subvert GHC's full laziness
 -- optimisations, which otherwise tends to float out subexpressions
@@ -572,7 +576,7 @@ commitBuffer hdl raw sz@(I# _) count@(I# _) flush release = do
 --
 -- This hack is a fairly big win for hPutStr performance.  --SDM 18/9/2001
 --
-commitBuffer' hdl raw sz@(I# _) count@(I# _) flush release
+commitBuffer' raw sz@(I# _) count@(I# _) flush release
   handle_@Handle__{ haFD=fd, haBuffer=ref, haBuffers=spare_buf_ref } = do
 
 #ifdef DEBUG_DUMP
@@ -779,9 +783,9 @@ bufRead fd ref is_stream ptr so_far count =
                else do mb_buf <- maybeFillReadBuffer fd True is_stream buf
                        case mb_buf of
                          Nothing -> return so_far -- got nothing, we're done
-                         Just new_buf -> do 
-                           writeIORef ref new_buf
-                           bufRead fd ref is_stream ptr so_far count
+                         Just buf' -> do
+                               writeIORef ref buf'
+                               bufRead fd ref is_stream ptr so_far count
      else do 
        let avail = w - r
        if (count == avail)
@@ -797,6 +801,8 @@ bufRead fd ref is_stream ptr so_far count =
                return (so_far + count)
           else do
   
+       memcpy_ptr_baoff ptr raw r (fromIntegral avail)
+       writeIORef ref buf{ bufWPtr=0, bufRPtr=0 }
        let remaining = count - avail
            so_far' = so_far + avail
            ptr' = ptr `plusPtr` avail
@@ -878,6 +884,8 @@ bufReadNonBlocking fd ref is_stream ptr so_far count =
                return (so_far + count)
           else do
 
+       memcpy_ptr_baoff ptr raw r (fromIntegral avail)
+       writeIORef ref buf{ bufWPtr=0, bufRPtr=0 }
        let remaining = count - avail
            so_far' = so_far + avail
            ptr' = ptr `plusPtr` avail