2 , ForeignFunctionInterface
3 , GeneralizedNewtypeDeriving
9 -- | A binding to the epoll I/O event notification facility
11 -- epoll is a variant of poll that can be used either as an edge-triggered or
12 -- a level-triggered interface and scales well to large numbers of watched file
15 -- epoll decouples monitor an fd from the process of registering it.
17 module System.Event.EPoll
23 import qualified System.Event.Internal as E
25 #include "EventConfig.h"
26 #if !defined(HAVE_EPOLL)
30 new = error "EPoll back end not implemented for this platform"
34 {-# INLINE available #-}
37 #include <sys/epoll.h>
39 import Control.Monad (when)
40 import Data.Bits (Bits, (.|.), (.&.))
41 import Data.Monoid (Monoid(..))
42 import Data.Word (Word32)
43 import Foreign.C.Error (throwErrnoIfMinus1, throwErrnoIfMinus1_)
44 import Foreign.C.Types (CInt)
45 import Foreign.Marshal.Utils (with)
46 import Foreign.Ptr (Ptr)
47 import Foreign.Storable (Storable(..))
49 import GHC.Err (undefined)
50 import GHC.Num (Num(..))
51 import GHC.Real (ceiling, fromIntegral)
52 import GHC.Show (Show)
53 import System.Posix.Internals (c_close)
54 #if !defined(HAVE_EPOLL_CREATE1)
55 import System.Posix.Internals (setCloseOnExec)
57 import System.Posix.Types (Fd(..))
59 import qualified System.Event.Array as A
60 import System.Event.Internal (Timeout(..))
64 {-# INLINE available #-}
67 epollFd :: {-# UNPACK #-} !EPollFd
68 , epollEvents :: {-# UNPACK #-} !(A.Array Event)
71 -- | Create a new epoll backend.
76 let !be = E.backend poll modifyFd delete (EPoll epfd evts)
79 delete :: EPoll -> IO ()
81 _ <- c_close . fromEPollFd . epollFd $ be
84 -- | Change the set of events we are interested in for a given file
86 modifyFd :: EPoll -> Fd -> E.Event -> E.Event -> IO ()
87 modifyFd ep fd oevt nevt = with (Event (fromEvent nevt) fd) $
88 epollControl (epollFd ep) op fd
89 where op | oevt == mempty = controlOpAdd
90 | nevt == mempty = controlOpDelete
91 | otherwise = controlOpModify
93 -- | Select a set of file descriptors which are ready for I/O
94 -- operations and call @f@ for all ready file descriptors, passing the
95 -- events that are ready.
96 poll :: EPoll -- ^ state
97 -> Timeout -- ^ timeout in milliseconds
98 -> (Fd -> E.Event -> IO ()) -- ^ I/O callback
100 poll ep timeout f = do
101 let events = epollEvents ep
103 -- Will return zero if the system call was interupted, in which case
104 -- we just return (and try again later.)
105 n <- A.unsafeLoad events $ \es cap ->
106 epollWait (epollFd ep) es cap $ fromTimeout timeout
109 A.forM_ events $ \e -> f (eventFd e) (toEvent (eventTypes e))
110 cap <- A.capacity events
111 when (cap == n) $ A.ensureCapacity events (2 * cap)
113 newtype EPollFd = EPollFd {
115 } deriving (Eq, Show)
118 eventTypes :: EventType
122 instance Storable Event where
123 sizeOf _ = #size struct epoll_event
124 alignment _ = alignment (undefined :: CInt)
127 ets <- #{peek struct epoll_event, events} ptr
128 ed <- #{peek struct epoll_event, data.fd} ptr
129 let !ev = Event (EventType ets) ed
133 #{poke struct epoll_event, events} ptr (unEventType $ eventTypes e)
134 #{poke struct epoll_event, data.fd} ptr (eventFd e)
136 newtype ControlOp = ControlOp CInt
138 #{enum ControlOp, ControlOp
139 , controlOpAdd = EPOLL_CTL_ADD
140 , controlOpModify = EPOLL_CTL_MOD
141 , controlOpDelete = EPOLL_CTL_DEL
144 newtype EventType = EventType {
145 unEventType :: Word32
146 } deriving (Show, Eq, Num, Bits)
148 #{enum EventType, EventType
150 , epollOut = EPOLLOUT
151 , epollErr = EPOLLERR
152 , epollHup = EPOLLHUP
155 -- | Create a new epoll context, returning a file descriptor associated with the context.
156 -- The fd may be used for subsequent calls to this epoll context.
158 -- The size parameter to epoll_create is a hint about the expected number of handles.
160 -- The file descriptor returned from epoll_create() should be destroyed via
161 -- a call to close() after polling is finished
163 epollCreate :: IO EPollFd
165 fd <- throwErrnoIfMinus1 "epollCreate" $
166 #if defined(HAVE_EPOLL_CREATE1)
167 c_epoll_create1 (#const EPOLL_CLOEXEC)
169 c_epoll_create 256 -- argument is ignored
172 let !epollFd' = EPollFd fd
175 epollControl :: EPollFd -> ControlOp -> Fd -> Ptr Event -> IO ()
176 epollControl (EPollFd epfd) (ControlOp op) (Fd fd) event =
177 throwErrnoIfMinus1_ "epollControl" $ c_epoll_ctl epfd op fd event
179 epollWait :: EPollFd -> Ptr Event -> Int -> Int -> IO Int
180 epollWait (EPollFd epfd) events numEvents timeout =
182 E.throwErrnoIfMinus1NoRetry "epollWait" $
183 c_epoll_wait epfd events (fromIntegral numEvents) (fromIntegral timeout)
185 fromEvent :: E.Event -> EventType
186 fromEvent e = remap E.evtRead epollIn .|.
187 remap E.evtWrite epollOut
189 | e `E.eventIs` evt = to
192 toEvent :: EventType -> E.Event
193 toEvent e = remap (epollIn .|. epollErr .|. epollHup) E.evtRead `mappend`
194 remap (epollOut .|. epollErr .|. epollHup) E.evtWrite
196 | e .&. evt /= 0 = to
199 fromTimeout :: Timeout -> Int
200 fromTimeout Forever = -1
201 fromTimeout (Timeout s) = ceiling $ 1000 * s
203 #if defined(HAVE_EPOLL_CREATE1)
204 foreign import ccall unsafe "sys/epoll.h epoll_create1"
205 c_epoll_create1 :: CInt -> IO CInt
207 foreign import ccall unsafe "sys/epoll.h epoll_create"
208 c_epoll_create :: CInt -> IO CInt
211 foreign import ccall unsafe "sys/epoll.h epoll_ctl"
212 c_epoll_ctl :: CInt -> CInt -> CInt -> Ptr Event -> IO CInt
214 foreign import ccall safe "sys/epoll.h epoll_wait"
215 c_epoll_wait :: CInt -> Ptr Event -> CInt -> CInt -> IO CInt
217 #endif /* defined(HAVE_EPOLL) */