Revert "Revert "rts/base: Fix #9423"" and resolve issue that caused the revert.
authorAndreas Voellmy <andreas.voellmy@gmail.com>
Tue, 16 Sep 2014 12:56:54 +0000 (07:56 -0500)
committerAustin Seipp <austin@well-typed.com>
Tue, 16 Sep 2014 12:58:36 +0000 (07:58 -0500)
Summary:
This reverts commit 4748f5936fe72d96edfa17b153dbfd84f2c4c053. The fix for #9423
was reverted because this commit introduced a C function setIOManagerControlFd()
(defined in Schedule.c) defined for all OS types, while the prototype
(in includes/rts/IOManager.h) was only included when mingw32_HOST_OS is
not defined. This broke Windows builds.

This commit reverts the original commit and resolves the problem by only defining
setIOManagerControlFd() when mingw32_HOST_OS is defined. Hence the missing prototype
error should not occur on Windows.

In addition, since the io_manager_control_wr_fd field of the Capability struct is only
usd by the setIOManagerControlFd, this commit includes the io_manager_control_wr_fd
field in the Capability struct only when mingw32_HOST_OS is not defined.

Test Plan: Try to compile successfully on all platforms.

Reviewers: austin

Reviewed By: austin

Subscribers: simonmar, ezyang, carter

Differential Revision: https://phabricator.haskell.org/D174

includes/rts/IOManager.h
libraries/base/GHC/Event/Control.hs
libraries/base/GHC/Event/Manager.hs
libraries/base/GHC/Event/Thread.hs
libraries/base/GHC/Event/TimerManager.hs
rts/Capability.c
rts/Capability.h
rts/Linker.c
rts/posix/Signals.c

index 1c331b9..7bf2cdf 100644 (file)
@@ -26,7 +26,8 @@ void     sendIOManagerEvent (HsWord32 event);
 
 #else
 
-void     setIOManagerControlFd   (int fd);
+void     setIOManagerControlFd   (nat cap_no, int fd);
+void     setTimerManagerControlFd(int fd);
 void     setIOManagerWakeupFd   (int fd);
 
 #endif
index 2951a6a..53a9bc8 100644 (file)
@@ -17,6 +17,7 @@ module GHC.Event.Control
     , readControlMessage
     -- *** File descriptors
     , controlReadFd
+    , controlWriteFd
     , wakeupReadFd
     -- ** Control message sending
     , sendWakeup
@@ -91,7 +92,6 @@ newControl shouldRegister = allocaArray 2 $ \fds -> do
         setCloseOnExec wr
         return (rd, wr)
   (ctrl_rd, ctrl_wr) <- createPipe
-  when shouldRegister $ c_setIOManagerControlFd ctrl_wr
 #if defined(HAVE_EVENTFD)
   ev <- throwErrnoIfMinus1 "eventfd" $ c_eventfd 0 0
   setNonBlockingFD ev True
@@ -200,9 +200,5 @@ foreign import ccall unsafe "sys/eventfd.h eventfd_write"
    c_eventfd_write :: CInt -> CULLong -> IO CInt
 #endif
 
--- Used to tell the RTS how it can send messages to the I/O manager.
-foreign import ccall "setIOManagerControlFd"
-   c_setIOManagerControlFd :: CInt -> IO ()
-
-foreign import ccall "setIOManagerWakeupFd"
+foreign import ccall unsafe "setIOManagerWakeupFd"
    c_setIOManagerWakeupFd :: CInt -> IO ()
index 1dbe036..f07efba 100644 (file)
@@ -27,6 +27,7 @@ module GHC.Event.Manager
 
       -- * State
     , callbackTableVar
+    , emControl
 
       -- * Registering interest in I/O events
     , Event
index dcfa32a..0a82a54 100644 (file)
@@ -22,6 +22,7 @@ import Data.List (zipWith3)
 import Data.Maybe (Maybe(..))
 import Data.Tuple (snd)
 import Foreign.C.Error (eBADF, errnoToIOError)
