From 24d55bf5f1962bbbcfae3a8a2bbd75676250c4e1 Mon Sep 17 00:00:00 2001
From: Bas van Dijk <v.dijk.bas@gmail.com>
Date: Mon, 4 Apr 2011 20:22:09 +0200
Subject: [PATCH] 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
|
b
|
|
| 8 | 8 | |
| 9 | 9 | -- * Creation |
| 10 | 10 | , new |
| | 11 | , getSystemEventManager |
| 11 | 12 | |
| 12 | 13 | -- * Running |
| 13 | 14 | , loop |
| … |
… |
|
| 37 | 38 | ) where |
| 38 | 39 | |
| 39 | 40 | import GHC.Event.Manager |
| | 41 | import GHC.Event.Thread (getSystemEventManager) |
diff --git a/GHC/Event/Thread.hs b/GHC/Event/Thread.hs
index dbfb14f..42bf541 100644
|
a
|
b
|
|
| 1 | 1 | {-# LANGUAGE BangPatterns, ForeignFunctionInterface, NoImplicitPrelude #-} |
| 2 | 2 | |
| 3 | 3 | module GHC.Event.Thread |
| 4 | | ( |
| 5 | | ensureIOManagerIsRunning |
| | 4 | ( getSystemEventManager |
| | 5 | , ensureIOManagerIsRunning |
| 6 | 6 | , threadWaitRead |
| 7 | 7 | , threadWaitWrite |
| 8 | 8 | , closeFdWith |
| … |
… |
|
| 36 | 36 | -- run /earlier/ than specified. |
| 37 | 37 | threadDelay :: Int -> IO () |
| 38 | 38 | threadDelay usecs = mask_ $ do |
| 39 | | Just mgr <- readIORef eventManager |
| | 39 | Just mgr <- getSystemEventManager |
| 40 | 40 | m <- newEmptyMVar |
| 41 | 41 | reg <- registerTimeout mgr usecs (putMVar m ()) |
| 42 | 42 | takeMVar m `onException` M.unregisterTimeout mgr reg |
| … |
… |
|
| 47 | 47 | registerDelay :: Int -> IO (TVar Bool) |
| 48 | 48 | registerDelay usecs = do |
| 49 | 49 | t <- atomically $ newTVar False |
| 50 | | Just mgr <- readIORef eventManager |
| | 50 | Just mgr <- getSystemEventManager |
| 51 | 51 | _ <- registerTimeout mgr usecs . atomically $ writeTVar t True |
| 52 | 52 | return t |
| 53 | 53 | |
| … |
… |
|
| 80 | 80 | -> Fd -- ^ File descriptor to close. |
| 81 | 81 | -> IO () |
| 82 | 82 | closeFdWith close fd = do |
| 83 | | Just mgr <- readIORef eventManager |
| | 83 | Just mgr <- getSystemEventManager |
| 84 | 84 | M.closeFd mgr close fd |
| 85 | 85 | |
| 86 | 86 | threadWait :: Event -> Fd -> IO () |
| 87 | 87 | threadWait evt fd = mask_ $ do |
| 88 | 88 | m <- newEmptyMVar |
| 89 | | Just mgr <- readIORef eventManager |
| | 89 | Just mgr <- getSystemEventManager |
| 90 | 90 | reg <- registerFd mgr (\reg e -> unregisterFd_ mgr reg >> putMVar m e) fd evt |
| 91 | 91 | evt' <- takeMVar m `onException` unregisterFd_ mgr reg |
| 92 | 92 | if evt' `eventIs` evtClose |
| 93 | 93 | then ioError $ errnoToIOError "threadWait" eBADF Nothing Nothing |
| 94 | 94 | else return () |
| 95 | 95 | |
| | 96 | -- | Retrieve the system event manager. |
| | 97 | -- |
| | 98 | -- This function always returns 'Just' the system event manager when using the |
| | 99 | -- threaded RTS and 'Nothing' otherwise. |
| | 100 | getSystemEventManager :: IO (Maybe EventManager) |
| | 101 | getSystemEventManager = readIORef eventManager |
| | 102 | |
| 96 | 103 | foreign import ccall unsafe "getOrSetSystemEventThreadEventManagerStore" |
| 97 | 104 | getOrSetSystemEventThreadEventManagerStore :: Ptr a -> IO (Ptr a) |
| 98 | 105 | |
