X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=GHC%2FIO%2FFD.hs;h=b5392d477d1df5ca57b9997d2dbd25eb7c9bc613;hb=41e8fba828acbae1751628af50849f5352b27873;hp=4c3e11766504ecbc0e075bb2aa2349cf28729968;hpb=595f2cbc9072003f4e86dab6d1c9a408d388f3b7;p=ghc-base.git

diff --git a/GHC/IO/FD.hs b/GHC/IO/FD.hs
index 4c3e117..b5392d4 100644
--- a/GHC/IO/FD.hs
+++ b/GHC/IO/FD.hs
@@ -1,5 +1,13 @@
-{-# OPTIONS_GHC -XNoImplicitPrelude -XBangPatterns #-}
+{-# LANGUAGE CPP
+           , NoImplicitPrelude
+           , BangPatterns
+           , ForeignFunctionInterface
+           , DeriveDataTypeable
+  #-}
+{-# OPTIONS_GHC -fno-warn-identities #-}
+-- Whether there are identities depends on the platform
 {-# OPTIONS_HADDOCK hide #-}
+
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  GHC.IO.FD
@@ -98,8 +106,15 @@ instance GHC.IO.Device.IODevice FD where
   dup           = dup
   dup2          = dup2
 
+-- We used to use System.Posix.Internals.dEFAULT_BUFFER_SIZE, which is
+-- taken from the value of BUFSIZ on the current platform.  This value
+-- varies too much though: it is 512 on Windows, 1024 on OS X and 8192
+-- on Linux.  So let's just use a decent size on every platform:
+dEFAULT_FD_BUFFER_SIZE :: Int
+dEFAULT_FD_BUFFER_SIZE = 8096
+
 instance BufferedIO FD where
-  newBuffer _dev state = newByteBuffer dEFAULT_BUFFER_SIZE state
+  newBuffer _dev state = newByteBuffer dEFAULT_FD_BUFFER_SIZE state
   fillReadBuffer    fd buf = readBuf' fd buf
   fillReadBuffer0   fd buf = readBufNonBlocking fd buf
   flushWriteBuffer  fd buf = writeBuf' fd buf
@@ -278,15 +293,17 @@ stderr = stdFD 2
 close :: FD -> IO ()
 close fd =
 #ifndef mingw32_HOST_OS
-  (flip finally) (release fd) $ do
+  (flip finally) (release fd) $
 #endif
-  throwErrnoIfMinus1Retry_ "GHC.IO.FD.close" $
+  do let closer realFd =
+           throwErrnoIfMinus1Retry_ "GHC.IO.FD.close" $
 #ifdef mingw32_HOST_OS
-    if fdIsSocket fd then
-       c_closesocket (fdFD fd)
-    else
+           if fdIsSocket fd then
+             c_closesocket (fromIntegral realFd)
+           else
 #endif
-       c_close (fdFD fd)
+             c_close (fromIntegral realFd)
+     closeFdWith closer (fromIntegral (fdFD fd))
 
 release :: FD -> IO ()
 #ifdef mingw32_HOST_OS
@@ -395,13 +412,14 @@ setRaw fd raw = System.Posix.Internals.setCooked (fdFD fd) (not raw)
 
 fdRead :: FD -> Ptr Word8 -> Int -> IO Int
 fdRead fd ptr bytes
-  = readRawBufferPtr "GHC.IO.FD.fdRead" fd ptr 0 (fromIntegral bytes)
+  = do { r <- readRawBufferPtr "GHC.IO.FD.fdRead" fd ptr 0 (fromIntegral bytes)
+       ; return (fromIntegral r) }
 
 fdReadNonBlocking :: FD -> Ptr Word8 -> Int -> IO (Maybe Int)
 fdReadNonBlocking fd ptr bytes = do
   r <- readRawBufferPtrNoBlock "GHC.IO.FD.fdReadNonBlocking" fd ptr 
            0 (fromIntegral bytes)
-  case r of
+  case fromIntegral r of
     (-1) -> return (Nothing)
     n    -> return (Just n)