X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=System%2FEvent%2FEPoll.hsc;fp=System%2FEvent%2FEPoll.hsc;h=0000000000000000000000000000000000000000;hb=5caacc93b6904c13dd363f3ba4815c25c6c4fb26;hp=f30c4bd419932d17bdde082f64c6c838c2b4a514;hpb=a6ad1ebfcad259e9b8ba60c32ab04437e328f54a;p=ghc-base.git diff --git a/System/Event/EPoll.hsc b/System/Event/EPoll.hsc deleted file mode 100644 index f30c4bd..0000000 --- a/System/Event/EPoll.hsc +++ /dev/null @@ -1,206 +0,0 @@ -{-# LANGUAGE CPP - , ForeignFunctionInterface - , GeneralizedNewtypeDeriving - , NoImplicitPrelude - , BangPatterns - #-} - --- --- | A binding to the epoll I/O event notification facility --- --- epoll is a variant of poll that can be used either as an edge-triggered or --- a level-triggered interface and scales well to large numbers of watched file --- descriptors. --- --- epoll decouples monitor an fd from the process of registering it. --- -module System.Event.EPoll - ( - new - , available - ) where - -import qualified System.Event.Internal as E - -#include "EventConfig.h" -#if !defined(HAVE_EPOLL) -import GHC.Base - -new :: IO E.Backend -new = error "EPoll back end not implemented for this platform" - -available :: Bool -available = False -{-# INLINE available #-} -#else - -#include - -import Control.Monad (when) -import Data.Bits (Bits, (.|.), (.&.)) -import Data.Monoid (Monoid(..)) -import Data.Word (Word32) -import Foreign.C.Error (throwErrnoIfMinus1, throwErrnoIfMinus1_) -import Foreign.C.Types (CInt) -import Foreign.Marshal.Utils (with) -import Foreign.Ptr (Ptr) -import Foreign.Storable (Storable(..)) -import GHC.Base -import GHC.Err (undefined) -import GHC.Num (Num(..)) -import GHC.Real (ceiling, fromIntegral) -import GHC.Show (Show) -import System.Posix.Internals (c_close) -import System.Posix.Internals (setCloseOnExec) -import System.Posix.Types (Fd(..)) - -import qualified System.Event.Array as A -import System.Event.Internal (Timeout(..)) - -available :: Bool -available = True -{-# INLINE available #-} - -data EPoll = EPoll { - epollFd :: {-# UNPACK #-} !EPollFd - , epollEvents :: {-# UNPACK #-} !(A.Array Event) - } - --- | Create a new epoll backend. -new :: IO E.Backend -new = do - epfd <- epollCreate - evts <- A.new 64 - let !be = E.backend poll modifyFd delete (EPoll epfd evts) - return be - -delete :: EPoll -> IO () -delete be = do - _ <- c_close . fromEPollFd . epollFd $ be - return () - --- | Change the set of events we are interested in for a given file --- descriptor. -modifyFd :: EPoll -> Fd -> E.Event -> E.Event -> IO () -modifyFd ep fd oevt nevt = with (Event (fromEvent nevt) fd) $ - epollControl (epollFd ep) op fd - where op | oevt == mempty = controlOpAdd - | nevt == mempty = controlOpDelete - | otherwise = controlOpModify - --- | Select a set of file descriptors which are ready for I/O --- operations and call @f@ for all ready file descriptors, passing the --- events that are ready. -poll :: EPoll -- ^ state - -> Timeout -- ^ timeout in milliseconds - -> (Fd -> E.Event -> IO ()) -- ^ I/O callback - -> IO () -poll ep timeout f = do - let events = epollEvents ep - - -- Will return zero if the system call was interupted, in which case - -- we just return (and try again later.) - n <- A.unsafeLoad events $ \es cap -> - epollWait (epollFd ep) es cap $ fromTimeout timeout - - when (n > 0) $ do - A.forM_ events $ \e -> f (eventFd e) (toEvent (eventTypes e)) - cap <- A.capacity events - when (cap == n) $ A.ensureCapacity events (2 * cap) - -newtype EPollFd = EPollFd { - fromEPollFd :: CInt - } deriving (Eq, Show) - -data Event = Event { - eventTypes :: EventType - , eventFd :: Fd - } deriving (Show) - -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.fd} ptr - let !ev = Event (EventType ets) ed - return ev - - poke ptr e = do - #{poke struct epoll_event, events} ptr (unEventType $ eventTypes e) - #{poke struct epoll_event, data.fd} ptr (eventFd e) - -newtype ControlOp = ControlOp CInt - -#{enum ControlOp, ControlOp - , controlOpAdd = EPOLL_CTL_ADD - , controlOpModify = EPOLL_CTL_MOD - , controlOpDelete = EPOLL_CTL_DEL - } - -newtype EventType = EventType { - unEventType :: Word32 - } deriving (Show, Eq, Num, Bits) - -#{enum EventType, EventType - , epollIn = EPOLLIN - , epollOut = EPOLLOUT - , epollErr = EPOLLERR - , epollHup = EPOLLHUP - } - --- | Create a new epoll context, returning a file descriptor associated with the context. --- The fd may be used for subsequent calls to this epoll context. --- --- The size parameter to epoll_create is a hint about the expected number of handles. --- --- The file descriptor returned from epoll_create() should be destroyed via --- a call to close() after polling is finished --- -epollCreate :: IO EPollFd -epollCreate = do - fd <- throwErrnoIfMinus1 "epollCreate" $ - c_epoll_create 256 -- argument is ignored - setCloseOnExec fd - let !epollFd' = EPollFd fd - return epollFd' - -epollControl :: EPollFd -> ControlOp -> Fd -> Ptr Event -> IO () -epollControl (EPollFd epfd) (ControlOp op) (Fd fd) event = - throwErrnoIfMinus1_ "epollControl" $ c_epoll_ctl epfd op fd event - -epollWait :: EPollFd -> Ptr Event -> Int -> Int -> IO Int -epollWait (EPollFd epfd) events numEvents timeout = - fmap fromIntegral . - E.throwErrnoIfMinus1NoRetry "epollWait" $ - c_epoll_wait epfd events (fromIntegral numEvents) (fromIntegral timeout) - -fromEvent :: E.Event -> EventType -fromEvent e = remap E.evtRead epollIn .|. - remap E.evtWrite epollOut - where remap evt to - | e `E.eventIs` evt = to - | otherwise = 0 - -toEvent :: EventType -> E.Event -toEvent e = remap (epollIn .|. epollErr .|. epollHup) E.evtRead `mappend` - remap (epollOut .|. epollErr .|. epollHup) E.evtWrite - where remap evt to - | e .&. evt /= 0 = to - | otherwise = mempty - -fromTimeout :: Timeout -> Int -fromTimeout Forever = -1 -fromTimeout (Timeout s) = ceiling $ 1000 * s - -foreign import ccall unsafe "sys/epoll.h epoll_create" - c_epoll_create :: CInt -> IO CInt - -foreign import ccall unsafe "sys/epoll.h epoll_ctl" - c_epoll_ctl :: CInt -> CInt -> CInt -> Ptr Event -> IO CInt - -foreign import ccall safe "sys/epoll.h epoll_wait" - c_epoll_wait :: CInt -> Ptr Event -> CInt -> CInt -> IO CInt - -#endif /* defined(HAVE_EPOLL) */