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 */
50 * Function: shutdown_handler()
52 * Local function that performs the default handling of Ctrl+C kind
53 * events; gently shutting down the RTS
55 * To repeat Signals.c remark -- user code may choose to override the
56 * default handler. Which is fine, assuming they put back the default
57 * handler when/if they de-install the custom handler.
60 static BOOL WINAPI shutdown_handler(DWORD dwCtrlType)
64 case CTRL_CLOSE_EVENT:
65 /* see generic_handler() comment re: this event */
68 case CTRL_BREAK_EVENT:
70 // If we're already trying to interrupt the RTS, terminate with
71 // extreme prejudice. So the first ^C tries to exit the program
72 // cleanly, and the second one just kills it.
73 if (sched_state >= SCHED_INTERRUPTING) {
74 stg_exit(EXIT_INTERRUPTED);
77 /* Cheesy pulsing of an event to wake up a waiting RTS thread, if any */
79 resetAbandonRequestWait();
83 /* shutdown + logoff events are not handled here. */
91 * Function: initDefaultHandlers()
93 * Install any default signal/console handlers. Currently we install a
94 * Ctrl+C handler that shuts down the RTS in an orderly manner.
96 void initDefaultHandlers(void)
98 if ( !SetConsoleCtrlHandler(shutdown_handler, TRUE) ) {
99 errorBelch("warning: failed to install default console handler");
105 * Function: blockUserSignals()
107 * Temporarily block the delivery of further console events. Needed to
108 * avoid race conditions when GCing the stack of outstanding handlers or
109 * when emptying the stack by running the handlers.
113 blockUserSignals(void)
115 deliver_event = rtsFalse;
120 * Function: unblockUserSignals()
122 * The inverse of blockUserSignals(); re-enable the deliver of console events.
125 unblockUserSignals(void)
127 deliver_event = rtsTrue;
132 * Function: awaitUserSignals()
134 * Wait for the next console event. Currently a NOP (returns immediately.)
136 void awaitUserSignals(void)
143 * Function: startSignalHandlers()
145 * Run the handlers associated with the stacked up console events. Console
146 * event delivery is blocked for the duration of this call.
148 void startSignalHandlers(Capability *cap)
150 StgStablePtr handler;
152 if (console_handler < 0) {
157 ACQUIRE_LOCK(&sched_mutex);
159 handler = deRefStablePtr((StgStablePtr)console_handler);
160 while (stg_pending_events > 0) {
161 stg_pending_events--;
164 RtsFlags.GcFlags.initialStkSize,
166 (StgClosure *)handler,
168 stg_pending_buf[stg_pending_events]))));
171 RELEASE_LOCK(&sched_mutex);
172 unblockUserSignals();
176 * Function: markSignalHandlers()
178 * Evacuate the handler stack. _Assumes_ that console event delivery
179 * has already been blocked.
181 void markSignalHandlers (evac_fn evac)
183 // nothing to mark; the console handler is a StablePtr which is
184 // already treated as a root by the GC.
189 * Function: generic_handler()
191 * Local function which handles incoming console event (done in a sep OS thread),
192 * recording the event in stg_pending_events.
194 static BOOL WINAPI generic_handler(DWORD dwCtrlType)
196 ACQUIRE_LOCK(&sched_mutex);
198 /* Ultra-simple -- up the counter + signal a switch. */
200 case CTRL_CLOSE_EVENT:
201 /* Don't support the delivery of this event; if we
202 * indicate that we've handled it here and the Haskell handler
203 * doesn't take proper action (e.g., terminate the OS process),
204 * the user of the app will be unable to kill/close it. Not
205 * good, so disable the delivery for now.
209 if (!deliver_event) return TRUE;
211 if ( stg_pending_events < N_PENDING_EVENTS ) {
212 stg_pending_buf[stg_pending_events] = dwCtrlType;
213 stg_pending_events++;
215 /* Cheesy pulsing of an event to wake up a waiting RTS thread, if any */
216 abandonRequestWait();
217 resetAbandonRequestWait();
221 RELEASE_LOCK(&sched_mutex);
226 * Function: rts_InstallConsoleEvent()
228 * Install/remove a console event handler.
231 rts_InstallConsoleEvent(int action, StgStablePtr *handler)
233 StgInt previous_hdlr = console_handler;
237 console_handler = STG_SIG_IGN;
238 if ( !SetConsoleCtrlHandler(NULL, TRUE) ) {
239 errorBelch("warning: unable to ignore console events");
243 console_handler = STG_SIG_IGN;
244 if ( !SetConsoleCtrlHandler(NULL, FALSE) ) {
245 errorBelch("warning: unable to restore default console event handling");
249 console_handler = (StgInt)*handler;
250 if ( previous_hdlr < 0 ) {
251 /* Only install generic_handler() once */
252 if ( !SetConsoleCtrlHandler(generic_handler, TRUE) ) {
253 errorBelch("warning: unable to install console event handler");
259 if (previous_hdlr == STG_SIG_DFL ||
260 previous_hdlr == STG_SIG_IGN) {
261 return previous_hdlr;
263 *handler = (StgStablePtr)previous_hdlr;
269 * Function: rts_HandledConsoleEvent()
271 * Signal that a Haskell console event handler has completed its run.
272 * The explicit notification that a Haskell handler has completed is
273 * required to better handle the delivery of Ctrl-C/Break events whilst
274 * an async worker thread is handling a read request on stdin. The
275 * Win32 console implementation will abort such a read request when Ctrl-C
276 * is delivered. That leaves the worker thread in a bind: should it
277 * abandon the request (the Haskell thread reading from stdin has been
278 * thrown an exception to signal the delivery of Ctrl-C & hence have
279 * aborted the I/O request) or simply ignore the aborted read and retry?
280 * (the Haskell thread reading from stdin isn't concerned with the
281 * delivery and handling of Ctrl-C.) With both scenarios being
282 * possible, the worker thread needs to be told -- that is, did the
283 * console event handler cause the IO request to be abandoned?
287 rts_ConsoleHandlerDone(int ev)
289 if ( (DWORD)ev == CTRL_BREAK_EVENT ||
290 (DWORD)ev == CTRL_C_EVENT ) {
291 /* only these two cause stdin system calls to abort.. */
292 SetEvent(hConsoleEvent); /* event is manual-reset */
293 Sleep(0); /* yield */
294 ResetEvent(hConsoleEvent); /* turn it back off again */
299 * Function: rts_waitConsoleHandlerCompletion()
301 * Esoteric entry point used by worker thread that got woken
302 * up as part Ctrl-C delivery.
305 rts_waitConsoleHandlerCompletion()
307 /* As long as the worker doesn't need to do a multiple wait,
308 * let's keep this HANDLE private to this 'module'.
310 return (WaitForSingleObject(hConsoleEvent, INFINITE) == WAIT_OBJECT_0);