Add support for the IO manager thread on Windows

Fixes #637.
The implications of this change are:
  - threadDelay on Windows no longer creates a new OS thread each time,
    instead it communicates with the IO manager thread in the same way as
    on Unix.
  - deadlock detection now works the same way on Windows as on Unix; that
    is the timer interrupt wakes up the IO manager thread, which causes
    the scheduler to check for deadlock.
  - Console events now get sent to the IO manager thread, in the same way as
    signals do on Unix.  This means that console events should behave more
    reliably with -threaded on Windows.

All this applies only with -threaded.  Without -threaded, the old
ConsoleEvent code is still used.

After some testing, this could be pushed to the 6.6 branch.

9 files changed, 210 insertions, 36 deletions

diff --git a/includes/RtsExternal.h b/includes/RtsExternal.h
index 8e1a26acab..bf581b7a2b 100644
--- a/includes/RtsExternal.h
+++ b/includes/RtsExternal.h
@@ -73,10 +73,19 @@ extern void rts_ConsoleHandlerDone  ( int ev );
 extern int stg_sig_install (int, int, StgStablePtr *, void *);
 #endif
 
-#if !defined(mingw32_HOST_OS)
+#if defined(mingw32_HOST_OS)
+extern StgInt console_handler;
+#else
 extern StgInt *signal_handlers;
 #endif
+
+#if defined(mingw32_HOST_OS)
+void *getIOManagerEvent (void);
+StgWord32 readIOManagerEvent (void);
+void sendIOManagerEvent (StgWord32 event);
+#else
 extern void setIOManagerPipe (int fd);
+#endif
 
 extern void* allocateExec(unsigned int len);
 
diff --git a/rts/Prelude.h b/rts/Prelude.h
index 7d7b5b2d1d..2a6ca9158d 100644
--- a/rts/Prelude.h
+++ b/rts/Prelude.h
@@ -42,9 +42,7 @@ PRELUDE_CLOSURE(base_GHCziIOBase_BlockedIndefinitely_closure);
 PRELUDE_CLOSURE(base_GHCziIOBase_NonTermination_closure);
 PRELUDE_CLOSURE(base_GHCziIOBase_NestedAtomically_closure);
 
-#if !defined(mingw32_HOST_OS)
 PRELUDE_CLOSURE(base_GHCziConc_ensureIOManagerIsRunning_closure);
-#endif
 
 PRELUDE_INFO(base_GHCziBase_Czh_static_info);
 PRELUDE_INFO(base_GHCziBase_Izh_static_info);
diff --git a/rts/RtsStartup.c b/rts/RtsStartup.c
index dba529bb20..824ef98101 100644
--- a/rts/RtsStartup.c
+++ b/rts/RtsStartup.c
@@ -19,6 +19,7 @@
 #include "STM.h"        /* initSTM */
 #include "Signals.h"
 #include "RtsSignals.h"
+#include "ThrIOManager.h"
 #include "Timer.h"      /* startTimer, stopTimer */
 #include "Weak.h"
 #include "Ticky.h"
@@ -268,7 +269,7 @@ hs_init(int *argc, char **argv[])
     x86_init_fpu();
 #endif
 
-#if defined(THREADED_RTS) && !defined(mingw32_HOST_OS)
+#if defined(THREADED_RTS)
     ioManagerStart();
 #endif
 
@@ -371,7 +372,7 @@ hs_exit(void)
     /* start timing the shutdown */
     stat_startExit();
     
-#if defined(THREADED_RTS) && !defined(mingw32_HOST_OS)
+#if defined(THREADED_RTS)
     ioManagerDie();
 #endif
 
diff --git a/rts/Schedule.c b/rts/Schedule.c
index 0a46ec5144..cf62c5ae7a 100644
--- a/rts/Schedule.c
+++ b/rts/Schedule.c
@@ -51,6 +51,7 @@
 #include "Trace.h"
 #include "RaiseAsync.h"
 #include "Threads.h"
+#include "ThrIOManager.h"
 
 #ifdef HAVE_SYS_TYPES_H
 #include <sys/types.h>
