@@ -50,7 +50,9 @@ data EventLoop = forall a. Backend a => EventLoop new :: IO EventLoop new = do #ifdef BACKEND_KQUEUE - be <- KQueue.new -- TODO: Detect backend to use. + be <- KQueue.new +#elif BACKEND_EPOLL + be <- EPoll.new #endif cbs <- stToIO V.empty return $ EventLoop be cbs src/System/Event.hs @@ -2,31 +2,51 @@ module System.Event.EPoll where +#include <sys/epoll.h> + +import Control.Monad (liftM2, when) import Data.Bits ((.|.)) import Foreign.C.Error (throwErrnoIfMinus1) import Foreign.C.Types (CInt, CUInt) +import Foreign.Marshal.Error (void) +import Foreign.Marshal.Utils (with) import Foreign.Ptr (Ptr) +import Foreign.Storable (Storable(..)) -#include <sys/epoll.h> +import qualified System.Event.Array as A +import qualified System.Event.Internal as E -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- newtype EPollFd = EPollFd { unEPollFd :: CInt - } deriving (Eq, Show) + } -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- data Event = Event { eventTypes :: EventType - , eventData :: Ptr () - } deriving Show + , eventFd :: CInt + } + +instance Storable Event where + sizeOf _ = #size struct epoll_event + alignment _ = alignment (undefined :: CInt) + + peek ptr = do + ets <- #{peek struct epoll_event, events} ptr + ed <- #{peek struct epoll_event, data} ptr + return $ Event (EventType ets) ed + + poke ptr e = do + #{poke struct epoll_event, events} ptr (unEventType $ eventTypes e) + #{poke struct epoll_event, data} ptr (eventFd e) -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- newtype ControlOp = ControlOp { unControlOp :: CInt - } deriving (Eq, Show) + } #{enum ControlOp, ControlOp , controlOpAdd = EPOLL_CTL_ADD @@ -38,7 +58,7 @@ newtype ControlOp = ControlOp newtype EventType = EventType { unEventType :: CUInt - } deriving (Eq, Show) + } #{enum EventType, EventType , eventTypeReadyForRead = EPOLLIN @@ -56,41 +76,83 @@ combineEventTypes = EventType . foldr ((.|.) . unEventType) 0 -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -foreign import ccall unsafe "epoll.h epoll_create" - c_epoll_create :: CInt -> IO EPollFd +foreign import ccall unsafe "ep.h epoll_create" + c_epoll_create :: CInt -> IO CInt -foreign import ccall unsafe "epoll.h epoll_ctl" - c_epoll_ctl :: EPollFd -> CInt -> CInt -> Ptr Event -> IO CInt +foreign import ccall unsafe "ep.h epoll_ctl" + c_epoll_ctl :: CInt -> CInt -> CInt -> Ptr Event -> IO CInt -foreign import ccall unsafe "epoll.h epoll_wait" - c_epoll_wait :: EPollFd -> Ptr Event -> CInt -> CInt -> IO CInt +foreign import ccall unsafe "ep.h epoll_wait" + c_epoll_wait :: CInt -> Ptr Event -> CInt -> CInt -> IO CInt -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- epollCreate :: IO EPollFd epollCreate = - EPollFd `fmap` throwErrnoIfMinus1 - "epollCreate" - (unEPollFd `fmap` c_epoll_create size) + EPollFd `fmap` throwErrnoIfMinus1 "epollCreate" (c_epoll_create size) where -- From manpage EPOLL_CREATE(2): "Since Linux 2.6.8, the size argument is -- unused. (The kernel dynamically sizes the required data structures without -- needing this initial hint.)" We pass 256 because libev does. size = 256 :: CInt -epollControl :: EPollFd -> ControlOp -> CInt -> Ptr Event -> IO CInt -epollControl epfd op fd events = - throwErrnoIfMinus1 - "epollControl" - (c_epoll_ctl epfd (unControlOp op) fd events) +epollControl :: EPollFd -> ControlOp -> CInt -> Ptr Event -> IO () +epollControl epfd op fd event = + void $ + throwErrnoIfMinus1 + "epollControl" + (c_epoll_ctl (unEPollFd epfd) (unControlOp op) fd event) -epollWait :: EPollFd -> Ptr Event -> Int -> Int -> IO CInt +epollWait :: EPollFd -> Ptr Event -> Int -> Int -> IO Int epollWait epfd events maxNumEvents maxNumMilliseconds = - throwErrnoIfMinus1 - "epollWait" - (c_epoll_wait - epfd - events - (fromIntegral maxNumEvents) - (fromIntegral maxNumMilliseconds) - ) + fmap fromIntegral $ + throwErrnoIfMinus1 + "epollWait" + (c_epoll_wait + (unEPollFd epfd) + events + (fromIntegral maxNumEvents) + (fromIntegral maxNumMilliseconds) + ) + +-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- + +data EPoll = EPoll + { epollEpfd :: !EPollFd + , epollEvents :: !(A.Array Event) + } + +instance E.Backend EPoll where + new = new + set = set + poll = poll + +new :: IO EPoll +new = liftM2 EPoll epollCreate (A.new 64) + +set :: EPoll -> CInt -> [E.Event] -> IO () +set ep fd events = + with e $ \ePtr -> + epollControl (epollEpfd ep) controlOpAdd fd ePtr + where + e = Event ets fd + ets = combineEventTypes (map fromEvent events) + +poll :: EPoll -> (CInt -> [E.Event] -> IO ()) -> IO () +poll ep f = do + let epfd = epollEpfd ep + let events = epollEvents ep + + A.useAsPtr events $ \eventsPtr eventsLen -> do + n <- epollWait epfd eventsPtr eventsLen maxNumMilliseconds + when (n > 0) $ putStrLn "events!" + when (n == eventsLen) $ A.ensureCapacity events (2 * eventsLen) + A.mapM_ events $ \e -> f (eventFd e) [] + where + maxNumMilliseconds = 1000 + +-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- + +fromEvent :: E.Event -> EventType +fromEvent E.Read = eventTypeReadyForRead +fromEvent E.Write = eventTypeReadyForWrite src/System/Event/EPoll.hsc 67fafdad40e7c2d55b397d03202d93dfd0b01d58 Brian Lewis brian@lorf.org http://github.com/tibbe/event/commit/a2ef202325df1e414839c2e5edff678d1f0ab6a4 a2ef202325df1e414839c2e5edff678d1f0ab6a4 2009-08-03T15:57:10-07:00 2009-08-03T15:57:10-07:00 Added more epoll basics 2bfdc0be5bd5b9eab8d472353835eb7b2286cd9d Brian Lewis brian@lorf.org