{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE CPP
, NoImplicitPrelude
, MagicHash
, UnboxedTuples
#-}
{-# OPTIONS_HADDOCK not-home #-}
module GHC.Conc.IO
( ensureIOManagerIsRunning
, ioManagerCapabilitiesChanged
, interruptIOManager
, threadDelay
, registerDelay
, threadWaitRead
, threadWaitWrite
, threadWaitReadSTM
, threadWaitWriteSTM
, closeFdWith
#if defined(mingw32_HOST_OS)
, asyncRead
, asyncWrite
, asyncDoProc
, asyncReadBA
, asyncWriteBA
, ConsoleEvent(..)
, win32ConsoleHandler
, toWin32ConsoleEvent
#endif
) where
import Foreign
import GHC.Base
import GHC.Conc.Sync as Sync
import GHC.Real ( fromIntegral )
import System.Posix.Types
#if defined(mingw32_HOST_OS)
import qualified GHC.Conc.Windows as Windows
import GHC.IO.SubSystem
import GHC.Conc.Windows (asyncRead, asyncWrite, asyncDoProc, asyncReadBA,
asyncWriteBA, ConsoleEvent(..), win32ConsoleHandler,
toWin32ConsoleEvent)
#else
import qualified GHC.Event.Thread as Event
#endif
ensureIOManagerIsRunning :: IO ()
#if !defined(mingw32_HOST_OS)
ensureIOManagerIsRunning :: IO ()
ensureIOManagerIsRunning = IO ()
Event.ensureIOManagerIsRunning
#else
ensureIOManagerIsRunning = Windows.ensureIOManagerIsRunning
#endif
interruptIOManager :: IO ()
#if !defined(mingw32_HOST_OS)
interruptIOManager :: IO ()
interruptIOManager = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#else
interruptIOManager = Windows.interruptIOManager
#endif
ioManagerCapabilitiesChanged :: IO ()
#if !defined(mingw32_HOST_OS)
ioManagerCapabilitiesChanged :: IO ()
ioManagerCapabilitiesChanged = IO ()
Event.ioManagerCapabilitiesChanged
#else
ioManagerCapabilitiesChanged = return ()
#endif
threadWaitRead :: Fd -> IO ()
threadWaitRead :: Fd -> IO ()
threadWaitRead Fd
fd
#if !defined(mingw32_HOST_OS)
| Bool
threaded = Fd -> IO ()
Event.threadWaitRead Fd
fd
#endif
| Bool
otherwise = (State# RealWorld -> (# State# RealWorld, () #)) -> IO ()
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO ((State# RealWorld -> (# State# RealWorld, () #)) -> IO ())
-> (State# RealWorld -> (# State# RealWorld, () #)) -> IO ()
forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s ->
case Fd -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Fd
fd of { I# Int#
fd# ->
case Int# -> State# RealWorld -> State# RealWorld
forall d. Int# -> State# d -> State# d
waitRead# Int#
fd# State# RealWorld
s of { State# RealWorld
s' -> (# State# RealWorld
s', () #)
}}
threadWaitWrite :: Fd -> IO ()
threadWaitWrite :: Fd -> IO ()
threadWaitWrite Fd
fd
#if !defined(mingw32_HOST_OS)
| Bool
threaded = Fd -> IO ()
Event.threadWaitWrite Fd
fd
#endif
| Bool
otherwise = (State# RealWorld -> (# State# RealWorld, () #)) -> IO ()
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO ((State# RealWorld -> (# State# RealWorld, () #)) -> IO ())
-> (State# RealWorld -> (# State# RealWorld, () #)) -> IO ()
forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s ->
case Fd -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Fd
fd of { I# Int#
fd# ->
case Int# -> State# RealWorld -> State# RealWorld
forall d. Int# -> State# d -> State# d
waitWrite# Int#
fd# State# RealWorld
s of { State# RealWorld
s' -> (# State# RealWorld
s', () #)
}}
threadWaitReadSTM :: Fd -> IO (Sync.STM (), IO ())
threadWaitReadSTM :: Fd -> IO (STM (), IO ())
threadWaitReadSTM Fd
fd
#if !defined(mingw32_HOST_OS)
| Bool
threaded = Fd -> IO (STM (), IO ())
Event.threadWaitReadSTM Fd
fd
#endif
| Bool
otherwise = do
TVar Bool
m <- Bool -> IO (TVar Bool)
forall a. a -> IO (TVar a)
Sync.newTVarIO Bool
False
ThreadId
t <- IO () -> IO ThreadId
Sync.forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ do
Fd -> IO ()
threadWaitRead Fd
fd
STM () -> IO ()
forall a. STM a -> IO a
Sync.atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TVar Bool -> Bool -> STM ()
forall a. TVar a -> a -> STM ()
Sync.writeTVar TVar Bool
m Bool
True
let waitAction :: STM ()
waitAction = do Bool
b <- TVar Bool -> STM Bool
forall a. TVar a -> STM a
Sync.readTVar TVar Bool
m
if Bool
b then () -> STM ()
forall (m :: * -> *) a. Monad m => a -> m a
return () else STM ()
forall a. STM a
retry
let killAction :: IO ()
killAction = ThreadId -> IO ()
Sync.killThread ThreadId
t
(STM (), IO ()) -> IO (STM (), IO ())
forall (m :: * -> *) a. Monad m => a -> m a
return (STM ()
waitAction, IO ()
killAction)
threadWaitWriteSTM :: Fd -> IO (Sync.STM (), IO ())
threadWaitWriteSTM :: Fd -> IO (STM (), IO ())
threadWaitWriteSTM Fd
fd
#if !defined(mingw32_HOST_OS)
| Bool
threaded = Fd -> IO (STM (), IO ())
Event.threadWaitWriteSTM Fd
fd
#endif
| Bool
otherwise = do
TVar Bool
m <- Bool -> IO (TVar Bool)
forall a. a -> IO (TVar a)
Sync.newTVarIO Bool
False
ThreadId
t <- IO () -> IO ThreadId
Sync.forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ do
Fd -> IO ()
threadWaitWrite Fd
fd
STM () -> IO ()
forall a. STM a -> IO a
Sync.atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TVar Bool -> Bool -> STM ()
forall a. TVar a -> a -> STM ()
Sync.writeTVar TVar Bool
m Bool
True
let waitAction :: STM ()
waitAction = do Bool
b <- TVar Bool -> STM Bool
forall a. TVar a -> STM a
Sync.readTVar TVar Bool
m
if Bool
b then () -> STM ()
forall (m :: * -> *) a. Monad m => a -> m a
return () else STM ()
forall a. STM a
retry
let killAction :: IO ()
killAction = ThreadId -> IO ()
Sync.killThread ThreadId
t
(STM (), IO ()) -> IO (STM (), IO ())
forall (m :: * -> *) a. Monad m => a -> m a
return (STM ()
waitAction, IO ()
killAction)
closeFdWith :: (Fd -> IO ())
-> Fd
-> IO ()
closeFdWith :: (Fd -> IO ()) -> Fd -> IO ()
closeFdWith Fd -> IO ()
close Fd
fd
#if !defined(mingw32_HOST_OS)
| Bool
threaded = (Fd -> IO ()) -> Fd -> IO ()
Event.closeFdWith Fd -> IO ()
close Fd
fd
#endif
| Bool
otherwise = Fd -> IO ()
close Fd
fd
threadDelay :: Int -> IO ()
threadDelay :: Int -> IO ()
threadDelay Int
time
#if defined(mingw32_HOST_OS)
| isWindowsNativeIO = Windows.threadDelay time
| threaded = Windows.threadDelay time
#else
| Bool
threaded = Int -> IO ()
Event.threadDelay Int
time
#endif
| Bool
otherwise = (State# RealWorld -> (# State# RealWorld, () #)) -> IO ()
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO ((State# RealWorld -> (# State# RealWorld, () #)) -> IO ())
-> (State# RealWorld -> (# State# RealWorld, () #)) -> IO ()
forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s ->
case Int
time of { I# Int#
time# ->
case Int# -> State# RealWorld -> State# RealWorld
forall d. Int# -> State# d -> State# d
delay# Int#
time# State# RealWorld
s of { State# RealWorld
s' -> (# State# RealWorld
s', () #)
}}
registerDelay :: Int -> IO (TVar Bool)
registerDelay :: Int -> IO (TVar Bool)
registerDelay Int
usecs
#if defined(mingw32_HOST_OS)
| isWindowsNativeIO = Windows.registerDelay usecs
| threaded = Windows.registerDelay usecs
#else
| Bool
threaded = Int -> IO (TVar Bool)
Event.registerDelay Int
usecs
#endif
| Bool
otherwise = [Char] -> IO (TVar Bool)
forall a. [Char] -> a
errorWithoutStackTrace [Char]
"registerDelay: requires -threaded"
foreign import ccall unsafe "rtsSupportsBoundThreads" threaded :: Bool