X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=GHC%2FIO.hs;h=d8dbbb90662d20620342be6303d1d1ca67a0356e;hb=d644424fc0c7927947150e254bce09ae5302c485;hp=c4c9143de2e29c57cc42e17e52362cce7d5a57d8;hpb=0870508f48e629ca598451e4f5cde2c1ae285242;p=haskell-directory.git

diff --git a/GHC/IO.hs b/GHC/IO.hs
index c4c9143..d8dbbb9 100644
--- 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
 
@@ -16,6 +16,7 @@
 --
 -----------------------------------------------------------------------------
 
+-- #hide
 module GHC.IO ( 
    hWaitForInput, hGetChar, hGetLine, hGetContents, hPutChar, hPutStr,
    commitBuffer',	-- hack, see below
@@ -27,8 +28,6 @@ module GHC.IO (
    memcpy_baoff_ptr,
  ) where
 
-#include "config.h"
-
 import Foreign
 import Foreign.C
 
@@ -47,6 +46,10 @@ import GHC.Show
 import GHC.List
 import GHC.Exception    ( ioError, catch )
 
+#ifdef mingw32_HOST_OS
+import GHC.Conc
+#endif
+
 -- ---------------------------------------------------------------------------
 -- Simple input operations
 
@@ -89,7 +92,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 +409,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 +562,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 +575,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
@@ -723,7 +726,7 @@ writeChunkNonBlocking fd is_stream ptr bytes = loop 0 bytes
   loop :: Int -> Int -> IO Int
   loop off bytes | bytes <= 0 = return off
   loop off bytes = do
-#ifndef mingw32_TARGET_OS
+#ifndef mingw32_HOST_OS
     ssize <- c_write (fromIntegral fd) (ptr `plusPtr` off) (fromIntegral bytes)
     let r = fromIntegral ssize :: Int
     if (r == -1)
@@ -779,9 +782,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 +800,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 +883,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
@@ -893,7 +900,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_TARGET_OS
+#ifndef mingw32_HOST_OS
     ssize <- c_read (fromIntegral fd) (castPtr ptr) (fromIntegral bytes)
     let r = fromIntegral ssize :: Int
     if (r == -1)