summaryrefslogtreecommitdiffstats
path: root/generic/tclEvent.c
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2003-09-29 21:38:47 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2003-09-29 21:38:47 (GMT)
commit51d61f0f3368b5b9b14bbbbefb0a2aedb30ed5e3 (patch)
tree493b7c36e3c10db4c4a6edd067cf03ec4aa1a60a /generic/tclEvent.c
parentab6eb1243a00175b523c0b8ca52aa43f6edec906 (diff)
downloadtcl-51d61f0f3368b5b9b14bbbbefb0a2aedb30ed5e3.zip
tcl-51d61f0f3368b5b9b14bbbbefb0a2aedb30ed5e3.tar.gz
tcl-51d61f0f3368b5b9b14bbbbefb0a2aedb30ed5e3.tar.bz2
TIP#121 (app exit proc API) implementation from Joe Mistachkin
Diffstat (limited to 'generic/tclEvent.c')
-rw-r--r--generic/tclEvent.c70
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!");
+ }
}
/*