diff options
Diffstat (limited to 'libraries/base/GHC/Event')
| -rw-r--r-- | libraries/base/GHC/Event/Control.hs | 8 | ||||
| -rw-r--r-- | libraries/base/GHC/Event/Manager.hs | 1 | ||||
| -rw-r--r-- | libraries/base/GHC/Event/Thread.hs | 35 | ||||
| -rw-r--r-- | libraries/base/GHC/Event/TimerManager.hs | 1 |
4 files changed, 20 insertions, 25 deletions
diff --git a/libraries/base/GHC/Event/Control.hs b/libraries/base/GHC/Event/Control.hs index 53a9bc86d8..2951a6a681 100644 --- a/libraries/base/GHC/Event/Control.hs +++ b/libraries/base/GHC/Event/Control.hs @@ -17,7 +17,6 @@ module GHC.Event.Control , readControlMessage -- *** File descriptors , controlReadFd - , controlWriteFd , wakeupReadFd -- ** Control message sending , sendWakeup @@ -92,6 +91,7 @@ newControl shouldRegister = allocaArray 2 $ \fds -> do setCloseOnExec wr return (rd, wr) (ctrl_rd, ctrl_wr) <- createPipe + when shouldRegister $ c_setIOManagerControlFd ctrl_wr #if defined(HAVE_EVENTFD) ev <- throwErrnoIfMinus1 "eventfd" $ c_eventfd 0 0 setNonBlockingFD ev True @@ -200,5 +200,9 @@ foreign import ccall unsafe "sys/eventfd.h eventfd_write" c_eventfd_write :: CInt -> CULLong -> IO CInt #endif -foreign import ccall unsafe "setIOManagerWakeupFd" +-- Used to tell the RTS how it can send messages to the I/O manager. +foreign import ccall "setIOManagerControlFd" + c_setIOManagerControlFd :: CInt -> IO () + +foreign import ccall "setIOManagerWakeupFd" c_setIOManagerWakeupFd :: CInt -> IO () diff --git a/libraries/base/GHC/Event/Manager.hs b/libraries/base/GHC/Event/Manager.hs index 80c05f7c0c..d55d5b1193 100644 --- a/libraries/base/GHC/Event/Manager.hs +++ b/libraries/base/GHC/Event/Manager.hs @@ -27,7 +27,6 @@ module GHC.Event.Manager -- * State , callbackTableVar - , emControl -- * Registering interest in I/O events , Event diff --git a/libraries/base/GHC/Event/Thread.hs b/libraries/base/GHC/Event/Thread.hs index 0a82a548da..dcfa32aa28 100644 --- a/libraries/base/GHC/Event/Thread.hs +++ b/libraries/base/GHC/Event/Thread.hs @@ -22,7 +22,6 @@ import Data.List (zipWith3) import Data.Maybe (Maybe(..)) import Data.Tuple (snd) import Foreign.C.Error (eBADF, errnoToIOError) -import Foreign.C.Types (CInt(..), CUInt(..)) import Foreign.Ptr (Ptr) import GHC.Base import GHC.Conc.Sync (TVar, ThreadId, ThreadStatus(..), atomically, forkIO, @@ -34,14 +33,12 @@ import GHC.IO.Exception (ioError) import GHC.IOArray (IOArray, newIOArray, readIOArray, writeIOArray, boundsIOArray) import GHC.MVar (MVar, newEmptyMVar, newMVar, putMVar, takeMVar) -import GHC.Event.Control (controlWriteFd) import GHC.Event.Internal (eventIs, evtClose) import GHC.Event.Manager (Event, EventManager, evtRead, evtWrite, loop, new, registerFd, unregisterFd_) import qualified GHC.Event.Manager as M import qualified GHC.Event.TimerManager as TM import GHC.Num ((-), (+)) -import GHC.Real (fromIntegral) import GHC.Show (showSignedInt) import System.IO.Unsafe (unsafePerformIO) import System.Posix.Types (Fd) @@ -264,11 +261,7 @@ startIOManagerThread :: IOArray Int (Maybe (ThreadId, EventManager)) startIOManagerThread eventManagerArray i = do let create = do !mgr <- new True - !t <- forkOn i $ do - c_setIOManagerControlFd - (fromIntegral i) - (fromIntegral $ controlWriteFd $ M.emControl mgr) - loop mgr + !t <- forkOn i $ loop mgr labelThread t ("IOManager on cap " ++ show_int i) writeIOArray eventManagerArray i (Just (t,mgr)) old <- readIOArray eventManagerArray i @@ -284,7 +277,6 @@ startIOManagerThread eventManagerArray i = do -- the fork, for example. In this case we should clean up -- open pipes and everything else related to the event manager. -- See #4449 - c_setIOManagerControlFd (fromIntegral i) (-1) M.cleanup em create _other -> return () @@ -293,10 +285,8 @@ startTimerManagerThread :: IO () startTimerManagerThread = modifyMVar_ timerManagerThreadVar $ \old -> do let create = do !mgr <- TM.new - c_setTimerManagerControlFd - (fromIntegral $ controlWriteFd $ TM.emControl mgr) writeIORef timerManager $ Just mgr - !t <- forkIO $ TM.loop mgr + !t <- forkIO $ TM.loop mgr `finally` shutdownManagers labelThread t "TimerManager" return $ Just t case old of @@ -314,11 +304,21 @@ startTimerManagerThread = modifyMVar_ timerManagerThreadVar $ \old -> do mem <- readIORef timerManager _ <- case mem of Nothing -> return () - Just em -> do c_setTimerManagerControlFd (-1) - TM.cleanup em + Just em -> TM.cleanup em create _other -> return st +shutdownManagers :: IO () +shutdownManagers = + withMVar ioManagerLock $ \_ -> do + eventManagerArray <- readIORef eventManager + let (_, high) = boundsIOArray eventManagerArray + forM_ [0..high] $ \i -> do + mmgr <- readIOArray eventManagerArray i + case mmgr of + Nothing -> return () + Just (_,mgr) -> M.shutdown mgr + foreign import ccall unsafe "rtsSupportsBoundThreads" threaded :: Bool ioManagerCapabilitiesChanged :: IO () @@ -352,10 +352,3 @@ ioManagerCapabilitiesChanged = do Just (_,mgr) <- readIOArray eventManagerArray i tid <- restartPollLoop mgr i writeIOArray eventManagerArray i (Just (tid,mgr)) - --- Used to tell the RTS how it can send messages to the I/O manager. -foreign import ccall unsafe "setIOManagerControlFd" - c_setIOManagerControlFd :: CUInt -> CInt -> IO () - -foreign import ccall unsafe "setTimerManagerControlFd" - c_setTimerManagerControlFd :: CInt -> IO () diff --git a/libraries/base/GHC/Event/TimerManager.hs b/libraries/base/GHC/Event/TimerManager.hs index 63a72ef80b..f581330e25 100644 --- a/libraries/base/GHC/Event/TimerManager.hs +++ b/libraries/base/GHC/Event/TimerManager.hs @@ -15,7 +15,6 @@ module GHC.Event.TimerManager , new , newWith , newDefaultBackend - , emControl -- * Running , finished |