ghc/rts/win32/ConsoleHandler.c

   1 /*
   2  * Console control handler support.
   3  *
   4  */
   5 #include "Rts.h"
   6 #include <windows.h>
   7 #include "ConsoleHandler.h"
   8 #include "SchedAPI.h"
   9 #include "Schedule.h"
  10 #include "RtsUtils.h"
  11 #include "RtsFlags.h"
  12 #include "AsyncIO.h"
  13
  14 extern int stg_InstallConsoleEvent(int action, StgStablePtr *handler);
  15
  16 static BOOL WINAPI shutdown_handler(DWORD dwCtrlType);
  17 static BOOL WINAPI generic_handler(DWORD dwCtrlType);
  18
  19 static rtsBool deliver_event = rtsTrue;
  20 static StgInt console_handler = STG_SIG_DFL;
  21
  22 static HANDLE hConsoleEvent = INVALID_HANDLE_VALUE;
  23
  24 #define N_PENDING_EVENTS 16
  25 StgInt stg_pending_events = 0;           /* number of undelivered events */
  26 DWORD stg_pending_buf[N_PENDING_EVENTS]; /* their associated event numbers. */
  27
  28 /*
  29  * Function: initUserSignals()
  30  *
  31  * Initialize the console handling substrate.
  32  */
  33 void
  34 initUserSignals(void)
  35 {
  36     stg_pending_events = 0;
  37     console_handler = STG_SIG_DFL;
  38     if (hConsoleEvent == INVALID_HANDLE_VALUE) {
  39         hConsoleEvent =
  40             CreateEvent ( NULL,  /* default security attributes */
  41                           FALSE, /* auto-reset event */
  42                           FALSE, /* initially non-signalled */
  43                           NULL); /* no name */
  44     }
  45     return;
  46 }
  47
  48 /*
  49  * Function: shutdown_handler()
  50  *
  51  * Local function that performs the default handling of Ctrl+C kind
  52  * events; gently shutting down the RTS
  53  *
  54  * To repeat Signals.c remark -- user code may choose to override the
  55  * default handler. Which is fine, assuming they put back the default
  56  * handler when/if they de-install the custom handler.
  57  *
  58  */
  59 static BOOL WINAPI shutdown_handler(DWORD dwCtrlType)
  60 {
  61     switch (dwCtrlType) {
  62
  63     case CTRL_CLOSE_EVENT:
  64         /* see generic_handler() comment re: this event */
  65         return FALSE;
  66     case CTRL_C_EVENT:
  67     case CTRL_BREAK_EVENT:
  68
  69         // If we're already trying to interrupt the RTS, terminate with
  70         // extreme prejudice.  So the first ^C tries to exit the program
  71         // cleanly, and the second one just kills it.
  72         if (interrupted) {
  73             stg_exit(EXIT_INTERRUPTED);
  74         } else {
  75             interruptStgRts();
  76             /* Cheesy pulsing of an event to wake up a waiting RTS thread, if any */
  77             abandonRequestWait();
  78             resetAbandonRequestWait();
  79         }
  80         return TRUE;
  81
  82         /* shutdown + logoff events are not handled here. */
  83     default:
  84         return FALSE;
  85     }
  86 }
  87
  88
  89 /*
  90  * Function: initDefaultHandlers()
  91  *
  92  * Install any default signal/console handlers. Currently we install a
  93  * Ctrl+C handler that shuts down the RTS in an orderly manner.
  94  */
  95 void initDefaultHandlers(void)
  96 {
  97     if ( !SetConsoleCtrlHandler(shutdown_handler, TRUE) ) {
  98         errorBelch("warning: failed to install default console handler");
  99     }
 100 }
 101
 102
 103 /*
 104  * Function: blockUserSignals()
 105  *
 106  * Temporarily block the delivery of further console events. Needed to
 107  * avoid race conditions when GCing the stack of outstanding handlers or
 108  * when emptying the stack by running the handlers.
 109  *
 110  */
 111 void
 112 blockUserSignals(void)
 113 {
 114     deliver_event = rtsFalse;
 115 }
 116
 117
 118 /*
 119  * Function: unblockUserSignals()
 120  *
 121  * The inverse of blockUserSignals(); re-enable the deliver of console events.
 122  */
 123 void
 124 unblockUserSignals(void)
 125 {
 126     deliver_event = rtsTrue;
 127 }
 128
 129
 130 /*
 131  * Function: awaitUserSignals()
 132  *
 133  * Wait for the next console event. Currently a NOP (returns immediately.)
 134  */
 135 void awaitUserSignals(void)
 136 {
 137     return;
 138 }
 139
 140
 141 /*
 142  * Function: startSignalHandlers()
 143  *
 144  * Run the handlers associated with the stacked up console events. Console
 145  * event delivery is blocked for the duration of this call.
 146  */
 147 void startSignalHandlers(void)
 148 {
 149     StgStablePtr handler;
 150
 151     if (console_handler < 0) {
 152         return;
 153     }
 154     blockUserSignals();
 155
 156     handler = deRefStablePtr((StgStablePtr)console_handler);
 157     while (stg_pending_events > 0) {
 158         stg_pending_events--;
 159         scheduleThread(
 160             createIOThread(RtsFlags.GcFlags.initialStkSize,
 161                            rts_apply((StgClosure *)handler,
 162                                      rts_mkInt(stg_pending_buf[stg_pending_events]))));
 163     }
 164     unblockUserSignals();
 165 }
 166
 167
 168 /*
 169  * Function: markSignalHandlers()
 170  *
 171  * Evacuate the handler stack. _Assumes_ that console event delivery
 172  * has already been blocked.
 173  */
 174 void markSignalHandlers (evac_fn evac)
 175 {
 176     if (console_handler >= 0) {
 177         StgPtr p = deRefStablePtr((StgStablePtr)console_handler);
 178         evac((StgClosure**)&p);
 179     }
 180 }
 181
 182
 183 /*
 184  * Function: handleSignalsInThisThread()
 185  *
 186  * Have current (OS) thread assume responsibility of handling console events/signals.
 187  * Currently not used (by the console event handling code.)
 188  */
 189 void handleSignalsInThisThread(void)
 190 {
 191     return;
 192 }
 193
 194 /*
 195  * Function: generic_handler()
 196  *
 197  * Local function which handles incoming console event (done in a sep OS thread),
 198  * recording the event in stg_pending_events.
 199  */
 200 static BOOL WINAPI generic_handler(DWORD dwCtrlType)
 201 {
 202     /* Ultra-simple -- up the counter + signal a switch. */
 203     switch(dwCtrlType) {
 204     case CTRL_CLOSE_EVENT:
 205         /* Don't support the delivery of this event; if we
 206          * indicate that we've handled it here and the Haskell handler
 207          * doesn't take proper action (e.g., terminate the OS process),
 208          * the user of the app will be unable to kill/close it. Not
 209          * good, so disable the delivery for now.
 210          */
 211         return FALSE;
 212     default:
 213         if (!deliver_event) return TRUE;
 214
 215         if ( stg_pending_events < N_PENDING_EVENTS ) {
 216             stg_pending_buf[stg_pending_events] = dwCtrlType;
 217             stg_pending_events++;
 218         }
 219         /* Cheesy pulsing of an event to wake up a waiting RTS thread, if any */
 220         abandonRequestWait();
 221         resetAbandonRequestWait();
 222         return TRUE;
 223     }
 224 }
 225
 226
 227 /*
 228  * Function: rts_InstallConsoleEvent()
 229  *
 230  * Install/remove a console event handler.
 231  */
 232 int
 233 rts_InstallConsoleEvent(int action, StgStablePtr *handler)
 234 {
 235     StgInt previous_hdlr = console_handler;
 236
 237     switch (action) {
 238     case STG_SIG_IGN:
 239         console_handler = STG_SIG_IGN;
 240         if ( !SetConsoleCtrlHandler(NULL, TRUE) ) {
 241             errorBelch("warning: unable to ignore console events");
 242         }
 243         break;
 244     case STG_SIG_DFL:
 245         console_handler = STG_SIG_IGN;
 246         if ( !SetConsoleCtrlHandler(NULL, FALSE) ) {
 247             errorBelch("warning: unable to restore default console event handling");
 248         }
 249         break;
 250     case STG_SIG_HAN:
 251         console_handler = (StgInt)*handler;
 252         if ( previous_hdlr < 0 ) {
 253           /* Only install generic_handler() once */
 254           if ( !SetConsoleCtrlHandler(generic_handler, TRUE) ) {
 255             errorBelch("warning: unable to install console event handler");
 256           }
 257         }
 258         break;
 259     }
 260
 261     if (previous_hdlr == STG_SIG_DFL ||
 262         previous_hdlr == STG_SIG_IGN) {
 263         return previous_hdlr;
 264     } else {
 265         *handler = (StgStablePtr)previous_hdlr;
 266         return STG_SIG_HAN;
 267     }
 268 }
 269
 270 /*
 271  * Function: rts_HandledConsoleEvent()
 272  *
 273  * Signal that a Haskell console event handler has completed its run.
 274  * The explicit notification that a Haskell handler has completed is
 275  * required to better handle the delivery of Ctrl-C/Break events whilst
 276  * an async worker thread is handling a read request on stdin. The
 277  * Win32 console implementation will abort such a read request when Ctrl-C
 278  * is delivered. That leaves the worker thread in a bind: should it
 279  * abandon the request (the Haskell thread reading from stdin has been
 280  * thrown an exception to signal the delivery of Ctrl-C & hence have
 281  * aborted the I/O request) or simply ignore the aborted read and retry?
 282  * (the Haskell thread reading from stdin isn't concerned with the
 283  * delivery and handling of Ctrl-C.) With both scenarios being
 284  * possible, the worker thread needs to be told -- that is, did the
 285  * console event handler cause the IO request to be abandoned?
 286  *
 287  */
 288 void
 289 rts_ConsoleHandlerDone(int ev)
 290 {
 291     if ( (DWORD)ev == CTRL_BREAK_EVENT ||
 292          (DWORD)ev == CTRL_C_EVENT ) {
 293         /* only these two cause stdin system calls to abort.. */
 294         SetEvent(hConsoleEvent); /* event is auto-reset */
 295     }
 296 }
 297
 298 /*
 299  * Function: rts_waitConsoleHandlerCompletion()
 300  *
 301  * Esoteric entry point used by worker thread that got woken
 302  * up as part Ctrl-C delivery.
 303  */
 304 int
 305 rts_waitConsoleHandlerCompletion()
 306 {
 307     /* As long as the worker doesn't need to do a multiple wait,
 308      * let's keep this HANDLE private to this 'module'.
 309      */
 310     return (WaitForSingleObject(hConsoleEvent, INFINITE) == WAIT_OBJECT_0);
 311 }