X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Frts%2Fwin32%2FConsoleHandler.c;h=413e13cc277f18d62552ee4103e5185bd40c4e21;hb=86f2671b37507012692a53c2fe45357b0988cb40;hp=4220f29145e0c7b3a3acef2e2cfe900f25b6e880;hpb=3bb535af4751025d75afa89d3f410554f4071a9f;p=ghc-hetmet.git

diff --git a/ghc/rts/win32/ConsoleHandler.c b/ghc/rts/win32/ConsoleHandler.c
index 4220f29..413e13c 100644
--- a/ghc/rts/win32/ConsoleHandler.c
+++ b/ghc/rts/win32/ConsoleHandler.c
@@ -9,6 +9,8 @@
 #include "Schedule.h"
 #include "RtsUtils.h"
 #include "RtsFlags.h"
+#include "AsyncIO.h"
+#include "RtsSignals.h"
 
 extern int stg_InstallConsoleEvent(int action, StgStablePtr *handler);
 
@@ -18,6 +20,8 @@ static BOOL WINAPI generic_handler(DWORD dwCtrlType);
 static rtsBool deliver_event = rtsTrue;
 static StgInt console_handler = STG_SIG_DFL;
 
+static HANDLE hConsoleEvent = INVALID_HANDLE_VALUE;
+
 #define N_PENDING_EVENTS 16
 StgInt stg_pending_events = 0;           /* number of undelivered events */
 DWORD stg_pending_buf[N_PENDING_EVENTS]; /* their associated event numbers. */
@@ -32,6 +36,13 @@ initUserSignals(void)
 {
     stg_pending_events = 0;
     console_handler = STG_SIG_DFL;
+    if (hConsoleEvent == INVALID_HANDLE_VALUE) {
+	hConsoleEvent = 
+	    CreateEvent ( NULL,  /* default security attributes */
+			  TRUE,  /* manual-reset event */
+			  FALSE, /* initially non-signalled */
+			  NULL); /* no name */
+    }
     return;
 }
 
