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 GHC.Event.EPoll
23 import qualified GHC.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 import System.Posix.Internals (setCloseOnExec)
55 import System.Posix.Types (Fd(..))
57 import qualified GHC.Event.Array as A
58 import GHC.Event.Internal (Timeout(..))
62 {-# INLINE available #-}
65 epollFd :: {-# UNPACK #-} !EPollFd
66 , epollEvents :: {-# UNPACK #-} !(A.Array Event)
69 -- | Create a new epoll backend.
74 let !be = E.backend poll modifyFd delete (EPoll epfd evts)
77 delete :: EPoll -> IO ()
79 _ <- c_close . fromEPollFd . epollFd $ be
82 -- | Change the set of events we are interested in for a given file
84 modifyFd :: EPoll -> Fd -> E.Event -> E.Event -> IO ()
85 modifyFd ep fd oevt nevt = with (Event (fromEvent nevt) fd) $
86 epollControl (epollFd ep) op fd
87 where op | oevt == mempty = controlOpAdd
88 | nevt == mempty = controlOpDelete
89 | otherwise = controlOpModify
91 -- | Select a set of file descriptors which are ready for I/O
92 -- operations and call @f@ for all ready file descriptors, passing the
93 -- events that are ready.
94 poll :: EPoll -- ^ state
95 -> Timeout -- ^ timeout in milliseconds
96 -> (Fd -> E.Event -> IO ()) -- ^ I/O callback
98 poll ep timeout f = do
99 let events = epollEvents ep
101 -- Will return zero if the system call was interupted, in which case
102 -- we just return (and try again later.)
103 n <- A.unsafeLoad events $ \es cap ->
104 epollWait (epollFd ep) es cap $ fromTimeout timeout
107 A.forM_ events $ \e -> f (eventFd e) (toEvent (eventTypes e))
108 cap <- A.capacity events
109 when (cap == n) $ A.ensureCapacity events (2 * cap)
111 newtype EPollFd = EPollFd {
113 } deriving (Eq, Show)
116 eventTypes :: EventType
120 instance Storable Event where
121 sizeOf _ = #size struct epoll_event
122 alignment _ = alignment (undefined :: CInt)
125 ets <- #{peek struct epoll_event, events} ptr
126 ed <- #{peek struct epoll_event, data.fd} ptr
127 let !ev = Event (EventType ets) ed
131 #{poke struct epoll_event, events} ptr (unEventType $ eventTypes e)
132 #{poke struct epoll_event, data.fd} ptr (eventFd e)
134 newtype ControlOp = ControlOp CInt
136 #{enum ControlOp, ControlOp
137 , controlOpAdd = EPOLL_CTL_ADD
138 , controlOpModify = EPOLL_CTL_MOD
139 , controlOpDelete = EPOLL_CTL_DEL
142 newtype EventType = EventType {
143 unEventType :: Word32
144 } deriving (Show, Eq, Num, Bits)
146 #{enum EventType, EventType
148 , epollOut = EPOLLOUT
149 , epollErr = EPOLLERR
150 , epollHup = EPOLLHUP
153 -- | Create a new epoll context, returning a file descriptor associated with the context.
154 -- The fd may be used for subsequent calls to this epoll context.
156 -- The size parameter to epoll_create is a hint about the expected number of handles.
158 -- The file descriptor returned from epoll_create() should be destroyed via
159 -- a call to close() after polling is finished
161 epollCreate :: IO EPollFd
163 fd <- throwErrnoIfMinus1 "epollCreate" $
164 c_epoll_create 256 -- argument is ignored
166 let !epollFd' = EPollFd fd
169 epollControl :: EPollFd -> ControlOp -> Fd -> Ptr Event -> IO ()
170 epollControl (EPollFd epfd) (ControlOp op) (Fd fd) event =
171 throwErrnoIfMinus1_ "epollControl" $ c_epoll_ctl epfd op fd event
173 epollWait :: EPollFd -> Ptr Event -> Int -> Int -> IO Int
174 epollWait (EPollFd epfd) events numEvents timeout =
176 E.throwErrnoIfMinus1NoRetry "epollWait" $
177 c_epoll_wait epfd events (fromIntegral numEvents) (fromIntegral timeout)
179 fromEvent :: E.Event -> EventType
180 fromEvent e = remap E.evtRead epollIn .|.
181 remap E.evtWrite epollOut
183 | e `E.eventIs` evt = to
186 toEvent :: EventType -> E.Event
187 toEvent e = remap (epollIn .|. epollErr .|. epollHup) E.evtRead `mappend`
188 remap (epollOut .|. epollErr .|. epollHup) E.evtWrite
190 | e .&. evt /= 0 = to
193 fromTimeout :: Timeout -> Int
194 fromTimeout Forever = -1
195 fromTimeout (Timeout s) = ceiling $ 1000 * s
197 foreign import ccall unsafe "sys/epoll.h epoll_create"
198 c_epoll_create :: CInt -> IO CInt
200 foreign import ccall unsafe "sys/epoll.h epoll_ctl"
201 c_epoll_ctl :: CInt -> CInt -> CInt -> Ptr Event -> IO CInt
203 foreign import ccall safe "sys/epoll.h epoll_wait"
204 c_epoll_wait :: CInt -> Ptr Event -> CInt -> CInt -> IO CInt
206 #endif /* defined(HAVE_EPOLL) */