[commit: base] : Apply the epoll backend design (separate polling from registration) for the KQueue backend. (e5f5cfc)

[Johan Tibell]

Repository : ssh://darcs.haskell.org//srv/darcs/packages/base

On branch  : 

http://hackage.haskell.org/trac/ghc/changeset/e5f5cfcd62a589b0784528d3b1f415a0a8fd2f07

>---------------------------------------------------------------

commit e5f5cfcd62a589b0784528d3b1f415a0a8fd2f07
Author: Andreas Voellmy <andreas.voellmy at gmail.com>
Date:   Fri Dec 21 12:33:06 2012 -0500

    Apply the epoll backend design (separate polling from registration) for the KQueue backend.
    
    This design follows Kazu Yamamoto's implementation for KQueue.

>---------------------------------------------------------------

 GHC/Event/KQueue.hsc |   53 +++++++++++++++++++++++++------------------------
 1 files changed, 27 insertions(+), 26 deletions(-)

diff --git a/GHC/Event/KQueue.hsc b/GHC/Event/KQueue.hsc
index 9aa47a3..7e467e9 100644
--- a/GHC/Event/KQueue.hsc
+++ b/GHC/Event/KQueue.hsc
@@ -28,10 +28,10 @@ available = False
 {-# INLINE available #-}
 #else
 
-import Control.Concurrent.MVar (MVar, newMVar, swapMVar, withMVar)
-import Control.Monad (when, unless)
+import Control.Monad (when, void)
 import Data.Bits (Bits(..))
 import Data.Maybe (Maybe(..))
+import Data.Monoid (Monoid(..))
 import Data.Word (Word16, Word32)
 import Foreign.C.Error (throwErrnoIfMinus1)
 import Foreign.C.Types
@@ -76,17 +76,14 @@ available = True
 
 data EventQueue = EventQueue {
       eqFd       :: {-# UNPACK #-} !QueueFd
-    , eqChanges  :: {-# UNPACK #-} !(MVar (A.Array Event))
     , eqEvents   :: {-# UNPACK #-} !(A.Array Event)
     }
 
 new :: IO E.Backend
 new = do
   qfd <- kqueue
-  changesArr <- A.empty
-  changes <- newMVar changesArr 
   events <- A.new 64
-  let !be = E.backend poll modifyFd modifyFdOnce delete (EventQueue qfd changes events)
+  let !be = E.backend poll modifyFd modifyFdOnce delete (EventQueue qfd events)
   return be
 
 delete :: EventQueue -> IO ()
@@ -95,12 +92,18 @@ delete q = do
   return ()
 
 modifyFd :: EventQueue -> Fd -> E.Event -> E.Event -> IO ()
-modifyFd q fd oevt nevt = withMVar (eqChanges q) $ \ch -> do
-  let addChange filt flag = A.snoc ch $ event fd filt flag noteEOF
-  when (oevt `E.eventIs` E.evtRead)  $ addChange filterRead flagDelete
-  when (oevt `E.eventIs` E.evtWrite) $ addChange filterWrite flagDelete
-  when (nevt `E.eventIs` E.evtRead)  $ addChange filterRead flagAdd
-  when (nevt `E.eventIs` E.evtWrite) $ addChange filterWrite flagAdd
+modifyFd q fd oevt nevt
+  | nevt == mempty = do
+      let !ev = event fd (toFilter oevt) flagDelete noteEOF
+      kqueueControl (eqFd q) ev
+  | otherwise      = do
+      let !ev = event fd (toFilter nevt) flagAdd noteEOF
+      kqueueControl (eqFd q) ev
+
+toFilter :: E.Event -> Filter
+toFilter evt
+  | evt `E.eventIs` E.evtRead = filterRead
+  | otherwise                 = filterWrite
 
 modifyFdOnce :: EventQueue -> Fd -> E.Event -> IO ()
 modifyFdOnce = error "modifyFdOnce not supported in KQueue backend"
@@ -110,19 +113,13 @@ poll :: EventQueue
      -> (Fd -> E.Event -> IO ())
      -> IO Int
 poll EventQueue{..} mtout f = do
-    changesArr <- A.empty
-    changes <- swapMVar eqChanges changesArr
-    changesLen <- A.length changes
-    len <- A.length eqEvents
-    when (changesLen > len) $ A.ensureCapacity eqEvents (2 * changesLen)
-    n <- A.useAsPtr changes $ \changesPtr chLen ->
-           A.unsafeLoad eqEvents $ \evPtr evCap ->
-           case mtout of
-             Just tout -> withTimeSpec (fromTimeout tout) $
-                          kevent True eqFd changesPtr chLen evPtr evCap
-             Nothing   -> withTimeSpec (TimeSpec 0 0) $
-                          kevent False eqFd changesPtr chLen evPtr evCap
-    unless (n == 0) $ do
+    n <- A.unsafeLoad eqEvents $ \evp cap ->
+      case mtout of
+        Just tout -> withTimeSpec (fromTimeout tout) $
+                     kevent True eqFd nullPtr 0 evp cap
+        Nothing   -> withTimeSpec (TimeSpec 0 0) $
+                     kevent False eqFd nullPtr 0 evp cap
+    when (n > 0) $ do
         cap <- A.capacity eqEvents
         when (n == cap) $ A.ensureCapacity eqEvents (2 * cap)
         A.forM_ eqEvents $ \e -> f (fromIntegral (ident e)) (toEvent (filter e))
@@ -269,6 +266,11 @@ instance Storable TimeSpec where
 kqueue :: IO QueueFd
 kqueue = QueueFd `fmap` throwErrnoIfMinus1 "kqueue" c_kqueue
 
+kqueueControl :: KQueueFd -> Event -> IO ()
+kqueueControl kfd ev = void $
+    withTimeSpec (TimeSpec 0 0) $ \tp ->
+        withEvent ev $ \evp -> kevent False kfd evp 1 nullPtr 0 tp
+
 -- TODO: We cannot retry on EINTR as the timeout would be wrong.
 -- Perhaps we should just return without calling any callbacks.
 kevent :: Bool -> QueueFd -> Ptr Event -> Int -> Ptr Event -> Int -> Ptr TimeSpec
@@ -332,4 +334,3 @@ foreign import ccall unsafe "kevent"
 #endif
 
 #endif /* defined(HAVE_KQUEUE) */
-