@@ -50,17 +61,22 @@ static BOOL WINAPI shutdown_handler(DWORD dwCtrlType)
 {
     switch (dwCtrlType) {
     
+    case CTRL_CLOSE_EVENT:
+	/* see generic_handler() comment re: this event */
+	return FALSE;
     case CTRL_C_EVENT:
     case CTRL_BREAK_EVENT:
-    case CTRL_CLOSE_EVENT:
 
 	// If we're already trying to interrupt the RTS, terminate with
 	// extreme prejudice.  So the first ^C tries to exit the program
 	// cleanly, and the second one just kills it.
-	if (interrupted) {
+	if (sched_state >= SCHED_INTERRUPTING) {
 	    stg_exit(EXIT_INTERRUPTED);
 	} else {
 	    interruptStgRts();
+	    /* Cheesy pulsing of an event to wake up a waiting RTS thread, if any */
+	    abandonRequestWait();
+	    resetAbandonRequestWait();
 	}
 	return TRUE;
 
@@ -129,27 +145,33 @@ void awaitUserSignals(void)
  * Run the handlers associated with the stacked up console events. Console
  * event delivery is blocked for the duration of this call.
  */
-void startSignalHandlers(void)
+void startSignalHandlers(Capability *cap)
 {
     StgStablePtr handler;
 
     if (console_handler < 0) {
 	return;
     }
+
     blockUserSignals();
+    ACQUIRE_LOCK(&sched_mutex);
     
     handler = deRefStablePtr((StgStablePtr)console_handler);
     while (stg_pending_events > 0) {
 	stg_pending_events--;
-	scheduleThread(
-	    createIOThread(RtsFlags.GcFlags.initialStkSize, 
-			   rts_apply((StgClosure *)handler,
-				     rts_mkInt(stg_pending_buf[stg_pending_events]))));
+	scheduleThread(cap,
+	    createIOThread(cap,
+			   RtsFlags.GcFlags.initialStkSize, 
+			   rts_apply(cap,
+				     (StgClosure *)handler,
+				     rts_mkInt(cap,
+					       stg_pending_buf[stg_pending_events]))));
     }
+    
+    RELEASE_LOCK(&sched_mutex);
     unblockUserSignals();
 }
 
-
 /*
  * Function: markSignalHandlers()
  *
@@ -165,17 +187,6 @@ void markSignalHandlers (evac_fn evac)
 }
 
 
-/*
- * Function: handleSignalsInThisThread()
- * 
- * Have current (OS) thread assume responsibility of handling console events/signals.
- * Currently not used (by the console event handling code.)
- */
-void handleSignalsInThisThread(void)
-{
-    return;
-}
-
 /* 
  * Function: generic_handler()
  *
@@ -184,23 +195,42 @@ void handleSignalsInThisThread(void)
  */
 static BOOL WINAPI generic_handler(DWORD dwCtrlType)
 {
+    ACQUIRE_LOCK(&sched_mutex);
+
     /* Ultra-simple -- up the counter + signal a switch. */
-    if ( stg_pending_events < N_PENDING_EVENTS ) {
-	stg_pending_buf[stg_pending_events] = dwCtrlType;
-	stg_pending_events++;
+    switch(dwCtrlType) {
+    case CTRL_CLOSE_EVENT:
+	/* Don't support the delivery of this event; if we
+	 * indicate that we've handled it here and the Haskell handler
+	 * doesn't take proper action (e.g., terminate the OS process),
+	 * the user of the app will be unable to kill/close it. Not
+	 * good, so disable the delivery for now.
+	 */
+	return FALSE;
+    default:
+	if (!deliver_event) return TRUE;
+
+	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();
+	return TRUE;
     }
-    context_switch = 1;
-    return TRUE;
+
+    RELEASE_LOCK(&sched_mutex);
 }
 
 
 /*
- * Function: stg_InstallConsoleEvent()
+ * Function: rts_InstallConsoleEvent()
  *
  * Install/remove a console event handler.
  */
 int
-stg_InstallConsoleEvent(int action, StgStablePtr *handler)
+rts_InstallConsoleEvent(int action, StgStablePtr *handler)
 {
     StgInt previous_hdlr = console_handler;
 
@@ -236,3 +266,48 @@ stg_InstallConsoleEvent(int action, StgStablePtr *handler)
 	return STG_SIG_HAN;
     }
 }
+
+/*
+ * Function: rts_HandledConsoleEvent()
+ *
+ * Signal that a Haskell console event handler has completed its run.
+ * The explicit notification that a Haskell handler has completed is 
+ * required to better handle the delivery of Ctrl-C/Break events whilst
+ * an async worker thread is handling a read request on stdin. The 
+ * Win32 console implementation will abort such a read request when Ctrl-C
+ * is delivered. That leaves the worker thread in a bind: should it 
+ * abandon the request (the Haskell thread reading from stdin has been 
+ * thrown an exception to signal the delivery of Ctrl-C & hence have 
+ * aborted the I/O request) or simply ignore the aborted read and retry?
+ * (the Haskell thread reading from stdin isn't concerned with the
+ * delivery and handling of Ctrl-C.) With both scenarios being
+ * possible, the worker thread needs to be told -- that is, did the
+ * console event handler cause the IO request to be abandoned? 
+ *
+ */
+void
+rts_ConsoleHandlerDone(int ev)
+{
+    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 */
+    }
+}
+
+/*
+ * Function: rts_waitConsoleHandlerCompletion()
+ *
+ * Esoteric entry point used by worker thread that got woken
+ * up as part Ctrl-C delivery.
+ */
+int
+rts_waitConsoleHandlerCompletion()
+{
+    /* As long as the worker doesn't need to do a multiple wait,
+     * let's keep this HANDLE private to this 'module'.
+     */
+    return (WaitForSingleObject(hConsoleEvent, INFINITE) == WAIT_OBJECT_0);
+}