+import Foreign.C.Types (CInt(..), CUInt(..))
 import Foreign.Ptr (Ptr)
 import GHC.Base
 import GHC.Conc.Sync (TVar, ThreadId, ThreadStatus(..), atomically, forkIO,
@@ -33,12 +34,14 @@ import GHC.IO.Exception (ioError)
 import GHC.IOArray (IOArray, newIOArray, readIOArray, writeIOArray,
                     boundsIOArray)
 import GHC.MVar (MVar, newEmptyMVar, newMVar, putMVar, takeMVar)
+import GHC.Event.Control (controlWriteFd)
 import GHC.Event.Internal (eventIs, evtClose)
 import GHC.Event.Manager (Event, EventManager, evtRead, evtWrite, loop,
                              new, registerFd, unregisterFd_)
 import qualified GHC.Event.Manager as M
 import qualified GHC.Event.TimerManager as TM
 import GHC.Num ((-), (+))
+import GHC.Real (fromIntegral)
 import GHC.Show (showSignedInt)
 import System.IO.Unsafe (unsafePerformIO)
 import System.Posix.Types (Fd)
@@ -261,7 +264,11 @@ startIOManagerThread :: IOArray Int (Maybe (ThreadId, EventManager))
 startIOManagerThread eventManagerArray i = do
   let create = do
         !mgr <- new True
-        !t <- forkOn i $ loop mgr
+        !t <- forkOn i $ do
+                c_setIOManagerControlFd
+                  (fromIntegral i)
+                  (fromIntegral $ controlWriteFd $ M.emControl mgr)
+                loop mgr
         labelThread t ("IOManager on cap " ++ show_int i)
         writeIOArray eventManagerArray i (Just (t,mgr))
   old <- readIOArray eventManagerArray i
@@ -277,6 +284,7 @@ startIOManagerThread eventManagerArray i = do
           -- the fork, for example. In this case we should clean up
           -- open pipes and everything else related to the event manager.
           -- See #4449
+          c_setIOManagerControlFd (fromIntegral i) (-1)
           M.cleanup em
           create
         _other         -> return ()
@@ -285,8 +293,10 @@ startTimerManagerThread :: IO ()
 startTimerManagerThread = modifyMVar_ timerManagerThreadVar $ \old -> do
   let create = do
         !mgr <- TM.new
+        c_setTimerManagerControlFd
+          (fromIntegral $ controlWriteFd $ TM.emControl mgr)
         writeIORef timerManager $ Just mgr
-        !t <- forkIO $ TM.loop mgr `finally` shutdownManagers
+        !t <- forkIO $ TM.loop mgr
         labelThread t "TimerManager"
         return $ Just t
   case old of
@@ -304,21 +314,11 @@ startTimerManagerThread = modifyMVar_ timerManagerThreadVar $ \old -> do
           mem <- readIORef timerManager
           _ <- case mem of
                  Nothing -> return ()
-                 Just em -> TM.cleanup em
+                 Just em -> do c_setTimerManagerControlFd (-1)
+                               TM.cleanup em
           create
         _other         -> return st
 
-shutdownManagers :: IO ()
-shutdownManagers =
-  withMVar ioManagerLock $ \_ -> do
-    eventManagerArray <- readIORef eventManager
-    let (_, high) = boundsIOArray eventManagerArray
-    forM_ [0..high] $ \i -> do
-      mmgr <- readIOArray eventManagerArray i
-      case mmgr of
-        Nothing -> return ()
-        Just (_,mgr) -> M.shutdown mgr
-
 foreign import ccall unsafe "rtsSupportsBoundThreads" threaded :: Bool
 
 ioManagerCapabilitiesChanged :: IO ()
@@ -352,3 +352,10 @@ ioManagerCapabilitiesChanged = do
               Just (_,mgr) <- readIOArray eventManagerArray i
               tid <- restartPollLoop mgr i
               writeIOArray eventManagerArray i (Just (tid,mgr))
+
+-- Used to tell the RTS how it can send messages to the I/O manager.
+foreign import ccall unsafe "setIOManagerControlFd"
+   c_setIOManagerControlFd :: CUInt -> CInt -> IO ()
+
+foreign import ccall unsafe "setTimerManagerControlFd"
+   c_setTimerManagerControlFd :: CInt -> IO ()
index 7ba2aea..cbfce59 100644 (file)
@@ -15,6 +15,7 @@ module GHC.Event.TimerManager
     , new
     , newWith
     , newDefaultBackend
+    , emControl
 
       -- * Running
     , finished
index 29c5270..a954006 100644 (file)
 #include "STM.h"
 #include "RtsUtils.h"
 
+#if !defined(mingw32_HOST_OS)
+#include "rts/IOManager.h" // for setIOManagerControlFd()
+#endif
+
 #include <string.h>
 
 // one global capability, this is the Capability for non-threaded
@@ -255,6 +259,9 @@ initCapability( Capability *cap, nat i )
     cap->spark_stats.converted  = 0;
     cap->spark_stats.gcd        = 0;
     cap->spark_stats.fizzled    = 0;
+#if !defined(mingw32_HOST_OS)
+    cap->io_manager_control_wr_fd = -1;
+#endif
 #endif
     cap->total_allocated        = 0;
 
@@ -1076,6 +1083,18 @@ rtsBool checkSparkCountInvariant (void)
 }
 #endif
 
