path: root/ghc/rts/win32/ConsoleHandler.c

/*
 * Console control handler support.
 *
 */
#include "Rts.h"
#include <windows.h>
#include "ConsoleHandler.h"
#include "SchedAPI.h"
#include "Schedule.h"
#include "RtsUtils.h"
#include "RtsFlags.h"
#include "AsyncIO.h"
#include "RtsSignals.h"

extern int stg_InstallConsoleEvent(int action, StgStablePtr *handler);

static BOOL WINAPI shutdown_handler(DWORD dwCtrlType);
static BOOL WINAPI generic_handler(DWORD dwCtrlType);

static rtsBool deliver_event = rtsTrue;
static StgInt console_handler = STG_SIG_DFL;

static HANDLE hConsoleEvent = INVALID_HANDLE_VALUE;

#define N_PENDING_EVENTS 16
StgInt stg_pending_events = 0;           /* number of undelivered events */
DWORD stg_pending_buf[N_PENDING_EVENTS]; /* their associated event numbers. */

/*
 * Function: initUserSignals()
 *
 * Initialize the console handling substrate.
 */
void
initUserSignals(void)
{
    stg_pending_events = 0;
    console_handler = STG_SIG_DFL;
    if (hConsoleEvent == INVALID_HANDLE_VALUE) {
	hConsoleEvent = 
	    CreateEvent ( NULL,  /* default security attributes */
			  TRUE,  /* manual-reset event */
			  FALSE, /* initially non-signalled */
			  NULL); /* no name */
    }
    return;
}

/*
 * Function: shutdown_handler()
 *
 * Local function that performs the default handling of Ctrl+C kind
 * events; gently shutting down the RTS
 *
 * To repeat Signals.c remark -- user code may choose to override the
 * default handler. Which is fine, assuming they put back the default
 * handler when/if they de-install the custom handler.
 * 
 */
static BOOL WINAPI shutdown_handler(DWORD dwCtrlType)
{
    switch (dwCtrlType) {
    
    case CTRL_CLOSE_EVENT:
	/* see generic_handler() comment re: this event */
	return FALSE;
    case CTRL_C_EVENT:
    case CTRL_BREAK_EVENT:

	// If we're already trying to interrupt the RTS, terminate with
	// extreme prejudice.  So the first ^C tries to exit the program
	// cleanly, and the second one just kills it.
	if (sched_state >= SCHED_INTERRUPTING) {
	    stg_exit(EXIT_INTERRUPTED);
	} else {
	    interruptStgRts();
	    /* Cheesy pulsing of an event to wake up a waiting RTS thread, if any */
	    abandonRequestWait();
	    resetAbandonRequestWait();
	}
	return TRUE;

	/* shutdown + logoff events are not handled here. */
    default:
	return FALSE;
    }
}


/*
 * Function: initDefaultHandlers()
 *
 * Install any default signal/console handlers. Currently we install a
 * Ctrl+C handler that shuts down the RTS in an orderly manner.
 */
void initDefaultHandlers(void)
{
    if ( !SetConsoleCtrlHandler(shutdown_handler, TRUE) ) {
	errorBelch("warning: failed to install default console handler");
    }
}


/*
 * Function: blockUserSignals()
 *
 * Temporarily block the delivery of further console events. Needed to
 * avoid race conditions when GCing the stack of outstanding handlers or
 * when emptying the stack by running the handlers.
 * 
 */
void
blockUserSignals(void)
{
    deliver_event = rtsFalse;
}


/*
 * Function: unblockUserSignals()
 *
 * The inverse of blockUserSignals(); re-enable the deliver of console events.
 */
void
unblockUserSignals(void)
{
    deliver_event = rtsTrue;
}


/*
 * Function: awaitUserSignals()
 *
 * Wait for the next console event. Currently a NOP (returns immediately.)
 */
void awaitUserSignals(void)
{
    return;
}


/*
 * Function: startSignalHandlers()
 *
 * Run the handlers associated with the stacked up console events. Console
 * event delivery is blocked for the duration of this call.
 */
void startSignalHandlers(Capability *cap)
{
    StgStablePtr handler;

    if (console_handler < 0) {
	return;
    }

    blockUserSignals();
    ACQUIRE_LOCK(&sched_mutex);
    
    handler = deRefStablePtr((StgStablePtr)console_handler);
    while (stg_pending_events > 0) {
	stg_pending_events--;
	scheduleThread(cap,
	    createIOThread(cap,
			   RtsFlags.GcFlags.initialStkSize, 
			   rts_apply(cap,
				     (StgClosure *)handler,
				     rts_mkInt(cap,
					       stg_pending_buf[stg_pending_events]))));
    }
    
    RELEASE_LOCK(&sched_mutex);
    unblockUserSignals();
}

/*
 * Function: markSignalHandlers()
 *
 * Evacuate the handler stack. _Assumes_ that console event delivery
 * has already been blocked.
 */
void markSignalHandlers (evac_fn evac)
{
    if (console_handler >= 0) {
	StgPtr p = deRefStablePtr((StgStablePtr)console_handler);
	evac((StgClosure**)(void *)&p);
    }
}


/* 
 * Function: generic_handler()
 *
 * Local function which handles incoming console event (done in a sep OS thread),
 * recording the event in stg_pending_events. 
 */
static BOOL WINAPI generic_handler(DWORD dwCtrlType)
{
    ACQUIRE_LOCK(&sched_mutex);

    /* Ultra-simple -- up the counter + signal a switch. */
    switch(dwCtrlType) {
    case CTRL_CLOSE_EVENT:
	/* Don't support the delivery of this event; if we
	 * indicate that we've handled it here and the Haskell handler
	 * doesn't take proper action (e.g., terminate the OS process),
	 * the user of the app will be unable to kill/close it. Not
	 * good, so disable the delivery for now.
	 */
	return FALSE;
    default:
	if (!deliver_event) return TRUE;

	if ( stg_pending_events < N_PENDING_EVENTS ) {
	    stg_pending_buf[stg_pending_events] = dwCtrlType;
	    stg_pending_events++;
	}
	/* Cheesy pulsing of an event to wake up a waiting RTS thread, if any */
	abandonRequestWait();
	resetAbandonRequestWait();
	return TRUE;
    }

    RELEASE_LOCK(&sched_mutex);
}


/*
 * Function: rts_InstallConsoleEvent()
 *
 * Install/remove a console event handler.
 */
int
rts_InstallConsoleEvent(int action, StgStablePtr *handler)
{
    StgInt previous_hdlr = console_handler;

    switch (action) {
    case STG_SIG_IGN:
	console_handler = STG_SIG_IGN;
	if ( !SetConsoleCtrlHandler(NULL, TRUE) ) {
	    errorBelch("warning: unable to ignore console events");
	}
	break;
    case STG_SIG_DFL:
	console_handler = STG_SIG_IGN;
	if ( !SetConsoleCtrlHandler(NULL, FALSE) ) {
	    errorBelch("warning: unable to restore default console event handling");
	}
	break;
    case STG_SIG_HAN:
	console_handler = (StgInt)*handler;
	if ( previous_hdlr < 0 ) {
	  /* Only install generic_handler() once */
	  if ( !SetConsoleCtrlHandler(generic_handler, TRUE) ) {
	    errorBelch("warning: unable to install console event handler");
	  }
	}
	break;
    }
    
    if (previous_hdlr == STG_SIG_DFL || 
	previous_hdlr == STG_SIG_IGN) {
	return previous_hdlr;
    } else {
	*handler = (StgStablePtr)previous_hdlr;
	return STG_SIG_HAN;
    }
}

/*
 * Function: rts_HandledConsoleEvent()
 *
 * Signal that a Haskell console event handler has completed its run.
 * The explicit notification that a Haskell handler has completed is 
 * required to better handle the delivery of Ctrl-C/Break events whilst
 * an async worker thread is handling a read request on stdin. The 
 * Win32 console implementation will abort such a read request when Ctrl-C
 * is delivered. That leaves the worker thread in a bind: should it 
 * abandon the request (the Haskell thread reading from stdin has been 
 * thrown an exception to signal the delivery of Ctrl-C & hence have 
 * aborted the I/O request) or simply ignore the aborted read and retry?
 * (the Haskell thread reading from stdin isn't concerned with the
 * delivery and handling of Ctrl-C.) With both scenarios being
 * possible, the worker thread needs to be told -- that is, did the
 * console event handler cause the IO request to be abandoned? 
 *
 */
void
rts_ConsoleHandlerDone(int ev)
{
    if ( (DWORD)ev == CTRL_BREAK_EVENT ||
	 (DWORD)ev == CTRL_C_EVENT ) {
	/* only these two cause stdin system calls to abort.. */
	SetEvent(hConsoleEvent); /* event is manual-reset */
	Sleep(0); /* yield */
	ResetEvent(hConsoleEvent); /* turn it back off again */
    }
}

/*
 * Function: rts_waitConsoleHandlerCompletion()
 *
 * Esoteric entry point used by worker thread that got woken
 * up as part Ctrl-C delivery.
 */
int
rts_waitConsoleHandlerCompletion()
{
    /* As long as the worker doesn't need to do a multiple wait,
     * let's keep this HANDLE private to this 'module'.
     */
    return (WaitForSingleObject(hConsoleEvent, INFINITE) == WAIT_OBJECT_0);
}