X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=GHC%2FIO%2FHandle%2FFD.hs;h=fd188a852db879c6b5fa698a9de5e2dd22e19ad8;hb=41e8fba828acbae1751628af50849f5352b27873;hp=d74dd2da84c081ca50027321ee5115a9d441ece9;hpb=d2063b5b0be014545b21819172c87756efcb0b0c;p=ghc-base.git

diff --git a/GHC/IO/Handle/FD.hs b/GHC/IO/Handle/FD.hs
index d74dd2d..fd188a8 100644
--- a/GHC/IO/Handle/FD.hs
+++ b/GHC/IO/Handle/FD.hs
@@ -1,4 +1,5 @@
-{-# OPTIONS_GHC -XNoImplicitPrelude #-}
+{-# LANGUAGE CPP, NoImplicitPrelude, PatternGuards #-}
+
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  GHC.IO.Handle.FD
@@ -21,16 +22,14 @@ module GHC.IO.Handle.FD (
  ) where
 
 import GHC.Base
-import GHC.Num
-import GHC.Real
 import GHC.Show
 import Data.Maybe
-import Control.Monad
+-- import Control.Monad
 import Foreign.C.Types
 import GHC.MVar
 import GHC.IO
 import GHC.IO.Encoding
-import GHC.IO.Exception
+-- import GHC.IO.Exception
 import GHC.IO.Device as IODevice
 import GHC.IO.Exception
 import GHC.IO.IOMode
@@ -51,24 +50,30 @@ import qualified System.Posix.Internals as Posix
 
 -- | A handle managing input from the Haskell program's standard input channel.
 stdin :: Handle
+{-# NOINLINE stdin #-}
 stdin = unsafePerformIO $ do
    -- ToDo: acquire lock
+   setBinaryMode FD.stdin
    mkHandle FD.stdin "<stdin>" ReadHandle True (Just localeEncoding)
                 nativeNewlineMode{-translate newlines-}
                 (Just stdHandleFinalizer) Nothing
 
 -- | A handle managing output to the Haskell program's standard output channel.
 stdout :: Handle
+{-# NOINLINE stdout #-}
 stdout = unsafePerformIO $ do
    -- ToDo: acquire lock
+   setBinaryMode FD.stdout
    mkHandle FD.stdout "<stdout>" WriteHandle True (Just localeEncoding)
                 nativeNewlineMode{-translate newlines-}
                 (Just stdHandleFinalizer) Nothing
 
 -- | A handle managing output to the Haskell program's standard error channel.
 stderr :: Handle
+{-# NOINLINE stderr #-}
 stderr = unsafePerformIO $ do
     -- ToDo: acquire lock
+   setBinaryMode FD.stderr
    mkHandle FD.stderr "<stderr>" WriteHandle False{-stderr is unbuffered-} 
                 (Just localeEncoding)
                 nativeNewlineMode{-translate newlines-}
@@ -78,8 +83,26 @@ stdHandleFinalizer :: FilePath -> MVar Handle__ -> IO ()
 stdHandleFinalizer fp m = do
   h_ <- takeMVar m
   flushWriteBuffer h_
+  case haType h_ of 
+      ClosedHandle -> return ()
+      _other       -> closeTextCodecs h_
   putMVar m (ioe_finalizedHandle fp)
 
+-- We have to put the FDs into binary mode on Windows to avoid the newline
+-- translation that the CRT IO library does.
+setBinaryMode :: FD -> IO ()
+#ifdef mingw32_HOST_OS
+setBinaryMode fd = do _ <- setmode (fdFD fd) True
+                      return ()
+#else
+setBinaryMode _ = return ()
+#endif
+
+#ifdef mingw32_HOST_OS
+foreign import ccall unsafe "__hscore_setmode"
+  setmode :: CInt -> Bool -> IO CInt
+#endif
+
 -- ---------------------------------------------------------------------------
 -- isEOF
 
@@ -172,13 +195,16 @@ mkHandleFromFD
    -> Maybe TextEncoding
    -> IO Handle
 
-mkHandleFromFD fd fd_type filepath iomode set_non_blocking mb_codec
+mkHandleFromFD fd0 fd_type filepath iomode set_non_blocking mb_codec
   = do
 #ifndef mingw32_HOST_OS
-    when set_non_blocking $ FD.setNonBlockingMode fd
     -- turn on non-blocking mode
+    fd <- if set_non_blocking 
+             then FD.setNonBlockingMode fd0 True
+             else return fd0
 #else
     let _ = set_non_blocking -- warning suppression
+    fd <- return fd0
 #endif
 
     let nl | isJust mb_codec = nativeNewlineMode
@@ -214,7 +240,7 @@ fdToHandle' fdint mb_type is_socket filepath iomode binary = do
                         Just RegularFile -> Nothing
                           -- no stat required for streams etc.:
                         Just other       -> Just (other,0,0)
-  (fd,fd_type) <- FD.mkFD (fromIntegral fdint) iomode mb_stat
+  (fd,fd_type) <- FD.mkFD fdint iomode mb_stat
                        is_socket
                        is_socket
   mkHandleFromFD fd fd_type filepath iomode is_socket
@@ -229,8 +255,8 @@ fdToHandle' fdint mb_type is_socket filepath iomode binary = do
 -- translation instead.
 fdToHandle :: Posix.FD -> IO Handle
 fdToHandle fdint = do
-   iomode <- Posix.fdGetMode (fromIntegral fdint)
-   (fd,fd_type) <- FD.mkFD (fromIntegral fdint) iomode Nothing
+   iomode <- Posix.fdGetMode fdint
+   (fd,fd_type) <- FD.mkFD fdint iomode Nothing
             False{-is_socket-} 
               -- NB. the is_socket flag is False, meaning that:
               --  on Windows we're guessing this is not a socket (XXX)