+#if !defined(mingw32_HOST_OS)
+void setIOManagerControlFd(nat cap_no USED_IF_THREADS, int fd USED_IF_THREADS) {
+#if defined(THREADED_RTS)
+    if (cap_no < n_capabilities) {
+        capabilities[cap_no]->io_manager_control_wr_fd = fd;
+    } else {
+        errorBelch("warning: setIOManagerControlFd called with illegal capability number.");
+    }
+#endif
+}
+#endif
+
 // Local Variables:
 // mode: C
 // fill-column: 80
index c7dceef..9a6651e 100644 (file)
@@ -126,6 +126,10 @@ struct Capability_ {
 
     // Stats on spark creation/conversion
     SparkCounters spark_stats;
+#if !defined(mingw32_HOST_OS)
+    // IO manager for this cap
+    int io_manager_control_wr_fd;
+#endif
 #endif
     // Total words allocated by this cap since rts start
     W_ total_allocated;
index b24be58..dba346e 100644 (file)
@@ -860,6 +860,7 @@ typedef struct _RtsSymbolVal {
 #if !defined(mingw32_HOST_OS)
 #define RTS_USER_SIGNALS_SYMBOLS        \
    SymI_HasProto(setIOManagerControlFd) \
+   SymI_HasProto(setTimerManagerControlFd) \
    SymI_HasProto(setIOManagerWakeupFd)  \
    SymI_HasProto(ioManagerWakeup)       \
    SymI_HasProto(blockUserSignals)      \
index d5129f0..ba4a8b7 100644 (file)
@@ -127,28 +127,27 @@ more_handlers(int sig)
 
 // Here's the pipe into which we will send our signals
 static int io_manager_wakeup_fd = -1;
-static int io_manager_control_fd = -1;
+static int timer_manager_control_wr_fd = -1;
 
 #define IO_MANAGER_WAKEUP 0xff
 #define IO_MANAGER_DIE    0xfe
 #define IO_MANAGER_SYNC   0xfd
 
-void
-setIOManagerWakeupFd (int fd)
-{
-    // only called when THREADED_RTS, but unconditionally
-    // compiled here because GHC.Event.Control depends on it.
-    io_manager_wakeup_fd = fd;
+void setTimerManagerControlFd(int fd) {
+    timer_manager_control_wr_fd = fd;
 }
 
 void
-setIOManagerControlFd (int fd)
+setIOManagerWakeupFd (int fd)
 {
     // only called when THREADED_RTS, but unconditionally
     // compiled here because GHC.Event.Control depends on it.
-    io_manager_control_fd = fd;
+    io_manager_wakeup_fd = fd;
 }
 
+/* -----------------------------------------------------------------------------
+ * Wake up at least one IO or timer manager HS thread.
+ * -------------------------------------------------------------------------- */
 void
 ioManagerWakeup (void)
 {
@@ -170,14 +169,24 @@ ioManagerWakeup (void)
 void
 ioManagerDie (void)
 {
+    StgWord8 byte = (StgWord8)IO_MANAGER_DIE;
+    nat i;
+    int fd;
     int r;
-    // Ask the IO Manager thread to exit
-    if (io_manager_control_fd >= 0) {
-        StgWord8 byte = (StgWord8)IO_MANAGER_DIE;
-        r = write(io_manager_control_fd, &byte, 1);
+
+    if (0 <= timer_manager_control_wr_fd) {
+        r = write(timer_manager_control_wr_fd, &byte, 1);
         if (r == -1) { sysErrorBelch("ioManagerDie: write"); }
-        io_manager_control_fd = -1;
-        io_manager_wakeup_fd = -1;
+        timer_manager_control_wr_fd = -1;
+    }
+
+    for (i=0; i < n_capabilities; i++) {
+        fd = capabilities[i]->io_manager_control_wr_fd;
+        if (0 <= fd) {
+            r = write(fd, &byte, 1);
+            if (r == -1) { sysErrorBelch("ioManagerDie: write"); }
+            capabilities[i]->io_manager_control_wr_fd = -1;
+        }
     }
 }
 
@@ -192,7 +201,7 @@ ioManagerStart (void)
 {
     // Make sure the IO manager thread is running
     Capability *cap;
-    if (io_manager_control_fd < 0 || io_manager_wakeup_fd < 0) {
+    if (timer_manager_control_wr_fd < 0 || io_manager_wakeup_fd < 0) {
         cap = rts_lock();
         ioManagerStartCap(&cap);
         rts_unlock(cap);
@@ -223,26 +232,37 @@ generic_handler(int sig USED_IF_THREADS,
 {
 #if defined(THREADED_RTS)
 
-    if (io_manager_control_fd != -1)
-    {
-        StgWord8 buf[sizeof(siginfo_t) + 1];
-        int r;
+    StgWord8 buf[sizeof(siginfo_t) + 1];
+    int r;
 
-        buf[0] = sig;
+    buf[0] = sig;
+    if (info == NULL) {
+        // info may be NULL on Solaris (see #3790)
+        memset(buf+1, 0, sizeof(siginfo_t));
+    } else {
+        memcpy(buf+1, info, sizeof(siginfo_t));
+    }
 
-        if (info == NULL) {
-            // info may be NULL on Solaris (see #3790)
-            memset(buf+1, 0, sizeof(siginfo_t));
-        } else {
-            memcpy(buf+1, info, sizeof(siginfo_t));
+    if (0 <= timer_manager_control_wr_fd)
+    {
+        r = write(timer_manager_control_wr_fd, buf, sizeof(siginfo_t)+1);
+        if (r == -1 && errno == EAGAIN) {
+            errorBelch("lost signal due to full pipe: %d\n", sig);
         }
+    }
 
-        r = write(io_manager_control_fd, buf, sizeof(siginfo_t)+1);
-        if (r == -1 && errno == EAGAIN)
-        {
-            errorBelch("lost signal due to full pipe: %d\n", sig);
+    nat i;
+    int fd;
+    for (i=0; i < n_capabilities; i++) {
+        fd = capabilities[i]->io_manager_control_wr_fd;
+        if (0 <= fd) {
+            r = write(fd, buf, sizeof(siginfo_t)+1);
+            if (r == -1 && errno == EAGAIN) {
+                errorBelch("lost signal due to full pipe: %d\n", sig);
+            }
         }
     }
+
     // If the IO manager hasn't told us what the FD of the write end
     // of its pipe is, there's not much we can do here, so just ignore
     // the signal..