@@ -849,7 +850,7 @@ schedulePushWork(Capability *cap USED_IF_THREADS,
  * Start any pending signal handlers
  * ------------------------------------------------------------------------- */
 
-#if defined(RTS_USER_SIGNALS) && (!defined(THREADED_RTS) || defined(mingw32_HOST_OS))
+#if defined(RTS_USER_SIGNALS) && !defined(THREADED_RTS)
 static void
 scheduleStartSignalHandlers(Capability *cap)
 {
@@ -971,7 +972,7 @@ scheduleDetectDeadlock (Capability *cap, Task *task)
 	
 	if ( !emptyRunQueue(cap) ) return;
 
-#if defined(RTS_USER_SIGNALS) && (!defined(THREADED_RTS) || defined(mingw32_HOST_OS))
+#if defined(RTS_USER_SIGNALS) && !defined(THREADED_RTS)
 	/* If we have user-installed signal handlers, then wait
 	 * for signals to arrive rather then bombing out with a
 	 * deadlock.
@@ -2820,17 +2821,10 @@ void
 wakeUpRts(void)
 {
 #if defined(THREADED_RTS)
-#if !defined(mingw32_HOST_OS)
     // This forces the IO Manager thread to wakeup, which will
     // in turn ensure that some OS thread wakes up and runs the
     // scheduler loop, which will cause a GC and deadlock check.
     ioManagerWakeup();
-#else
-    // On Windows this might be safe enough, because we aren't
-    // in a signal handler.  Later we should use the IO Manager,
-    // though.
-    prodOneCapability();
-#endif
 #endif
 }
 
diff --git a/rts/ThrIOManager.h b/rts/ThrIOManager.h
new file mode 100644
index 0000000000..eeccc6c420
--- /dev/null
+++ b/rts/ThrIOManager.h
@@ -0,0 +1,15 @@
+/* -----------------------------------------------------------------------------

+ *

+ * (c) The GHC Team 1998-2006

+ *

+ * Communicating with the IO manager thread (see GHC.Conc).

+ * Posix implementation in posix/Signals.c

+ * Win32 implementation in win32/ThrIOManager.c

+ *

+ * -------------------------------------------------------------------------*/

+

+#if defined(THREADED_RTS)

+void ioManagerWakeup (void);

+void ioManagerDie (void);

+void ioManagerStart (void);

+#endif

diff --git a/rts/posix/Signals.h b/rts/posix/Signals.h
index b005abb5b5..aa440b38aa 100644
--- a/rts/posix/Signals.h
+++ b/rts/posix/Signals.h
@@ -18,12 +18,6 @@ extern StgPtr *next_pending_handler;
 void startSignalHandlers(Capability *cap);
 #endif
 
-#if defined(THREADED_RTS)
-void ioManagerWakeup (void);
-void ioManagerDie (void);
-void ioManagerStart (void);
-#endif
-
 extern StgInt *signal_handlers;
 
 #endif /* POSIX_SIGNALS_H */
diff --git a/rts/win32/ConsoleHandler.c b/rts/win32/ConsoleHandler.c
index afaa4245b8..5b5cfc338b 100644
--- a/rts/win32/ConsoleHandler.c
+++ b/rts/win32/ConsoleHandler.c
@@ -18,7 +18,9 @@ static BOOL WINAPI shutdown_handler(DWORD dwCtrlType);
 static BOOL WINAPI generic_handler(DWORD dwCtrlType);
 
 static rtsBool deliver_event = rtsTrue;
-static StgInt console_handler = STG_SIG_DFL;
+StgInt console_handler = STG_SIG_DFL;
+
+#if !defined(THREADED_RTS)
 
 static HANDLE hConsoleEvent = INVALID_HANDLE_VALUE;
 
@@ -26,6 +28,8 @@ static HANDLE hConsoleEvent = INVALID_HANDLE_VALUE;
 StgInt stg_pending_events = 0;           /* number of undelivered events */
 DWORD stg_pending_buf[N_PENDING_EVENTS]; /* their associated event numbers. */
 
+#endif
+
 /*
  * Function: initUserSignals()
  *
@@ -34,8 +38,9 @@ DWORD stg_pending_buf[N_PENDING_EVENTS]; /* their associated event numbers. */
 void
 initUserSignals(void)
 {
-    stg_pending_events = 0;
     console_handler = STG_SIG_DFL;
+#if !defined (THREADED_RTS)
+    stg_pending_events = 0;
     if (hConsoleEvent == INVALID_HANDLE_VALUE) {
 	hConsoleEvent = 
 	    CreateEvent ( NULL,  /* default security attributes */
@@ -43,6 +48,7 @@ initUserSignals(void)
 			  FALSE, /* initially non-signalled */
 			  NULL); /* no name */
     }
+#endif
     return;
 }
 
@@ -50,9 +56,11 @@ initUserSignals(void)
 void
 finiUserSignals(void)
 {
+#if !defined (THREADED_RTS)
     if (hConsoleEvent != INVALID_HANDLE_VALUE) {
         CloseHandle(hConsoleEvent);
     }
+#endif
 }
 
 /*
@@ -83,9 +91,6 @@ static BOOL WINAPI shutdown_handler(DWORD dwCtrlType)
 	    stg_exit(EXIT_INTERRUPTED);
 	} else {
 	    interruptStgRts();
-	    /* Cheesy pulsing of an event to wake up a waiting RTS thread, if any */
-	    abandonRequestWait();
-	    resetAbandonRequestWait();
 	}
 	return TRUE;
 
@@ -148,6 +153,7 @@ void awaitUserSignals(void)
 }
 
 
