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 */
49 /* Seems to be a bit of an orphan...where used? */
53 if (hConsoleEvent != INVALID_HANDLE_VALUE) {
54 CloseHandle(hConsoleEvent);
59 * Function: shutdown_handler()
61 * Local function that performs the default handling of Ctrl+C kind
62 * events; gently shutting down the RTS
64 * To repeat Signals.c remark -- user code may choose to override the
65 * default handler. Which is fine, assuming they put back the default
66 * handler when/if they de-install the custom handler.
69 static BOOL WINAPI shutdown_handler(DWORD dwCtrlType)
73 case CTRL_CLOSE_EVENT:
74 /* see generic_handler() comment re: this event */
77 case CTRL_BREAK_EVENT:
79 // If we're already trying to interrupt the RTS, terminate with
80 // extreme prejudice. So the first ^C tries to exit the program
81 // cleanly, and the second one just kills it.
82 if (sched_state >= SCHED_INTERRUPTING) {
83 stg_exit(EXIT_INTERRUPTED);
86 /* Cheesy pulsing of an event to wake up a waiting RTS thread, if any */
88 resetAbandonRequestWait();
92 /* shutdown + logoff events are not handled here. */
100 * Function: initDefaultHandlers()
102 * Install any default signal/console handlers. Currently we install a
103 * Ctrl+C handler that shuts down the RTS in an orderly manner.
105 void initDefaultHandlers(void)
107 if ( !SetConsoleCtrlHandler(shutdown_handler, TRUE) ) {
108 errorBelch("warning: failed to install default console handler");
114 * Function: blockUserSignals()
116 * Temporarily block the delivery of further console events. Needed to
117 * avoid race conditions when GCing the stack of outstanding handlers or
118 * when emptying the stack by running the handlers.
122 blockUserSignals(void)
124 deliver_event = rtsFalse;
129 * Function: unblockUserSignals()
131 * The inverse of blockUserSignals(); re-enable the deliver of console events.
134 unblockUserSignals(void)
136 deliver_event = rtsTrue;
141 * Function: awaitUserSignals()
143 * Wait for the next console event. Currently a NOP (returns immediately.)
145 void awaitUserSignals(void)
152 * Function: startSignalHandlers()
154 * Run the handlers associated with the stacked up console events. Console
155 * event delivery is blocked for the duration of this call.
157 void startSignalHandlers(Capability *cap)
159 StgStablePtr handler;
161 if (console_handler < 0) {
166 ACQUIRE_LOCK(&sched_mutex);
168 handler = deRefStablePtr((StgStablePtr)console_handler);
169 while (stg_pending_events > 0) {
170 stg_pending_events--;
173 RtsFlags.GcFlags.initialStkSize,
175 (StgClosure *)handler,
177 stg_pending_buf[stg_pending_events]))));
180 RELEASE_LOCK(&sched_mutex);
181 unblockUserSignals();
185 * Function: markSignalHandlers()
187 * Evacuate the handler stack. _Assumes_ that console event delivery
188 * has already been blocked.
190 void markSignalHandlers (evac_fn evac STG_UNUSED)
192 // nothing to mark; the console handler is a StablePtr which is
193 // already treated as a root by the GC.
198 * Function: generic_handler()
200 * Local function which handles incoming console event (done in a sep OS thread),
201 * recording the event in stg_pending_events.
203 static BOOL WINAPI generic_handler(DWORD dwCtrlType)
205 ACQUIRE_LOCK(&sched_mutex);
207 /* Ultra-simple -- up the counter + signal a switch. */
209 case CTRL_CLOSE_EVENT:
210 /* Don't support the delivery of this event; if we
211 * indicate that we've handled it here and the Haskell handler
212 * doesn't take proper action (e.g., terminate the OS process),
213 * the user of the app will be unable to kill/close it. Not
214 * good, so disable the delivery for now.
218 if (!deliver_event) return TRUE;
220 if ( stg_pending_events < N_PENDING_EVENTS ) {
221 stg_pending_buf[stg_pending_events] = dwCtrlType;
222 stg_pending_events++;
224 /* Cheesy pulsing of an event to wake up a waiting RTS thread, if any */
225 abandonRequestWait();
226 resetAbandonRequestWait();
230 RELEASE_LOCK(&sched_mutex);
235 * Function: rts_InstallConsoleEvent()
237 * Install/remove a console event handler.
240 rts_InstallConsoleEvent(int action, StgStablePtr *handler)
242 StgInt previous_hdlr = console_handler;
246 console_handler = STG_SIG_IGN;
247 if ( !SetConsoleCtrlHandler(NULL, TRUE) ) {
248 errorBelch("warning: unable to ignore console events");
252 console_handler = STG_SIG_IGN;
253 if ( !SetConsoleCtrlHandler(NULL, FALSE) ) {
254 errorBelch("warning: unable to restore default console event handling");
258 console_handler = (StgInt)*handler;
259 if ( previous_hdlr < 0 ) {
260 /* Only install generic_handler() once */
261 if ( !SetConsoleCtrlHandler(generic_handler, TRUE) ) {
262 errorBelch("warning: unable to install console event handler");
268 if (previous_hdlr == STG_SIG_DFL ||
269 previous_hdlr == STG_SIG_IGN) {
270 return previous_hdlr;
272 *handler = (StgStablePtr)previous_hdlr;
278 * Function: rts_HandledConsoleEvent()
280 * Signal that a Haskell console event handler has completed its run.
281 * The explicit notification that a Haskell handler has completed is
282 * required to better handle the delivery of Ctrl-C/Break events whilst
283 * an async worker thread is handling a read request on stdin. The
284 * Win32 console implementation will abort such a read request when Ctrl-C
285 * is delivered. That leaves the worker thread in a bind: should it
286 * abandon the request (the Haskell thread reading from stdin has been
287 * thrown an exception to signal the delivery of Ctrl-C & hence have
288 * aborted the I/O request) or simply ignore the aborted read and retry?
289 * (the Haskell thread reading from stdin isn't concerned with the
290 * delivery and handling of Ctrl-C.) With both scenarios being
291 * possible, the worker thread needs to be told -- that is, did the
292 * console event handler cause the IO request to be abandoned?
296 rts_ConsoleHandlerDone(int ev)
298 if ( (DWORD)ev == CTRL_BREAK_EVENT ||
299 (DWORD)ev == CTRL_C_EVENT ) {
300 /* only these two cause stdin system calls to abort.. */
301 SetEvent(hConsoleEvent); /* event is manual-reset */
302 Sleep(0); /* yield */
303 ResetEvent(hConsoleEvent); /* turn it back off again */
308 * Function: rts_waitConsoleHandlerCompletion()
310 * Esoteric entry point used by worker thread that got woken
311 * up as part Ctrl-C delivery.
314 rts_waitConsoleHandlerCompletion()
316 /* As long as the worker doesn't need to do a multiple wait,
317 * let's keep this HANDLE private to this 'module'.
319 return (WaitForSingleObject(hConsoleEvent, INFINITE) == WAIT_OBJECT_0);