X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=GHC%2FIO%2FHandle%2FFD.hs;h=b61c641afb207e868d7c27b7f79690c7ee31b797;hb=1258ad2dd3a9dc063c2276ca3bca3271ef7b1bf1;hp=a2a3d1477d07a99a3dca1cb2ad49a8e45ca7ba78;hpb=6c4536b0ff00f8bda65b3aef770174fae2d4f88c;p=ghc-base.git diff --git a/GHC/IO/Handle/FD.hs b/GHC/IO/Handle/FD.hs index a2a3d14..b61c641 100644 --- a/GHC/IO/Handle/FD.hs +++ b/GHC/IO/Handle/FD.hs @@ -1,4 +1,5 @@ -{-# OPTIONS_GHC -XNoImplicitPrelude #-} +{-# LANGUAGE CPP, NoImplicitPrelude, PatternGuards, ForeignFunctionInterface #-} + ----------------------------------------------------------------------------- -- | -- Module : GHC.IO.Handle.FD @@ -15,22 +16,20 @@ module GHC.IO.Handle.FD ( stdin, stdout, stderr, - openFile, openBinaryFile, + openFile, openBinaryFile, openFileBlocking, mkHandleFromFD, fdToHandle, fdToHandle', isEOF ) 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 "" 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 "" 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 "" 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 @@ -125,7 +148,17 @@ addFilePathToIOError fun fp ioe openFile :: FilePath -> IOMode -> IO Handle openFile fp im = catchException - (openFile' fp im dEFAULT_OPEN_IN_BINARY_MODE) + (openFile' fp im dEFAULT_OPEN_IN_BINARY_MODE True) + (\e -> ioError (addFilePathToIOError "openFile" fp e)) + +-- | Like 'openFile', but opens the file in ordinary blocking mode. +-- This can be useful for opening a FIFO for reading: if we open in +-- non-blocking mode then the open will fail if there are no writers, +-- whereas a blocking open will block until a writer appears. +openFileBlocking :: FilePath -> IOMode -> IO Handle +openFileBlocking fp im = + catchException + (openFile' fp im dEFAULT_OPEN_IN_BINARY_MODE False) (\e -> ioError (addFilePathToIOError "openFile" fp e)) -- | Like 'openFile', but open the file in binary mode. @@ -140,18 +173,20 @@ openFile fp im = openBinaryFile :: FilePath -> IOMode -> IO Handle openBinaryFile fp m = catchException - (openFile' fp m True) + (openFile' fp m True True) (\e -> ioError (addFilePathToIOError "openBinaryFile" fp e)) -openFile' :: String -> IOMode -> Bool -> IO Handle -openFile' filepath iomode binary = do +openFile' :: String -> IOMode -> Bool -> Bool -> IO Handle +openFile' filepath iomode binary non_blocking = do -- first open the file to get an FD - (fd, fd_type) <- FD.openFile filepath iomode + (fd, fd_type) <- FD.openFile filepath iomode non_blocking let mb_codec = if binary then Nothing else Just localeEncoding -- then use it to make a Handle - mkHandleFromFD fd fd_type filepath iomode True{-non-blocking-} mb_codec + mkHandleFromFD fd fd_type filepath iomode + False {- do not *set* non-blocking mode -} + mb_codec `onException` IODevice.close fd -- NB. don't forget to close the FD if mkHandleFromFD fails, otherwise -- this FD leaks. @@ -166,9 +201,9 @@ openFile' filepath iomode binary = do mkHandleFromFD :: FD -> IODeviceType - -> FilePath -- a string describing this file descriptor (e.g. the filename) + -> FilePath -- a string describing this file descriptor (e.g. the filename) -> IOMode - -> Bool -- non_blocking (*sets* non-blocking mode on the FD) + -> Bool -- *set* non-blocking mode on the FD -> Maybe TextEncoding -> IO Handle @@ -217,7 +252,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 @@ -232,8 +267,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)