+#if !defined (THREADED_RTS)
 /*
  * Function: startSignalHandlers()
  *
@@ -180,6 +186,7 @@ void startSignalHandlers(Capability *cap)
     RELEASE_LOCK(&sched_mutex);
     unblockUserSignals();
 }
+#endif /* !THREADED_RTS */
 
 /*
  * Function: markSignalHandlers()
@@ -202,8 +209,6 @@ void markSignalHandlers (evac_fn evac STG_UNUSED)
  */
 static BOOL WINAPI generic_handler(DWORD dwCtrlType)
 {
-    ACQUIRE_LOCK(&sched_mutex);
-
     /* Ultra-simple -- up the counter + signal a switch. */
     switch(dwCtrlType) {
     case CTRL_CLOSE_EVENT:
@@ -217,17 +222,16 @@ static BOOL WINAPI generic_handler(DWORD dwCtrlType)
     default:
 	if (!deliver_event) return TRUE;
 
+#if defined(THREADED_RTS)
+        sendIOManagerEvent((StgWord8) ((dwCtrlType<<1) | 1));
+#else
 	if ( stg_pending_events < N_PENDING_EVENTS ) {
 	    stg_pending_buf[stg_pending_events] = dwCtrlType;
 	    stg_pending_events++;
 	}
-	/* Cheesy pulsing of an event to wake up a waiting RTS thread, if any */
-	abandonRequestWait();
-	resetAbandonRequestWait();
+#endif
 	return TRUE;
     }
-
-    RELEASE_LOCK(&sched_mutex);
 }
 
 
@@ -293,17 +297,22 @@ rts_InstallConsoleEvent(int action, StgStablePtr *handler)
  *
  */
 void
-rts_ConsoleHandlerDone(int ev)
+rts_ConsoleHandlerDone (int ev USED_IF_NOT_THREADS)
 {
+#if !defined(THREADED_RTS)
     if ( (DWORD)ev == CTRL_BREAK_EVENT ||
 	 (DWORD)ev == CTRL_C_EVENT ) {
 	/* only these two cause stdin system calls to abort.. */
 	SetEvent(hConsoleEvent); /* event is manual-reset */
 	Sleep(0); /* yield */
 	ResetEvent(hConsoleEvent); /* turn it back off again */
+        // SDM: yeuch, this can't possibly work reliably.
+        // I'm not having it in THREADED_RTS.
     }
+#endif
 }
 
+#if !defined(THREADED_RTS)
 /*
  * Function: rts_waitConsoleHandlerCompletion()
  *
@@ -318,3 +327,4 @@ rts_waitConsoleHandlerCompletion()
      */
     return (WaitForSingleObject(hConsoleEvent, INFINITE) == WAIT_OBJECT_0);
 }
+#endif
diff --git a/rts/win32/ConsoleHandler.h b/rts/win32/ConsoleHandler.h
index b09adf71cb..33fa065733 100644
--- a/rts/win32/ConsoleHandler.h
+++ b/rts/win32/ConsoleHandler.h
@@ -9,9 +9,16 @@
  * Console control handlers lets an application handle Ctrl+C, Ctrl+Break etc.
  * in Haskell under Win32. Akin to the Unix signal SIGINT.
  *
