summaryrefslogtreecommitdiffstats
path: root/generic/tclEvent.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclEvent.c')
-rw-r--r--generic/tclEvent.c439
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:
+ */