Repository : ssh://darcs.haskell.org//srv/darcs/packages/base On branch : master
http://hackage.haskell.org/trac/ghc/changeset/cc5431edd61fccbf082db6df10d502bb85e86078 >--------------------------------------------------------------- commit cc5431edd61fccbf082db6df10d502bb85e86078 Author: Bas van Dijk <[email protected]> Date: Mon Apr 4 20:22:09 2011 +0200 Add GHC.Event.getSystemEventManager :: IO (Maybe EventManager) >--------------------------------------------------------------- GHC/Event.hs | 2 ++ GHC/Event/Thread.hs | 19 +++++++++++++------ 2 files changed, 15 insertions(+), 6 deletions(-) diff --git a/GHC/Event.hs b/GHC/Event.hs index 6bb975e..7920895 100644 --- a/GHC/Event.hs +++ b/GHC/Event.hs @@ -8,6 +8,7 @@ module GHC.Event -- * Creation , new + , getSystemEventManager -- * Running , loop @@ -37,3 +38,4 @@ module GHC.Event ) where import GHC.Event.Manager +import GHC.Event.Thread (getSystemEventManager) diff --git a/GHC/Event/Thread.hs b/GHC/Event/Thread.hs index dbfb14f..42bf541 100644 --- a/GHC/Event/Thread.hs +++ b/GHC/Event/Thread.hs @@ -1,8 +1,8 @@ {-# LANGUAGE BangPatterns, ForeignFunctionInterface, NoImplicitPrelude #-} module GHC.Event.Thread - ( - ensureIOManagerIsRunning + ( getSystemEventManager + , ensureIOManagerIsRunning , threadWaitRead , threadWaitWrite , closeFdWith @@ -36,7 +36,7 @@ import System.Posix.Types (Fd) -- run /earlier/ than specified. threadDelay :: Int -> IO () threadDelay usecs = mask_ $ do - Just mgr <- readIORef eventManager + Just mgr <- getSystemEventManager m <- newEmptyMVar reg <- registerTimeout mgr usecs (putMVar m ()) takeMVar m `onException` M.unregisterTimeout mgr reg @@ -47,7 +47,7 @@ threadDelay usecs = mask_ $ do registerDelay :: Int -> IO (TVar Bool) registerDelay usecs = do t <- atomically $ newTVar False - Just mgr <- readIORef eventManager + Just mgr <- getSystemEventManager _ <- registerTimeout mgr usecs . atomically $ writeTVar t True return t @@ -80,19 +80,26 @@ closeFdWith :: (Fd -> IO ()) -- ^ Action that performs the close. -> Fd -- ^ File descriptor to close. -> IO () closeFdWith close fd = do - Just mgr <- readIORef eventManager + Just mgr <- getSystemEventManager M.closeFd mgr close fd threadWait :: Event -> Fd -> IO () threadWait evt fd = mask_ $ do m <- newEmptyMVar - Just mgr <- readIORef eventManager + Just mgr <- getSystemEventManager reg <- registerFd mgr (\reg e -> unregisterFd_ mgr reg >> putMVar m e) fd evt evt' <- takeMVar m `onException` unregisterFd_ mgr reg if evt' `eventIs` evtClose then ioError $ errnoToIOError "threadWait" eBADF Nothing Nothing else return () +-- | Retrieve the system event manager. +-- +-- This function always returns 'Just' the system event manager when using the +-- threaded RTS and 'Nothing' otherwise. +getSystemEventManager :: IO (Maybe EventManager) +getSystemEventManager = readIORef eventManager + foreign import ccall unsafe "getOrSetSystemEventThreadEventManagerStore" getOrSetSystemEventThreadEventManagerStore :: Ptr a -> IO (Ptr a) _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
