merged tcl 8.1 branch back into the main trunk

1 files changed, 543 insertions, 112 deletions

diff --git a/generic/tclEvent.c b/generic/tclEvent.c
index 162af15..7499577 100644
--- a/generic/tclEvent.c
+++ b/generic/tclEvent.c
@@ -6,12 +6,12 @@
  *	command procedures. 
  *
  * Copyright (c) 1990-1994 The Regents of the University of California.
- * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ * Copyright (c) 1994-1998 Sun Microsystems, Inc.
  *
  * 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.3 1998/09/14 18:39:58 stanton Exp $
+ * RCS: @(#) $Id: tclEvent.c,v 1.4 1999/04/16 00:46:46 stanton Exp $
  */
 
 #include "tclInt.h"
@@ -28,8 +28,9 @@ typedef struct BgError {
     Tcl_Interp *interp;		/* Interpreter in which error occurred.  NULL
 				 * means this error report has been cancelled
 				 * (a previous report generated a break). */
-    char *errorMsg;		/* The error message (interp->result when
-				 * the error occurred).  Malloc-ed. */
+    char *errorMsg;		/* Copy of the error message (the interp's
+				 * result when the error occurred).
+				 * Malloc-ed. */
     char *errorInfo;		/* Value of the errorInfo variable
 				 * (malloc-ed). */
     char *errorCode;		/* Value of the errorCode variable
@@ -66,27 +67,38 @@ typedef struct ExitHandler {
 				 * this application, or NULL for end of list. */
 } ExitHandler;
 
-static ExitHandler *firstExitPtr = NULL;
-				/* First in list of all exit handlers for
-				 * application. */
-
 /*
- * The following variable is a "secret" indication to Tcl_Exit that
- * it should dump out the state of memory before exiting.  If the
- * value is non-NULL, it gives the name of the file in which to
- * dump memory usage information.
+ * 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.
  */
 
-char *tclMemDumpFileName = NULL;
+static ExitHandler *firstExitPtr = NULL;
+				/* First in list of all exit handlers for
+				 * application. */
+TCL_DECLARE_MUTEX(exitMutex)
 
 /*
- * This variable is set to 1 when Tcl_Exit is called, and at the end of
+ * 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.
  */
 
-static int tclInExit = 0;
+static int inFinalize = 0;
+static int subsystemsInitialized = 0;
+static int encodingsInitialized  = 0;
+
+static Tcl_Obj *tclLibraryPath = 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;
 
 /*
  * Prototypes for procedures referenced only in this file:
@@ -127,6 +139,7 @@ Tcl_BackgroundError(interp)
     BgError *errPtr;
     char *errResult, *varValue;
     ErrAssocData *assocPtr;
+    int length;
 
     /*
      * The Tcl_AddErrorInfo call below (with an empty string) ensures that
@@ -138,12 +151,12 @@ Tcl_BackgroundError(interp)
 
     Tcl_AddErrorInfo(interp, "");
 
-    errResult = TclGetStringFromObj(Tcl_GetObjResult(interp), (int *) NULL);
+    errResult = Tcl_GetStringFromObj(Tcl_GetObjResult(interp), &length);
 	
     errPtr = (BgError *) ckalloc(sizeof(BgError));
     errPtr->interp = interp;
-    errPtr->errorMsg = (char *) ckalloc((unsigned) (strlen(errResult) + 1));
-    strcpy(errPtr->errorMsg, errResult);
+    errPtr->errorMsg = (char *) ckalloc((unsigned) (length + 1));
+    memcpy(errPtr->errorMsg, errResult, (size_t) (length + 1));
     varValue = Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY);
     if (varValue == NULL) {
 	varValue = errPtr->errorMsg;
@@ -206,7 +219,6 @@ HandleBgErrors(clientData)
     ClientData clientData;	/* Pointer to ErrAssocData structure. */
 {
     Tcl_Interp *interp;
-    char *command;
     char *argv[2];
     int code;
     BgError *errPtr;
@@ -237,11 +249,10 @@ HandleBgErrors(clientData)
 
 	argv[0] = "bgerror";
 	argv[1] = assocPtr->firstBgPtr->errorMsg;
-	command = Tcl_Merge(2, argv);
+	
 	Tcl_AllowExceptions(interp);
         Tcl_Preserve((ClientData) interp);
-	code = Tcl_GlobalEval(interp, command);
-	ckfree(command);
+	code = TclGlobalInvoke(interp, 2, argv, 0);
 	if (code == TCL_ERROR) {
 
             /*
@@ -256,29 +267,11 @@ HandleBgErrors(clientData)
              */
 
             if (Tcl_IsSafe(interp)) {
-                Tcl_HashTable *hTblPtr;
-                Tcl_HashEntry *hPtr;
-
-                hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp,
-                        "tclHiddenCmds", NULL);
-                if (hTblPtr == (Tcl_HashTable *) NULL) {
-                    goto doneWithInterp;
-                }
-                hPtr = Tcl_FindHashEntry(hTblPtr, "bgerror");
-                if (hPtr == (Tcl_HashEntry *) NULL) {
-                    goto doneWithInterp;
-                }
-
-                /*
-                 * OK, the hidden command "bgerror" exists, invoke it.
-                 */
-
-                argv[0] = "bgerror";
-                argv[1] = ckalloc((unsigned)
-                        strlen(assocPtr->firstBgPtr->errorMsg));
-                strcpy(argv[1], assocPtr->firstBgPtr->errorMsg);
-                (void) TclInvoke(interp, 2, argv, TCL_INVOKE_HIDDEN);
-                ckfree(argv[1]);
+		Tcl_SavedResult save;
+		
+		Tcl_SaveResult(interp, &save);
+                TclGlobalInvoke(interp, 2, argv, TCL_INVOKE_HIDDEN);
+		Tcl_RestoreResult(interp, &save);
 
                 goto doneWithInterp;
             } 
@@ -290,22 +283,24 @@ HandleBgErrors(clientData)
             
             errChannel = Tcl_GetStdChannel(TCL_STDERR);
             if (errChannel != (Tcl_Channel) NULL) {
-                if (strcmp(interp->result,
-           "\"bgerror\" is an invalid command name or ambiguous abbreviation")
-                        == 0) {
-                    Tcl_Write(errChannel, assocPtr->firstBgPtr->errorInfo, -1);
-                    Tcl_Write(errChannel, "\n", -1);
+		char *string;
+		int len;
+
+		string = Tcl_GetStringFromObj(Tcl_GetObjResult(interp), &len);
+                if (strcmp(string, "\"bgerror\" is an invalid command name or ambiguous abbreviation") == 0) {
+                    Tcl_WriteChars(errChannel, assocPtr->firstBgPtr->errorInfo, -1);
+                    Tcl_WriteChars(errChannel, "\n", -1);
                 } else {
-                    Tcl_Write(errChannel,
+                    Tcl_WriteChars(errChannel,
                             "bgerror failed to handle background error.\n",
                             -1);
-                    Tcl_Write(errChannel, "    Original error: ", -1);
-                    Tcl_Write(errChannel, assocPtr->firstBgPtr->errorMsg,
+                    Tcl_WriteChars(errChannel, "    Original error: ", -1);
+                    Tcl_WriteChars(errChannel, assocPtr->firstBgPtr->errorMsg,
                             -1);
-                    Tcl_Write(errChannel, "\n", -1);
-                    Tcl_Write(errChannel, "    Error in bgerror: ", -1);
-                    Tcl_Write(errChannel, interp->result, -1);
-                    Tcl_Write(errChannel, "\n", -1);
+                    Tcl_WriteChars(errChannel, "\n", -1);
+                    Tcl_WriteChars(errChannel, "    Error in bgerror: ", -1);
+                    Tcl_WriteChars(errChannel, string, len);
+                    Tcl_WriteChars(errChannel, "\n", -1);
                 }
                 Tcl_Flush(errChannel);
             }
@@ -416,8 +411,10 @@ Tcl_CreateExitHandler(proc, clientData)
     exitPtr = (ExitHandler *) ckalloc(sizeof(ExitHandler));
     exitPtr->proc = proc;
     exitPtr->clientData = clientData;
+    Tcl_MutexLock(&exitMutex);
     exitPtr->nextPtr = firstExitPtr;
     firstExitPtr = exitPtr;
+    Tcl_MutexUnlock(&exitMutex);
 }
 
 /*
@@ -446,6 +443,7 @@ Tcl_DeleteExitHandler(proc, clientData)
 {
     ExitHandler *exitPtr, *prevPtr;
 
+    Tcl_MutexLock(&exitMutex);
     for (prevPtr = NULL, exitPtr = firstExitPtr; exitPtr != NULL;
 	    prevPtr = exitPtr, exitPtr = exitPtr->nextPtr) {
 	if ((exitPtr->proc == proc)
@@ -455,6 +453,82 @@ Tcl_DeleteExitHandler(proc, clientData)
 	    } else {
 		prevPtr->nextPtr = exitPtr->nextPtr;
 	    }
+	    Tcl_MutexUnlock(&exitMutex);
+	    ckfree((char *) exitPtr);
+	    return;
+	}
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_CreateThreadExitHandler --
+ *
+ *	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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_CreateThreadExitHandler(proc, clientData)
+    Tcl_ExitProc *proc;		/* Procedure to invoke. */
+    ClientData clientData;	/* Arbitrary value to pass to proc. */
+{
+    ExitHandler *exitPtr;
+    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+
+    exitPtr = (ExitHandler *) ckalloc(sizeof(ExitHandler));
+    exitPtr->proc = proc;
+    exitPtr->clientData = clientData;
+    exitPtr->nextPtr = tsdPtr->firstExitPtr;
+    tsdPtr->firstExitPtr = exitPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_DeleteThreadExitHandler --
+ *
+ *	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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_DeleteThreadExitHandler(proc, clientData)
+    Tcl_ExitProc *proc;		/* Procedure 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((char *) exitPtr);
 	    return;
 	}
@@ -484,12 +558,242 @@ Tcl_Exit(status)
 				 * 0 for normal return, 1 for error return. */
 {
     Tcl_Finalize();
-#ifdef TCL_MEM_DEBUG
-    if (tclMemDumpFileName != NULL) {
-	Tcl_DumpActiveMemory(tclMemDumpFileName);
+    TclpExit(status);
+}
+
+/*
+ *-------------------------------------------------------------------------
+ * 
+ * TclSetLibraryPath --
+ *
+ *	Set the path that will be used for searching for init.tcl and 
+ *	encodings when an interp is being created.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Changing the library path will affect what directories are
+ *	examined when looking for encodings for all interps from that
+ *	point forward.
+ *
+ *	The refcount of the new library path is incremented and the 
+ *	refcount of the old path is decremented.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+void
+TclSetLibraryPath(pathPtr)
+    Tcl_Obj *pathPtr;		/* A Tcl list object whose elements are
+				 * the new library path. */
+{
+    Tcl_MutexLock(&exitMutex);
+    if (pathPtr != NULL) {
+	Tcl_IncrRefCount(pathPtr);
+    }
+    if (tclLibraryPath != NULL) {
+	Tcl_DecrRefCount(tclLibraryPath);
+    }
+    tclLibraryPath = pathPtr;
+    Tcl_MutexUnlock(&exitMutex);
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * TclGetLibraryPath --
+ *
+ *	Return a Tcl list object whose elements are the library path.
+ *	The caller should not modify the contents of the returned object.
+ *
+ * Results:
+ *	As above.
+ *
+ * Side effects:
+ *	None.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+TclGetLibraryPath()
+{
+    return tclLibraryPath;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * 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(argv0)
+    CONST char *argv0;		/* Name of executable from argv[0] to main()
+				 * in native multi-byte encoding. */
+{
+    ThreadSpecificData *tsdPtr;
+
+    if (inFinalize != 0) {
+	panic("TclInitSubsystems called while finalizing");
     }
+
+    /*
+     * Grab the thread local storage pointer before doing anything because
+     * the initialization routines will be registering exit handlers.
+     * We use this pointer to detect if this is the first time this
+     * thread has created an interpreter.
+     */
+
+    tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey);
+    if (subsystemsInitialized == 0) {
+	/* 
+	 * 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.
+	     */
+
+	    subsystemsInitialized = 1;
+
+	    tclExecutableName = NULL;
+
+	    /*
+	     * Initialize locks used by the memory allocators before anything
+	     * interesting happens so we can use the allocators in the
+	     * implementation of self-initializing locks.
+	     */
+#if USE_TCLALLOC
+	    TclInitAlloc();
+#endif
+#ifdef TCL_MEM_DEBUG
+	    TclInitDbCkalloc();
 #endif
-    TclPlatformExit(status);
+
+	    TclpInitPlatform();
+    	    TclInitObjSubsystem();
+	    TclInitIOSubsystem();
+	    TclInitEncodingSubsystem();
+    	    TclInitNamespaceSubsystem();
+	}
+	TclpInitUnlock();
+    }
+
+    if (tsdPtr == NULL) {
+	/*
+	 * First time this thread has created an interpreter.
+	 * We fetch the key again just in case no exit handlers were
+	 * registered by this point.
+	 */
+
+	(void) TCL_TSD_INIT(&dataKey);
+	TclInitNotifier();
+     }
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * TclFindEncodings --
+ *
+ *	Find and load the encoding file for this operating system.
+ *	Before this is called, Tcl makes assumptions about the
+ *	native string representation, but the true encoding is not
+ *	assured.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Varied, see the respective initialization routines.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+void
+TclFindEncodings(argv0)
+    CONST char *argv0;		/* Name of executable from argv[0] to main()
+				 * in native multi-byte encoding. */
+{
+    char *native;
+    Tcl_Obj *pathPtr;
+    Tcl_DString libPath, buffer;
+
+    if (encodingsInitialized == 0) {
+	/* 
+	 * Double check inside the mutex.  There may be calls
+	 * back into this routine from some of the procedures below.
+	 */
+
+	TclpInitLock();
+	if (encodingsInitialized == 0) {
+	    /*
+	     * Have to set this bit here to avoid deadlock with the
+	     * routines below us that call into TclInitSubsystems.
+	     */
+
+	    encodingsInitialized = 1;
+
+	    native = TclpFindExecutable(argv0);
+	    TclpInitLibraryPath(native);
+
+	    /*
+	     * The library path was set in the TclpInitLibraryPath routine.
+	     * The string set is a dirty UTF string.  To preserve the value
+	     * convert the UTF string back to native before setting the new
+	     * default encoding.
+	     */
+	    
+	    pathPtr = TclGetLibraryPath();
+	    if (pathPtr != NULL) {
+		Tcl_UtfToExternalDString(NULL, Tcl_GetString(pathPtr), -1,
+			&libPath);
+	    }
+
+	    TclpSetInitialEncodings();
+
+	    /*
+	     * Now convert the native sting back to native string back to UTF.
+	     */
+	     
+	    if (pathPtr != NULL) {
+		Tcl_ExternalToUtfDString(NULL, Tcl_DStringValue(&libPath), -1,
+			&buffer);
+		pathPtr = Tcl_NewStringObj(Tcl_DStringValue(&buffer), -1);
+		TclSetLibraryPath(pathPtr);
+
+		Tcl_DStringFree(&libPath);
+		Tcl_DStringFree(&buffer);
+	    }
+	}
+	TclpInitUnlock();
+    }
 }
 
 /*
@@ -497,16 +801,16 @@ Tcl_Exit(status)
  *
  * Tcl_Finalize --
  *
- *	Runs the exit handlers to allow Tcl to clean up its state prior
- *	to being unloaded. Called by Tcl_Exit and when Tcl was dynamically
- *	loaded and is now 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.
  *
  * Side effects:
- *	Whatever the exit handlers do. Also frees up storage associated
- *	with the Tcl object type table.
+ *	Varied, see the respective finalization routines.
  *
  *----------------------------------------------------------------------
  */
@@ -515,34 +819,150 @@ void
 Tcl_Finalize()
 {
     ExitHandler *exitPtr;
+
+    TclpInitLock();
+    if (subsystemsInitialized != 0) {
+	subsystemsInitialized = 0;
+	encodingsInitialized  = 0;
+
+	/*
+	 * Invoke exit handlers first.
+	 */
+
+	Tcl_MutexLock(&exitMutex);
+	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.
+	     */
+
+	    firstExitPtr = exitPtr->nextPtr;
+	    Tcl_MutexUnlock(&exitMutex);
+	    (*exitPtr->proc)(exitPtr->clientData);
+	    ckfree((char *) exitPtr);
+	    Tcl_MutexLock(&exitMutex);
+	}    
+	firstExitPtr = NULL;
+	Tcl_MutexUnlock(&exitMutex);
+
+	/*
+	 * 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.
+	 */
     
-    /*
-     * Invoke exit handler first.
-     */
+	Tcl_FinalizeThread();
+
+	/*
+	 * Now finalize the Tcl execution environment.  Note that this
+	 * must be done after the exit handlers, because there are
+	 * order dependencies.
+	 */
+
+	TclFinalizeCompExecEnv();
+	TclFinalizeEnvironment();
+
+	TclFinalizeEncodingSubsystem();
+
+	if (tclLibraryPath != NULL) {
+	    Tcl_DecrRefCount(tclLibraryPath);
+	    tclLibraryPath = NULL;
+	}
+	if (tclExecutableName != NULL) {
+	    ckfree(tclExecutableName);
+	    tclExecutableName = NULL;
+	}
+	if (tclNativeExecutableName != NULL) {
+	    ckfree(tclNativeExecutableName);
+	    tclNativeExecutableName = NULL;
+	}
+	if (tclDefaultEncodingDir != NULL) {
+	    ckfree(tclDefaultEncodingDir);
+	    tclDefaultEncodingDir = NULL;
+	}
+	
+	Tcl_SetPanicProc(NULL);
+
+	/*
+	 * 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.
+	 */
+
+	TclFinalizeLoad();
 
-    tclInExit = 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.
+	 * There shouldn't be any malloc'ed memory after this.
 	 */
 
-	firstExitPtr = exitPtr->nextPtr;
-	(*exitPtr->proc)(exitPtr->clientData);
-	ckfree((char *) exitPtr);
+	TclFinalizeMemorySubsystem();
+	inFinalize = 0;
     }
+    TclpInitUnlock();
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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.
+ *
+ *----------------------------------------------------------------------
+ */
 
-    /*
-     * Now finalize the Tcl execution environment.  Note that this must be done
-     * after the exit handlers, because there are order dependencies.
-     */
-    
-    TclFinalizeCompExecEnv();
-    TclFinalizeEnvironment();
-    TclpFinalize();
-    firstExitPtr = NULL;
-    tclInExit = 0;
+void
+Tcl_FinalizeThread()
+{
+    ExitHandler *exitPtr;
+    ThreadSpecificData *tsdPtr =
+	    (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey);
+
+    if (tsdPtr != NULL) {
+	/*
+	 * Invoke thread exit handlers first.
+	 */
+
+	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((char *) exitPtr);
+	}
+	TclFinalizeIOSubsystem();
+	TclFinalizeNotifier();
+
+	/*
+	 * Blow away all thread local storage blocks.
+	 */
+
+	TclFinalizeThreadData();
+    }
 }
 
 /*
@@ -564,13 +984,14 @@ Tcl_Finalize()
 int
 TclInExit()
 {
-    return tclInExit;
+    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+    return tsdPtr->inExit;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_VwaitCmd --
+ * Tcl_VwaitObjCmd --
  *
  *	This procedure is invoked to process the "vwait" Tcl command.
  *	See the user documentation for details on what it does.
@@ -586,20 +1007,21 @@ TclInExit()
 
 	/* ARGSUSED */
 int
-Tcl_VwaitCmd(clientData, interp, argc, argv)
+Tcl_VwaitObjCmd(clientData, interp, objc, objv)
     ClientData clientData;	/* Not used. */
     Tcl_Interp *interp;		/* Current interpreter. */
-    int argc;			/* Number of arguments. */
-    char **argv;		/* Argument strings. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
 {
     int done, foundEvent;
+    char *nameString;
 
-    if (argc != 2) {
-	Tcl_AppendResult(interp, "wrong # args: should be \"",
-		argv[0], " name\"", (char *) NULL);
+    if (objc != 2) {
+        Tcl_WrongNumArgs(interp, 1, objv, "name");
 	return TCL_ERROR;
     }
-    if (Tcl_TraceVar(interp, argv[1],
+    nameString = Tcl_GetString(objv[1]);
+    if (Tcl_TraceVar(interp, nameString,
 	    TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
 	    VwaitVarProc, (ClientData) &done) != TCL_OK) {
 	return TCL_ERROR;
@@ -609,7 +1031,7 @@ Tcl_VwaitCmd(clientData, interp, argc, argv)
     while (!done && foundEvent) {
 	foundEvent = Tcl_DoOneEvent(TCL_ALL_EVENTS);
     }
-    Tcl_UntraceVar(interp, argv[1],
+    Tcl_UntraceVar(interp, nameString,
 	    TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
 	    VwaitVarProc, (ClientData) &done);
 
@@ -620,7 +1042,7 @@ Tcl_VwaitCmd(clientData, interp, argc, argv)
 
     Tcl_ResetResult(interp);
     if (!foundEvent) {
-	Tcl_AppendResult(interp, "can't wait for variable \"", argv[1],
+	Tcl_AppendResult(interp, "can't wait for variable \"", nameString,
 		"\":  would wait forever", (char *) NULL);
 	return TCL_ERROR;
     }
@@ -645,7 +1067,7 @@ VwaitVarProc(clientData, interp, name1, name2, flags)
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_UpdateCmd --
+ * Tcl_UpdateObjCmd --
  *
  *	This procedure is invoked to process the "update" Tcl command.
  *	See the user documentation for details on what it does.
@@ -661,29 +1083,38 @@ VwaitVarProc(clientData, interp, name1, name2, flags)
 
 	/* ARGSUSED */
 int
-Tcl_UpdateCmd(clientData, interp, argc, argv)
+Tcl_UpdateObjCmd(clientData, interp, objc, objv)
     ClientData clientData;	/* Not used. */
     Tcl_Interp *interp;		/* Current interpreter. */
-    int argc;			/* Number of arguments. */
-    char **argv;		/* Argument strings. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
 {
-    int flags;
+    int optionIndex;
+    int flags = 0;		/* Initialized to avoid compiler warning. */
+    static char *updateOptions[] = {"idletasks", (char *) NULL};
+    enum updateOptions {REGEXP_IDLETASKS};
 
-    if (argc == 1) {
+    if (objc == 1) {
 	flags = TCL_ALL_EVENTS|TCL_DONT_WAIT;
-    } else if (argc == 2) {
-	if (strncmp(argv[1], "idletasks", strlen(argv[1])) != 0) {
-	    Tcl_AppendResult(interp, "bad option \"", argv[1],
-		    "\": must be idletasks", (char *) NULL);
+    } else if (objc == 2) {
+	if (Tcl_GetIndexFromObj(interp, objv[1], updateOptions,
+		"option", 0, &optionIndex) != TCL_OK) {
 	    return TCL_ERROR;
 	}
-	flags = TCL_WINDOW_EVENTS|TCL_IDLE_EVENTS|TCL_DONT_WAIT;
+	switch ((enum updateOptions) optionIndex) {
+	    case REGEXP_IDLETASKS: {
+		flags = TCL_WINDOW_EVENTS|TCL_IDLE_EVENTS|TCL_DONT_WAIT;
+		break;
+	    }
+	    default: {
+		panic("Tcl_UpdateObjCmd: bad option index to UpdateOptions");
+	    }
+	}
     } else {
-	Tcl_AppendResult(interp, "wrong # args: should be \"",
-		argv[0], " ?idletasks?\"", (char *) NULL);
+        Tcl_WrongNumArgs(interp, 1, objv, "?idletasks?");
 	return TCL_ERROR;
     }
-
+    
     while (Tcl_DoOneEvent(flags) != 0) {
 	/* Empty loop body */
     }