X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;ds=sidebyside;f=GHC%2FIO.hs;h=f24891429cb534ad139cbe70382ab4165a8b7043;hb=194f49e0ad9d8ab04a42a71c3e3b1e22dd7688fb;hp=d8dbbb90662d20620342be6303d1d1ca67a0356e;hpb=d9a0d6f44a930da4ae49678908e37793d693467c;p=haskell-directory.git

diff --git a/GHC/IO.hs b/GHC/IO.hs
index d8dbbb9..f248914 100644
--- a/GHC/IO.hs
+++ b/GHC/IO.hs
@@ -401,8 +401,8 @@ unpackAcc buf (I# r) (I# len) acc = IO $ \s -> unpack acc (len -# 1#) s
 --  * 'isPermissionError' if another system resource limit would be exceeded.
 
 hPutChar :: Handle -> Char -> IO ()
-hPutChar handle c = 
-    c `seq` do   -- must evaluate c before grabbing the handle lock
+hPutChar handle c = do
+    c `seq` return ()
     wantWritableHandle "hPutChar" handle $ \ handle_  -> do
     let fd = haFD handle_
     case haBufferMode handle_ of
@@ -910,12 +910,13 @@ readChunkNonBlocking fd is_stream ptr bytes = do
 		 else throwErrno "readChunk"
       else return r
 #else
-    (ssize, rc) <- asyncRead fd (fromIntegral $ fromEnum is_stream)
-   			       (fromIntegral bytes) ptr
-    let r = fromIntegral ssize :: Int
-    if r == (-1)
-     then ioError (errnoToIOError "hGetBufNonBlocking" (Errno (fromIntegral rc)) Nothing Nothing)
-     else return r
+    fromIntegral `liftM`
+        readRawBufferPtr "readChunkNonBlocking" (fromIntegral fd) is_stream 
+	   		    (castPtr ptr) 0 (fromIntegral bytes)
+
+    -- we don't have non-blocking read support on Windows, so just invoke
+    -- the ordinary low-level read which will block until data is available,
+    -- but won't wait for the whole buffer to fill.
 #endif
 
 slurpFile :: FilePath -> IO (Ptr (), Int)