2 * Console control handler support.
8 #include "ConsoleHandler.h"
15 #include "RtsSignals.h"
17 extern int stg_InstallConsoleEvent(int action, StgStablePtr *handler);
19 static BOOL WINAPI shutdown_handler(DWORD dwCtrlType);
20 static BOOL WINAPI generic_handler(DWORD dwCtrlType);
22 static rtsBool deliver_event = rtsTrue;
23 static StgInt console_handler = STG_SIG_DFL;
25 static HANDLE hConsoleEvent = INVALID_HANDLE_VALUE;
27 #define N_PENDING_EVENTS 16
28 StgInt stg_pending_events = 0; /* number of undelivered events */
29 DWORD stg_pending_buf[N_PENDING_EVENTS]; /* their associated event numbers. */
32 * Function: initUserSignals()
34 * Initialize the console handling substrate.
39 stg_pending_events = 0;
40 console_handler = STG_SIG_DFL;
41 if (hConsoleEvent == INVALID_HANDLE_VALUE) {
43 CreateEvent ( NULL, /* default security attributes */
44 TRUE, /* manual-reset event */
45 FALSE, /* initially non-signalled */
51 /* Seems to be a bit of an orphan...where used? */
55 if (hConsoleEvent != INVALID_HANDLE_VALUE) {
56 CloseHandle(hConsoleEvent);
61 * Function: shutdown_handler()
63 * Local function that performs the default handling of Ctrl+C kind
64 * events; gently shutting down the RTS
66 * To repeat Signals.c remark -- user code may choose to override the
67 * default handler. Which is fine, assuming they put back the default
68 * handler when/if they de-install the custom handler.
71 static BOOL WINAPI shutdown_handler(DWORD dwCtrlType)
75 case CTRL_CLOSE_EVENT:
76 /* see generic_handler() comment re: this event */
79 case CTRL_BREAK_EVENT:
81 // If we're already trying to interrupt the RTS, terminate with
82 // extreme prejudice. So the first ^C tries to exit the program
83 // cleanly, and the second one just kills it.
84 if (sched_state >= SCHED_INTERRUPTING) {
85 stg_exit(EXIT_INTERRUPTED);
88 /* Cheesy pulsing of an event to wake up a waiting RTS thread, if any */
90 resetAbandonRequestWait();
94 /* shutdown + logoff events are not handled here. */
102 * Function: initDefaultHandlers()
104 * Install any default signal/console handlers. Currently we install a
105 * Ctrl+C handler that shuts down the RTS in an orderly manner.
107 void initDefaultHandlers(void)
109 if ( !SetConsoleCtrlHandler(shutdown_handler, TRUE) ) {
110 errorBelch("warning: failed to install default console handler");
116 * Function: blockUserSignals()
118 * Temporarily block the delivery of further console events. Needed to
119 * avoid race conditions when GCing the stack of outstanding handlers or
120 * when emptying the stack by running the handlers.
124 blockUserSignals(void)
126 deliver_event = rtsFalse;
131 * Function: unblockUserSignals()
133 * The inverse of blockUserSignals(); re-enable the deliver of console events.
136 unblockUserSignals(void)
138 deliver_event = rtsTrue;
143 * Function: awaitUserSignals()
145 * Wait for the next console event. Currently a NOP (returns immediately.)
147 void awaitUserSignals(void)
154 * Function: startSignalHandlers()
156 * Run the handlers associated with the stacked up console events. Console
157 * event delivery is blocked for the duration of this call.
159 void startSignalHandlers(Capability *cap)
161 StgStablePtr handler;
163 if (console_handler < 0) {
168 ACQUIRE_LOCK(&sched_mutex);
170 handler = deRefStablePtr((StgStablePtr)console_handler);
171 while (stg_pending_events > 0) {
172 stg_pending_events--;
175 RtsFlags.GcFlags.initialStkSize,
177 (StgClosure *)handler,
179 stg_pending_buf[stg_pending_events]))));
182 RELEASE_LOCK(&sched_mutex);
183 unblockUserSignals();
187 * Function: markSignalHandlers()
189 * Evacuate the handler stack. _Assumes_ that console event delivery
190 * has already been blocked.
192 void markSignalHandlers (evac_fn evac STG_UNUSED)
194 // nothing to mark; the console handler is a StablePtr which is
195 // already treated as a root by the GC.
200 * Function: generic_handler()
202 * Local function which handles incoming console event (done in a sep OS thread),
203 * recording the event in stg_pending_events.
205 static BOOL WINAPI generic_handler(DWORD dwCtrlType)
207 ACQUIRE_LOCK(&sched_mutex);
209 /* Ultra-simple -- up the counter + signal a switch. */
211 case CTRL_CLOSE_EVENT:
212 /* Don't support the delivery of this event; if we
213 * indicate that we've handled it here and the Haskell handler
214 * doesn't take proper action (e.g., terminate the OS process),
215 * the user of the app will be unable to kill/close it. Not
216 * good, so disable the delivery for now.
220 if (!deliver_event) return TRUE;
222 if ( stg_pending_events < N_PENDING_EVENTS ) {
223 stg_pending_buf[stg_pending_events] = dwCtrlType;
224 stg_pending_events++;
226 /* Cheesy pulsing of an event to wake up a waiting RTS thread, if any */
227 abandonRequestWait();
228 resetAbandonRequestWait();
232 RELEASE_LOCK(&sched_mutex);
237 * Function: rts_InstallConsoleEvent()
239 * Install/remove a console event handler.
242 rts_InstallConsoleEvent(int action, StgStablePtr *handler)
244 StgInt previous_hdlr = console_handler;
248 console_handler = STG_SIG_IGN;
249 if ( !SetConsoleCtrlHandler(NULL, TRUE) ) {
250 errorBelch("warning: unable to ignore console events");
254 console_handler = STG_SIG_IGN;
255 if ( !SetConsoleCtrlHandler(NULL, FALSE) ) {
256 errorBelch("warning: unable to restore default console event handling");
260 console_handler = (StgInt)*handler;
261 if ( previous_hdlr < 0 ) {
262 /* Only install generic_handler() once */
263 if ( !SetConsoleCtrlHandler(generic_handler, TRUE) ) {
264 errorBelch("warning: unable to install console event handler");
270 if (previous_hdlr == STG_SIG_DFL ||
271 previous_hdlr == STG_SIG_IGN) {
272 return previous_hdlr;
274 *handler = (StgStablePtr)previous_hdlr;
280 * Function: rts_HandledConsoleEvent()
282 * Signal that a Haskell console event handler has completed its run.
283 * The explicit notification that a Haskell handler has completed is
284 * required to better handle the delivery of Ctrl-C/Break events whilst
285 * an async worker thread is handling a read request on stdin. The
286 * Win32 console implementation will abort such a read request when Ctrl-C
287 * is delivered. That leaves the worker thread in a bind: should it
288 * abandon the request (the Haskell thread reading from stdin has been
289 * thrown an exception to signal the delivery of Ctrl-C & hence have
290 * aborted the I/O request) or simply ignore the aborted read and retry?
291 * (the Haskell thread reading from stdin isn't concerned with the
292 * delivery and handling of Ctrl-C.) With both scenarios being
293 * possible, the worker thread needs to be told -- that is, did the
294 * console event handler cause the IO request to be abandoned?
298 rts_ConsoleHandlerDone(int ev)
300 if ( (DWORD)ev == CTRL_BREAK_EVENT ||
301 (DWORD)ev == CTRL_C_EVENT ) {
302 /* only these two cause stdin system calls to abort.. */
303 SetEvent(hConsoleEvent); /* event is manual-reset */
304 Sleep(0); /* yield */
305 ResetEvent(hConsoleEvent); /* turn it back off again */
310 * Function: rts_waitConsoleHandlerCompletion()
312 * Esoteric entry point used by worker thread that got woken
313 * up as part Ctrl-C delivery.
316 rts_waitConsoleHandlerCompletion()
318 /* As long as the worker doesn't need to do a multiple wait,
319 * let's keep this HANDLE private to this 'module'.
321 return (WaitForSingleObject(hConsoleEvent, INFINITE) == WAIT_OBJECT_0);