[commit: base] : Introduce IORef to refer to array of IO managers. (1e30209)

[Johan Tibell]

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

On branch  : 

http://hackage.haskell.org/trac/ghc/changeset/1e30209053f7ad3c7f4b939b2458701fa51bc8f0

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

commit 1e30209053f7ad3c7f4b939b2458701fa51bc8f0
Author: Andreas Voellmy <andreas.voellmy at gmail.com>
Date:   Sat Dec 22 20:11:21 2012 -0500

    Introduce IORef to refer to array of IO managers.
    
    This change prepares the way for supporting changing number of IO managers when number of capabilities changes.

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

 GHC/Event/Thread.hs |   45 +++++++++++++++++++++++++--------------------
 1 files changed, 25 insertions(+), 20 deletions(-)

diff --git a/GHC/Event/Thread.hs b/GHC/Event/Thread.hs
index 8c5989b..bef907c 100644
--- a/GHC/Event/Thread.hs
+++ b/GHC/Event/Thread.hs
@@ -24,12 +24,13 @@ import Foreign.C.Error (eBADF, errnoToIOError)
 import Foreign.Ptr (Ptr)
 import GHC.Base
 import GHC.Conc.Sync (TVar, ThreadId, ThreadStatus(..), atomically, forkIO,
-                      labelThread, modifyMVar_, newTVar, sharedCAF,
+                      labelThread, modifyMVar_, withMVar, newTVar, sharedCAF,
                       numCapabilities, threadCapability, myThreadId, forkOn,
                       threadStatus, writeTVar, newTVarIO, readTVar, retry,throwSTM,STM)
 import GHC.IO (mask_, onException)
 import GHC.IO.Exception (ioError)
-import GHC.IOArray (IOArray, newIOArray, readIOArray, writeIOArray)
+import GHC.IOArray (IOArray, newIOArray, readIOArray, writeIOArray,
+                    boundsIOArray)
 import GHC.MVar (MVar, newEmptyMVar, newMVar, putMVar, takeMVar)
 import GHC.Event.Internal (eventIs, evtClose)
 import GHC.Event.Manager (Event, EventManager, evtRead, evtWrite, loop,
@@ -93,7 +94,11 @@ closeFdWith :: (Fd -> IO ())        -- ^ Action that performs the close.
             -> Fd                   -- ^ File descriptor to close.
             -> IO ()
 closeFdWith close fd = do
-  tableVars <- forM [0,1..numCapabilities-1] (getCallbackTableVar fd)
+  eventManagerArray <- readIORef eventManager
+  let (low, high) = boundsIOArray eventManagerArray
+  tableVars <- forM [low..high] $ \i -> do
+    Just (_,!mgr) <- readIOArray eventManagerArray i
+    return (mgr, M.callbackTableVar mgr fd)
   mask_ $ do
     tables <- forM tableVars (takeMVar.snd)
     close fd
@@ -102,13 +107,6 @@ closeFdWith close fd = do
       tableVars
       tables
 
-getCallbackTableVar :: Fd
-                       -> Int
-                       -> IO (EventManager, MVar (IM.IntMap [M.FdData]))
-getCallbackTableVar fd cap =
-  do Just (_,!mgr) <- readIOArray eventManager cap
-     return (mgr, M.callbackTableVar mgr fd)
-
 threadWait :: Event -> Fd -> IO ()
 threadWait evt fd = mask_ $ do
   m <- newEmptyMVar
@@ -168,15 +166,17 @@ getSystemEventManager :: IO EventManager
 getSystemEventManager = do
   t <- myThreadId
   (cap, _) <- threadCapability t
-  Just (_,mgr) <- readIOArray eventManager cap
+  eventManagerArray <- readIORef eventManager
+  Just (_,mgr) <- readIOArray eventManagerArray cap
   return mgr
 
 foreign import ccall unsafe "getOrSetSystemEventThreadEventManagerStore"
     getOrSetSystemEventThreadEventManagerStore :: Ptr a -> IO (Ptr a)
 
-eventManager :: IOArray Int (Maybe (ThreadId, EventManager))
+eventManager :: IORef (IOArray Int (Maybe (ThreadId, EventManager)))
 eventManager = unsafePerformIO $ do
-    em <- newIOArray (0, numCapabilities - 1) Nothing
+    eventManagerArray <- newIOArray (0, numCapabilities - 1) Nothing
+    em <- newIORef eventManagerArray
     sharedCAF em getOrSetSystemEventThreadEventManagerStore
 {-# NOINLINE eventManager #-}
 
@@ -220,18 +220,21 @@ ensureIOManagerIsRunning
       startTimerManagerThread
 
 startIOManagerThreads :: IO ()
-startIOManagerThreads =
-  modifyMVar_ ioManagerLock $ \_ ->
-  forM_ [0,1..numCapabilities-1] startIOManagerThread
+startIOManagerThreads = do
+  eventManagerArray <- readIORef eventManager
+  let (low, high) = boundsIOArray eventManagerArray
+  withMVar ioManagerLock $ \_ ->
+    forM_ [low..high] startIOManagerThread
   
 startIOManagerThread :: Int -> IO ()
 startIOManagerThread i = do
+  eventManagerArray <- readIORef eventManager
   let create = do
         !mgr <- new True
         !t <- forkOn i $ loop mgr
         labelThread t "IOManager"
-        writeIOArray eventManager i (Just (t,mgr))
-  old <- readIOArray eventManager i
+        writeIOArray eventManagerArray i (Just (t,mgr))
+  old <- readIOArray eventManagerArray i
   case old of
     Nothing            -> create
     Just (t,em) -> do
@@ -277,8 +280,10 @@ startTimerManagerThread = modifyMVar_ timerManagerThreadVar $ \old -> do
 
 shutdownManagers :: IO ()
 shutdownManagers =
-  do forM_ [0,1..numCapabilities-1] $ \i -> do
-       mmgr <- readIOArray eventManager i
+  do eventManagerArray <- readIORef eventManager
+     let (low, high) = boundsIOArray eventManagerArray
+     forM_ [low..high] $ \i -> do
+       mmgr <- readIOArray eventManagerArray i
        case mmgr of
          Nothing -> return ()
          Just (_,mgr) -> M.shutdown mgr