[commit: base] master: Refactor by introducing a boolean argument to newControl to determine (bec9f30)

[Johan Tibell]

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

On branch  : master

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

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

commit bec9f3098fa717f4d5bdee4dc7d3424c62bae5c2
Author: Andreas Voellmy <andreas.voellmy at gmail.com>
Date:   Wed Dec 19 23:14:28 2012 -0500

    Refactor by introducing a boolean argument to newControl to determine
    whether the files created for a Control instance are registered with
    the RTS IO manager hooks.
    
    This change makes no functional changes. It simply prepares the way
    for supporting multiple IO managers, we want to control which one is
    registered with the RTS.

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

 GHC/Event/Control.hs |   10 +++++-----
 GHC/Event/Manager.hs |   10 +++++-----
 GHC/Event/Thread.hs  |    2 +-
 3 files changed, 11 insertions(+), 11 deletions(-)

diff --git a/GHC/Event/Control.hs b/GHC/Event/Control.hs
index cd5641a..d08323d 100644
--- a/GHC/Event/Control.hs
+++ b/GHC/Event/Control.hs
@@ -79,8 +79,8 @@ wakeupReadFd = controlEventFd
 
 -- | Create the structure (usually a pipe) used for waking up the IO
 -- manager thread from another thread.
-newControl :: IO Control
-newControl = allocaArray 2 $ \fds -> do
+newControl :: Bool -> IO Control
+newControl shouldRegister = allocaArray 2 $ \fds -> do
   let createPipe = do
         throwErrnoIfMinus1_ "pipe" $ c_pipe fds
         rd <- peekElemOff fds 0
@@ -92,15 +92,15 @@ newControl = allocaArray 2 $ \fds -> do
         setCloseOnExec wr
         return (rd, wr)
   (ctrl_rd, ctrl_wr) <- createPipe
-  c_setIOManagerControlFd ctrl_wr
+  when shouldRegister $ c_setIOManagerControlFd ctrl_wr
 #if defined(HAVE_EVENTFD)
   ev <- throwErrnoIfMinus1 "eventfd" $ c_eventfd 0 0
   setNonBlockingFD ev True
   setCloseOnExec ev
-  c_setIOManagerWakeupFd ev
+  when shouldRegister $ c_setIOManagerWakeupFd ev
 #else
   (wake_rd, wake_wr) <- createPipe
-  c_setIOManagerWakeupFd wake_wr
+  when shouldRegister $ c_setIOManagerWakeupFd wake_wr
 #endif
   return W { controlReadFd  = fromIntegral ctrl_rd
            , controlWriteFd = fromIntegral ctrl_wr
diff --git a/GHC/Event/Manager.hs b/GHC/Event/Manager.hs
index 35f414b..0ecd271 100644
--- a/GHC/Event/Manager.hs
+++ b/GHC/Event/Manager.hs
@@ -180,14 +180,14 @@ newDefaultBackend = error "no back end for this platform"
 #endif
 
 -- | Create a new event manager.
-new :: IO EventManager
-new = newWith =<< newDefaultBackend
+new :: Bool -> IO EventManager
+new shouldRegister = newWith shouldRegister =<< newDefaultBackend
 
-newWith :: Backend -> IO EventManager
-newWith be = do
+newWith :: Bool -> Backend -> IO EventManager
+newWith shouldRegister be = do
   iofds <- newMVar IM.empty
   timeouts <- newIORef id
-  ctrl <- newControl
+  ctrl <- newControl shouldRegister
   state <- newIORef Created
   us <- newSource
   _ <- mkWeakIORef state $ do
diff --git a/GHC/Event/Thread.hs b/GHC/Event/Thread.hs
index 938010f..e685108 100644
--- a/GHC/Event/Thread.hs
+++ b/GHC/Event/Thread.hs
@@ -173,7 +173,7 @@ ensureIOManagerIsRunning
 startIOManagerThread :: IO ()
 startIOManagerThread = modifyMVar_ ioManager $ \old -> do
   let create = do
-        !mgr <- new
+        !mgr <- new True
         writeIORef eventManager $ Just mgr
         !t <- forkIO $ loop mgr
         labelThread t "IOManager"