diff options
Diffstat (limited to 'generic/tclEvent.c')
| -rw-r--r-- | generic/tclEvent.c | 439 |
1 files changed, 220 insertions, 219 deletions
diff --git a/generic/tclEvent.c b/generic/tclEvent.c index fb58f0f..e70ce67 100644 --- a/generic/tclEvent.c +++ b/generic/tclEvent.c @@ -2,42 +2,41 @@ * tclEvent.c -- * * This file implements some general event related interfaces including - * background errors, exit handlers, and the "vwait" and "update" - * command procedures. + * background errors, exit handlers, and the "vwait" and "update" command + * procedures. * * Copyright (c) 1990-1994 The Regents of the University of California. * Copyright (c) 1994-1998 Sun Microsystems, Inc. * Copyright (c) 2004 by Zoran Vasiljevic. * - * See the file "license.terms" for information on usage and redistribution - * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + * 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.59 2005/06/24 20:07:21 kennykb Exp $ + * RCS: @(#) $Id: tclEvent.c,v 1.60 2005/07/17 21:17:40 dkf Exp $ */ #include "tclInt.h" /* - * The data structure below is used to report background errors. One - * such structure is allocated for each error; it holds information - * about the interpreter and the error until an idle handler command - * can be invoked. + * The data structure below is used to report background errors. One such + * structure is allocated for each error; it holds information about the + * interpreter and the error until an idle handler command can be invoked. */ typedef struct BgError { Tcl_Obj *errorMsg; /* Copy of the error message (the interp's * result when the error occurred). */ - Tcl_Obj *returnOpts; /* Active return options when the - * error occurred */ - struct BgError *nextPtr; /* Next in list of all pending error - * reports for this interpreter, or NULL - * for end of list. */ + Tcl_Obj *returnOpts; /* Active return options when the error + * occurred */ + struct BgError *nextPtr; /* Next in list of all pending error reports + * for this interpreter, or NULL for end of + * list. */ } BgError; /* - * One of the structures below is associated with the "tclBgError" - * assoc data for each interpreter. It keeps track of the head and - * tail of the list of pending background errors for the interpreter. + * One of the structures below is associated with the "tclBgError" assoc data + * for each interpreter. It keeps track of the head and tail of the list of + * pending background errors for the interpreter. */ typedef struct ErrAssocData { @@ -59,14 +58,13 @@ typedef struct ErrAssocData { typedef struct ExitHandler { Tcl_ExitProc *proc; /* Procedure to call when process exits. */ ClientData clientData; /* One word of information to pass to proc. */ - struct ExitHandler *nextPtr;/* Next in list of all exit handlers for - * this application, or NULL for end of list. */ + struct ExitHandler *nextPtr;/* Next in list of all exit handlers for this + * application, or NULL for end of list. */ } ExitHandler; /* - * There is both per-process and per-thread exit handlers. - * The first list is controlled by a mutex. The other is in - * thread local storage. + * There is both per-process and per-thread exit handlers. The first list is + * controlled by a mutex. The other is in thread local storage. */ static ExitHandler *firstExitPtr = NULL; @@ -76,9 +74,9 @@ TCL_DECLARE_MUTEX(exitMutex) /* * This variable is set to 1 when Tcl_Finalize is called, and at the end of - * its work, it is reset to 0. The variable is checked by TclInExit() to - * allow different behavior for exit-time processing, e.g. in closing of - * files and pipes. + * its work, it is reset to 0. The variable is checked by TclInExit() to allow + * different behavior for exit-time processing, e.g. in closing of files and + * pipes. */ static int inFinalize = 0; @@ -93,11 +91,11 @@ static int subsystemsInitialized = 0; static Tcl_ExitProc *appExitPtr = NULL; typedef struct ThreadSpecificData { - ExitHandler *firstExitPtr; /* First in list of all exit handlers for - * this thread. */ - int inExit; /* True when this thread is exiting. This - * is used as a hack to decide to close - * the standard channels. */ + ExitHandler *firstExitPtr; /* First in list of all exit handlers for this + * thread. */ + int inExit; /* True when this thread is exiting. This is + * used as a hack to decide to close the + * standard channels. */ } ThreadSpecificData; static Tcl_ThreadDataKey dataKey; @@ -108,7 +106,7 @@ typedef struct { ClientData clientData; /* The one argument to Main() */ } ThreadClientData; static Tcl_ThreadCreateType NewThreadProc _ANSI_ARGS_(( - ClientData clientData)); + ClientData clientData)); #endif /* @@ -127,17 +125,15 @@ static char * VwaitVarProc _ANSI_ARGS_((ClientData clientData, * * Tcl_BackgroundError -- * - * This procedure is invoked to handle errors that occur in Tcl - * commands that are invoked in "background" (e.g. from event or - * timer bindings). + * This procedure is invoked to handle errors that occur in Tcl commands + * that are invoked in "background" (e.g. from event or timer bindings). * * Results: * None. * * Side effects: - * A handler command is invoked later as an idle handler to - * process the error, passing it the interp result and return - * options. + * A handler command is invoked later as an idle handler to process the + * error, passing it the interp result and return options. * *---------------------------------------------------------------------- */ @@ -175,8 +171,8 @@ Tcl_BackgroundError(interp) * * HandleBgErrors -- * - * This procedure is invoked as an idle handler to process all of - * the accumulated background errors. + * This procedure is invoked as an idle handler to process all of the + * accumulated background errors. * * Results: * None. @@ -196,10 +192,10 @@ HandleBgErrors(clientData) BgError *errPtr; /* - * Not bothering to save/restore the interp state. Assume that - * any code that has interp state it needs to keep will make - * its own Tcl_SaveInterpState call before calling something like - * Tcl_DoOneEvent() that could lead us here. + * Not bothering to save/restore the interp state. Assume that any code + * that has interp state it needs to keep will make its own + * Tcl_SaveInterpState call before calling something like Tcl_DoOneEvent() + * that could lead us here. */ Tcl_Preserve((ClientData) assocPtr); @@ -211,8 +207,8 @@ HandleBgErrors(clientData) errPtr = assocPtr->firstBgPtr; Tcl_IncrRefCount(assocPtr->cmdPrefix); - Tcl_ListObjGetElements(NULL, assocPtr->cmdPrefix, - &prefixObjc, &prefixObjv); + Tcl_ListObjGetElements(NULL, assocPtr->cmdPrefix, &prefixObjc, + &prefixObjv); tempObjv = (Tcl_Obj **) ckalloc((prefixObjc+2)*sizeof(Tcl_Obj *)); memcpy(tempObjv, prefixObjv, prefixObjc*sizeof(Tcl_Obj *)); tempObjv[prefixObjc] = errPtr->errorMsg; @@ -261,7 +257,7 @@ HandleBgErrors(clientData) Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp)); } Tcl_WriteChars(errChannel, "\n", 1); - Tcl_Flush(errChannel); + Tcl_Flush(errChannel); } } } @@ -275,10 +271,9 @@ HandleBgErrors(clientData) * * TclDefaultBgErrorHandlerObjCmd -- * - * This procedure is invoked to process the "::tcl::Bgerror" Tcl - * command. It is the default handler command registered with - * [interp bgerror] for the sake of compatibility with older Tcl - * releases. + * This procedure is invoked to process the "::tcl::Bgerror" Tcl command. + * It is the default handler command registered with [interp bgerror] for + * the sake of compatibility with older Tcl releases. * * Results: * A standard Tcl object result. @@ -291,10 +286,10 @@ HandleBgErrors(clientData) int TclDefaultBgErrorHandlerObjCmd(dummy, interp, objc, objv) - ClientData dummy; /* Not used. */ - Tcl_Interp *interp; /* Current interpreter. */ - int objc; /* Number of arguments. */ - Tcl_Obj *CONST objv[]; /* Argument objects. */ + ClientData dummy; /* Not used. */ + Tcl_Interp *interp; /* Current interpreter. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument objects. */ { Tcl_Obj *keyPtr, *valuePtr; Tcl_Obj *tempObjv[2]; @@ -306,12 +301,12 @@ TclDefaultBgErrorHandlerObjCmd(dummy, interp, objc, objv) } /* - * Restore important state variables to what they were at - * the time the error occurred. + * Restore important state variables to what they were at the time the + * error occurred. * - * Need to set the variables, not the interp fields, because - * Tcl_EvalObjv() calls Tcl_ResetResult() which would destroy - * anything we write to the interp fields. + * Need to set the variables, not the interp fields, because Tcl_EvalObjv + * calls Tcl_ResetResult which would destroy anything we write to the + * interp fields. */ keyPtr = Tcl_NewStringObj("-errorcode", -1); @@ -330,7 +325,9 @@ TclDefaultBgErrorHandlerObjCmd(dummy, interp, objc, objv) Tcl_SetVar2Ex(interp, "errorInfo", NULL, valuePtr, TCL_GLOBAL_ONLY); } - /* Create and invoke the bgerror command. */ + /* + * Create and invoke the bgerror command. + */ tempObjv[0] = Tcl_NewStringObj("bgerror", -1); Tcl_IncrRefCount(tempObjv[0]); @@ -338,16 +335,16 @@ TclDefaultBgErrorHandlerObjCmd(dummy, interp, objc, objv) Tcl_AllowExceptions(interp); code = Tcl_EvalObjv(interp, 2, tempObjv, TCL_EVAL_GLOBAL); if (code == TCL_ERROR) { - /* - * If the interpreter is safe, we look for a hidden command - * named "bgerror" and call that with the error information. - * Otherwise, simply ignore the error. The rationale is that - * this could be an error caused by a malicious applet trying - * to cause an infinite barrage of error messages. The hidden - * "bgerror" command can be used by a security policy to - * interpose on such attacks and e.g. kill the applet after a - * few attempts. - */ + /* + * If the interpreter is safe, we look for a hidden command named + * "bgerror" and call that with the error information. Otherwise, + * simply ignore the error. The rationale is that this could be an + * error caused by a malicious applet trying to cause an infinite + * barrage of error messages. The hidden "bgerror" command can be used + * by a security policy to interpose on such attacks and e.g. kill the + * applet after a few attempts. + */ + if (Tcl_IsSafe(interp)) { Tcl_ResetResult(interp); TclObjInvoke(interp, 2, tempObjv, TCL_INVOKE_HIDDEN); @@ -357,25 +354,24 @@ TclDefaultBgErrorHandlerObjCmd(dummy, interp, objc, objv) Tcl_Obj *resultPtr = Tcl_GetObjResult(interp); Tcl_IncrRefCount(resultPtr); - if (Tcl_FindCommand(interp, "bgerror", - NULL, TCL_GLOBAL_ONLY) == NULL) { + if (Tcl_FindCommand(interp, "bgerror", NULL, + TCL_GLOBAL_ONLY) == NULL) { if (valuePtr) { Tcl_WriteObj(errChannel, valuePtr); Tcl_WriteChars(errChannel, "\n", -1); } - } else { + } else { Tcl_WriteChars(errChannel, "bgerror failed to handle background error.\n", -1); Tcl_WriteChars(errChannel, " Original error: ", -1); Tcl_WriteObj(errChannel, objv[1]); Tcl_WriteChars(errChannel, "\n", -1); - Tcl_WriteChars(errChannel, - " Error in bgerror: ", -1); + Tcl_WriteChars(errChannel, " Error in bgerror: ", -1); Tcl_WriteObj(errChannel, resultPtr); Tcl_WriteChars(errChannel, "\n", -1); - } + } Tcl_DecrRefCount(resultPtr); - Tcl_Flush(errChannel); + Tcl_Flush(errChannel); } } code = TCL_OK; @@ -390,8 +386,8 @@ TclDefaultBgErrorHandlerObjCmd(dummy, interp, objc, objv) * * TclSetBgErrorHandler -- * - * This procedure sets the command prefix to be used to handle - * background errors in interp. + * This procedure sets the command prefix to be used to handle background + * errors in interp. * * Results: * None. @@ -435,8 +431,8 @@ TclSetBgErrorHandler(interp, cmdPrefix) * * TclGetBgErrorHandler -- * - * This procedure retrieves the command prefix currently used - * to handle background errors in interp. + * This procedure retrieves the command prefix currently used to handle + * background errors in interp. * * Results: * A (Tcl_Obj *) to a list of words (command prefix). @@ -467,17 +463,16 @@ TclGetBgErrorHandler(interp) * * BgErrorDeleteProc -- * - * This procedure is associated with the "tclBgError" assoc data - * for an interpreter; it is invoked when the interpreter is - * deleted in order to free the information assoicated with any - * pending error reports. + * This procedure is associated with the "tclBgError" assoc data for an + * interpreter; it is invoked when the interpreter is deleted in order to + * free the information assoicated with any pending error reports. * * Results: * None. * * Side effects: - * Background error information is freed: if there were any - * pending error reports, they are cancelled. + * Background error information is freed: if there were any pending error + * reports, they are cancelled. * *---------------------------------------------------------------------- */ @@ -514,8 +509,8 @@ BgErrorDeleteProc(clientData, interp) * None. * * Side effects: - * Proc will be invoked with clientData as argument when the - * application exits. + * Proc will be invoked with clientData as argument when the application + * exits. * *---------------------------------------------------------------------- */ @@ -541,16 +536,15 @@ Tcl_CreateExitHandler(proc, clientData) * * Tcl_DeleteExitHandler -- * - * This procedure cancels an existing exit handler matching proc - * and clientData, if such a handler exits. + * This procedure cancels an existing exit handler matching proc and + * clientData, if such a handler exits. * * Results: * None. * * Side effects: - * If there is an exit handler corresponding to proc and clientData - * then it is cancelled; if no such handler exists then nothing - * happens. + * If there is an exit handler corresponding to proc and clientData then + * it is cancelled; if no such handler exists then nothing happens. * *---------------------------------------------------------------------- */ @@ -585,15 +579,15 @@ Tcl_DeleteExitHandler(proc, clientData) * * Tcl_CreateThreadExitHandler -- * - * Arrange for a given procedure to be invoked just before the - * current thread exits. + * Arrange for a given procedure to be invoked just before the current + * thread exits. * * Results: * None. * * Side effects: - * Proc will be invoked with clientData as argument when the - * application exits. + * Proc will be invoked with clientData as argument when the application + * exits. * *---------------------------------------------------------------------- */ @@ -618,16 +612,15 @@ Tcl_CreateThreadExitHandler(proc, clientData) * * Tcl_DeleteThreadExitHandler -- * - * This procedure cancels an existing exit handler matching proc - * and clientData, if such a handler exits. + * This procedure cancels an existing exit handler matching proc and + * clientData, if such a handler exits. * * Results: * None. * * Side effects: - * If there is an exit handler corresponding to proc and clientData - * then it is cancelled; if no such handler exists then nothing - * happens. + * If there is an exit handler corresponding to proc and clientData then + * it is cancelled; if no such handler exists then nothing happens. * *---------------------------------------------------------------------- */ @@ -660,10 +653,9 @@ 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. + * 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. @@ -681,8 +673,8 @@ Tcl_SetExitProc(proc) Tcl_ExitProc *prevExitProc; /* - * Swap the old exit proc for the new one, saving the old one for - * our return value. + * Swap the old exit proc for the new one, saving the old one for our + * return value. */ Tcl_MutexLock(&exitMutex); @@ -704,8 +696,7 @@ Tcl_SetExitProc(proc) * None. * * Side effects: - * All existing exit handlers are invoked, then the application - * ends. + * All existing exit handlers are invoked, then the application ends. * *---------------------------------------------------------------------- */ @@ -723,10 +714,11 @@ Tcl_Exit(status) if (currentAppExitPtr) { /* - * Warning: this code SHOULD NOT return, as there is code that - * depends on Tcl_Exit never returning. In fact, we will - * Tcl_Panic if anyone returns, so critical is this dependcy. + * Warning: this code SHOULD NOT return, as there is code that depends + * on Tcl_Exit never returning. In fact, we will Tcl_Panic if anyone + * returns, so critical is this dependcy. */ + currentAppExitPtr((ClientData) status); Tcl_Panic("AppExitProc returned unexpectedly"); } else { @@ -742,17 +734,16 @@ Tcl_Exit(status) * * TclInitSubsystems -- * - * Initialize various subsytems in Tcl. This should be called the - * first time an interp is created, or before any of the subsystems - * are used. This function ensures an order for the initialization - * of subsystems: + * Initialize various subsytems in Tcl. This should be called the first + * time an interp is created, or before any of the subsystems are used. + * This function ensures an order for the initialization of subsystems: * - * 1. that cannot be initialized in lazy order because they are - * mutually dependent. + * 1. that cannot be initialized in lazy order because they are mutually + * dependent. * - * 2. so that they can be finalized in a known order w/o causing - * the subsequent re-initialization of a subsystem in the act of - * shutting down another. + * 2. so that they can be finalized in a known order w/o causing the + * subsequent re-initialization of a subsystem in the act of shutting + * down another. * * Results: * None. @@ -772,15 +763,15 @@ TclInitSubsystems() if (subsystemsInitialized == 0) { /* - * Double check inside the mutex. There are definitly calls - * back into this routine from some of the procedures below. + * Double check inside the mutex. There are definitly calls back into + * this routine from some of the procedures below. */ TclpInitLock(); if (subsystemsInitialized == 0) { /* - * Have to set this bit here to avoid deadlock with the - * routines below us that call into TclInitSubsystems. + * Have to set this bit here to avoid deadlock with the routines + * below us that call into TclInitSubsystems. */ subsystemsInitialized = 1; @@ -790,21 +781,23 @@ TclInitSubsystems() * interesting happens so we can use the allocators in the * implementation of self-initializing locks. */ + #if USE_TCLALLOC - TclInitAlloc(); /* process wide mutex init */ + TclInitAlloc(); /* Process wide mutex init */ #endif #ifdef TCL_MEM_DEBUG - TclInitDbCkalloc(); /* process wide mutex init */ + TclInitDbCkalloc(); /* Process wide mutex init */ #endif - TclpInitPlatform(); /* creates signal handler(s) */ - TclInitDoubleConversion(); /* initializes constants for - * converting to/from double */ - TclInitObjSubsystem(); /* register obj types, create mutexes */ - TclInitIOSubsystem(); /* inits a tsd key (noop) */ - TclInitEncodingSubsystem(); /* process wide encoding init */ + TclpInitPlatform(); /* Creates signal handler(s) */ + TclInitDoubleConversion(); /* Initializes constants for + * converting to/from double. */ + TclInitObjSubsystem(); /* Register obj types, create + * mutexes. */ + TclInitIOSubsystem(); /* Inits a tsd key (noop). */ + TclInitEncodingSubsystem(); /* Process wide encoding init. */ TclpSetInterfaces(); - TclInitNamespaceSubsystem(); /* register ns obj type (mutexed) */ + TclInitNamespaceSubsystem();/* Register ns obj type (mutexed). */ } TclpInitUnlock(); } @@ -816,10 +809,9 @@ TclInitSubsystems() * * Tcl_Finalize -- * - * Shut down Tcl. First calls registered exit handlers, then - * carefully shuts down various subsystems. - * Called by Tcl_Exit or when the Tcl shared library is being - * unloaded. + * Shut down Tcl. First calls registered exit handlers, then carefully + * shuts down various subsystems. Called by Tcl_Exit or when the Tcl + * shared library is being unloaded. * * Results: * None. @@ -843,10 +835,9 @@ Tcl_Finalize() inFinalize = 1; for (exitPtr = firstExitPtr; exitPtr != NULL; exitPtr = firstExitPtr) { /* - * 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_DeleteExitHandler on itself. + * 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_DeleteExitHandler on itself. */ firstExitPtr = exitPtr->nextPtr; @@ -863,105 +854,108 @@ Tcl_Finalize() subsystemsInitialized = 0; /* - * Ensure the thread-specific data is initialised as it is - * used in Tcl_FinalizeThread() + * Ensure the thread-specific data is initialised as it is used in + * Tcl_FinalizeThread() */ (void) TCL_TSD_INIT(&dataKey); /* - * Clean up after the current thread now, after exit handlers. - * In particular, the testexithandler command sets up something - * that writes to standard output, which gets closed. - * Note that there is no thread-local storage after this call. + * Clean up after the current thread now, after exit handlers. In + * particular, the testexithandler command sets up something that + * writes to standard output, which gets closed. Note that there is + * no thread-local storage after this call. */ Tcl_FinalizeThread(); /* - * Now finalize the Tcl execution environment. Note that this - * must be done after the exit handlers, because there are - * order dependencies. + * Now finalize the Tcl execution environment. Note that this must be + * done after the exit handlers, because there are order dependencies. */ TclFinalizeCompExecEnv(); TclFinalizeEnvironment(); /* - * Finalizing the filesystem must come after anything which - * might conceivably interact with the 'Tcl_FS' API. + * Finalizing the filesystem must come after anything which might + * conceivably interact with the 'Tcl_FS' API. */ + TclFinalizeFilesystem(); /* - * We must be sure the encoding finalization doesn't need - * to examine the filesystem in any way. Since it only - * needs to clean up internal data structures, this is - * fine. + * We must be sure the encoding finalization doesn't need to examine + * the filesystem in any way. Since it only needs to clean up + * internal data structures, this is fine. */ + TclFinalizeEncodingSubsystem(); Tcl_SetPanicProc(NULL); /* - * Repeat finalization of the thread local storage once more. - * Although this step is already done by the Tcl_FinalizeThread - * call above, series of events happening afterwards may - * re-initialize TSD slots. Those need to be finalized again, - * otherwise we're leaking memory chunks. - * Very important to note is that things happening afterwards - * should not reference anything which may re-initialize TSD's. - * This includes freeing Tcl_Objs's, among other things. + * Repeat finalization of the thread local storage once more. Although + * this step is already done by the Tcl_FinalizeThread call above, + * series of events happening afterwards may re-initialize TSD slots. + * Those need to be finalized again, otherwise we're leaking memory + * chunks. Very important to note is that things happening afterwards + * should not reference anything which may re-initialize TSD's. This + * includes freeing Tcl_Objs's, among other things. * * This fixes the Tcl Bug #990552. */ + TclFinalizeThreadData(); /* * Free synchronization objects. There really should only be one * thread alive at this moment. */ + TclFinalizeSynchronization(); /* - * We defer unloading of packages until very late - * to avoid memory access issues. Both exit callbacks and - * synchronization variables may be stored in packages. + * We defer unloading of packages until very late to avoid memory + * access issues. Both exit callbacks and synchronization variables + * may be stored in packages. * - * Note that TclFinalizeLoad unloads packages in the reverse - * of the order they were loaded in (i.e. last to be loaded - * is the first to be unloaded). This can be important for - * correct unloading when dependencies exist. + * Note that TclFinalizeLoad unloads packages in the reverse of the + * order they were loaded in (i.e. last to be loaded is the first to + * be unloaded). This can be important for correct unloading when + * dependencies exist. * - * Once load has been finalized, we will have deleted any - * temporary copies of shared libraries and can therefore - * reset the filesystem to its original state. + * Once load has been finalized, we will have deleted any temporary + * copies of shared libraries and can therefore reset the filesystem + * to its original state. */ TclFinalizeLoad(); TclResetFilesystem(); - /* Now we can free constants for conversions to/from double */ + /* + * Now we can free constants for conversions to/from double. + */ TclFinalizeDoubleConversion(); /* - * There have been several bugs in the past that cause - * exit handlers to be established during Tcl_Finalize - * processing. Such exit handlers leave malloc'ed memory, - * and Tcl_FinalizeThreadAlloc or Tcl_FinalizeMemorySubsystem - * will result in a corrupted heap. The result can be a - * mysterious crash on process exit. Check here that + * There have been several bugs in the past that cause exit handlers + * to be established during Tcl_Finalize processing. Such exit + * handlers leave malloc'ed memory, and Tcl_FinalizeThreadAlloc or + * Tcl_FinalizeMemorySubsystem will result in a corrupted heap. The + * result can be a mysterious crash on process exit. Check here that * nobody's done this. */ - if ( firstExitPtr != NULL ) { - Tcl_Panic( "exit handlers were created during Tcl_Finalize" ); + if (firstExitPtr != NULL) { + Tcl_Panic("exit handlers were created during Tcl_Finalize"); } /* * There shouldn't be any malloc'ed memory after this. */ + TclFinalizePreserve(); #if defined(TCL_THREADS) && defined(USE_THREAD_ALLOC) TclFinalizeThreadAlloc(); @@ -977,8 +971,8 @@ Tcl_Finalize() * * Tcl_FinalizeThread -- * - * Runs the exit handlers to allow Tcl to clean up its state - * about a particular thread. + * Runs the exit handlers to allow Tcl to clean up its state about a + * particular thread. * * Results: * None. @@ -1019,14 +1013,14 @@ Tcl_FinalizeThread() /* * Blow away all thread local storage blocks. * - * Note that Tcl API allows creation of threads which do not use any - * Tcl interp or other Tcl subsytems. Those threads might, however, - * use thread local storage, so we must unconditionally finalize it. + * Note that Tcl API allows creation of threads which do not use any Tcl + * interp or other Tcl subsytems. Those threads might, however, use thread + * local storage, so we must unconditionally finalize it. * * Fix [Bug #571002] */ - TclFinalizeThreadData(); + TclFinalizeThreadData(); } /* @@ -1084,8 +1078,8 @@ TclInThreadExit() * * Tcl_VwaitObjCmd -- * - * This procedure is invoked to process the "vwait" Tcl command. - * See the user documentation for details on what it does. + * This procedure is invoked to process the "vwait" Tcl command. See the + * user documentation for details on what it does. * * Results: * A standard Tcl result. @@ -1108,7 +1102,7 @@ Tcl_VwaitObjCmd(clientData, interp, objc, objv) char *nameString; if (objc != 2) { - Tcl_WrongNumArgs(interp, 1, objv, "name"); + Tcl_WrongNumArgs(interp, 1, objv, "name"); return TCL_ERROR; } nameString = Tcl_GetString(objv[1]); @@ -1132,8 +1126,8 @@ Tcl_VwaitObjCmd(clientData, interp, objc, objv) VwaitVarProc, (ClientData) &done); /* - * Clear out the interpreter's result, since it may have been set - * by event handlers. + * Clear out the interpreter's result, since it may have been set by event + * handlers. */ Tcl_ResetResult(interp); @@ -1165,8 +1159,8 @@ VwaitVarProc(clientData, interp, name1, name2, flags) * * Tcl_UpdateObjCmd -- * - * This procedure is invoked to process the "update" Tcl command. - * See the user documentation for details on what it does. + * This procedure is invoked to process the "update" Tcl command. See + * the user documentation for details on what it does. * * Results: * A standard Tcl result. @@ -1198,16 +1192,14 @@ Tcl_UpdateObjCmd(clientData, interp, objc, objv) return TCL_ERROR; } switch ((enum updateOptions) optionIndex) { - case REGEXP_IDLETASKS: { - flags = TCL_WINDOW_EVENTS|TCL_IDLE_EVENTS|TCL_DONT_WAIT; - break; - } - default: { - Tcl_Panic("Tcl_UpdateObjCmd: bad option index to UpdateOptions"); - } + case REGEXP_IDLETASKS: + flags = TCL_WINDOW_EVENTS|TCL_IDLE_EVENTS|TCL_DONT_WAIT; + break; + default: + Tcl_Panic("Tcl_UpdateObjCmd: bad option index to UpdateOptions"); } } else { - Tcl_WrongNumArgs(interp, 1, objv, "?idletasks?"); + Tcl_WrongNumArgs(interp, 1, objv, "?idletasks?"); return TCL_ERROR; } @@ -1220,14 +1212,14 @@ Tcl_UpdateObjCmd(clientData, interp, objc, objv) } /* - * Must clear the interpreter's result because event handlers could - * have executed commands. + * Must clear the interpreter's result because event handlers could have + * executed commands. */ Tcl_ResetResult(interp); return TCL_OK; } - + #ifdef TCL_THREADS /* *----------------------------------------------------------------------------- @@ -1262,18 +1254,19 @@ NewThreadProc(ClientData clientData) TCL_THREAD_CREATE_RETURN; } #endif + /* *---------------------------------------------------------------------- * * Tcl_CreateThread -- * - * This procedure creates a new thread. This actually belongs - * to the tclThread.c file but since we use some private - * data structures local to this file, it is placed here. + * This procedure creates a new thread. This actually belongs to the + * tclThread.c file but since we use some private data structures local + * to this file, it is placed here. * * Results: - * TCL_OK if the thread could be created. The thread ID is - * returned in a parameter. + * TCL_OK if the thread could be created. The thread ID is returned in a + * parameter. * * Side effects: * A new thread is created. @@ -1287,19 +1280,27 @@ Tcl_CreateThread(idPtr, proc, clientData, stackSize, flags) Tcl_ThreadCreateProc proc; /* Main() function of the thread */ ClientData clientData; /* The one argument to Main() */ int stackSize; /* Size of stack for the new thread */ - int flags; /* Flags controlling behaviour of - * the new thread */ + int flags; /* Flags controlling behaviour of the + * new thread. */ { #ifdef TCL_THREADS ThreadClientData *cdPtr; - cdPtr = (ThreadClientData*)Tcl_Alloc(sizeof(ThreadClientData)); + cdPtr = (ThreadClientData *) Tcl_Alloc(sizeof(ThreadClientData)); cdPtr->proc = proc; cdPtr->clientData = clientData; return TclpThreadCreate(idPtr, NewThreadProc, (ClientData)cdPtr, - stackSize, flags); + stackSize, flags); #else return TCL_ERROR; #endif /* TCL_THREADS */ } + +/* + * Local Variables: + * mode: c + * c-basic-offset: 4 + * fill-column: 78 + * End: + */ |