{-# LANGUAGE CPP #-}
{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE BangPatterns, NoImplicitPrelude #-}
#include <ghcplatform.h>
module GHC.Internal.Event.Thread
#if defined(javascript_HOST_ARCH)
( ) where
#else
( getSystemEventManager
, getSystemTimerManager
, ensureIOManagerIsRunning
, ioManagerCapabilitiesChanged
, threadWaitRead
, threadWaitWrite
, threadWaitReadSTM
, threadWaitWriteSTM
, closeFdWith
, threadDelay
, registerDelay
, blockedOnBadFD
) where
import GHC.Internal.Control.Exception (finally, SomeException, toException)
import GHC.Internal.Data.Foldable (forM_, mapM_, sequence_)
import GHC.Internal.Data.IORef (IORef, newIORef, readIORef, writeIORef, atomicWriteIORef)
import GHC.Internal.Data.Maybe (fromMaybe)
import GHC.Internal.Data.Tuple (snd)
import GHC.Internal.Foreign.C.Error (eBADF, errnoToIOError)
import GHC.Internal.Foreign.C.Types (CInt(..), CUInt(..))
import GHC.Internal.Foreign.Ptr (Ptr)
import GHC.Internal.Base
import GHC.Internal.List (zipWith, zipWith3)
import GHC.Internal.Conc.Sync (TVar, ThreadId, ThreadStatus(..), atomically, forkIO,
labelThread, modifyMVar_, withMVar, newTVar, sharedCAF,
getNumCapabilities, threadCapability, myThreadId, forkOn,
threadStatus, writeTVar, newTVarIO, readTVar, retry,
throwSTM, STM, yield)
import GHC.Internal.IO (mask_, uninterruptibleMask_, onException)
import GHC.Internal.IO.Exception (ioError)
import GHC.Internal.IOArray (IOArray, newIOArray, readIOArray, writeIOArray,
boundsIOArray)
import GHC.Internal.MVar (MVar, newEmptyMVar, newMVar, putMVar, takeMVar)
import GHC.Internal.Event.Control (controlWriteFd)
import GHC.Internal.Event.Internal (eventIs, evtClose)
import GHC.Internal.Event.Manager (Event, EventManager, evtRead, evtWrite, loop,
new, registerFd, unregisterFd_)
import qualified GHC.Internal.Event.Manager as M
import qualified GHC.Internal.Event.TimerManager as TM
import GHC.Internal.Ix (inRange)
import GHC.Internal.Num ((-), (+))
import GHC.Internal.Real (fromIntegral)
import GHC.Internal.Show (showSignedInt)
import GHC.Internal.IO.Unsafe (unsafePerformIO)
import GHC.Internal.System.Posix.Types (Fd)
threadDelay :: Int -> IO ()
threadDelay :: Int -> IO ()
threadDelay Int
usecs = IO () -> IO ()
forall a. IO a -> IO a
mask_ (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
mgr <- IO TimerManager
getSystemTimerManager
m <- newEmptyMVar
reg <- TM.registerTimeout mgr usecs (putMVar m ())
takeMVar m `onException` TM.unregisterTimeout mgr reg
registerDelay :: Int -> IO (TVar Bool)
registerDelay :: Int -> IO (TVar Bool)
registerDelay Int
usecs = do
t <- STM (TVar Bool) -> IO (TVar Bool)
forall a. STM a -> IO a
atomically (STM (TVar Bool) -> IO (TVar Bool))
-> STM (TVar Bool) -> IO (TVar Bool)
forall a b. (a -> b) -> a -> b
$ Bool -> STM (TVar Bool)
forall a. a -> STM (TVar a)
newTVar Bool
False
mgr <- getSystemTimerManager
_ <- TM.registerTimeout mgr usecs . atomically $ writeTVar t True
return t
threadWaitRead :: Fd -> IO ()
threadWaitRead :: Fd -> IO ()
threadWaitRead = Event -> Fd -> IO ()
threadWait Event
evtRead
{-# INLINE threadWaitRead #-}
threadWaitWrite :: Fd -> IO ()
threadWaitWrite :: Fd -> IO ()
threadWaitWrite = Event -> Fd -> IO ()
threadWait Event
evtWrite
{-# INLINE threadWaitWrite #-}
closeFdWith :: (Fd -> IO ())
-> Fd
-> IO ()
closeFdWith :: (Fd -> IO ()) -> Fd -> IO ()
closeFdWith Fd -> IO ()
close Fd
fd = IO ()
close_loop
where
finish :: EventManager -> IntTable [FdData] -> IO b -> IO b
finish EventManager
mgr IntTable [FdData]
table IO b
cbApp = MVar (IntTable [FdData]) -> IntTable [FdData] -> IO ()
forall a. MVar a -> a -> IO ()
putMVar (EventManager -> Fd -> MVar (IntTable [FdData])
M.callbackTableVar EventManager
mgr Fd
fd) IntTable [FdData]
table IO () -> IO b -> IO b
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO b
cbApp
zipWithM :: (a -> b -> m a) -> [a] -> [b] -> m [a]
zipWithM a -> b -> m a
f [a]
xs [b]
ys = [m a] -> m [a]
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence ((a -> b -> m a) -> [a] -> [b] -> [m a]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith a -> b -> m a
f [a]
xs [b]
ys)
close_loop :: IO ()
close_loop = do
eventManagerArray <- IORef (IOArray Int (Maybe (ThreadId, EventManager)))
-> IO (IOArray Int (Maybe (ThreadId, EventManager)))
forall a. IORef a -> IO a
readIORef IORef (IOArray Int (Maybe (ThreadId, EventManager)))
eventManager
let ema_bounds@(low, high) = boundsIOArray eventManagerArray
mgrs <- flip mapM [low..high] $ \Int
i -> do
Just (_,!mgr) <- IOArray Int (Maybe (ThreadId, EventManager))
-> Int -> IO (Maybe (ThreadId, EventManager))
forall i e. Ix i => IOArray i e -> i -> IO e
readIOArray IOArray Int (Maybe (ThreadId, EventManager))
eventManagerArray Int
i
return mgr
join $ uninterruptibleMask_ $ do
tables <- flip mapM mgrs $ \EventManager
mgr -> MVar (IntTable [FdData]) -> IO (IntTable [FdData])
forall a. MVar a -> IO a
takeMVar (MVar (IntTable [FdData]) -> IO (IntTable [FdData]))
-> MVar (IntTable [FdData]) -> IO (IntTable [FdData])
forall a b. (a -> b) -> a -> b
$ EventManager -> Fd -> MVar (IntTable [FdData])
M.callbackTableVar EventManager
mgr Fd
fd
new_ema_bounds <- boundsIOArray `fmap` readIORef eventManager
if new_ema_bounds /= ema_bounds
then do
sequence_ $ zipWith (\EventManager
mgr IntTable [FdData]
table -> EventManager -> IntTable [FdData] -> IO () -> IO ()
forall {b}. EventManager -> IntTable [FdData] -> IO b -> IO b
finish EventManager
mgr IntTable [FdData]
table (() -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())) mgrs tables
pure close_loop
else do
cbApps <- zipWithM (\EventManager
mgr IntTable [FdData]
table -> EventManager -> IntTable [FdData] -> Fd -> IO (IO ())
M.closeFd_ EventManager
mgr IntTable [FdData]
table Fd
fd) mgrs tables
close fd `finally` sequence_ (zipWith3 finish mgrs tables cbApps)
pure (pure ())
threadWait :: Event -> Fd -> IO ()
threadWait :: Event -> Fd -> IO ()
threadWait Event
evt Fd
fd = IO () -> IO ()
forall a. IO a -> IO a
mask_ (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
m <- IO (MVar Event)
forall a. IO (MVar a)
newEmptyMVar
mgr <- getSystemEventManager_
reg <- registerFd mgr (\FdKey
_ Event
e -> MVar Event -> Event -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar Event
m Event
e) fd evt M.OneShot
evt' <- takeMVar m `onException` unregisterFd_ mgr reg
if evt' `eventIs` evtClose
then ioError $ errnoToIOError "threadWait" eBADF Nothing Nothing
else return ()
blockedOnBadFD :: SomeException
blockedOnBadFD :: SomeException
blockedOnBadFD = IOError -> SomeException
forall e. Exception e => e -> SomeException
toException (IOError -> SomeException) -> IOError -> SomeException
forall a b. (a -> b) -> a -> b
$ String -> Errno -> Maybe Handle -> Maybe String -> IOError
errnoToIOError String
"awaitEvent" Errno
eBADF Maybe Handle
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
threadWaitSTM :: Event -> Fd -> IO (STM (), IO ())
threadWaitSTM :: Event -> Fd -> IO (STM (), IO ())
threadWaitSTM Event
evt Fd
fd = IO (STM (), IO ()) -> IO (STM (), IO ())
forall a. IO a -> IO a
mask_ (IO (STM (), IO ()) -> IO (STM (), IO ()))
-> IO (STM (), IO ()) -> IO (STM (), IO ())
forall a b. (a -> b) -> a -> b
$ do
m <- Maybe Event -> IO (TVar (Maybe Event))
forall a. a -> IO (TVar a)
newTVarIO Maybe Event
forall a. Maybe a
Nothing
mgr <- getSystemEventManager_
reg <- registerFd mgr (\FdKey
_ Event
e -> STM () -> IO ()
forall a. STM a -> IO a
atomically (TVar (Maybe Event) -> Maybe Event -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar (Maybe Event)
m (Event -> Maybe Event
forall a. a -> Maybe a
Just Event
e))) fd evt M.OneShot
let waitAction =
do mevt <- TVar (Maybe Event) -> STM (Maybe Event)
forall a. TVar a -> STM a
readTVar TVar (Maybe Event)
m
case mevt of
Maybe Event
Nothing -> STM ()
forall a. STM a
retry
Just Event
evt' ->
if Event
evt' Event -> Event -> Bool
`eventIs` Event
evtClose
then IOError -> STM ()
forall e a. Exception e => e -> STM a
throwSTM (IOError -> STM ()) -> IOError -> STM ()
forall a b. (a -> b) -> a -> b
$ String -> Errno -> Maybe Handle -> Maybe String -> IOError
errnoToIOError String
"threadWaitSTM" Errno
eBADF Maybe Handle
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
else () -> STM ()
forall a. a -> STM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
return (waitAction, unregisterFd_ mgr reg >> return ())
threadWaitReadSTM :: Fd -> IO (STM (), IO ())
threadWaitReadSTM :: Fd -> IO (STM (), IO ())
threadWaitReadSTM = Event -> Fd -> IO (STM (), IO ())
threadWaitSTM Event
evtRead
{-# INLINE threadWaitReadSTM #-}
threadWaitWriteSTM :: Fd -> IO (STM (), IO ())
threadWaitWriteSTM :: Fd -> IO (STM (), IO ())
threadWaitWriteSTM = Event -> Fd -> IO (STM (), IO ())
threadWaitSTM Event
evtWrite
{-# INLINE threadWaitWriteSTM #-}
getSystemEventManager :: IO (Maybe EventManager)
getSystemEventManager :: IO (Maybe EventManager)
getSystemEventManager = do
t <- IO ThreadId
myThreadId
eventManagerArray <- readIORef eventManager
let r = IOArray Int (Maybe (ThreadId, EventManager)) -> (Int, Int)
forall i e. IOArray i e -> (i, i)
boundsIOArray IOArray Int (Maybe (ThreadId, EventManager))
eventManagerArray
(cap, _) <- threadCapability t
if not (inRange r cap)
then yield >> getSystemEventManager
else fmap snd `fmap` readIOArray eventManagerArray cap
getSystemEventManager_ :: IO EventManager
getSystemEventManager_ :: IO EventManager
getSystemEventManager_ = do
Just mgr <- IO (Maybe EventManager)
getSystemEventManager
return mgr
{-# INLINE getSystemEventManager_ #-}
foreign import ccall unsafe "getOrSetSystemEventThreadEventManagerStore"
getOrSetSystemEventThreadEventManagerStore :: Ptr a -> IO (Ptr a)
eventManager :: IORef (IOArray Int (Maybe (ThreadId, EventManager)))
eventManager :: IORef (IOArray Int (Maybe (ThreadId, EventManager)))
eventManager = IO (IORef (IOArray Int (Maybe (ThreadId, EventManager))))
-> IORef (IOArray Int (Maybe (ThreadId, EventManager)))
forall a. IO a -> a
unsafePerformIO (IO (IORef (IOArray Int (Maybe (ThreadId, EventManager))))
-> IORef (IOArray Int (Maybe (ThreadId, EventManager))))
-> IO (IORef (IOArray Int (Maybe (ThreadId, EventManager))))
-> IORef (IOArray Int (Maybe (ThreadId, EventManager)))
forall a b. (a -> b) -> a -> b
$ do
numCaps <- IO Int
getNumCapabilities
eventManagerArray <- newIOArray (0, numCaps - 1) Nothing
em <- newIORef eventManagerArray
sharedCAF em getOrSetSystemEventThreadEventManagerStore
{-# NOINLINE eventManager #-}
numEnabledEventManagers :: IORef Int
numEnabledEventManagers :: IORef Int
numEnabledEventManagers = IO (IORef Int) -> IORef Int
forall a. IO a -> a
unsafePerformIO (IO (IORef Int) -> IORef Int) -> IO (IORef Int) -> IORef Int
forall a b. (a -> b) -> a -> b
$ Int -> IO (IORef Int)
forall a. a -> IO (IORef a)
newIORef Int
0
{-# NOINLINE numEnabledEventManagers #-}
foreign import ccall unsafe "getOrSetSystemEventThreadIOManagerThreadStore"
getOrSetSystemEventThreadIOManagerThreadStore :: Ptr a -> IO (Ptr a)
{-# NOINLINE ioManagerLock #-}
ioManagerLock :: MVar ()
ioManagerLock :: MVar ()
ioManagerLock = IO (MVar ()) -> MVar ()
forall a. IO a -> a
unsafePerformIO (IO (MVar ()) -> MVar ()) -> IO (MVar ()) -> MVar ()
forall a b. (a -> b) -> a -> b
$ do
m <- () -> IO (MVar ())
forall a. a -> IO (MVar a)
newMVar ()
sharedCAF m getOrSetSystemEventThreadIOManagerThreadStore
getSystemTimerManager :: IO TM.TimerManager
getSystemTimerManager :: IO TimerManager
getSystemTimerManager =
TimerManager -> Maybe TimerManager -> TimerManager
forall a. a -> Maybe a -> a
fromMaybe TimerManager
forall {a}. a
err (Maybe TimerManager -> TimerManager)
-> IO (Maybe TimerManager) -> IO TimerManager
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` IORef (Maybe TimerManager) -> IO (Maybe TimerManager)
forall a. IORef a -> IO a
readIORef IORef (Maybe TimerManager)
timerManager
where
err :: a
err = String -> a
forall a. HasCallStack => String -> a
error String
"GHC.Internal.Event.Thread.getSystemTimerManager: the TimerManager requires linking against the threaded runtime"
foreign import ccall unsafe "getOrSetSystemTimerThreadEventManagerStore"
getOrSetSystemTimerThreadEventManagerStore :: Ptr a -> IO (Ptr a)
timerManager :: IORef (Maybe TM.TimerManager)
timerManager :: IORef (Maybe TimerManager)
timerManager = IO (IORef (Maybe TimerManager)) -> IORef (Maybe TimerManager)
forall a. IO a -> a
unsafePerformIO (IO (IORef (Maybe TimerManager)) -> IORef (Maybe TimerManager))
-> IO (IORef (Maybe TimerManager)) -> IORef (Maybe TimerManager)
forall a b. (a -> b) -> a -> b
$ do
em <- Maybe TimerManager -> IO (IORef (Maybe TimerManager))
forall a. a -> IO (IORef a)
newIORef Maybe TimerManager
forall a. Maybe a
Nothing
sharedCAF em getOrSetSystemTimerThreadEventManagerStore
{-# NOINLINE timerManager #-}
foreign import ccall unsafe "getOrSetSystemTimerThreadIOManagerThreadStore"
getOrSetSystemTimerThreadIOManagerThreadStore :: Ptr a -> IO (Ptr a)
{-# NOINLINE timerManagerThreadVar #-}
timerManagerThreadVar :: MVar (Maybe ThreadId)
timerManagerThreadVar :: MVar (Maybe ThreadId)
timerManagerThreadVar = IO (MVar (Maybe ThreadId)) -> MVar (Maybe ThreadId)
forall a. IO a -> a
unsafePerformIO (IO (MVar (Maybe ThreadId)) -> MVar (Maybe ThreadId))
-> IO (MVar (Maybe ThreadId)) -> MVar (Maybe ThreadId)
forall a b. (a -> b) -> a -> b
$ do
m <- Maybe ThreadId -> IO (MVar (Maybe ThreadId))
forall a. a -> IO (MVar a)
newMVar Maybe ThreadId
forall a. Maybe a
Nothing
sharedCAF m getOrSetSystemTimerThreadIOManagerThreadStore
ensureIOManagerIsRunning :: IO ()
ensureIOManagerIsRunning :: IO ()
ensureIOManagerIsRunning
| Bool -> Bool
not Bool
threaded = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Bool
otherwise = do
IO ()
startIOManagerThreads
IO ()
startTimerManagerThread
startIOManagerThreads :: IO ()
startIOManagerThreads :: IO ()
startIOManagerThreads =
MVar () -> (() -> IO ()) -> IO ()
forall a b. MVar a -> (a -> IO b) -> IO b
withMVar MVar ()
ioManagerLock ((() -> IO ()) -> IO ()) -> (() -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \()
_ -> do
eventManagerArray <- IORef (IOArray Int (Maybe (ThreadId, EventManager)))
-> IO (IOArray Int (Maybe (ThreadId, EventManager)))
forall a. IORef a -> IO a
readIORef IORef (IOArray Int (Maybe (ThreadId, EventManager)))
eventManager
let (_, high) = boundsIOArray eventManagerArray
mapM_ (startIOManagerThread eventManagerArray) [0..high]
writeIORef numEnabledEventManagers (high+1)
show_int :: Int -> String
show_int :: Int -> String
show_int Int
i = Int -> Int -> ShowS
showSignedInt Int
0 Int
i String
""
restartPollLoop :: EventManager -> Int -> IO ThreadId
restartPollLoop :: EventManager -> Int -> IO ThreadId
restartPollLoop EventManager
mgr Int
i = do
EventManager -> IO ()
M.release EventManager
mgr
!t <- Int -> IO () -> IO ThreadId
forkOn Int
i (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ EventManager -> IO ()
loop EventManager
mgr
labelThread t ("IOManager on cap " ++ show_int i)
return t
startIOManagerThread :: IOArray Int (Maybe (ThreadId, EventManager))
-> Int
-> IO ()
startIOManagerThread :: IOArray Int (Maybe (ThreadId, EventManager)) -> Int -> IO ()
startIOManagerThread IOArray Int (Maybe (ThreadId, EventManager))
eventManagerArray Int
i = do
let create :: IO ()
create = do
!mgr <- IO EventManager
new
!t <- forkOn i $ do
c_setIOManagerControlFd
(fromIntegral i)
(fromIntegral $ controlWriteFd $ M.emControl mgr)
loop mgr
labelThread t ("IOManager on cap " ++ show_int i)
writeIOArray eventManagerArray i (Just (t,mgr))
old <- IOArray Int (Maybe (ThreadId, EventManager))
-> Int -> IO (Maybe (ThreadId, EventManager))
forall i e. Ix i => IOArray i e -> i -> IO e
readIOArray IOArray Int (Maybe (ThreadId, EventManager))
eventManagerArray Int
i
case old of
Maybe (ThreadId, EventManager)
Nothing -> IO ()
create
Just (ThreadId
t,EventManager
em) -> do
s <- ThreadId -> IO ThreadStatus
threadStatus ThreadId
t
case s of
ThreadStatus
ThreadFinished -> IO ()
create
ThreadStatus
ThreadDied -> do
CUInt -> CInt -> IO ()
c_setIOManagerControlFd (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i) (-CInt
1)
EventManager -> IO ()
M.cleanup EventManager
em
IO ()
create
ThreadStatus
_other -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
startTimerManagerThread :: IO ()
startTimerManagerThread :: IO ()
startTimerManagerThread = MVar (Maybe ThreadId)
-> (Maybe ThreadId -> IO (Maybe ThreadId)) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ MVar (Maybe ThreadId)
timerManagerThreadVar ((Maybe ThreadId -> IO (Maybe ThreadId)) -> IO ())
-> (Maybe ThreadId -> IO (Maybe ThreadId)) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Maybe ThreadId
old -> do
let create :: IO (Maybe ThreadId)
create = do
!mgr <- IO TimerManager
TM.new
c_setTimerManagerControlFd
(fromIntegral $ controlWriteFd $ TM.emControl mgr)
atomicWriteIORef timerManager $ Just mgr
!t <- forkIO $ TM.loop mgr
labelThread t "TimerManager"
return $ Just t
case Maybe ThreadId
old of
Maybe ThreadId
Nothing -> IO (Maybe ThreadId)
create
st :: Maybe ThreadId
st@(Just ThreadId
t) -> do
s <- ThreadId -> IO ThreadStatus
threadStatus ThreadId
t
case s of
ThreadStatus
ThreadFinished -> IO (Maybe ThreadId)
create
ThreadStatus
ThreadDied -> do
mem <- IORef (Maybe TimerManager) -> IO (Maybe TimerManager)
forall a. IORef a -> IO a
readIORef IORef (Maybe TimerManager)
timerManager
_ <- case mem of
Maybe TimerManager
Nothing -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just TimerManager
em -> do CInt -> IO ()
c_setTimerManagerControlFd (-CInt
1)
TimerManager -> IO ()
TM.cleanup TimerManager
em
create
ThreadStatus
_other -> Maybe ThreadId -> IO (Maybe ThreadId)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ThreadId
st
foreign import ccall unsafe "rtsSupportsBoundThreads" threaded :: Bool
ioManagerCapabilitiesChanged :: IO ()
ioManagerCapabilitiesChanged :: IO ()
ioManagerCapabilitiesChanged =
MVar () -> (() -> IO ()) -> IO ()
forall a b. MVar a -> (a -> IO b) -> IO b
withMVar MVar ()
ioManagerLock ((() -> IO ()) -> IO ()) -> (() -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \()
_ -> do
new_n_caps <- IO Int
getNumCapabilities
numEnabled <- readIORef numEnabledEventManagers
writeIORef numEnabledEventManagers new_n_caps
eventManagerArray <- readIORef eventManager
let (_, high) = boundsIOArray eventManagerArray
let old_n_caps = Int
high Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
if new_n_caps > old_n_caps
then do new_eventManagerArray <- newIOArray (0, new_n_caps - 1) Nothing
forM_ [0..high] $ \Int
i -> do
Just (tid,mgr) <- IOArray Int (Maybe (ThreadId, EventManager))
-> Int -> IO (Maybe (ThreadId, EventManager))
forall i e. Ix i => IOArray i e -> i -> IO e
readIOArray IOArray Int (Maybe (ThreadId, EventManager))
eventManagerArray Int
i
if i < numEnabled
then writeIOArray new_eventManagerArray i (Just (tid,mgr))
else do tid' <- restartPollLoop mgr i
writeIOArray new_eventManagerArray i (Just (tid',mgr))
forM_ [old_n_caps..new_n_caps-1] $
startIOManagerThread new_eventManagerArray
atomicWriteIORef eventManager new_eventManagerArray
else when (new_n_caps > numEnabled) $
forM_ [numEnabled..new_n_caps-1] $ \Int
i -> do
Just (_,mgr) <- IOArray Int (Maybe (ThreadId, EventManager))
-> Int -> IO (Maybe (ThreadId, EventManager))
forall i e. Ix i => IOArray i e -> i -> IO e
readIOArray IOArray Int (Maybe (ThreadId, EventManager))
eventManagerArray Int
i
tid <- restartPollLoop mgr i
writeIOArray eventManagerArray i (Just (tid,mgr))
#if defined(wasm32_HOST_ARCH)
c_setIOManagerControlFd :: CUInt -> CInt -> IO ()
c_setIOManagerControlFd _ _ = pure ()
c_setTimerManagerControlFd :: CInt -> IO ()
c_setTimerManagerControlFd _ = pure ()
#else
foreign import ccall unsafe "setIOManagerControlFd"
c_setIOManagerControlFd :: CUInt -> CInt -> IO ()
foreign import ccall unsafe "setTimerManagerControlFd"
c_setTimerManagerControlFd :: CInt -> IO ()
#endif
#endif