- * The API offered by ConsoleHandler.h is identical to that of the signal handling
- * code (which isn't supported under win32.) Unsurprisingly, the underlying impl 
- * is derived from the signal handling code also.
+ * The API offered by ConsoleHandler.h is identical to that of the
+ * signal handling code (which isn't supported under win32.)
+ * Unsurprisingly, the underlying impl is derived from the signal
+ * handling code also.
+ */
+
+#if !defined(THREADED_RTS)
+/* 
+ * under THREADED_RTS, console events are passed to the IO manager
+ * thread, which starts up the handler.  See ThrIOManager.c.
  */
 
 /*
@@ -60,4 +67,6 @@ extern void handleSignalsInThisThread(void);
  */
 extern int rts_waitConsoleHandlerCompletion(void);
 
+#endif /* THREADED_RTS */
+
 #endif /* __CONSOLEHANDLER_H__ */
diff --git a/rts/win32/ThrIOManager.c b/rts/win32/ThrIOManager.c
new file mode 100644
index 0000000000..b0da0deee9
--- /dev/null
+++ b/rts/win32/ThrIOManager.c
@@ -0,0 +1,144 @@
+/* -----------------------------------------------------------------------------

+ *

+ * (c) The GHC Team, 1998-2006

+ *

+ * The IO manager thread in THREADED_RTS.  

+ * See also libraries/base/GHC/Conc.lhs.

+ *

+ * ---------------------------------------------------------------------------*/

+

+#include "Rts.h"

+#include "ThrIOManager.h"

+#include "Prelude.h"

+#include <windows.h>

+

+// Here's the Event that we use to wake up the IO manager thread

+static HANDLE io_manager_event = INVALID_HANDLE_VALUE;

+

+// must agree with values in GHC.Conc:

+#define IO_MANAGER_WAKEUP 0xffffffff

+#define IO_MANAGER_DIE    0xfffffffe

+// spurios wakeups are returned as zero.

+// console events are ((event<<1) | 1)

+

+HANDLE

+getIOManagerEvent (void)

+{

+    // This function has to exist even in the non-THREADED_RTS,

+    // because code in GHC.Conc refers to it.  It won't ever be called

+    // unless we're in the threaded RTS, however.

+#ifdef THREADED_RTS

+    HANDLE hRes;

+

+    if (io_manager_event == INVALID_HANDLE_VALUE) {

+        hRes = CreateEvent ( NULL, // no security attrs

+                             TRUE, // manual reset

+                             FALSE, // initial state,

+                             "IO Manager Event" );

+        if (hRes == NULL) {

+            sysErrorBelch("getIOManagerEvent");

+            stg_exit(EXIT_FAILURE);

+        }

+        io_manager_event = hRes;

+        return hRes;

+    } else {

+        return io_manager_event;

+    }

+#else

+    return NULL;

+#endif

+}

+

+

+#if defined(THREADED_RTS)

+

+#define EVENT_BUFSIZ 256

+Mutex event_buf_mutex;

+StgWord32 event_buf[EVENT_BUFSIZ];

+nat next_event;

+

+#endif

+

+StgWord32

+readIOManagerEvent (void)

+{

+    // This function must exist even in non-THREADED_RTS, 

+    // see getIOManagerEvent() above.

+#if defined(THREADED_RTS)

+    StgWord32 res;

+

+    ACQUIRE_LOCK(&event_buf_mutex);

+    if (io_manager_event != INVALID_HANDLE_VALUE) {

+        if (next_event == 0) {

+            res = 0; // no event to return

+        } else {

+            res = event_buf[--next_event];

+            if (next_event == 0) {

+                if (!ResetEvent(io_manager_event)) {

+                    sysErrorBelch("readIOManagerEvent");

+                    stg_exit(EXIT_FAILURE);

+                }

+            }

+        }

+    } else {

+        res = 0;

+    }

+    RELEASE_LOCK(&event_buf_mutex);

+    // debugBelch("readIOManagerEvent: %d\n", res);

+    return res;

+#else

+    return 0;

+#endif

+}

+

+void

+sendIOManagerEvent (StgWord32 event)

+{

+#if defined(THREADED_RTS)

+    // debugBelch("sendIOManagerEvent: %d\n", event);

+    ACQUIRE_LOCK(&event_buf_mutex);

+    if (io_manager_event != INVALID_HANDLE_VALUE) {

+        if (next_event == EVENT_BUFSIZ) {

+            errorBelch("event buffer overflowed; event dropped");

+        } else {

+            if (!SetEvent(io_manager_event)) {

+                sysErrorBelch("sendIOManagerEvent");

+                stg_exit(EXIT_FAILURE);

+            }        

+            event_buf[next_event++] = event;

+        }

+    }

+    RELEASE_LOCK(&event_buf_mutex);

+#endif

+}    

+

+#if defined(THREADED_RTS)

+void

+ioManagerWakeup (void)

+{

+    sendIOManagerEvent(IO_MANAGER_WAKEUP);

+}

+

+void

+ioManagerDie (void)

+{

+    sendIOManagerEvent(IO_MANAGER_DIE);

+    // ToDo: wait for the IO manager to pick up the event, and

+    // then release the Event and Mutex objects we've allocated.

+}

+

+void

+ioManagerStart (void)

+{

+    initMutex(&event_buf_mutex);

+    next_event = 0;

+

+    // Make sure the IO manager thread is running

+    Capability *cap;

+    if (io_manager_event == INVALID_HANDLE_VALUE) {

+	cap = rts_lock();

+	rts_evalIO(cap,&base_GHCziConc_ensureIOManagerIsRunning_closure,NULL);

+	rts_unlock(cap);

+    }

+}

+#endif