diff options
| -rw-r--r-- | libraries/base/Control/Concurrent.hs | 14 | ||||
| -rw-r--r-- | libraries/base/GHC/IO/FD.hs | 4 | ||||
| -rw-r--r-- | libraries/base/cbits/inputReady.c | 2 | ||||
| -rw-r--r-- | libraries/base/include/HsBase.h | 5 |
4 files changed, 13 insertions, 12 deletions
diff --git a/libraries/base/Control/Concurrent.hs b/libraries/base/Control/Concurrent.hs index 094639988b..bd222e2b1e 100644 --- a/libraries/base/Control/Concurrent.hs +++ b/libraries/base/Control/Concurrent.hs @@ -407,7 +407,7 @@ threadWaitRead fd -- fdReady does the right thing, but we have to call it in a -- separate thread, otherwise threadWaitRead won't be interruptible, -- and this only works with -threaded. - | threaded = withThread (waitFd fd 0) + | threaded = withThread (waitFd fd False) | otherwise = case fd of 0 -> do _ <- hWaitForInput stdin (-1) return () @@ -428,7 +428,7 @@ threadWaitRead fd threadWaitWrite :: Fd -> IO () threadWaitWrite fd #if defined(mingw32_HOST_OS) - | threaded = withThread (waitFd fd 1) + | threaded = withThread (waitFd fd True) | otherwise = errorWithoutStackTrace "threadWaitWrite requires -threaded on Windows" #else = GHC.Conc.threadWaitWrite fd @@ -444,7 +444,7 @@ threadWaitReadSTM :: Fd -> IO (STM (), IO ()) threadWaitReadSTM fd #if defined(mingw32_HOST_OS) | threaded = do v <- newTVarIO Nothing - mask_ $ void $ forkIO $ do result <- try (waitFd fd 0) + mask_ $ void $ forkIO $ do result <- try (waitFd fd False) atomically (writeTVar v $ Just result) let waitAction = do result <- readTVar v case result of @@ -468,7 +468,7 @@ threadWaitWriteSTM :: Fd -> IO (STM (), IO ()) threadWaitWriteSTM fd #if defined(mingw32_HOST_OS) | threaded = do v <- newTVarIO Nothing - mask_ $ void $ forkIO $ do result <- try (waitFd fd 1) + mask_ $ void $ forkIO $ do result <- try (waitFd fd True) atomically (writeTVar v $ Just result) let waitAction = do result <- readTVar v case result of @@ -494,13 +494,13 @@ withThread io = do Right a -> return a Left e -> throwIO (e :: IOException) -waitFd :: Fd -> CInt -> IO () +waitFd :: Fd -> Bool -> IO () waitFd fd write = do throwErrnoIfMinus1_ "fdReady" $ - fdReady (fromIntegral fd) write (-1) 0 + fdReady (fromIntegral fd) (if write then 1 else 0) (-1) 0 foreign import ccall safe "fdReady" - fdReady :: CInt -> CInt -> Int64 -> CInt -> IO CInt + fdReady :: CInt -> CBool -> Int64 -> CBool -> IO CInt #endif -- --------------------------------------------------------------------------- diff --git a/libraries/base/GHC/IO/FD.hs b/libraries/base/GHC/IO/FD.hs index 4a4f063219..bb188a9b9b 100644 --- a/libraries/base/GHC/IO/FD.hs +++ b/libraries/base/GHC/IO/FD.hs @@ -401,7 +401,7 @@ ready fd write msecs = do return (toEnum (fromIntegral r)) foreign import ccall safe "fdReady" - fdReady :: CInt -> CInt -> Int64 -> CInt -> IO CInt + fdReady :: CInt -> CBool -> Int64 -> CBool -> IO CInt -- --------------------------------------------------------------------------- -- Terminal-related stuff @@ -562,7 +562,7 @@ isNonBlocking :: FD -> Bool isNonBlocking fd = fdIsNonBlocking fd /= 0 foreign import ccall unsafe "fdReady" - unsafe_fdReady :: CInt -> CInt -> Int64 -> CInt -> IO CInt + unsafe_fdReady :: CInt -> CBool -> Int64 -> CBool -> IO CInt #else /* mingw32_HOST_OS.... */ diff --git a/libraries/base/cbits/inputReady.c b/libraries/base/cbits/inputReady.c index a3024bf114..9b1bb9eaf7 100644 --- a/libraries/base/cbits/inputReady.c +++ b/libraries/base/cbits/inputReady.c @@ -134,7 +134,7 @@ compute_WaitForSingleObject_timeout(bool infinite, Time remaining) * On error, sets `errno`. */ int -fdReady(int fd, int write, int64_t msecs, int isSock) +fdReady(int fd, bool write, int64_t msecs, bool isSock) { bool infinite = msecs < 0; diff --git a/libraries/base/include/HsBase.h b/libraries/base/include/HsBase.h index 748e3577ce..13640c590e 100644 --- a/libraries/base/include/HsBase.h +++ b/libraries/base/include/HsBase.h @@ -24,6 +24,7 @@ #include "HsFFI.h" +#include <stdbool.h> #include <stdio.h> #include <stdlib.h> #include <math.h> @@ -152,7 +153,7 @@ extern HsWord64 getMonotonicUSec(void); #endif /* in inputReady.c */ -extern int fdReady(int fd, int write, int64_t msecs, int isSock); +extern int fdReady(int fd, bool write, int64_t msecs, bool isSock); /* ----------------------------------------------------------------------------- INLINE functions. @@ -288,7 +289,7 @@ __hscore_ftruncate( int fd, off_t where ) return _chsize(fd,where); #else // ToDo: we should use _chsize_s() on Windows which allows a 64-bit -// offset, but it doesn't seem to be available from mingw at this time +// offset, but it doesn't seem to be available from mingw at this time // --SDM (01/2008) #error at least ftruncate or _chsize functions are required to build #endif |