summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
Diffstat (limited to 'generic')
-rw-r--r--generic/tclEvent.c113
-rw-r--r--generic/tclInt.h6
2 files changed, 111 insertions, 8 deletions
diff --git a/generic/tclEvent.c b/generic/tclEvent.c
index 2cdae51..554b8ee 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.28.2.15 2007/03/19 17:06:25 dgp Exp $
+ * RCS: @(#) $Id: tclEvent.c,v 1.28.2.16 2009/04/27 22:10:28 ferrieux Exp $
*/
#include "tclInt.h"
@@ -56,8 +56,8 @@ typedef struct ErrAssocData {
} ErrAssocData;
/*
- * For each exit handler created with a call to Tcl_CreateExitHandler
- * there is a structure of the following type:
+ * For each exit handler created with a call to Tcl_Create(Late)ExitHandler there is
+ * a structure of the following type:
*/
typedef struct ExitHandler {
@@ -76,6 +76,9 @@ typedef struct ExitHandler {
static ExitHandler *firstExitPtr = NULL;
/* First in list of all exit handlers for
* application. */
+static ExitHandler *firstLateExitPtr = NULL;
+ /* First in list of all late exit handlers for
+ * application. */
TCL_DECLARE_MUTEX(exitMutex)
/*
@@ -435,6 +438,39 @@ Tcl_CreateExitHandler(proc, clientData)
/*
*----------------------------------------------------------------------
*
+ * TclCreateLateExitHandler --
+ *
+ * Arrange for a given function to be invoked after all pre-thread cleanups
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Proc will be invoked with clientData as argument when the application
+ * exits.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclCreateLateExitHandler(
+ Tcl_ExitProc *proc, /* Function to invoke. */
+ ClientData clientData) /* Arbitrary value to pass to proc. */
+{
+ ExitHandler *exitPtr;
+
+ exitPtr = (ExitHandler *) ckalloc(sizeof(ExitHandler));
+ exitPtr->proc = proc;
+ exitPtr->clientData = clientData;
+ Tcl_MutexLock(&exitMutex);
+ exitPtr->nextPtr = firstLateExitPtr;
+ firstLateExitPtr = exitPtr;
+ Tcl_MutexUnlock(&exitMutex);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* Tcl_DeleteExitHandler --
*
* This procedure cancels an existing exit handler matching proc
@@ -479,6 +515,49 @@ Tcl_DeleteExitHandler(proc, clientData)
/*
*----------------------------------------------------------------------
*
+ * TclDeleteLateExitHandler --
+ *
+ * This function cancels an existing late exit handler matching proc and
+ * clientData, if such a handler exits.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * If there is a late exit handler corresponding to proc and clientData then
+ * it is canceled; if no such handler exists then nothing happens.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclDeleteLateExitHandler(
+ Tcl_ExitProc *proc, /* Function that was previously registered. */
+ ClientData clientData) /* Arbitrary value to pass to proc. */
+{
+ ExitHandler *exitPtr, *prevPtr;
+
+ Tcl_MutexLock(&exitMutex);
+ for (prevPtr = NULL, exitPtr = firstLateExitPtr; exitPtr != NULL;
+ prevPtr = exitPtr, exitPtr = exitPtr->nextPtr) {
+ if ((exitPtr->proc == proc)
+ && (exitPtr->clientData == clientData)) {
+ if (prevPtr == NULL) {
+ firstLateExitPtr = exitPtr->nextPtr;
+ } else {
+ prevPtr->nextPtr = exitPtr->nextPtr;
+ }
+ ckfree((char *) exitPtr);
+ break;
+ }
+ }
+ Tcl_MutexUnlock(&exitMutex);
+ return;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* Tcl_CreateThreadExitHandler --
*
* Arrange for a given procedure to be invoked just before the
@@ -825,14 +904,34 @@ Tcl_Finalize()
* Note that there is no thread-local storage after this call.
*/
- Tcl_FinalizeThread();
+ Tcl_FinalizeThread();
+ /*
+ * Now invoke late (process-wide) exit handlers.
+ */
+
+ Tcl_MutexLock(&exitMutex);
+ for (exitPtr = firstLateExitPtr; exitPtr != NULL; exitPtr = firstLateExitPtr) {
/*
- * Now finalize the Tcl execution environment. Note that this
- * must be done after the exit handlers, because there are
- * order dependencies.
+ * Be careful to remove the handler from the list before invoking its
+ * callback. This protects us against double-freeing if the callback
+ * should call Tcl_DeleteLateExitHandler on itself.
*/
+ firstLateExitPtr = exitPtr->nextPtr;
+ Tcl_MutexUnlock(&exitMutex);
+ exitPtr->proc(exitPtr->clientData);
+ ckfree((char *) exitPtr);
+ Tcl_MutexLock(&exitMutex);
+ }
+ firstLateExitPtr = NULL;
+ Tcl_MutexUnlock(&exitMutex);
+
+ /*
+ * Now finalize the Tcl execution environment. Note that this must be done
+ * after the exit handlers, because there are order dependencies.
+ */
+
TclFinalizeCompilation();
TclFinalizeExecution();
TclFinalizeEnvironment();
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 7de3d01..43870e7 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -13,7 +13,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclInt.h,v 1.118.2.32 2008/07/22 21:40:32 andreas_kupries Exp $
+ * RCS: @(#) $Id: tclInt.h,v 1.118.2.33 2009/04/27 22:10:28 ferrieux Exp $
*/
#ifndef _TCLINT
@@ -1893,6 +1893,10 @@ EXTERN int TclFileMakeDirsCmd _ANSI_ARGS_((Tcl_Interp *interp,
int objc, Tcl_Obj *CONST objv[])) ;
EXTERN int TclFileRenameCmd _ANSI_ARGS_((Tcl_Interp *interp,
int objc, Tcl_Obj *CONST objv[])) ;
+EXTERN void TclCreateLateExitHandler (Tcl_ExitProc * proc,
+ ClientData clientData);
+EXTERN void TclDeleteLateExitHandler (Tcl_ExitProc * proc,
+ ClientData clientData);
EXTERN void TclFinalizeAllocSubsystem _ANSI_ARGS_((void));
EXTERN void TclFinalizeAsync _ANSI_ARGS_((void));
EXTERN void TclFinalizeCompilation _ANSI_ARGS_((void));