/* 

  * tclEvent.c --

  *

  *	This file implements some general event related interfaces including

  *	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.

  * Portions Copyright (c) 2007-2008 Nokia Corporation and/or its subsidiaries. All rights reserved.  

  * 

  * See the file "license.terms" for information on usage and redistribution

  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.

  *

  * RCS: @(#) $Id: tclEvent.c,v 1.28.2.15 2007/03/19 17:06:25 dgp Exp $

  */

 #include "tclInt.h"

 #include "tclPort.h"

 #if defined(__SYMBIAN32__) && defined(__WINSCW__)

 #include "tclSymbianGlobals.h"

 #define dataKey getdataKey(0)

 #endif 

 /*

  * 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 bgerror can be invoked

  * later as an idle handler.

  */

 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;		/* 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

 				 * (malloc-ed). */

     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 {

     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_CreateExitHandler

  * there is a structure of the following type:

  */

 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. */

 } 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. */

 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.

  */

 #if !defined(__SYMBIAN32__) || !defined(__WINSCW__)

 static int inFinalize = 0;

 static int subsystemsInitialized = 0;

 #endif

 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. */

     Tcl_Obj *tclLibraryPath;	/* Path(s) to the Tcl library */

 } ThreadSpecificData;

 #if !defined(__SYMBIAN32__) || !defined(__WINSCW__)

 static Tcl_ThreadDataKey dataKey;

 /*

  * Common string for the library path for sharing across threads.

  * This is ckalloc'd and cleared in Tcl_Finalize.

  */

 static char *tclLibraryPathStr = NULL;

 #endif

 #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 _ANSI_ARGS_((

            ClientData clientData));

 #endif

 /*

  * Prototypes for procedures referenced only in this file:

  */

 static void		BgErrorDeleteProc _ANSI_ARGS_((ClientData clientData,

 			    Tcl_Interp *interp));

 static void		HandleBgErrors _ANSI_ARGS_((ClientData clientData));

 static char *		VwaitVarProc _ANSI_ARGS_((ClientData clientData,

 			    Tcl_Interp *interp, CONST char *name1, 

 			    CONST char *name2, int flags));

 /*

  *----------------------------------------------------------------------

  *

  * 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).

  *

  * Results:

  *	None.

  *

  * Side effects:

  *	The command "bgerror" is invoked later as an idle handler to

  *	process the error, passing it the error message.  If that fails,

  *	then an error message is output on stderr.

  *

  *----------------------------------------------------------------------

  */

 EXPORT_C void

 Tcl_BackgroundError(interp)

     Tcl_Interp *interp;		/* Interpreter in which an error has

 				 * occurred. */

 {

     BgError *errPtr;

     CONST char *errResult, *varValue;

     ErrAssocData *assocPtr;

     int length;

     /*

      * The Tcl_AddErrorInfo call below (with an empty string) ensures that

      * errorInfo gets properly set.  It's needed in cases where the error

      * came from a utility procedure like Tcl_GetVar instead of Tcl_Eval;

      * in these cases errorInfo still won't have been set when this

      * procedure is called.

      */

     Tcl_AddErrorInfo(interp, "");

     errResult = Tcl_GetStringFromObj(Tcl_GetObjResult(interp), &length);

     errPtr = (BgError *) ckalloc(sizeof(BgError));

     errPtr->interp = interp;

     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;

     }

     errPtr->errorInfo = (char *) ckalloc((unsigned) (strlen(varValue) + 1));

     strcpy(errPtr->errorInfo, varValue);

     varValue = Tcl_GetVar(interp, "errorCode", TCL_GLOBAL_ONLY);

     if (varValue == NULL) {

 	varValue = "";

     }

     errPtr->errorCode = (char *) ckalloc((unsigned) (strlen(varValue) + 1));

     strcpy(errPtr->errorCode, varValue);

     errPtr->nextPtr = NULL;

     assocPtr = (ErrAssocData *) Tcl_GetAssocData(interp, "tclBgError",

 	    (Tcl_InterpDeleteProc **) NULL);

     if (assocPtr == NULL) {

 	/*

 	 * This is the first time a background error has occurred in

 	 * this interpreter.  Create associated data to keep track of

 	 * pending error reports.

 	 */

 	assocPtr = (ErrAssocData *) ckalloc(sizeof(ErrAssocData));

 	assocPtr->firstBgPtr = NULL;

 	assocPtr->lastBgPtr = NULL;

 	Tcl_SetAssocData(interp, "tclBgError", BgErrorDeleteProc,

 		(ClientData) assocPtr);

     }

     if (assocPtr->firstBgPtr == NULL) {

 	assocPtr->firstBgPtr = errPtr;

 	Tcl_DoWhenIdle(HandleBgErrors, (ClientData) assocPtr);

     } else {

 	assocPtr->lastBgPtr->nextPtr = errPtr;

     }

     assocPtr->lastBgPtr = errPtr;

     Tcl_ResetResult(interp);

 }

 /*

  *----------------------------------------------------------------------

  *

  * HandleBgErrors --

  *

  *	This procedure is invoked as an idle handler to process all of

  *	the accumulated background errors.

  *

  * Results:

  *	None.

  *

  * Side effects:

  *	Depends on what actions "bgerror" takes for the errors.

  *

  *----------------------------------------------------------------------

  */

 static void

 HandleBgErrors(clientData)

     ClientData clientData;	/* Pointer to ErrAssocData structure. */

 {

     Tcl_Interp *interp;

     CONST char *argv[2];

     int code;

     BgError *errPtr;

     ErrAssocData *assocPtr = (ErrAssocData *) clientData;

     Tcl_Channel errChannel;

     Tcl_Preserve((ClientData) assocPtr);

     while (assocPtr->firstBgPtr != NULL) {

 	interp = assocPtr->firstBgPtr->interp;

 	if (interp == NULL) {

 	    goto doneWithInterp;

 	}

 	/*

 	 * Restore important state variables to what they were at

 	 * the time the error occurred.

 	 */

 	Tcl_SetVar(interp, "errorInfo", assocPtr->firstBgPtr->errorInfo,

 		TCL_GLOBAL_ONLY);

 	Tcl_SetVar(interp, "errorCode", assocPtr->firstBgPtr->errorCode,

 		TCL_GLOBAL_ONLY);

 	/*

 	 * Create and invoke the bgerror command.

 	 */

 	argv[0] = "bgerror";

 	argv[1] = assocPtr->firstBgPtr->errorMsg;

 	Tcl_AllowExceptions(interp);

         Tcl_Preserve((ClientData) interp);

 	code = TclGlobalInvoke(interp, 2, argv, 0);

 	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_SavedResult save;

 		Tcl_SaveResult(interp, &save);

                 TclGlobalInvoke(interp, 2, argv, TCL_INVOKE_HIDDEN);

 		Tcl_RestoreResult(interp, &save);

                 goto doneWithInterp;

             } 

             /*

              * We have to get the error output channel at the latest possible

              * time, because the eval (above) might have changed the channel.

              */

             errChannel = Tcl_GetStdChannel(TCL_STDERR);

             if (errChannel != (Tcl_Channel) NULL) {

 		char *string;

 		int len;

 		string = Tcl_GetStringFromObj(Tcl_GetObjResult(interp), &len);

 		if (Tcl_FindCommand(interp, "bgerror", NULL, TCL_GLOBAL_ONLY) == NULL) {

                     Tcl_WriteChars(errChannel, assocPtr->firstBgPtr->errorInfo, -1);

                     Tcl_WriteChars(errChannel, "\n", -1);

                 } else {

                     Tcl_WriteChars(errChannel,

                             "bgerror failed to handle background error.\n",

                             -1);

                     Tcl_WriteChars(errChannel, "    Original error: ", -1);

                     Tcl_WriteChars(errChannel, assocPtr->firstBgPtr->errorMsg,

                             -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);

             }

 	} else if (code == TCL_BREAK) {

 	    /*

 	     * Break means cancel any remaining error reports for this

 	     * interpreter.

 	     */

 	    for (errPtr = assocPtr->firstBgPtr; errPtr != NULL;

 		    errPtr = errPtr->nextPtr) {

 		if (errPtr->interp == interp) {

 		    errPtr->interp = NULL;

 		}

 	    }

 	}

 	/*

 	 * Discard the command and the information about the error report.

 	 */

 doneWithInterp:

 	if (assocPtr->firstBgPtr) {

 	    ckfree(assocPtr->firstBgPtr->errorMsg);

 	    ckfree(assocPtr->firstBgPtr->errorInfo);

 	    ckfree(assocPtr->firstBgPtr->errorCode);

 	    errPtr = assocPtr->firstBgPtr->nextPtr;

 	    ckfree((char *) assocPtr->firstBgPtr);

 	    assocPtr->firstBgPtr = errPtr;

 	}

         if (interp != NULL) {

             Tcl_Release((ClientData) interp);

         }

     }

     assocPtr->lastBgPtr = NULL;

     Tcl_Release((ClientData) assocPtr);

 }

 /*

  *----------------------------------------------------------------------

  *

  * 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.

  *

  * Results:

  *	None.

  *

  * Side effects:

  *	Background error information is freed: if there were any

  *	pending error reports, they are cancelled.

  *

  *----------------------------------------------------------------------

  */

 static void

 BgErrorDeleteProc(clientData, interp)

     ClientData clientData;	/* Pointer to ErrAssocData structure. */

     Tcl_Interp *interp;		/* Interpreter being deleted. */

 {

     ErrAssocData *assocPtr = (ErrAssocData *) clientData;

     BgError *errPtr;

     while (assocPtr->firstBgPtr != NULL) {

 	errPtr = assocPtr->firstBgPtr;

 	assocPtr->firstBgPtr = errPtr->nextPtr;

 	ckfree(errPtr->errorMsg);

 	ckfree(errPtr->errorInfo);

 	ckfree(errPtr->errorCode);

 	ckfree((char *) errPtr);

     }

     Tcl_CancelIdleCall(HandleBgErrors, (ClientData) assocPtr);

     Tcl_EventuallyFree((ClientData) assocPtr, TCL_DYNAMIC);

 }

 /*

  *----------------------------------------------------------------------

  *

  * Tcl_CreateExitHandler --

  *

  *	Arrange for a given procedure to be invoked just before the

  *	application exits.

  *

  * Results:

  *	None.

  *

  * Side effects:

  *	Proc will be invoked with clientData as argument when the

  *	application exits.

  *

  *----------------------------------------------------------------------

  */

 EXPORT_C void

 Tcl_CreateExitHandler(proc, clientData)

     Tcl_ExitProc *proc;		/* Procedure to invoke. */

     ClientData clientData;	/* Arbitrary value to pass to proc. */

 {

     ExitHandler *exitPtr;

     exitPtr = (ExitHandler *) ckalloc(sizeof(ExitHandler));

     exitPtr->proc = proc;

     exitPtr->clientData = clientData;

     Tcl_MutexLock(&exitMutex);

     exitPtr->nextPtr = firstExitPtr;

     firstExitPtr = exitPtr;

     Tcl_MutexUnlock(&exitMutex);

 }

 /*

  *----------------------------------------------------------------------

  *

  * Tcl_DeleteExitHandler --

  *

  *	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.

  *

  *----------------------------------------------------------------------

  */

 EXPORT_C void

 Tcl_DeleteExitHandler(proc, clientData)

     Tcl_ExitProc *proc;		/* Procedure 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((char *) exitPtr);

 	    break;

 	}

     }

     Tcl_MutexUnlock(&exitMutex);

     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.

  *

  *----------------------------------------------------------------------

  */

 EXPORT_C 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.

  *

  *----------------------------------------------------------------------

  */

 EXPORT_C 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;

 	}

     }

 }

 /*

  *----------------------------------------------------------------------

  *

  * Tcl_Exit --

  *

  *	This procedure is called to terminate the application.

  *

  * Results:

  *	None.

  *

  * Side effects:

  *	All existing exit handlers are invoked, then the application

  *	ends.

  *

  *----------------------------------------------------------------------

  */

 EXPORT_C void

 Tcl_Exit(status)

     int status;			/* Exit status for application;  typically

 				 * 0 for normal return, 1 for error return. */

 {

     Tcl_Finalize();

     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. */

 {

     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

     const char *toDupe;

     int size;

     if (pathPtr != NULL) {

 	Tcl_IncrRefCount(pathPtr);

     }

     if (tsdPtr->tclLibraryPath != NULL) {

 	Tcl_DecrRefCount(tsdPtr->tclLibraryPath);

     }

     tsdPtr->tclLibraryPath = pathPtr;

     /*

      *  No mutex locking is needed here as up the stack we're within

      *  TclpInitLock().

      */

     if (tclLibraryPathStr != NULL) {

 	ckfree(tclLibraryPathStr);

     }

     toDupe = Tcl_GetStringFromObj(pathPtr, &size);

     tclLibraryPathStr = ckalloc((unsigned)size+1);

     memcpy(tclLibraryPathStr, toDupe, (unsigned)size+1);

 }

 /*

  *-------------------------------------------------------------------------

  *

  * 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()

 {

     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

     if (tsdPtr->tclLibraryPath == NULL) {

 	/*

 	 * Grab the shared string and place it into a new thread specific

 	 * Tcl_Obj.

 	 */

 	tsdPtr->tclLibraryPath = Tcl_NewStringObj(tclLibraryPathStr, -1);

 	/* take ownership */

 	Tcl_IncrRefCount(tsdPtr->tclLibraryPath);

     }

     return tsdPtr->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(); /* process wide mutex init */

 #endif

 #ifdef TCL_MEM_DEBUG

 	    TclInitDbCkalloc(); /* process wide mutex init */

 #endif

 	    TclpInitPlatform(); /* creates signal handler(s) */

 	    TclInitObjSubsystem(); /* register obj types, create mutexes */

 	    TclInitIOSubsystem(); /* inits a tsd key (noop) */

 	    TclInitEncodingSubsystem(); /* process wide encoding init */

 	    TclInitNamespaceSubsystem(); /* register ns obj type (mutexed) */

 	}

 	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();

      }

 }

 /*

  *----------------------------------------------------------------------

  *

  * 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.

  *

  * Results:

  *	None.

  *

  * Side effects:

  *	Varied, see the respective finalization routines.

  *

  *----------------------------------------------------------------------

  */

 EXPORT_C void

 Tcl_Finalize()

 {

     ExitHandler *exitPtr;

     /*

      * 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);

     TclpInitLock();

     if (subsystemsInitialized != 0) {

 	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 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.

 	 */

 	TclFinalizeCompilation();

 	TclFinalizeExecution();

 	TclFinalizeEnvironment();

 	/* 

 	 * Finalizing the filesystem must come after anything which

 	 * might conceivably interact with the 'Tcl_FS' API. 

 	 */

 	TclFinalizeFilesystem();

 	/*

 	 * Undo all the 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();

 	if (tclExecutableName != NULL) {

 	    ckfree(tclExecutableName);

 	    tclExecutableName = NULL;

 	}

 	if (tclNativeExecutableName != NULL) {

 	    ckfree(tclNativeExecutableName);

 	    tclNativeExecutableName = NULL;

 	}

 	if (tclDefaultEncodingDir != NULL) {

 	    ckfree(tclDefaultEncodingDir);

 	    tclDefaultEncodingDir = NULL;

 	}

 	if (tclLibraryPathStr != NULL) {

 	    ckfree(tclLibraryPathStr);

 	    tclLibraryPathStr = NULL;

 	}

 	Tcl_SetPanicProc(NULL);

 	/*

 	 * 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.

 	 */

 #ifdef TCL_MEM_DEBUG

 	if ( firstExitPtr != NULL ) {

 	    Tcl_Panic( "exit handlers were created during Tcl_Finalize" );

 	}

 #endif

 	TclFinalizePreserve();

 	/*

 	 * Free synchronization objects.  There really should only be one

 	 * thread alive at this moment.

 	 */

 	TclFinalizeSynchronization();

 #if defined(TCL_THREADS) && defined(USE_THREAD_ALLOC) && !defined(TCL_MEM_DEBUG) && !defined(PURIFY)

 	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();

 	inFinalize = 0;

     }

     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.

  *

  *----------------------------------------------------------------------

  */

 EXPORT_C void

 Tcl_FinalizeThread()

 {

     ExitHandler *exitPtr;

     ThreadSpecificData *tsdPtr;

     tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey);

     if (tsdPtr != NULL) {

 	tsdPtr->inExit = 1;

 	/*

 	 * Clean up the library path now, before we invalidate thread-local

 	 * storage or calling thread exit handlers.

 	 */

 	if (tsdPtr->tclLibraryPath != NULL) {

 	    Tcl_DecrRefCount(tsdPtr->tclLibraryPath);

 	    tsdPtr->tclLibraryPath = NULL;

 	}

 	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();

 	TclFinalizeAsync();

     }

     /*

      * 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();

 }

 /*

  *----------------------------------------------------------------------

  *

  * 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()

 {

     return inFinalize;

 }

 /*

  *----------------------------------------------------------------------

  *

  * 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()

 {

     ThreadSpecificData *tsdPtr = (ThreadSpecificData *)

 	    TclThreadDataKeyGet(&dataKey);

     if (tsdPtr == NULL) {

 	return 0;

     } else {

 	return tsdPtr->inExit;

     }

 }

 /*

  *----------------------------------------------------------------------

  *

  * Tcl_VwaitObjCmd --

  *

  *	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.

  *

  * Side effects:

  *	See the user documentation.

  *

  *----------------------------------------------------------------------

  */

 	/* ARGSUSED */

 int

 Tcl_VwaitObjCmd(clientData, interp, objc, objv)

     ClientData clientData;	/* Not used. */

     Tcl_Interp *interp;		/* Current interpreter. */

     int objc;			/* Number of arguments. */

     Tcl_Obj *CONST objv[];	/* Argument objects. */

 {

     int done, foundEvent;

     char *nameString;

     if (objc != 2) {

         Tcl_WrongNumArgs(interp, 1, objv, "name");

 	return TCL_ERROR;

     }

     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;

     };

     done = 0;

     foundEvent = 1;

     while (!done && foundEvent) {

 	foundEvent = Tcl_DoOneEvent(TCL_ALL_EVENTS);

     }

     Tcl_UntraceVar(interp, nameString,

 	    TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,

 	    VwaitVarProc, (ClientData) &done);

     /*

      * Clear out the interpreter's result, since it may have been set

      * by event handlers.

      */

     Tcl_ResetResult(interp);

     if (!foundEvent) {

 	Tcl_AppendResult(interp, "can't wait for variable \"", nameString,

 		"\":  would wait forever", (char *) NULL);

 	return TCL_ERROR;

     }

     return TCL_OK;

 }

 	/* ARGSUSED */

 static char *

 VwaitVarProc(clientData, interp, name1, name2, flags)

     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 = (int *) clientData;

     *donePtr = 1;

     return (char *) NULL;

 }

 /*

  *----------------------------------------------------------------------

  *

  * Tcl_UpdateObjCmd --

  *

  *	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.

  *

  * Side effects:

  *	See the user documentation.

  *

  *----------------------------------------------------------------------

  */

 	/* ARGSUSED */

 int

 Tcl_UpdateObjCmd(clientData, interp, objc, objv)

     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 *updateOptions[] = {"idletasks", (char *) NULL};

     enum updateOptions {REGEXP_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 REGEXP_IDLETASKS: {

 		flags = TCL_WINDOW_EVENTS|TCL_IDLE_EVENTS|TCL_DONT_WAIT;

 		break;

 	    }

 	    default: {

 		panic("Tcl_UpdateObjCmd: bad option index to UpdateOptions");

 	    }

 	}

     } else {

         Tcl_WrongNumArgs(interp, 1, objv, "?idletasks?");

 	return TCL_ERROR;

     }

     while (Tcl_DoOneEvent(flags) != 0) {

 	/* Empty loop body */

     }

     /*

      * 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 threadClientData;

     Tcl_ThreadCreateProc *threadProc;

     cdPtr = (ThreadClientData*)clientData;

     threadProc = cdPtr->proc;

     threadClientData = cdPtr->clientData;

     ckfree((char*)clientData); /* Allocated in Tcl_CreateThread() */

     (*threadProc)(threadClientData);

     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.

  *

  * Results:

  *	TCL_OK if the thread could be created.  The thread ID is

  *	returned in a parameter.

  *

  * Side effects:

  *	A new thread is created.

  *

  *----------------------------------------------------------------------

  */

 EXPORT_C int

 Tcl_CreateThread(idPtr, proc, clientData, stackSize, flags)

     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;

     cdPtr = (ThreadClientData*)ckalloc(sizeof(ThreadClientData));

     cdPtr->proc = proc;

     cdPtr->clientData = clientData;

     return TclpThreadCreate(idPtr, NewThreadProc, (ClientData)cdPtr,

                            stackSize, flags);

 #else

     return TCL_ERROR;

 #endif /* TCL_THREADS */

 }