Commit ecb1a539 authored by sof's avatar sof

[project @ 2005-04-22 17:00:48 by sof]

[mingw only]
Better handling of I/O request abortions upon throwing an exception
to a Haskell thread. As was, a thread blocked on an I/O request was
simply unblocked, but its corresponding worker thread wasn't notified
that the request had been abandoned.

This manifested itself in GHCi upon Ctrl-C being hit at the prompt -- the
worker thread blocked waiting for input on stdin prior to Ctrl-C would
stick around even though its corresponding Haskell thread had been
thrown an Interrupted exception. The upshot was that the worker would
consume the next character typed in after Ctrl-C, but then just dropping
it. Dealing with this turned out to be even more interesting due to
Win32 aborting any console reads when Ctrl-C/Break events are delivered.

The story could be improved upon (at the cost of portability) by making
the Scheduler able to abort worker thread system calls; as is, requests
are cooperatively abandoned. Maybe later.

Also included are other minor tidyups to Ctrl-C handling under mingw.

Merge to STABLE.
parent 68c13856
......@@ -261,7 +261,11 @@ runGHCi paths maybe_expr = do
interactiveLoop is_tty show_prompt = do
-- Ignore ^C exceptions caught here
ghciHandleDyn (\e -> case e of
Interrupted -> ghciUnblock (interactiveLoop is_tty show_prompt)
Interrupted -> ghciUnblock (
#if defined(mingw32_HOST_OS)
io (putStrLn "") >>
#endif
interactiveLoop is_tty show_prompt)
_other -> return ()) $ do
-- read commands from stdin
......
......@@ -63,7 +63,8 @@ extern void* createAdjustor(int cconv, StgStablePtr hptr, StgFunPtr wptr,
extern void freeHaskellFunctionPtr(void* ptr);
#if defined(mingw32_HOST_OS)
extern int stg_InstallConsoleEvent(int action, StgStablePtr *handler);
extern int rts_InstallConsoleEvent ( int action, StgStablePtr *handler );
extern void rts_ConsoleHandlerDone ( int ev );
#else
extern int stg_sig_install (int, int, StgStablePtr *, void *);
#endif
......
......@@ -85,7 +85,7 @@ typedef StgWord32 StgThreadID;
typedef unsigned int StgThreadReturnCode;
#if defined(mingw32_HOST_OS)
/* results from an async I/O request + it's ID. */
/* results from an async I/O request + its request ID. */
typedef struct {
unsigned int reqID;
int len;
......@@ -98,7 +98,7 @@ typedef union {
struct StgTSO_ *tso;
StgInt fd; /* StgInt instead of int, so that it's the same size as the ptrs */
#if defined(mingw32_HOST_OS)
StgAsyncIOResult* async_result;
StgAsyncIOResult *async_result;
#endif
StgWord target;
} StgTSOBlockInfo;
......
......@@ -296,7 +296,8 @@ typedef struct _RtsSymbolVal {
SymX(log) \
SymX(sqrt) \
SymX(memcpy) \
SymX(stg_InstallConsoleEvent) \
SymX(rts_InstallConsoleEvent) \
SymX(rts_ConsoleHandlerDone) \
Sym(mktime) \
Sym(_imp___timezone) \
Sym(_imp___tzname) \
......@@ -1981,7 +1982,7 @@ ocGetNames_PEi386 ( ObjectCode* oc )
&& 0 != strcmp(".stab", sectab_i->Name)
&& 0 != strcmp(".stabstr", sectab_i->Name)
) {
errorBelch("Unknown PEi386 section name `%s'", sectab_i->Name);
errorBelch("Unknown PEi386 section name `%s' (while processing: %s)", sectab_i->Name, oc->fileName);
return 0;
}
......
......@@ -3343,6 +3343,12 @@ unblockThread(StgTSO *tso)
blocked_queue_tl = (StgTSO *)prev;
}
}
#if defined(mingw32_HOST_OS)
/* (Cooperatively) signal that the worker thread should abort
* the request.
*/
abandonWorkRequest(tso->block_info.async_result->reqID);
#endif
goto done;
}
}
......@@ -3477,6 +3483,12 @@ unblockThread(StgTSO *tso)
blocked_queue_tl = prev;
}
}
#if defined(mingw32_HOST_OS)
/* (Cooperatively) signal that the worker thread should abort
* the request.
*/
abandonWorkRequest(tso->block_info.async_result->reqID);
#endif
goto done;
}
}
......
......@@ -200,9 +200,11 @@ start:
DWORD dwRes = WaitForMultipleObjects(2, wait_handles, FALSE, INFINITE);
switch (dwRes) {
case WAIT_OBJECT_0:
/* a request was completed */
break;
case WAIT_OBJECT_0 + 1:
case WAIT_TIMEOUT:
/* timeout (unlikely) or told to abandon waiting */
return 0;
case WAIT_FAILED: {
DWORD dw = GetLastError();
......
......@@ -19,6 +19,8 @@ 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. */
......@@ -33,6 +35,13 @@ initUserSignals(void)
{
stg_pending_events = 0;
console_handler = STG_SIG_DFL;
if (hConsoleEvent == INVALID_HANDLE_VALUE) {
hConsoleEvent =
CreateEvent ( NULL, /* default security attributes */
FALSE, /* auto-reset event */
FALSE, /* initially non-signalled */
NULL); /* no name */
}
return;
}
......@@ -216,12 +225,12 @@ static BOOL WINAPI generic_handler(DWORD dwCtrlType)
/*
* Function: stg_InstallConsoleEvent()
* Function: rts_InstallConsoleEvent()
*
* Install/remove a console event handler.
*/
int
stg_InstallConsoleEvent(int action, StgStablePtr *handler)
rts_InstallConsoleEvent(int action, StgStablePtr *handler)
{
StgInt previous_hdlr = console_handler;
......@@ -257,3 +266,46 @@ stg_InstallConsoleEvent(int action, StgStablePtr *handler)
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 auto-reset */
}
}
/*
* 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);
}
......@@ -99,4 +99,12 @@ extern void markSignalHandlers (evac_fn evac);
*/
extern void handleSignalsInThisThread(void);
/*
* Function: rts_waitConsoleHandlerCompletion()
*
* Esoteric entry point used by worker thread that got woken
* up as part Ctrl-C delivery.
*/
extern int rts_waitConsoleHandlerCompletion(void);
#endif /* __CONSOLEHANDLER_H__ */
......@@ -4,8 +4,10 @@
*
* (c) sof, 2002-2003.
*/
#include "Rts.h"
#include "IOManager.h"
#include "WorkQueue.h"
#include "ConsoleHandler.h"
#include <stdio.h>
#include <stdlib.h>
#include <io.h>
......@@ -23,11 +25,17 @@ typedef struct IOManagerState {
int workersIdle;
HANDLE hExitEvent;
unsigned int requestID;
/* fields for keeping track of active WorkItems */
CritSection active_work_lock;
WorkItem* active_work_items;
} IOManagerState;
/* ToDo: wrap up this state via a IOManager handle instead? */
static IOManagerState* ioMan;
static void RegisterWorkItem ( IOManagerState* iom, WorkItem* wi);
static void DeregisterWorkItem( IOManagerState* iom, WorkItem* wi);
/*
* The routine executed by each worker thread.
*/
......@@ -86,6 +94,8 @@ IOWorkerProc(PVOID param)
if ( rc == (WAIT_OBJECT_0 + 1) ) {
/* work item available, fetch it. */
if (FetchWork(pq,(void**)&work)) {
work->abandonOp = 0;
RegisterWorkItem(iom,work);
if ( work->workKind & WORKER_READ ) {
if ( work->workKind & WORKER_FOR_SOCKET ) {
len = recv(work->workData.ioData.fd,
......@@ -96,14 +106,11 @@ IOWorkerProc(PVOID param)
errCode = WSAGetLastError();
}
} else {
DWORD dw;
while (1) {
/* Do the read(), with extra-special handling for Ctrl+C */
len = read(work->workData.ioData.fd,
work->workData.ioData.buf,
work->workData.ioData.len);
dw = GetLastError();
if ( len == 0 && work->workData.ioData.len != 0 ) {
/* Given the following scenario:
* - a console handler has been registered that handles Ctrl+C
......@@ -116,28 +123,33 @@ IOWorkerProc(PVOID param)
* The OS will invoke the console handler (in a separate OS thread),
* and the above read() (i.e., under the hood, a ReadFile() op) returns
* 0, with the error set to ERROR_OPERATION_ABORTED. We don't
* want to percolate this non-EOF condition too far back up, but ignore
* it.
*
* However, we do want to give the RTS an opportunity to deliver the
* console event. Take care of this in the low-level console handler
* in ConsoleHandler.c which wakes up the RTS thread that's blocked
* waiting for I/O results from this worker (and possibly others).
* It won't see any I/O, but notices and dispatches the queued up
* signals/console events while in the Scheduler.
*
* The original, and way hackier scheme, was to have the worker
* return a special return code representing aborted-due-to-ctrl-C-on-stdin,
* which GHC.Conc.asyncRead would look out for and retry the I/O
* call if encountered.
* want to percolate this error condition back to the Haskell user.
* Do this by waiting for the completion of the Haskell console handler.
* If upon completion of the console handler routine, the Haskell thread
* that issued the request is found to have been thrown an exception,
* the worker abandons the request (since that's what the Haskell thread
* has done.) If the Haskell thread hasn't been interrupted, the worker
* retries the read request as if nothing happened.
*/
if ( dw == ERROR_OPERATION_ABORTED ) {
/* Only do the retry when dealing with the standard input handle. */
if ( (GetLastError()) == ERROR_OPERATION_ABORTED ) {
/* For now, only abort when dealing with the standard input handle.
* i.e., for all others, an error is raised.
*/
HANDLE h = (HANDLE)GetStdHandle(STD_INPUT_HANDLE);
if ( _get_osfhandle(work->workData.ioData.fd) == (long)h ) {
Sleep(0);
} else {
break;
if (rts_waitConsoleHandlerCompletion()) {
/* If the Scheduler has set work->abandonOp, the Haskell thread has
* been thrown an exception (=> the worker must abandon this request.)
* We test for this below before invoking the on-completion routine.
*/
if (work->abandonOp) {
break;
} else {
continue;
}
}
} else {
break; /* Treat it like an error */
}
} else {
break;
......@@ -193,19 +205,22 @@ IOWorkerProc(PVOID param)
fflush(stderr);
continue;
}
work->onCompletion(work->requestID,
fd,
len,
complData,
errCode);
if (!work->abandonOp) {
work->onCompletion(work->requestID,
fd,
len,
complData,
errCode);
}
/* Free the WorkItem */
DeregisterWorkItem(iom,work);
free(work);
} else {
fprintf(stderr, "unable to fetch work; fatal.\n"); fflush(stderr);
return 1;
}
} else {
fprintf(stderr, "waiting failed; fatal.\n"); fflush(stderr);
fprintf(stderr, "waiting failed (%lu); fatal.\n", rc); fflush(stderr);
return 1;
}
}
......@@ -256,6 +271,8 @@ StartIOManager(void)
ioMan->workersIdle = 0;
ioMan->queueSize = 0;
ioMan->requestID = 1;
InitializeCriticalSection(&ioMan->active_work_lock);
ioMan->active_work_items = NULL;
return TRUE;
}
......@@ -358,6 +375,7 @@ AddIORequest ( int fd,
wItem->workData.ioData.fd = fd;
wItem->workData.ioData.len = len;
wItem->workData.ioData.buf = buffer;
wItem->link = NULL;
wItem->onCompletion = onCompletion;
wItem->requestID = reqID;
......@@ -384,6 +402,7 @@ AddDelayRequest ( unsigned int msecs,
wItem->workData.delayData.msecs = msecs;
wItem->onCompletion = onCompletion;
wItem->requestID = reqID;
wItem->link = NULL;
return depositWorkItem(reqID, wItem);
}
......@@ -408,6 +427,8 @@ AddProcRequest ( void* proc,
wItem->workData.procData.param = param;
wItem->onCompletion = onCompletion;
wItem->requestID = reqID;
wItem->abandonOp = 0;
wItem->link = NULL;
return depositWorkItem(reqID, wItem);
}
......@@ -421,3 +442,69 @@ void ShutdownIOManager ( void )
// free(ioMan);
// ioMan = NULL;
}
/* Keep track of WorkItems currently being serviced. */
static
void
RegisterWorkItem(IOManagerState* ioMan,
WorkItem* wi)
{
EnterCriticalSection(&ioMan->active_work_lock);
wi->link = ioMan->active_work_items;
ioMan->active_work_items = wi;
LeaveCriticalSection(&ioMan->active_work_lock);
}
static
void
DeregisterWorkItem(IOManagerState* ioMan,
WorkItem* wi)
{
WorkItem *ptr, *prev;
EnterCriticalSection(&ioMan->active_work_lock);
for(prev=NULL,ptr=ioMan->active_work_items;ptr;prev=ptr,ptr=ptr->link) {
if (wi->requestID == ptr->requestID) {
if (prev==NULL) {
ioMan->active_work_items = ptr->link;
} else {
prev->link = ptr->link;
}
LeaveCriticalSection(&ioMan->active_work_lock);
return;
}
}
fprintf(stderr, "DeregisterWorkItem: unable to locate work item %d\n", wi->requestID);
LeaveCriticalSection(&ioMan->active_work_lock);
}
/*
* Function: abandonWorkRequest()
*
* Signal that a work request isn't of interest. Called by the Scheduler
* if a blocked Haskell thread has an exception thrown to it.
*
* Note: we're not aborting the system call that a worker might be blocked on
* here, just disabling the propagation of its result once its finished. We
* may have to go the whole hog here and switch to overlapped I/O so that we
* can abort blocked system calls.
*/
void
abandonWorkRequest ( int reqID )
{
WorkItem *ptr;
EnterCriticalSection(&ioMan->active_work_lock);
for(ptr=ioMan->active_work_items;ptr;ptr=ptr->link) {
if (ptr->requestID == (unsigned int)reqID ) {
ptr->abandonOp = 1;
LeaveCriticalSection(&ioMan->active_work_lock);
return;
}
}
/* Note: if the request ID isn't present, the worker will have
* finished sometime since awaitRequests() last drained the completed
* request table; i.e., not an error.
*/
LeaveCriticalSection(&ioMan->active_work_lock);
}
......@@ -60,10 +60,12 @@ typedef union workData {
} WorkData;
typedef struct WorkItem {
unsigned int workKind;
WorkData workData;
unsigned int requestID;
CompletionProc onCompletion;
unsigned int workKind;
WorkData workData;
unsigned int requestID;
CompletionProc onCompletion;
unsigned int abandonOp;
struct WorkItem *link;
} WorkItem;
extern CompletionProc onComplete;
......@@ -103,4 +105,6 @@ extern int AddProcRequest ( void* proc,
void* data,
CompletionProc onCompletion);
extern void abandonWorkRequest ( int reqID );
#endif /* __IOMANAGER_H__ */
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment