[commit: base] : Modify per-capability IO manager poll loop to avoid blocking (and context switching the OS thread) when the poll loop is heavily loaded. (6d377db)

[Johan Tibell]

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

On branch  : 

http://hackage.haskell.org/trac/ghc/changeset/6d377db5d348012d1b8c357b4548d2fb66252fff

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

commit 6d377db5d348012d1b8c357b4548d2fb66252fff
Author: Andreas Voellmy <andreas.voellmy at gmail.com>
Date:   Fri Dec 21 11:17:41 2012 -0500

    Modify per-capability IO manager poll loop to avoid blocking (and context switching the OS thread) when the poll loop is heavily loaded.

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

 GHC/Event/Manager.hs |   14 ++++++++++++--
 1 files changed, 12 insertions(+), 2 deletions(-)

diff --git a/GHC/Event/Manager.hs b/GHC/Event/Manager.hs
index e8edd03..c977abd 100644
--- a/GHC/Event/Manager.hs
+++ b/GHC/Event/Manager.hs
@@ -58,6 +58,7 @@ import Data.Monoid (mappend, mconcat, mempty)
 import GHC.Arr (Array, (!), listArray)
 import GHC.Base
 import GHC.Conc.Signal (runHandlers)
+import GHC.Conc.Sync (yield)
 import GHC.List (filter)
 import GHC.Num (Num(..))
 import GHC.Real ((/), fromIntegral, mod)
@@ -208,13 +209,22 @@ loop mgr at EventManager{..} = do
                       show state
  where
   go = do running <- step mgr
-          when running go
+          when running (yield >> go)
 
 step :: EventManager -> IO Bool
 step mgr at EventManager{..} = do
-  I.poll emBackend (Just Forever) (onFdEvent mgr)
+  waitForIO
   state <- readIORef emState
   state `seq` return (state == Running)
+  where
+    waitForIO = do
+      n1 <- I.poll emBackend Nothing (onFdEvent mgr)
+      when (n1 <= 0) $ do
+        yield
+        n2 <- I.poll emBackend Nothing (onFdEvent mgr)
+        when (n2 <= 0) $ do
+          _ <- I.poll emBackend (Just Forever) (onFdEvent mgr)
+          return ()
 
 ------------------------------------------------------------------------
 -- Registering interest in I/O events