diff options
Diffstat (limited to 'generic/tclEvent.c')
| -rw-r--r-- | generic/tclEvent.c | 70 |
1 files changed, 67 insertions, 3 deletions
diff --git a/generic/tclEvent.c b/generic/tclEvent.c index 003e5a2..3449db1 100644 --- a/generic/tclEvent.c +++ b/generic/tclEvent.c @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclEvent.c,v 1.29 2003/05/13 12:39:50 dkf Exp $ + * RCS: @(#) $Id: tclEvent.c,v 1.30 2003/09/29 21:38:49 dkf Exp $ */ #include "tclInt.h" @@ -88,6 +88,14 @@ TCL_DECLARE_MUTEX(exitMutex) static int inFinalize = 0; static int subsystemsInitialized = 0; +/* + * This variable contains the application wide exit handler. It will be + * called by Tcl_Exit instead of the C-runtime exit if this variable is set + * to a non-NULL value. + */ + +static Tcl_ExitProc *appExitPtr = NULL; + typedef struct ThreadSpecificData { ExitHandler *firstExitPtr; /* First in list of all exit handlers for * this thread. */ @@ -542,6 +550,44 @@ Tcl_DeleteThreadExitHandler(proc, clientData) /* *---------------------------------------------------------------------- * + * Tcl_SetExitProc -- + * + * This procedure sets the application wide exit handler that + * will be called by Tcl_Exit in place of the C-runtime exit. If + * the application wide exit handler is NULL, the C-runtime exit + * will be used instead. + * + * Results: + * The previously set application wide exit handler. + * + * Side effects: + * Sets the application wide exit handler to the specified value. + * + *---------------------------------------------------------------------- + */ + +Tcl_ExitProc * +Tcl_SetExitProc(proc) + Tcl_ExitProc *proc; /* new exit handler for app or NULL */ +{ + Tcl_ExitProc *prevExitProc; + + /* + * Swap the old exit proc for the new one, saving the old one for + * our return value. + */ + + Tcl_MutexLock(&exitMutex); + prevExitProc = appExitPtr; + appExitPtr = proc; + Tcl_MutexUnlock(&exitMutex); + + return prevExitProc; +} + +/* + *---------------------------------------------------------------------- + * * Tcl_Exit -- * * This procedure is called to terminate the application. @@ -561,8 +607,26 @@ Tcl_Exit(status) int status; /* Exit status for application; typically * 0 for normal return, 1 for error return. */ { - Tcl_Finalize(); - TclpExit(status); + Tcl_ExitProc *currentAppExitPtr; + + Tcl_MutexLock(&exitMutex); + currentAppExitPtr = appExitPtr; + Tcl_MutexUnlock(&exitMutex); + + if (currentAppExitPtr) { + /* + * Warning: this code SHOULD NOT return, as there is code that + * depends on Tcl_Exit never returning. In fact, we will + * panic if anyone returns, so critical is this dependcy. + */ + currentAppExitPtr((ClientData) status); + Tcl_Panic("AppExitProc returned unexpectedly"); + } else { + /* use default handling */ + Tcl_Finalize(); + TclpExit(status); + Tcl_Panic("OS exit failed!"); + } } /* |