2 * Console control handler support.
7 #include "ConsoleHandler.h"
13 #include "RtsSignals.h"
15 extern int stg_InstallConsoleEvent(int action, StgStablePtr *handler);
17 static BOOL WINAPI shutdown_handler(DWORD dwCtrlType);
18 static BOOL WINAPI generic_handler(DWORD dwCtrlType);
20 static rtsBool deliver_event = rtsTrue;
21 static StgInt console_handler = STG_SIG_DFL;
23 static HANDLE hConsoleEvent = INVALID_HANDLE_VALUE;
25 #define N_PENDING_EVENTS 16
26 StgInt stg_pending_events = 0; /* number of undelivered events */
27 DWORD stg_pending_buf[N_PENDING_EVENTS]; /* their associated event numbers. */
30 * Function: initUserSignals()
32 * Initialize the console handling substrate.
37 stg_pending_events = 0;
38 console_handler = STG_SIG_DFL;
39 if (hConsoleEvent == INVALID_HANDLE_VALUE) {
41 CreateEvent ( NULL, /* default security attributes */
42 TRUE, /* manual-reset event */
43 FALSE, /* initially non-signalled */
52 if (hConsoleEvent != INVALID_HANDLE_VALUE) {
53 CloseHandle(hConsoleEvent);
58 * Function: shutdown_handler()
60 * Local function that performs the default handling of Ctrl+C kind
61 * events; gently shutting down the RTS
63 * To repeat Signals.c remark -- user code may choose to override the
64 * default handler. Which is fine, assuming they put back the default
65 * handler when/if they de-install the custom handler.
68 static BOOL WINAPI shutdown_handler(DWORD dwCtrlType)
72 case CTRL_CLOSE_EVENT:
73 /* see generic_handler() comment re: this event */
76 case CTRL_BREAK_EVENT:
78 // If we're already trying to interrupt the RTS, terminate with
79 // extreme prejudice. So the first ^C tries to exit the program
80 // cleanly, and the second one just kills it.
81 if (sched_state >= SCHED_INTERRUPTING) {
82 stg_exit(EXIT_INTERRUPTED);
85 /* Cheesy pulsing of an event to wake up a waiting RTS thread, if any */
87 resetAbandonRequestWait();
91 /* shutdown + logoff events are not handled here. */
99 * Function: initDefaultHandlers()
101 * Install any default signal/console handlers. Currently we install a
102 * Ctrl+C handler that shuts down the RTS in an orderly manner.
104 void initDefaultHandlers(void)
106 if ( !SetConsoleCtrlHandler(shutdown_handler, TRUE) ) {
107 errorBelch("warning: failed to install default console handler");
113 * Function: blockUserSignals()
115 * Temporarily block the delivery of further console events. Needed to
116 * avoid race conditions when GCing the stack of outstanding handlers or
117 * when emptying the stack by running the handlers.
121 blockUserSignals(void)
123 deliver_event = rtsFalse;
128 * Function: unblockUserSignals()
130 * The inverse of blockUserSignals(); re-enable the deliver of console events.
133 unblockUserSignals(void)
135 deliver_event = rtsTrue;
140 * Function: awaitUserSignals()
142 * Wait for the next console event. Currently a NOP (returns immediately.)
144 void awaitUserSignals(void)
151 * Function: startSignalHandlers()
153 * Run the handlers associated with the stacked up console events. Console
154 * event delivery is blocked for the duration of this call.
156 void startSignalHandlers(Capability *cap)
158 StgStablePtr handler;
160 if (console_handler < 0) {
165 ACQUIRE_LOCK(&sched_mutex);
167 handler = deRefStablePtr((StgStablePtr)console_handler);
168 while (stg_pending_events > 0) {
169 stg_pending_events--;
172 RtsFlags.GcFlags.initialStkSize,
174 (StgClosure *)handler,
176 stg_pending_buf[stg_pending_events]))));
179 RELEASE_LOCK(&sched_mutex);
180 unblockUserSignals();
184 * Function: markSignalHandlers()
186 * Evacuate the handler stack. _Assumes_ that console event delivery
187 * has already been blocked.
189 void markSignalHandlers (evac_fn evac)
191 // nothing to mark; the console handler is a StablePtr which is
192 // already treated as a root by the GC.
197 * Function: generic_handler()
199 * Local function which handles incoming console event (done in a sep OS thread),
200 * recording the event in stg_pending_events.
202 static BOOL WINAPI generic_handler(DWORD dwCtrlType)
204 ACQUIRE_LOCK(&sched_mutex);
206 /* Ultra-simple -- up the counter + signal a switch. */
208 case CTRL_CLOSE_EVENT:
209 /* Don't support the delivery of this event; if we
210 * indicate that we've handled it here and the Haskell handler
211 * doesn't take proper action (e.g., terminate the OS process),
212 * the user of the app will be unable to kill/close it. Not
213 * good, so disable the delivery for now.
217 if (!deliver_event) return TRUE;
219 if ( stg_pending_events < N_PENDING_EVENTS ) {
220 stg_pending_buf[stg_pending_events] = dwCtrlType;
221 stg_pending_events++;
223 /* Cheesy pulsing of an event to wake up a waiting RTS thread, if any */
224 abandonRequestWait();
225 resetAbandonRequestWait();
229 RELEASE_LOCK(&sched_mutex);
234 * Function: rts_InstallConsoleEvent()
236 * Install/remove a console event handler.
239 rts_InstallConsoleEvent(int action, StgStablePtr *handler)
241 StgInt previous_hdlr = console_handler;
245 console_handler = STG_SIG_IGN;
246 if ( !SetConsoleCtrlHandler(NULL, TRUE) ) {
247 errorBelch("warning: unable to ignore console events");
251 console_handler = STG_SIG_IGN;
252 if ( !SetConsoleCtrlHandler(NULL, FALSE) ) {
253 errorBelch("warning: unable to restore default console event handling");
257 console_handler = (StgInt)*handler;
258 if ( previous_hdlr < 0 ) {
259 /* Only install generic_handler() once */
260 if ( !SetConsoleCtrlHandler(generic_handler, TRUE) ) {
261 errorBelch("warning: unable to install console event handler");
267 if (previous_hdlr == STG_SIG_DFL ||
268 previous_hdlr == STG_SIG_IGN) {
269 return previous_hdlr;
271 *handler = (StgStablePtr)previous_hdlr;
277 * Function: rts_HandledConsoleEvent()
279 * Signal that a Haskell console event handler has completed its run.
280 * The explicit notification that a Haskell handler has completed is
281 * required to better handle the delivery of Ctrl-C/Break events whilst
282 * an async worker thread is handling a read request on stdin. The
283 * Win32 console implementation will abort such a read request when Ctrl-C
284 * is delivered. That leaves the worker thread in a bind: should it
285 * abandon the request (the Haskell thread reading from stdin has been
286 * thrown an exception to signal the delivery of Ctrl-C & hence have
287 * aborted the I/O request) or simply ignore the aborted read and retry?
288 * (the Haskell thread reading from stdin isn't concerned with the
289 * delivery and handling of Ctrl-C.) With both scenarios being
290 * possible, the worker thread needs to be told -- that is, did the
291 * console event handler cause the IO request to be abandoned?
295 rts_ConsoleHandlerDone(int ev)
297 if ( (DWORD)ev == CTRL_BREAK_EVENT ||
298 (DWORD)ev == CTRL_C_EVENT ) {
299 /* only these two cause stdin system calls to abort.. */
300 SetEvent(hConsoleEvent); /* event is manual-reset */
301 Sleep(0); /* yield */
302 ResetEvent(hConsoleEvent); /* turn it back off again */
307 * Function: rts_waitConsoleHandlerCompletion()
309 * Esoteric entry point used by worker thread that got woken
310 * up as part Ctrl-C delivery.
313 rts_waitConsoleHandlerCompletion()
315 /* As long as the worker doesn't need to do a multiple wait,
316 * let's keep this HANDLE private to this 'module'.
318 return (WaitForSingleObject(hConsoleEvent, INFINITE) == WAIT_OBJECT_0);