diff options
Diffstat (limited to 'generic')
| -rw-r--r-- | generic/tclEvent.c | 113 | ||||
| -rw-r--r-- | generic/tclInt.h | 6 |
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)); |