/* 

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

	     */