Merge commit '05fa4c89f20e9769db0e6c0b429cef2590771ace' as 'tcl8.6'

1 files changed, 1624 insertions, 0 deletions

diff --git a/tcl8.6/generic/tclEvent.c b/tcl8.6/generic/tclEvent.c
new file mode 100644
index 0000000..b0b8188
--- /dev/null
+++ b/tcl8.6/generic/tclEvent.c
@@ -0,0 +1,1624 @@
+/*
+ * tclEvent.c --
+ *
+ *	This file implements some general event related interfaces including
+ *	background errors, exit handlers, and the "vwait" and "update" command
+ *	functions.
+ *
+ * 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.
+ */
+
+#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.
+ */
+
+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. */
+} 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.
+ */
+
+typedef struct ErrAssocData {
+    Tcl_Interp *interp;		/* Interpreter in which error occurred. */
+    Tcl_Obj *cmdPrefix;		/* First word(s) of the handler command */
+    BgError *firstBgPtr;	/* First in list of all background errors
+				 * waiting to be processed for this
+				 * interpreter (NULL if none). */
+    BgError *lastBgPtr;		/* Last in list of all background errors
+				 * waiting to be processed for this
+				 * interpreter (NULL if none). */
+} ErrAssocData;
+
+/*
+ * For each exit handler created with a call to Tcl_Create(Late)ExitHandler
+ * there is a structure of the following type:
+ */
+
+typedef struct ExitHandler {
+    Tcl_ExitProc *proc;		/* Function 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. */
+} 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.
+ */
+
+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)
+
+/*
+ * This variable is set to 1 when Tcl_Exit is called. The variable is checked
+ * by TclInExit() to allow different behavior for exit-time processing, e.g.,
+ * in closing of files and pipes.
+ */
+
+static int inExit = 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_NORETURN1 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. */
+} ThreadSpecificData;
+static Tcl_ThreadDataKey dataKey;
+
+#ifdef TCL_THREADS
+typedef struct {
+    Tcl_ThreadCreateProc *proc;	/* Main() function of the thread */
+    ClientData clientData;	/* The one argument to Main() */
+} ThreadClientData;
+static Tcl_ThreadCreateType NewThreadProc(ClientData clientData);
+#endif /* TCL_THREADS */
+
+/*
+ * Prototypes for functions referenced only in this file:
+ */
+
+static void		BgErrorDeleteProc(ClientData clientData,
+			    Tcl_Interp *interp);
+static void		HandleBgErrors(ClientData clientData);
+static char *		VwaitVarProc(ClientData clientData,
+			    Tcl_Interp *interp, const char *name1,
+			    const char *name2, int flags);
+static void		InvokeExitHandlers(void);
+static void		FinalizeThread(int quick);
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_BackgroundError --
+ *
+ *	This function 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_BackgroundError(
+    Tcl_Interp *interp)		/* Interpreter in which an error has
+				 * occurred. */
+{
+    Tcl_BackgroundException(interp, TCL_ERROR);
+}
+
+void
+Tcl_BackgroundException(
+    Tcl_Interp *interp,		/* Interpreter in which an exception has
+				 * occurred. */
+    int code)			/* The exception code value */
+{
+    BgError *errPtr;
+    ErrAssocData *assocPtr;
+
+    if (code == TCL_OK) {
+	return;
+    }
+
+    errPtr = ckalloc(sizeof(BgError));
+    errPtr->errorMsg = Tcl_GetObjResult(interp);
+    Tcl_IncrRefCount(errPtr->errorMsg);
+    errPtr->returnOpts = Tcl_GetReturnOptions(interp, code);
+    Tcl_IncrRefCount(errPtr->returnOpts);
+    errPtr->nextPtr = NULL;
+
+    (void) TclGetBgErrorHandler(interp);
+    assocPtr = Tcl_GetAssocData(interp, "tclBgError", NULL);
+    if (assocPtr->firstBgPtr == NULL) {
+	assocPtr->firstBgPtr = errPtr;
+	Tcl_DoWhenIdle(HandleBgErrors, assocPtr);
+    } else {
+	assocPtr->lastBgPtr->nextPtr = errPtr;
+    }
+    assocPtr->lastBgPtr = errPtr;
+    Tcl_ResetResult(interp);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * HandleBgErrors --
+ *
+ *	This function is invoked as an idle handler to process all of the
+ *	accumulated background errors.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Depends on what actions the handler command takes for the errors.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+HandleBgErrors(
+    ClientData clientData)	/* Pointer to ErrAssocData structure. */
+{
+    ErrAssocData *assocPtr = clientData;
+    Tcl_Interp *interp = assocPtr->interp;
+    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.
+     */
+
+    Tcl_Preserve(assocPtr);
+    Tcl_Preserve(interp);
+    while (assocPtr->firstBgPtr != NULL) {
+	int code, prefixObjc;
+	Tcl_Obj **prefixObjv, **tempObjv;
+
+	/*
+	 * Note we copy the handler command prefix each pass through, so we do
+	 * support one handler setting another handler.
+	 */
+
+	Tcl_Obj *copyObj = TclListObjCopy(NULL, assocPtr->cmdPrefix);
+
+	errPtr = assocPtr->firstBgPtr;
+
+	Tcl_ListObjGetElements(NULL, copyObj, &prefixObjc, &prefixObjv);
+	tempObjv = ckalloc((prefixObjc+2) * sizeof(Tcl_Obj *));
+	memcpy(tempObjv, prefixObjv, prefixObjc*sizeof(Tcl_Obj *));
+	tempObjv[prefixObjc] = errPtr->errorMsg;
+	tempObjv[prefixObjc+1] = errPtr->returnOpts;
+	Tcl_AllowExceptions(interp);
+	code = Tcl_EvalObjv(interp, prefixObjc+2, tempObjv, TCL_EVAL_GLOBAL);
+
+	/*
+	 * Discard the command and the information about the error report.
+	 */
+
+	Tcl_DecrRefCount(copyObj);
+	Tcl_DecrRefCount(errPtr->errorMsg);
+	Tcl_DecrRefCount(errPtr->returnOpts);
+	assocPtr->firstBgPtr = errPtr->nextPtr;
+	ckfree(errPtr);
+	ckfree(tempObjv);
+
+	if (code == TCL_BREAK) {
+	    /*
+	     * Break means cancel any remaining error reports for this
+	     * interpreter.
+	     */
+
+	    while (assocPtr->firstBgPtr != NULL) {
+		errPtr = assocPtr->firstBgPtr;
+		assocPtr->firstBgPtr = errPtr->nextPtr;
+		Tcl_DecrRefCount(errPtr->errorMsg);
+		Tcl_DecrRefCount(errPtr->returnOpts);
+		ckfree(errPtr);
+	    }
+	} else if ((code == TCL_ERROR) && !Tcl_IsSafe(interp)) {
+	    Tcl_Channel errChannel = Tcl_GetStdChannel(TCL_STDERR);
+
+	    if (errChannel != NULL) {
+		Tcl_Obj *options = Tcl_GetReturnOptions(interp, code);
+		Tcl_Obj *keyPtr, *valuePtr = NULL;
+
+		TclNewLiteralStringObj(keyPtr, "-errorinfo");
+		Tcl_IncrRefCount(keyPtr);
+		Tcl_DictObjGet(NULL, options, keyPtr, &valuePtr);
+		Tcl_DecrRefCount(keyPtr);
+
+		Tcl_WriteChars(errChannel,
+			"error in background error handler:\n", -1);
+		if (valuePtr) {
+		    Tcl_WriteObj(errChannel, valuePtr);
+		} else {
+		    Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp));
+		}
+		Tcl_WriteChars(errChannel, "\n", 1);
+		Tcl_Flush(errChannel);
+		Tcl_DecrRefCount(options);
+	    }
+	}
+    }
+    assocPtr->lastBgPtr = NULL;
+    Tcl_Release(interp);
+    Tcl_Release(assocPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclDefaultBgErrorHandlerObjCmd --
+ *
+ *	This function 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.
+ *
+ * Side effects:
+ *	Depends on what actions the "bgerror" command takes for the errors.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclDefaultBgErrorHandlerObjCmd(
+    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];
+    int result, code, level;
+    Tcl_InterpState saved;
+
+    if (objc != 3) {
+	Tcl_WrongNumArgs(interp, 1, objv, "msg options");
+	return TCL_ERROR;
+    }
+
+    /*
+     * Check for a valid return options dictionary.
+     */
+
+    TclNewLiteralStringObj(keyPtr, "-level");
+    Tcl_IncrRefCount(keyPtr);
+    result = Tcl_DictObjGet(NULL, objv[2], keyPtr, &valuePtr);
+    Tcl_DecrRefCount(keyPtr);
+    if (result != TCL_OK || valuePtr == NULL) {
+	Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		"missing return option \"-level\"", -1));
+	Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL);
+	return TCL_ERROR;
+    }
+    if (Tcl_GetIntFromObj(interp, valuePtr, &level) == TCL_ERROR) {
+	return TCL_ERROR;
+    }
+    TclNewLiteralStringObj(keyPtr, "-code");
+    Tcl_IncrRefCount(keyPtr);
+    result = Tcl_DictObjGet(NULL, objv[2], keyPtr, &valuePtr);
+    Tcl_DecrRefCount(keyPtr);
+    if (result != TCL_OK || valuePtr == NULL) {
+	Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		"missing return option \"-code\"", -1));
+	Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL);
+	return TCL_ERROR;
+    }
+    if (Tcl_GetIntFromObj(interp, valuePtr, &code) == TCL_ERROR) {
+	return TCL_ERROR;
+    }
+
+    if (level != 0) {
+	/*
+	 * We're handling a TCL_RETURN exception.
+	 */
+
+	code = TCL_RETURN;
+    }
+    if (code == TCL_OK) {
+	/*
+	 * Somehow we got to exception handling with no exception. (Pass
+	 * TCL_OK to Tcl_BackgroundException()?) Just return without doing
+	 * anything.
+	 */
+
+	return TCL_OK;
+    }
+
+    /*
+     * Construct the bgerror command.
+     */
+
+    TclNewLiteralStringObj(tempObjv[0], "bgerror");
+    Tcl_IncrRefCount(tempObjv[0]);
+
+    /*
+     * Determine error message argument.  Check the return options in case
+     * a non-error exception brought us here.
+     */
+
+    switch (code) {
+    case TCL_ERROR:
+	tempObjv[1] = objv[1];
+	break;
+    case TCL_BREAK:
+	TclNewLiteralStringObj(tempObjv[1],
+		"invoked \"break\" outside of a loop");
+	break;
+    case TCL_CONTINUE:
+	TclNewLiteralStringObj(tempObjv[1],
+		"invoked \"continue\" outside of a loop");
+	break;
+    default:
+	tempObjv[1] = Tcl_ObjPrintf("command returned bad code: %d", code);
+	break;
+    }
+    Tcl_IncrRefCount(tempObjv[1]);
+
+    if (code != TCL_ERROR) {
+	Tcl_SetObjResult(interp, tempObjv[1]);
+    }
+
+    TclNewLiteralStringObj(keyPtr, "-errorcode");
+    Tcl_IncrRefCount(keyPtr);
+    result = Tcl_DictObjGet(NULL, objv[2], keyPtr, &valuePtr);
+    Tcl_DecrRefCount(keyPtr);
+    if (result == TCL_OK && valuePtr != NULL) {
+	Tcl_SetObjErrorCode(interp, valuePtr);
+    }
+
+    TclNewLiteralStringObj(keyPtr, "-errorinfo");
+    Tcl_IncrRefCount(keyPtr);
+    result = Tcl_DictObjGet(NULL, objv[2], keyPtr, &valuePtr);
+    Tcl_DecrRefCount(keyPtr);
+    if (result == TCL_OK && valuePtr != NULL) {
+	Tcl_AppendObjToErrorInfo(interp, valuePtr);
+    }
+
+    if (code == TCL_ERROR) {
+	Tcl_SetObjResult(interp, tempObjv[1]);
+    }
+
+    /*
+     * Save interpreter state so we can restore it if multiple handler
+     * attempts are needed.
+     */
+
+    saved = Tcl_SaveInterpState(interp, code);
+
+    /*
+     * Invoke the bgerror command.
+     */
+
+    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 (Tcl_IsSafe(interp)) {
+	    Tcl_RestoreInterpState(interp, saved);
+	    TclObjInvoke(interp, 2, tempObjv, TCL_INVOKE_HIDDEN);
+	} else {
+	    Tcl_Channel errChannel = Tcl_GetStdChannel(TCL_STDERR);
+
+	    if (errChannel != NULL) {
+		Tcl_Obj *resultPtr = Tcl_GetObjResult(interp);
+
+		Tcl_IncrRefCount(resultPtr);
+		if (Tcl_FindCommand(interp, "bgerror", NULL,
+			TCL_GLOBAL_ONLY) == NULL) {
+		    Tcl_RestoreInterpState(interp, saved);
+		    Tcl_WriteObj(errChannel, Tcl_GetVar2Ex(interp,
+			    "errorInfo", NULL, TCL_GLOBAL_ONLY));
+		    Tcl_WriteChars(errChannel, "\n", -1);
+		} else {
+		    Tcl_DiscardInterpState(saved);
+		    Tcl_WriteChars(errChannel,
+			    "bgerror failed to handle background error.\n",-1);
+		    Tcl_WriteChars(errChannel, "    Original error: ", -1);
+		    Tcl_WriteObj(errChannel, tempObjv[1]);
+		    Tcl_WriteChars(errChannel, "\n", -1);
+		    Tcl_WriteChars(errChannel, "    Error in bgerror: ", -1);
+		    Tcl_WriteObj(errChannel, resultPtr);
+		    Tcl_WriteChars(errChannel, "\n", -1);
+		}
+		Tcl_DecrRefCount(resultPtr);
+		Tcl_Flush(errChannel);
+	    } else {
+		Tcl_DiscardInterpState(saved);
+	    }
+	}
+	code = TCL_OK;
+    } else {
+	Tcl_DiscardInterpState(saved);
+    }
+
+    Tcl_DecrRefCount(tempObjv[0]);
+    Tcl_DecrRefCount(tempObjv[1]);
+    Tcl_ResetResult(interp);
+    return code;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclSetBgErrorHandler --
+ *
+ *	This function sets the command prefix to be used to handle background
+ *	errors in interp.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Error handler is registered.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclSetBgErrorHandler(
+    Tcl_Interp *interp,
+    Tcl_Obj *cmdPrefix)
+{
+    ErrAssocData *assocPtr = Tcl_GetAssocData(interp, "tclBgError", NULL);
+
+    if (cmdPrefix == NULL) {
+	Tcl_Panic("TclSetBgErrorHandler: NULL cmdPrefix argument");
+    }
+    if (assocPtr == NULL) {
+	/*
+	 * First access: initialize.
+	 */
+
+	assocPtr = ckalloc(sizeof(ErrAssocData));
+	assocPtr->interp = interp;
+	assocPtr->cmdPrefix = NULL;
+	assocPtr->firstBgPtr = NULL;
+	assocPtr->lastBgPtr = NULL;
+	Tcl_SetAssocData(interp, "tclBgError", BgErrorDeleteProc, assocPtr);
+    }
+    if (assocPtr->cmdPrefix) {
+	Tcl_DecrRefCount(assocPtr->cmdPrefix);
+    }
+    assocPtr->cmdPrefix = cmdPrefix;
+    Tcl_IncrRefCount(assocPtr->cmdPrefix);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclGetBgErrorHandler --
+ *
+ *	This function retrieves the command prefix currently used to handle
+ *	background errors in interp.
+ *
+ * Results:
+ *	A (Tcl_Obj *) to a list of words (command prefix).
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+TclGetBgErrorHandler(
+    Tcl_Interp *interp)
+{
+    ErrAssocData *assocPtr = Tcl_GetAssocData(interp, "tclBgError", NULL);
+
+    if (assocPtr == NULL) {
+	Tcl_Obj *bgerrorObj;
+
+	TclNewLiteralStringObj(bgerrorObj, "::tcl::Bgerror");
+	TclSetBgErrorHandler(interp, bgerrorObj);
+	assocPtr = Tcl_GetAssocData(interp, "tclBgError", NULL);
+    }
+    return assocPtr->cmdPrefix;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * BgErrorDeleteProc --
+ *
+ *	This function 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 canceled.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+BgErrorDeleteProc(
+    ClientData clientData,	/* Pointer to ErrAssocData structure. */
+    Tcl_Interp *interp)		/* Interpreter being deleted. */
+{
+    ErrAssocData *assocPtr = clientData;
+    BgError *errPtr;
+
+    while (assocPtr->firstBgPtr != NULL) {
+	errPtr = assocPtr->firstBgPtr;
+	assocPtr->firstBgPtr = errPtr->nextPtr;
+	Tcl_DecrRefCount(errPtr->errorMsg);
+	Tcl_DecrRefCount(errPtr->returnOpts);
+	ckfree(errPtr);
+    }
+    Tcl_CancelIdleCall(HandleBgErrors, assocPtr);
+    Tcl_DecrRefCount(assocPtr->cmdPrefix);
+    Tcl_EventuallyFree(assocPtr, TCL_DYNAMIC);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_CreateExitHandler --
+ *
+ *	Arrange for a given function to be invoked just before the application
+ *	exits.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Proc will be invoked with clientData as argument when the application
+ *	exits.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_CreateExitHandler(
+    Tcl_ExitProc *proc,		/* Function to invoke. */
+    ClientData clientData)	/* Arbitrary value to pass to proc. */
+{
+    ExitHandler *exitPtr = ckalloc(sizeof(ExitHandler));
+
+    exitPtr->proc = proc;
+    exitPtr->clientData = clientData;
+    Tcl_MutexLock(&exitMutex);
+    exitPtr->nextPtr = firstExitPtr;
+    firstExitPtr = exitPtr;
+    Tcl_MutexUnlock(&exitMutex);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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 = ckalloc(sizeof(ExitHandler));
+
+    exitPtr->proc = proc;
+    exitPtr->clientData = clientData;
+    Tcl_MutexLock(&exitMutex);
+    exitPtr->nextPtr = firstLateExitPtr;
+    firstLateExitPtr = exitPtr;
+    Tcl_MutexUnlock(&exitMutex);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_DeleteExitHandler --
+ *
+ *	This function 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 canceled; if no such handler exists then nothing happens.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_DeleteExitHandler(
+    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 = firstExitPtr; exitPtr != NULL;
+	    prevPtr = exitPtr, exitPtr = exitPtr->nextPtr) {
+	if ((exitPtr->proc == proc)
+		&& (exitPtr->clientData == clientData)) {
+	    if (prevPtr == NULL) {
+		firstExitPtr = exitPtr->nextPtr;
+	    } else {
+		prevPtr->nextPtr = exitPtr->nextPtr;
+	    }
+	    ckfree(exitPtr);
+	    break;
+	}
+    }
+    Tcl_MutexUnlock(&exitMutex);
+    return;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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(exitPtr);
+	    break;
+	}
+    }
+    Tcl_MutexUnlock(&exitMutex);
+    return;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_CreateThreadExitHandler --
+ *
+ *	Arrange for a given function 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_CreateThreadExitHandler(
+    Tcl_ExitProc *proc,		/* Function to invoke. */
+    ClientData clientData)	/* Arbitrary value to pass to proc. */
+{
+    ExitHandler *exitPtr;
+    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+
+    exitPtr = ckalloc(sizeof(ExitHandler));
+    exitPtr->proc = proc;
+    exitPtr->clientData = clientData;
+    exitPtr->nextPtr = tsdPtr->firstExitPtr;
+    tsdPtr->firstExitPtr = exitPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_DeleteThreadExitHandler --
+ *
+ *	This function 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 canceled; if no such handler exists then nothing happens.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_DeleteThreadExitHandler(
+    Tcl_ExitProc *proc,		/* Function that was previously registered. */
+    ClientData clientData)	/* Arbitrary value to pass to proc. */
+{
+    ExitHandler *exitPtr, *prevPtr;
+    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+
+    for (prevPtr = NULL, exitPtr = tsdPtr->firstExitPtr; exitPtr != NULL;
+	    prevPtr = exitPtr, exitPtr = exitPtr->nextPtr) {
+	if ((exitPtr->proc == proc)
+		&& (exitPtr->clientData == clientData)) {
+	    if (prevPtr == NULL) {
+		tsdPtr->firstExitPtr = exitPtr->nextPtr;
+	    } else {
+		prevPtr->nextPtr = exitPtr->nextPtr;
+	    }
+	    ckfree(exitPtr);
+	    return;
+	}
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_SetExitProc --
+ *
+ *	This function 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(
+    TCL_NORETURN1 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;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InvokeExitHandlers --
+ *
+ *      Call the registered exit handlers.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The exit handlers are invoked, and the ExitHandler struct is
+ *      freed.
+ *
+ *----------------------------------------------------------------------
+ */
+static void
+InvokeExitHandlers(void)
+{
+    ExitHandler *exitPtr;
+
+    Tcl_MutexLock(&exitMutex);
+    inExit = 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.
+	 */
+
+	firstExitPtr = exitPtr->nextPtr;
+	Tcl_MutexUnlock(&exitMutex);
+	exitPtr->proc(exitPtr->clientData);
+	ckfree(exitPtr);
+	Tcl_MutexLock(&exitMutex);
+    }
+    firstExitPtr = NULL;
+    Tcl_MutexUnlock(&exitMutex);
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_Exit --
+ *
+ *	This function is called to terminate the application.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	All existing exit handlers are invoked, then the application ends.
+ *
+ *----------------------------------------------------------------------
+ */
+
+TCL_NORETURN void
+Tcl_Exit(
+    int status)			/* Exit status for application; typically 0
+				 * for normal return, 1 for error return. */
+{
+    TCL_NORETURN1 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 Tcl_Panic if anyone
+	 * returns, so critical is this dependcy.
+	 */
+
+	currentAppExitPtr(INT2PTR(status));
+	Tcl_Panic("AppExitProc returned unexpectedly");
+    } else {
+
+	if (TclFullFinalizationRequested()) {
+
+	    /*
+	     * Thorough finalization for Valgrind et al.
+	     */
+
+	    Tcl_Finalize();
+
+	} else {
+
+	    /*
+	     * Fast and deterministic exit (default behavior)
+	     */
+
+	    InvokeExitHandlers();
+
+	    /*
+	     * Ensure the thread-specific data is initialised as it is used in
+	     * Tcl_FinalizeThread()
+	     */
+
+	    (void) TCL_TSD_INIT(&dataKey);
+
+	    /*
+	     * Now finalize the calling thread only (others are not safely
+	     * reachable).  Among other things, this triggers a flush of the
+	     * Tcl_Channels that may have data enqueued.
+	     */
+
+	    FinalizeThread(/* quick */ 1);
+	}
+	TclpExit(status);
+	Tcl_Panic("OS exit failed!");
+    }
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * 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:
+ *
+ *	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.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Varied, see the respective initialization routines.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+void
+TclInitSubsystems(void)
+{
+    if (inExit != 0) {
+	Tcl_Panic("TclInitSubsystems called while exiting");
+    }
+
+    if (subsystemsInitialized == 0) {
+	/*
+	 * Double check inside the mutex. There are definitly calls back into
+	 * this routine from some of the functions below.
+	 */
+
+	TclpInitLock();
+	if (subsystemsInitialized == 0) {
+
+		/*
+	     * Initialize locks used by the memory allocators before anything
+	     * interesting happens so we can use the allocators in the
+	     * implementation of self-initializing locks.
+	     */
+
+	    TclInitThreadStorage();     /* Creates master hash table for
+					 * thread local storage */
+#if USE_TCLALLOC
+	    TclInitAlloc();		/* Process wide mutex init */
+#endif
+#ifdef TCL_MEM_DEBUG
+	    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. */
+	    TclpSetInterfaces();
+	    TclInitNamespaceSubsystem();/* Register ns obj type (mutexed). */
+	    subsystemsInitialized = 1;
+	}
+	TclpInitUnlock();
+    }
+    TclInitNotifier();
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_Finalize --
+ *
+ *	Shut down Tcl. First calls registered exit handlers, then carefully
+ *	shuts down various subsystems.  Should be invoked by user before the
+ *	Tcl shared library is being unloaded in an embedded context.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Varied, see the respective finalization routines.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_Finalize(void)
+{
+    ExitHandler *exitPtr;
+
+    /*
+     * Invoke exit handlers first.
+     */
+
+    InvokeExitHandlers();
+
+    TclpInitLock();
+    if (subsystemsInitialized == 0) {
+	goto alreadyFinalized;
+    }
+    subsystemsInitialized = 0;
+
+    /*
+     * 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 or IO subsystem after this call.
+     */
+
+    Tcl_FinalizeThread();
+
+    /*
+     * Now invoke late (process-wide) exit handlers.
+     */
+
+    Tcl_MutexLock(&exitMutex);
+    for (exitPtr = firstLateExitPtr; exitPtr != NULL;
+	    exitPtr = firstLateExitPtr) {
+	/*
+	 * 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(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.
+     */
+
+    TclFinalizeEvaluation();
+    TclFinalizeExecution();
+    TclFinalizeEnvironment();
+
+    /*
+     * Finalizing the filesystem must come after anything which might
+     * conceivably interact with the 'Tcl_FS' API.
+     */
+
+    TclFinalizeFilesystem();
+
+    /*
+     * Undo all Tcl_ObjType registrations, and reset the master list of free
+     * Tcl_Obj's. After this returns, no more Tcl_Obj's should be allocated or
+     * freed.
+     *
+     * Note in particular that TclFinalizeObjects() must follow
+     * TclFinalizeFilesystem() because TclFinalizeFilesystem free's the
+     * Tcl_Obj that holds the path of the current working directory.
+     */
+
+    TclFinalizeObjects();
+
+    /*
+     * 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();
+
+    /*
+     * 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(/* quick */ 0);
+
+    /*
+     * 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_FinalizeMemorySubsystem or
+     * Tcl_FinalizeThreadAlloc 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");
+    }
+
+    TclFinalizePreserve();
+
+    /*
+     * Free synchronization objects. There really should only be one thread
+     * alive at this moment.
+     */
+
+    TclFinalizeSynchronization();
+
+    /*
+     * Close down the thread-specific object allocator.
+     */
+
+#if defined(TCL_THREADS) && defined(USE_THREAD_ALLOC)
+    TclFinalizeThreadAlloc();
+#endif
+
+    /*
+     * 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.
+     *
+     * 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();
+
+    /*
+     * At this point, there should no longer be any ckalloc'ed memory.
+     */
+
+    TclFinalizeMemorySubsystem();
+
+  alreadyFinalized:
+    TclFinalizeLock();
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_FinalizeThread --
+ *
+ *	Runs the exit handlers to allow Tcl to clean up its state about a
+ *	particular thread.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Varied, see the respective finalization routines.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_FinalizeThread(void)
+{
+    FinalizeThread(/* quick */ 0);
+}
+
+void
+FinalizeThread(
+    int quick)
+{
+    ExitHandler *exitPtr;
+    ThreadSpecificData *tsdPtr;
+
+    /*
+     * We use TclThreadDataKeyGet here, rather than Tcl_GetThreadData, because
+     * we don't want to initialize the data block if it hasn't been
+     * initialized already.
+     */
+
+    tsdPtr = TclThreadDataKeyGet(&dataKey);
+    if (tsdPtr != NULL) {
+	tsdPtr->inExit = 1;
+
+	for (exitPtr = tsdPtr->firstExitPtr; exitPtr != NULL;
+		exitPtr = tsdPtr->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_DeleteThreadExitHandler on itself.
+	     */
+
+	    tsdPtr->firstExitPtr = exitPtr->nextPtr;
+	    exitPtr->proc(exitPtr->clientData);
+	    ckfree(exitPtr);
+	}
+	TclFinalizeIOSubsystem();
+	TclFinalizeNotifier();
+	TclFinalizeAsync();
+	TclFinalizeThreadObjects();
+    }
+
+    /*
+     * 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.
+     *
+     * Fix [Bug #571002]
+     */
+    TclFinalizeThreadData(quick);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclInExit --
+ *
+ *	Determines if we are in the middle of exit-time cleanup.
+ *
+ * Results:
+ *	If we are in the middle of exiting, 1, otherwise 0.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclInExit(void)
+{
+    return inExit;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclInThreadExit --
+ *
+ *	Determines if we are in the middle of thread exit-time cleanup.
+ *
+ * Results:
+ *	If we are in the middle of exiting this thread, 1, otherwise 0.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclInThreadExit(void)
+{
+    ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);
+
+    if (tsdPtr == NULL) {
+	return 0;
+    }
+    return tsdPtr->inExit;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_VwaitObjCmd --
+ *
+ *	This function is invoked to process the "vwait" Tcl command. See the
+ *	user documentation for details on what it does.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+int
+Tcl_VwaitObjCmd(
+    ClientData clientData,	/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
+{
+    int done, foundEvent;
+    const char *nameString;
+
+    if (objc != 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "name");
+	return TCL_ERROR;
+    }
+    nameString = Tcl_GetString(objv[1]);
+    if (Tcl_TraceVar2(interp, nameString, NULL,
+	    TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+	    VwaitVarProc, &done) != TCL_OK) {
+	return TCL_ERROR;
+    };
+    done = 0;
+    foundEvent = 1;
+    while (!done && foundEvent) {
+	foundEvent = Tcl_DoOneEvent(TCL_ALL_EVENTS);
+	if (Tcl_Canceled(interp, TCL_LEAVE_ERR_MSG) == TCL_ERROR) {
+	    break;
+	}
+	if (Tcl_LimitExceeded(interp)) {
+	    Tcl_ResetResult(interp);
+	    Tcl_SetObjResult(interp, Tcl_NewStringObj("limit exceeded", -1));
+	    break;
+	}
+    }
+    Tcl_UntraceVar2(interp, nameString, NULL,
+	    TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+	    VwaitVarProc, &done);
+
+    if (!foundEvent) {
+	Tcl_ResetResult(interp);
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		"can't wait for variable \"%s\": would wait forever",
+		nameString));
+	Tcl_SetErrorCode(interp, "TCL", "EVENT", "NO_SOURCES", NULL);
+	return TCL_ERROR;
+    }
+    if (!done) {
+	/*
+	 * The interpreter's result was already set to the right error message
+	 * prior to exiting the loop above.
+	 */
+
+	return TCL_ERROR;
+    }
+
+    /*
+     * Clear out the interpreter's result, since it may have been set by event
+     * handlers.
+     */
+
+    Tcl_ResetResult(interp);
+    return TCL_OK;
+}
+
+	/* ARGSUSED */
+static char *
+VwaitVarProc(
+    ClientData clientData,	/* Pointer to integer to set to 1. */
+    Tcl_Interp *interp,		/* Interpreter containing variable. */
+    const char *name1,		/* Name of variable. */
+    const char *name2,		/* Second part of variable name. */
+    int flags)			/* Information about what happened. */
+{
+    int *donePtr = clientData;
+
+    *donePtr = 1;
+    Tcl_UntraceVar(interp, name1, TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+	    VwaitVarProc, clientData);
+    return NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_UpdateObjCmd --
+ *
+ *	This function is invoked to process the "update" Tcl command. See the
+ *	user documentation for details on what it does.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+int
+Tcl_UpdateObjCmd(
+    ClientData clientData,	/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
+{
+    int optionIndex;
+    int flags = 0;		/* Initialized to avoid compiler warning. */
+    static const char *const updateOptions[] = {"idletasks", NULL};
+    enum updateOptions {OPT_IDLETASKS};
+
+    if (objc == 1) {
+	flags = TCL_ALL_EVENTS|TCL_DONT_WAIT;
+    } else if (objc == 2) {
+	if (Tcl_GetIndexFromObj(interp, objv[1], updateOptions,
+		"option", 0, &optionIndex) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+	switch ((enum updateOptions) optionIndex) {
+	case OPT_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?");
+	return TCL_ERROR;
+    }
+
+    while (Tcl_DoOneEvent(flags) != 0) {
+	if (Tcl_Canceled(interp, TCL_LEAVE_ERR_MSG) == TCL_ERROR) {
+	    return TCL_ERROR;
+	}
+	if (Tcl_LimitExceeded(interp)) {
+	    Tcl_ResetResult(interp);
+	    Tcl_SetObjResult(interp, Tcl_NewStringObj("limit exceeded", -1));
+	    return TCL_ERROR;
+	}
+    }
+
+    /*
+     * Must clear the interpreter's result because event handlers could have
+     * executed commands.
+     */
+
+    Tcl_ResetResult(interp);
+    return TCL_OK;
+}
+
+#ifdef TCL_THREADS
+/*
+ *----------------------------------------------------------------------
+ *
+ * NewThreadProc --
+ *
+ *	Bootstrap function of a new Tcl thread.
+ *
+ * Results:
+ *	None.
+ *
+ * Side Effects:
+ *	Initializes Tcl notifier for the current thread.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Tcl_ThreadCreateType
+NewThreadProc(
+    ClientData clientData)
+{
+    ThreadClientData *cdPtr = clientData;
+    ClientData threadClientData;
+    Tcl_ThreadCreateProc *threadProc;
+
+    threadProc = cdPtr->proc;
+    threadClientData = cdPtr->clientData;
+    ckfree(clientData);		/* Allocated in Tcl_CreateThread() */
+
+    threadProc(threadClientData);
+
+    TCL_THREAD_CREATE_RETURN;
+}
+#endif
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_CreateThread --
+ *
+ *	This function 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.
+ *
+ * Side effects:
+ *	A new thread is created.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_CreateThread(
+    Tcl_ThreadId *idPtr,	/* Return, the ID of the thread */
+    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. */
+{
+#ifdef TCL_THREADS
+    ThreadClientData *cdPtr = ckalloc(sizeof(ThreadClientData));
+    int result;
+
+    cdPtr->proc = proc;
+    cdPtr->clientData = clientData;
+    result = TclpThreadCreate(idPtr, NewThreadProc, cdPtr, stackSize, flags);
+    if (result != TCL_OK) {
+	ckfree(cdPtr);
+    }
+    return result;
+#else
+    return TCL_ERROR;
+#endif /* TCL_THREADS */
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */