sl@0: /* 
sl@0:  * tclEvent.c --
sl@0:  *
sl@0:  *	This file implements some general event related interfaces including
sl@0:  *	background errors, exit handlers, and the "vwait" and "update"
sl@0:  *	command procedures. 
sl@0:  *
sl@0:  * Copyright (c) 1990-1994 The Regents of the University of California.
sl@0:  * Copyright (c) 1994-1998 Sun Microsystems, Inc.
sl@0:  * Portions Copyright (c) 2007-2008 Nokia Corporation and/or its subsidiaries. All rights reserved.  
sl@0:  * 
sl@0:  * See the file "license.terms" for information on usage and redistribution
sl@0:  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
sl@0:  *
sl@0:  * RCS: @(#) $Id: tclEvent.c,v 1.28.2.15 2007/03/19 17:06:25 dgp Exp $
sl@0:  */
sl@0: 
sl@0: #include "tclInt.h"
sl@0: #include "tclPort.h"
sl@0: #if defined(__SYMBIAN32__) && defined(__WINSCW__)
sl@0: #include "tclSymbianGlobals.h"
sl@0: #define dataKey getdataKey(0)
sl@0: #endif 
sl@0: 
sl@0: /*
sl@0:  * The data structure below is used to report background errors.  One
sl@0:  * such structure is allocated for each error;  it holds information
sl@0:  * about the interpreter and the error until bgerror can be invoked
sl@0:  * later as an idle handler.
sl@0:  */
sl@0: 
sl@0: typedef struct BgError {
sl@0:     Tcl_Interp *interp;		/* Interpreter in which error occurred.  NULL
sl@0: 				 * means this error report has been cancelled
sl@0: 				 * (a previous report generated a break). */
sl@0:     char *errorMsg;		/* Copy of the error message (the interp's
sl@0: 				 * result when the error occurred).
sl@0: 				 * Malloc-ed. */
sl@0:     char *errorInfo;		/* Value of the errorInfo variable
sl@0: 				 * (malloc-ed). */
sl@0:     char *errorCode;		/* Value of the errorCode variable
sl@0: 				 * (malloc-ed). */
sl@0:     struct BgError *nextPtr;	/* Next in list of all pending error
sl@0: 				 * reports for this interpreter, or NULL
sl@0: 				 * for end of list. */
sl@0: } BgError;
sl@0: 
sl@0: /*
sl@0:  * One of the structures below is associated with the "tclBgError"
sl@0:  * assoc data for each interpreter.  It keeps track of the head and
sl@0:  * tail of the list of pending background errors for the interpreter.
sl@0:  */
sl@0: 
sl@0: typedef struct ErrAssocData {
sl@0:     BgError *firstBgPtr;	/* First in list of all background errors
sl@0: 				 * waiting to be processed for this
sl@0: 				 * interpreter (NULL if none). */
sl@0:     BgError *lastBgPtr;		/* Last in list of all background errors
sl@0: 				 * waiting to be processed for this
sl@0: 				 * interpreter (NULL if none). */
sl@0: } ErrAssocData;
sl@0: 
sl@0: /*
sl@0:  * For each exit handler created with a call to Tcl_CreateExitHandler
sl@0:  * there is a structure of the following type:
sl@0:  */
sl@0: 
sl@0: typedef struct ExitHandler {
sl@0:     Tcl_ExitProc *proc;		/* Procedure to call when process exits. */
sl@0:     ClientData clientData;	/* One word of information to pass to proc. */
sl@0:     struct ExitHandler *nextPtr;/* Next in list of all exit handlers for
sl@0: 				 * this application, or NULL for end of list. */
sl@0: } ExitHandler;
sl@0: 
sl@0: /*
sl@0:  * There is both per-process and per-thread exit handlers.
sl@0:  * The first list is controlled by a mutex.  The other is in
sl@0:  * thread local storage.
sl@0:  */
sl@0: 
sl@0: static ExitHandler *firstExitPtr = NULL;
sl@0: 				/* First in list of all exit handlers for
sl@0: 				 * application. */
sl@0: TCL_DECLARE_MUTEX(exitMutex)
sl@0: 
sl@0: /*
sl@0:  * This variable is set to 1 when Tcl_Finalize is called, and at the end of
sl@0:  * its work, it is reset to 0. The variable is checked by TclInExit() to
sl@0:  * allow different behavior for exit-time processing, e.g. in closing of
sl@0:  * files and pipes.
sl@0:  */
sl@0: #if !defined(__SYMBIAN32__) || !defined(__WINSCW__)
sl@0: static int inFinalize = 0;
sl@0: static int subsystemsInitialized = 0;
sl@0: #endif
sl@0: 
sl@0: typedef struct ThreadSpecificData {
sl@0:     ExitHandler *firstExitPtr;  /* First in list of all exit handlers for
sl@0: 				 * this thread. */
sl@0:     int inExit;			/* True when this thread is exiting. This
sl@0: 				 * is used as a hack to decide to close
sl@0: 				 * the standard channels. */
sl@0:     Tcl_Obj *tclLibraryPath;	/* Path(s) to the Tcl library */
sl@0: } ThreadSpecificData;
sl@0: #if !defined(__SYMBIAN32__) || !defined(__WINSCW__)
sl@0: static Tcl_ThreadDataKey dataKey;
sl@0: 
sl@0: /*
sl@0:  * Common string for the library path for sharing across threads.
sl@0:  * This is ckalloc'd and cleared in Tcl_Finalize.
sl@0:  */
sl@0: static char *tclLibraryPathStr = NULL;
sl@0: #endif
sl@0: 
sl@0: #ifdef TCL_THREADS
sl@0: 
sl@0: typedef struct {
sl@0:     Tcl_ThreadCreateProc *proc;	/* Main() function of the thread */
sl@0:     ClientData clientData;	/* The one argument to Main() */
sl@0: } ThreadClientData;
sl@0: static Tcl_ThreadCreateType NewThreadProc _ANSI_ARGS_((
sl@0:            ClientData clientData));
sl@0: #endif
sl@0: 
sl@0: /*
sl@0:  * Prototypes for procedures referenced only in this file:
sl@0:  */
sl@0: 
sl@0: static void		BgErrorDeleteProc _ANSI_ARGS_((ClientData clientData,
sl@0: 			    Tcl_Interp *interp));
sl@0: static void		HandleBgErrors _ANSI_ARGS_((ClientData clientData));
sl@0: static char *		VwaitVarProc _ANSI_ARGS_((ClientData clientData,
sl@0: 			    Tcl_Interp *interp, CONST char *name1, 
sl@0: 			    CONST char *name2, int flags));
sl@0: 
sl@0: /*
sl@0:  *----------------------------------------------------------------------
sl@0:  *
sl@0:  * Tcl_BackgroundError --
sl@0:  *
sl@0:  *	This procedure is invoked to handle errors that occur in Tcl
sl@0:  *	commands that are invoked in "background" (e.g. from event or
sl@0:  *	timer bindings).
sl@0:  *
sl@0:  * Results:
sl@0:  *	None.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	The command "bgerror" is invoked later as an idle handler to
sl@0:  *	process the error, passing it the error message.  If that fails,
sl@0:  *	then an error message is output on stderr.
sl@0:  *
sl@0:  *----------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: EXPORT_C void
sl@0: Tcl_BackgroundError(interp)
sl@0:     Tcl_Interp *interp;		/* Interpreter in which an error has
sl@0: 				 * occurred. */
sl@0: {
sl@0:     BgError *errPtr;
sl@0:     CONST char *errResult, *varValue;
sl@0:     ErrAssocData *assocPtr;
sl@0:     int length;
sl@0: 
sl@0:     /*
sl@0:      * The Tcl_AddErrorInfo call below (with an empty string) ensures that
sl@0:      * errorInfo gets properly set.  It's needed in cases where the error
sl@0:      * came from a utility procedure like Tcl_GetVar instead of Tcl_Eval;
sl@0:      * in these cases errorInfo still won't have been set when this
sl@0:      * procedure is called.
sl@0:      */
sl@0: 
sl@0:     Tcl_AddErrorInfo(interp, "");
sl@0: 
sl@0:     errResult = Tcl_GetStringFromObj(Tcl_GetObjResult(interp), &length);
sl@0: 	
sl@0:     errPtr = (BgError *) ckalloc(sizeof(BgError));
sl@0:     errPtr->interp = interp;
sl@0:     errPtr->errorMsg = (char *) ckalloc((unsigned) (length + 1));
sl@0:     memcpy(errPtr->errorMsg, errResult, (size_t) (length + 1));
sl@0:     varValue = Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY);
sl@0:     if (varValue == NULL) {
sl@0: 	varValue = errPtr->errorMsg;
sl@0:     }
sl@0:     errPtr->errorInfo = (char *) ckalloc((unsigned) (strlen(varValue) + 1));
sl@0:     strcpy(errPtr->errorInfo, varValue);
sl@0:     varValue = Tcl_GetVar(interp, "errorCode", TCL_GLOBAL_ONLY);
sl@0:     if (varValue == NULL) {
sl@0: 	varValue = "";
sl@0:     }
sl@0:     errPtr->errorCode = (char *) ckalloc((unsigned) (strlen(varValue) + 1));
sl@0:     strcpy(errPtr->errorCode, varValue);
sl@0:     errPtr->nextPtr = NULL;
sl@0: 
sl@0:     assocPtr = (ErrAssocData *) Tcl_GetAssocData(interp, "tclBgError",
sl@0: 	    (Tcl_InterpDeleteProc **) NULL);
sl@0:     if (assocPtr == NULL) {
sl@0: 
sl@0: 	/*
sl@0: 	 * This is the first time a background error has occurred in
sl@0: 	 * this interpreter.  Create associated data to keep track of
sl@0: 	 * pending error reports.
sl@0: 	 */
sl@0: 
sl@0: 	assocPtr = (ErrAssocData *) ckalloc(sizeof(ErrAssocData));
sl@0: 	assocPtr->firstBgPtr = NULL;
sl@0: 	assocPtr->lastBgPtr = NULL;
sl@0: 	Tcl_SetAssocData(interp, "tclBgError", BgErrorDeleteProc,
sl@0: 		(ClientData) assocPtr);
sl@0:     }
sl@0:     if (assocPtr->firstBgPtr == NULL) {
sl@0: 	assocPtr->firstBgPtr = errPtr;
sl@0: 	Tcl_DoWhenIdle(HandleBgErrors, (ClientData) assocPtr);
sl@0:     } else {
sl@0: 	assocPtr->lastBgPtr->nextPtr = errPtr;
sl@0:     }
sl@0:     assocPtr->lastBgPtr = errPtr;
sl@0:     Tcl_ResetResult(interp);
sl@0: }
sl@0: 
sl@0: /*
sl@0:  *----------------------------------------------------------------------
sl@0:  *
sl@0:  * HandleBgErrors --
sl@0:  *
sl@0:  *	This procedure is invoked as an idle handler to process all of
sl@0:  *	the accumulated background errors.
sl@0:  *
sl@0:  * Results:
sl@0:  *	None.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	Depends on what actions "bgerror" takes for the errors.
sl@0:  *
sl@0:  *----------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: static void
sl@0: HandleBgErrors(clientData)
sl@0:     ClientData clientData;	/* Pointer to ErrAssocData structure. */
sl@0: {
sl@0:     Tcl_Interp *interp;
sl@0:     CONST char *argv[2];
sl@0:     int code;
sl@0:     BgError *errPtr;
sl@0:     ErrAssocData *assocPtr = (ErrAssocData *) clientData;
sl@0:     Tcl_Channel errChannel;
sl@0: 
sl@0:     Tcl_Preserve((ClientData) assocPtr);
sl@0:     
sl@0:     while (assocPtr->firstBgPtr != NULL) {
sl@0: 	interp = assocPtr->firstBgPtr->interp;
sl@0: 	if (interp == NULL) {
sl@0: 	    goto doneWithInterp;
sl@0: 	}
sl@0: 
sl@0: 	/*
sl@0: 	 * Restore important state variables to what they were at
sl@0: 	 * the time the error occurred.
sl@0: 	 */
sl@0: 
sl@0: 	Tcl_SetVar(interp, "errorInfo", assocPtr->firstBgPtr->errorInfo,
sl@0: 		TCL_GLOBAL_ONLY);
sl@0: 	Tcl_SetVar(interp, "errorCode", assocPtr->firstBgPtr->errorCode,
sl@0: 		TCL_GLOBAL_ONLY);
sl@0: 
sl@0: 	/*
sl@0: 	 * Create and invoke the bgerror command.
sl@0: 	 */
sl@0: 
sl@0: 	argv[0] = "bgerror";
sl@0: 	argv[1] = assocPtr->firstBgPtr->errorMsg;
sl@0: 	
sl@0: 	Tcl_AllowExceptions(interp);
sl@0:         Tcl_Preserve((ClientData) interp);
sl@0: 	code = TclGlobalInvoke(interp, 2, argv, 0);
sl@0: 	if (code == TCL_ERROR) {
sl@0: 
sl@0:             /*
sl@0:              * If the interpreter is safe, we look for a hidden command
sl@0:              * named "bgerror" and call that with the error information.
sl@0:              * Otherwise, simply ignore the error. The rationale is that
sl@0:              * this could be an error caused by a malicious applet trying
sl@0:              * to cause an infinite barrage of error messages. The hidden
sl@0:              * "bgerror" command can be used by a security policy to
sl@0:              * interpose on such attacks and e.g. kill the applet after a
sl@0:              * few attempts.
sl@0:              */
sl@0: 
sl@0:             if (Tcl_IsSafe(interp)) {
sl@0: 		Tcl_SavedResult save;
sl@0: 		
sl@0: 		Tcl_SaveResult(interp, &save);
sl@0:                 TclGlobalInvoke(interp, 2, argv, TCL_INVOKE_HIDDEN);
sl@0: 		Tcl_RestoreResult(interp, &save);
sl@0: 
sl@0:                 goto doneWithInterp;
sl@0:             } 
sl@0: 
sl@0:             /*
sl@0:              * We have to get the error output channel at the latest possible
sl@0:              * time, because the eval (above) might have changed the channel.
sl@0:              */
sl@0:             
sl@0:             errChannel = Tcl_GetStdChannel(TCL_STDERR);
sl@0:             if (errChannel != (Tcl_Channel) NULL) {
sl@0: 		char *string;
sl@0: 		int len;
sl@0: 
sl@0: 		string = Tcl_GetStringFromObj(Tcl_GetObjResult(interp), &len);
sl@0: 		if (Tcl_FindCommand(interp, "bgerror", NULL, TCL_GLOBAL_ONLY) == NULL) {
sl@0:                     Tcl_WriteChars(errChannel, assocPtr->firstBgPtr->errorInfo, -1);
sl@0:                     Tcl_WriteChars(errChannel, "\n", -1);
sl@0:                 } else {
sl@0:                     Tcl_WriteChars(errChannel,
sl@0:                             "bgerror failed to handle background error.\n",
sl@0:                             -1);
sl@0:                     Tcl_WriteChars(errChannel, "    Original error: ", -1);
sl@0:                     Tcl_WriteChars(errChannel, assocPtr->firstBgPtr->errorMsg,
sl@0:                             -1);
sl@0:                     Tcl_WriteChars(errChannel, "\n", -1);
sl@0:                     Tcl_WriteChars(errChannel, "    Error in bgerror: ", -1);
sl@0:                     Tcl_WriteChars(errChannel, string, len);
sl@0:                     Tcl_WriteChars(errChannel, "\n", -1);
sl@0:                 }
sl@0:                 Tcl_Flush(errChannel);
sl@0:             }
sl@0: 	} else if (code == TCL_BREAK) {
sl@0: 
sl@0: 	    /*
sl@0: 	     * Break means cancel any remaining error reports for this
sl@0: 	     * interpreter.
sl@0: 	     */
sl@0: 
sl@0: 	    for (errPtr = assocPtr->firstBgPtr; errPtr != NULL;
sl@0: 		    errPtr = errPtr->nextPtr) {
sl@0: 		if (errPtr->interp == interp) {
sl@0: 		    errPtr->interp = NULL;
sl@0: 		}
sl@0: 	    }
sl@0: 	}
sl@0: 
sl@0: 	/*
sl@0: 	 * Discard the command and the information about the error report.
sl@0: 	 */
sl@0: 
sl@0: doneWithInterp:
sl@0: 
sl@0: 	if (assocPtr->firstBgPtr) {
sl@0: 	    ckfree(assocPtr->firstBgPtr->errorMsg);
sl@0: 	    ckfree(assocPtr->firstBgPtr->errorInfo);
sl@0: 	    ckfree(assocPtr->firstBgPtr->errorCode);
sl@0: 	    errPtr = assocPtr->firstBgPtr->nextPtr;
sl@0: 	    ckfree((char *) assocPtr->firstBgPtr);
sl@0: 	    assocPtr->firstBgPtr = errPtr;
sl@0: 	}
sl@0:         
sl@0:         if (interp != NULL) {
sl@0:             Tcl_Release((ClientData) interp);
sl@0:         }
sl@0:     }
sl@0:     assocPtr->lastBgPtr = NULL;
sl@0: 
sl@0:     Tcl_Release((ClientData) assocPtr);
sl@0: }
sl@0: 
sl@0: /*
sl@0:  *----------------------------------------------------------------------
sl@0:  *
sl@0:  * BgErrorDeleteProc --
sl@0:  *
sl@0:  *	This procedure is associated with the "tclBgError" assoc data
sl@0:  *	for an interpreter;  it is invoked when the interpreter is
sl@0:  *	deleted in order to free the information assoicated with any
sl@0:  *	pending error reports.
sl@0:  *
sl@0:  * Results:
sl@0:  *	None.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	Background error information is freed: if there were any
sl@0:  *	pending error reports, they are cancelled.
sl@0:  *
sl@0:  *----------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: static void
sl@0: BgErrorDeleteProc(clientData, interp)
sl@0:     ClientData clientData;	/* Pointer to ErrAssocData structure. */
sl@0:     Tcl_Interp *interp;		/* Interpreter being deleted. */
sl@0: {
sl@0:     ErrAssocData *assocPtr = (ErrAssocData *) clientData;
sl@0:     BgError *errPtr;
sl@0: 
sl@0:     while (assocPtr->firstBgPtr != NULL) {
sl@0: 	errPtr = assocPtr->firstBgPtr;
sl@0: 	assocPtr->firstBgPtr = errPtr->nextPtr;
sl@0: 	ckfree(errPtr->errorMsg);
sl@0: 	ckfree(errPtr->errorInfo);
sl@0: 	ckfree(errPtr->errorCode);
sl@0: 	ckfree((char *) errPtr);
sl@0:     }
sl@0:     Tcl_CancelIdleCall(HandleBgErrors, (ClientData) assocPtr);
sl@0:     Tcl_EventuallyFree((ClientData) assocPtr, TCL_DYNAMIC);
sl@0: }
sl@0: 
sl@0: /*
sl@0:  *----------------------------------------------------------------------
sl@0:  *
sl@0:  * Tcl_CreateExitHandler --
sl@0:  *
sl@0:  *	Arrange for a given procedure to be invoked just before the
sl@0:  *	application exits.
sl@0:  *
sl@0:  * Results:
sl@0:  *	None.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	Proc will be invoked with clientData as argument when the
sl@0:  *	application exits.
sl@0:  *
sl@0:  *----------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: EXPORT_C void
sl@0: Tcl_CreateExitHandler(proc, clientData)
sl@0:     Tcl_ExitProc *proc;		/* Procedure to invoke. */
sl@0:     ClientData clientData;	/* Arbitrary value to pass to proc. */
sl@0: {
sl@0:     ExitHandler *exitPtr;
sl@0: 
sl@0:     exitPtr = (ExitHandler *) ckalloc(sizeof(ExitHandler));
sl@0:     exitPtr->proc = proc;
sl@0:     exitPtr->clientData = clientData;
sl@0:     Tcl_MutexLock(&exitMutex);
sl@0:     exitPtr->nextPtr = firstExitPtr;
sl@0:     firstExitPtr = exitPtr;
sl@0:     Tcl_MutexUnlock(&exitMutex);
sl@0: }
sl@0: 
sl@0: /*
sl@0:  *----------------------------------------------------------------------
sl@0:  *
sl@0:  * Tcl_DeleteExitHandler --
sl@0:  *
sl@0:  *	This procedure cancels an existing exit handler matching proc
sl@0:  *	and clientData, if such a handler exits.
sl@0:  *
sl@0:  * Results:
sl@0:  *	None.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	If there is an exit handler corresponding to proc and clientData
sl@0:  *	then it is cancelled;  if no such handler exists then nothing
sl@0:  *	happens.
sl@0:  *
sl@0:  *----------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: EXPORT_C void
sl@0: Tcl_DeleteExitHandler(proc, clientData)
sl@0:     Tcl_ExitProc *proc;		/* Procedure that was previously registered. */
sl@0:     ClientData clientData;	/* Arbitrary value to pass to proc. */
sl@0: {
sl@0:     ExitHandler *exitPtr, *prevPtr;
sl@0: 
sl@0:     Tcl_MutexLock(&exitMutex);
sl@0:     for (prevPtr = NULL, exitPtr = firstExitPtr; exitPtr != NULL;
sl@0: 	    prevPtr = exitPtr, exitPtr = exitPtr->nextPtr) {
sl@0: 	if ((exitPtr->proc == proc)
sl@0: 		&& (exitPtr->clientData == clientData)) {
sl@0: 	    if (prevPtr == NULL) {
sl@0: 		firstExitPtr = exitPtr->nextPtr;
sl@0: 	    } else {
sl@0: 		prevPtr->nextPtr = exitPtr->nextPtr;
sl@0: 	    }
sl@0: 	    ckfree((char *) exitPtr);
sl@0: 	    break;
sl@0: 	}
sl@0:     }
sl@0:     Tcl_MutexUnlock(&exitMutex);
sl@0:     return;
sl@0: }
sl@0: 
sl@0: /*
sl@0:  *----------------------------------------------------------------------
sl@0:  *
sl@0:  * Tcl_CreateThreadExitHandler --
sl@0:  *
sl@0:  *	Arrange for a given procedure to be invoked just before the
sl@0:  *	current thread exits.
sl@0:  *
sl@0:  * Results:
sl@0:  *	None.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	Proc will be invoked with clientData as argument when the
sl@0:  *	application exits.
sl@0:  *
sl@0:  *----------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: EXPORT_C void
sl@0: Tcl_CreateThreadExitHandler(proc, clientData)
sl@0:     Tcl_ExitProc *proc;		/* Procedure to invoke. */
sl@0:     ClientData clientData;	/* Arbitrary value to pass to proc. */
sl@0: {
sl@0:     ExitHandler *exitPtr;
sl@0:     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
sl@0: 
sl@0:     exitPtr = (ExitHandler *) ckalloc(sizeof(ExitHandler));
sl@0:     exitPtr->proc = proc;
sl@0:     exitPtr->clientData = clientData;
sl@0:     exitPtr->nextPtr = tsdPtr->firstExitPtr;
sl@0:     tsdPtr->firstExitPtr = exitPtr;
sl@0: }
sl@0: 
sl@0: /*
sl@0:  *----------------------------------------------------------------------
sl@0:  *
sl@0:  * Tcl_DeleteThreadExitHandler --
sl@0:  *
sl@0:  *	This procedure cancels an existing exit handler matching proc
sl@0:  *	and clientData, if such a handler exits.
sl@0:  *
sl@0:  * Results:
sl@0:  *	None.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	If there is an exit handler corresponding to proc and clientData
sl@0:  *	then it is cancelled;  if no such handler exists then nothing
sl@0:  *	happens.
sl@0:  *
sl@0:  *----------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: EXPORT_C void
sl@0: Tcl_DeleteThreadExitHandler(proc, clientData)
sl@0:     Tcl_ExitProc *proc;		/* Procedure that was previously registered. */
sl@0:     ClientData clientData;	/* Arbitrary value to pass to proc. */
sl@0: {
sl@0:     ExitHandler *exitPtr, *prevPtr;
sl@0:     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
sl@0: 
sl@0:     for (prevPtr = NULL, exitPtr = tsdPtr->firstExitPtr; exitPtr != NULL;
sl@0: 	    prevPtr = exitPtr, exitPtr = exitPtr->nextPtr) {
sl@0: 	if ((exitPtr->proc == proc)
sl@0: 		&& (exitPtr->clientData == clientData)) {
sl@0: 	    if (prevPtr == NULL) {
sl@0: 		tsdPtr->firstExitPtr = exitPtr->nextPtr;
sl@0: 	    } else {
sl@0: 		prevPtr->nextPtr = exitPtr->nextPtr;
sl@0: 	    }
sl@0: 	    ckfree((char *) exitPtr);
sl@0: 	    return;
sl@0: 	}
sl@0:     }
sl@0: }
sl@0: 
sl@0: /*
sl@0:  *----------------------------------------------------------------------
sl@0:  *
sl@0:  * Tcl_Exit --
sl@0:  *
sl@0:  *	This procedure is called to terminate the application.
sl@0:  *
sl@0:  * Results:
sl@0:  *	None.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	All existing exit handlers are invoked, then the application
sl@0:  *	ends.
sl@0:  *
sl@0:  *----------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: EXPORT_C void
sl@0: Tcl_Exit(status)
sl@0:     int status;			/* Exit status for application;  typically
sl@0: 				 * 0 for normal return, 1 for error return. */
sl@0: {
sl@0:     Tcl_Finalize();
sl@0:     TclpExit(status);
sl@0: }
sl@0: 
sl@0: /*
sl@0:  *-------------------------------------------------------------------------
sl@0:  * 
sl@0:  * TclSetLibraryPath --
sl@0:  *
sl@0:  *	Set the path that will be used for searching for init.tcl and 
sl@0:  *	encodings when an interp is being created.
sl@0:  *
sl@0:  * Results:
sl@0:  *	None.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	Changing the library path will affect what directories are
sl@0:  *	examined when looking for encodings for all interps from that
sl@0:  *	point forward.
sl@0:  *
sl@0:  *	The refcount of the new library path is incremented and the 
sl@0:  *	refcount of the old path is decremented.
sl@0:  *
sl@0:  *-------------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: void
sl@0: TclSetLibraryPath(pathPtr)
sl@0:     Tcl_Obj *pathPtr;		/* A Tcl list object whose elements are
sl@0: 				 * the new library path. */
sl@0: {
sl@0:     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
sl@0:     const char *toDupe;
sl@0:     int size;
sl@0: 
sl@0:     if (pathPtr != NULL) {
sl@0: 	Tcl_IncrRefCount(pathPtr);
sl@0:     }
sl@0:     if (tsdPtr->tclLibraryPath != NULL) {
sl@0: 	Tcl_DecrRefCount(tsdPtr->tclLibraryPath);
sl@0:     }
sl@0:     tsdPtr->tclLibraryPath = pathPtr;
sl@0: 
sl@0:     /*
sl@0:      *  No mutex locking is needed here as up the stack we're within
sl@0:      *  TclpInitLock().
sl@0:      */
sl@0:     if (tclLibraryPathStr != NULL) {
sl@0: 	ckfree(tclLibraryPathStr);
sl@0:     }
sl@0:     toDupe = Tcl_GetStringFromObj(pathPtr, &size);
sl@0:     tclLibraryPathStr = ckalloc((unsigned)size+1);
sl@0:     memcpy(tclLibraryPathStr, toDupe, (unsigned)size+1);
sl@0: }
sl@0: 
sl@0: /*
sl@0:  *-------------------------------------------------------------------------
sl@0:  *
sl@0:  * TclGetLibraryPath --
sl@0:  *
sl@0:  *	Return a Tcl list object whose elements are the library path.
sl@0:  *	The caller should not modify the contents of the returned object.
sl@0:  *
sl@0:  * Results:
sl@0:  *	As above.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	None.
sl@0:  *
sl@0:  *-------------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: Tcl_Obj *
sl@0: TclGetLibraryPath()
sl@0: {
sl@0:     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
sl@0: 
sl@0:     if (tsdPtr->tclLibraryPath == NULL) {
sl@0: 	/*
sl@0: 	 * Grab the shared string and place it into a new thread specific
sl@0: 	 * Tcl_Obj.
sl@0: 	 */
sl@0: 	tsdPtr->tclLibraryPath = Tcl_NewStringObj(tclLibraryPathStr, -1);
sl@0: 
sl@0: 	/* take ownership */
sl@0: 	Tcl_IncrRefCount(tsdPtr->tclLibraryPath);
sl@0:     }
sl@0:     return tsdPtr->tclLibraryPath;
sl@0: }
sl@0: 
sl@0: /*
sl@0:  *-------------------------------------------------------------------------
sl@0:  *
sl@0:  * TclInitSubsystems --
sl@0:  *
sl@0:  *	Initialize various subsytems in Tcl.  This should be called the
sl@0:  *	first time an interp is created, or before any of the subsystems
sl@0:  *	are used.  This function ensures an order for the initialization 
sl@0:  *	of subsystems:
sl@0:  *
sl@0:  *	1. that cannot be initialized in lazy order because they are 
sl@0:  *	mutually dependent.
sl@0:  *
sl@0:  *	2. so that they can be finalized in a known order w/o causing
sl@0:  *	the subsequent re-initialization of a subsystem in the act of
sl@0:  *	shutting down another.
sl@0:  *
sl@0:  * Results:
sl@0:  *	None.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	Varied, see the respective initialization routines.
sl@0:  *
sl@0:  *-------------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: void
sl@0: TclInitSubsystems(argv0)
sl@0:     CONST char *argv0;		/* Name of executable from argv[0] to main()
sl@0: 				 * in native multi-byte encoding. */
sl@0: {
sl@0:     ThreadSpecificData *tsdPtr;
sl@0: 
sl@0:     if (inFinalize != 0) {
sl@0: 	panic("TclInitSubsystems called while finalizing");
sl@0:     }
sl@0: 
sl@0:     /*
sl@0:      * Grab the thread local storage pointer before doing anything because
sl@0:      * the initialization routines will be registering exit handlers.
sl@0:      * We use this pointer to detect if this is the first time this
sl@0:      * thread has created an interpreter.
sl@0:      */
sl@0: 
sl@0:     tsdPtr = (ThreadSpecificData *) TclThreadDataKeyGet(&dataKey);
sl@0: 
sl@0:     if (subsystemsInitialized == 0) {
sl@0: 	/* 
sl@0: 	 * Double check inside the mutex.  There are definitly calls
sl@0: 	 * back into this routine from some of the procedures below.
sl@0: 	 */
sl@0: 
sl@0: 	TclpInitLock();
sl@0: 	if (subsystemsInitialized == 0) {
sl@0: 	    /*
sl@0: 	     * Have to set this bit here to avoid deadlock with the
sl@0: 	     * routines below us that call into TclInitSubsystems.
sl@0: 	     */
sl@0: 
sl@0: 	    subsystemsInitialized = 1;
sl@0: 
sl@0: 	    tclExecutableName = NULL;
sl@0: 
sl@0: 	    /*
sl@0: 	     * Initialize locks used by the memory allocators before anything
sl@0: 	     * interesting happens so we can use the allocators in the
sl@0: 	     * implementation of self-initializing locks.
sl@0: 	     */
sl@0: 
sl@0: #if USE_TCLALLOC
sl@0: 	    TclInitAlloc(); /* process wide mutex init */
sl@0: #endif
sl@0: #ifdef TCL_MEM_DEBUG
sl@0: 	    TclInitDbCkalloc(); /* process wide mutex init */
sl@0: #endif
sl@0: 
sl@0: 	    TclpInitPlatform(); /* creates signal handler(s) */
sl@0: 	    TclInitObjSubsystem(); /* register obj types, create mutexes */
sl@0: 	    TclInitIOSubsystem(); /* inits a tsd key (noop) */
sl@0: 	    TclInitEncodingSubsystem(); /* process wide encoding init */
sl@0: 	    TclInitNamespaceSubsystem(); /* register ns obj type (mutexed) */
sl@0: 	}
sl@0: 	TclpInitUnlock();
sl@0:     }
sl@0: 
sl@0:     if (tsdPtr == NULL) {
sl@0: 	/*
sl@0: 	 * First time this thread has created an interpreter.
sl@0: 	 * We fetch the key again just in case no exit handlers were
sl@0: 	 * registered by this point.
sl@0: 	 */
sl@0: 
sl@0: 	(void) TCL_TSD_INIT(&dataKey);
sl@0: 	TclInitNotifier();
sl@0:      }
sl@0: }
sl@0: 
sl@0: /*
sl@0:  *----------------------------------------------------------------------
sl@0:  *
sl@0:  * Tcl_Finalize --
sl@0:  *
sl@0:  *	Shut down Tcl.  First calls registered exit handlers, then
sl@0:  *	carefully shuts down various subsystems.
sl@0:  *	Called by Tcl_Exit or when the Tcl shared library is being 
sl@0:  *	unloaded.
sl@0:  *
sl@0:  * Results:
sl@0:  *	None.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	Varied, see the respective finalization routines.
sl@0:  *
sl@0:  *----------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: EXPORT_C void
sl@0: Tcl_Finalize()
sl@0: {
sl@0:     ExitHandler *exitPtr;
sl@0:     
sl@0:     /*
sl@0:      * Invoke exit handlers first.
sl@0:      */
sl@0: 
sl@0:     Tcl_MutexLock(&exitMutex);
sl@0:     inFinalize = 1;
sl@0:     for (exitPtr = firstExitPtr; exitPtr != NULL; exitPtr = firstExitPtr) {
sl@0: 	/*
sl@0: 	 * Be careful to remove the handler from the list before
sl@0: 	 * invoking its callback.  This protects us against
sl@0: 	 * double-freeing if the callback should call
sl@0: 	 * Tcl_DeleteExitHandler on itself.
sl@0: 	 */
sl@0: 
sl@0: 	firstExitPtr = exitPtr->nextPtr;
sl@0: 	Tcl_MutexUnlock(&exitMutex);
sl@0: 	(*exitPtr->proc)(exitPtr->clientData);
sl@0: 	ckfree((char *) exitPtr);
sl@0: 	Tcl_MutexLock(&exitMutex);
sl@0:     }    
sl@0:     firstExitPtr = NULL;
sl@0:     Tcl_MutexUnlock(&exitMutex);
sl@0: 
sl@0:     TclpInitLock();
sl@0:     if (subsystemsInitialized != 0) {
sl@0: 	subsystemsInitialized = 0;
sl@0: 
sl@0: 	/*
sl@0: 	 * Ensure the thread-specific data is initialised as it is
sl@0: 	 * used in Tcl_FinalizeThread()
sl@0: 	 */
sl@0: 
sl@0: 	(void) TCL_TSD_INIT(&dataKey);
sl@0: 
sl@0: 	/*
sl@0: 	 * Clean up after the current thread now, after exit handlers.
sl@0: 	 * In particular, the testexithandler command sets up something
sl@0: 	 * that writes to standard output, which gets closed.
sl@0: 	 * Note that there is no thread-local storage after this call.
sl@0: 	 */
sl@0: 
sl@0: 	Tcl_FinalizeThread();
sl@0: 
sl@0: 	/*
sl@0: 	 * Now finalize the Tcl execution environment.  Note that this
sl@0: 	 * must be done after the exit handlers, because there are
sl@0: 	 * order dependencies.
sl@0: 	 */
sl@0: 
sl@0: 	TclFinalizeCompilation();
sl@0: 	TclFinalizeExecution();
sl@0: 	TclFinalizeEnvironment();
sl@0: 
sl@0: 	/* 
sl@0: 	 * Finalizing the filesystem must come after anything which
sl@0: 	 * might conceivably interact with the 'Tcl_FS' API. 
sl@0: 	 */
sl@0: 
sl@0: 	TclFinalizeFilesystem();
sl@0: 
sl@0: 	/*
sl@0: 	 * Undo all the Tcl_ObjType registrations, and reset the master list
sl@0: 	 * of free Tcl_Obj's.  After this returns, no more Tcl_Obj's should
sl@0: 	 * be allocated or freed.
sl@0: 	 *
sl@0: 	 * Note in particular that TclFinalizeObjects() must follow
sl@0: 	 * TclFinalizeFilesystem() because TclFinalizeFilesystem free's
sl@0: 	 * the Tcl_Obj that holds the path of the current working directory.
sl@0: 	 */
sl@0: 
sl@0: 	TclFinalizeObjects();
sl@0: 
sl@0: 	/* 
sl@0: 	 * We must be sure the encoding finalization doesn't need
sl@0: 	 * to examine the filesystem in any way.  Since it only
sl@0: 	 * needs to clean up internal data structures, this is
sl@0: 	 * fine.
sl@0: 	 */
sl@0: 	TclFinalizeEncodingSubsystem();
sl@0: 
sl@0: 	if (tclExecutableName != NULL) {
sl@0: 	    ckfree(tclExecutableName);
sl@0: 	    tclExecutableName = NULL;
sl@0: 	}
sl@0: 	if (tclNativeExecutableName != NULL) {
sl@0: 	    ckfree(tclNativeExecutableName);
sl@0: 	    tclNativeExecutableName = NULL;
sl@0: 	}
sl@0: 	if (tclDefaultEncodingDir != NULL) {
sl@0: 	    ckfree(tclDefaultEncodingDir);
sl@0: 	    tclDefaultEncodingDir = NULL;
sl@0: 	}
sl@0: 	if (tclLibraryPathStr != NULL) {
sl@0: 	    ckfree(tclLibraryPathStr);
sl@0: 	    tclLibraryPathStr = NULL;
sl@0: 	}
sl@0: 	
sl@0: 	Tcl_SetPanicProc(NULL);
sl@0: 
sl@0: 	/*
sl@0: 	 * There have been several bugs in the past that cause
sl@0: 	 * exit handlers to be established during Tcl_Finalize
sl@0: 	 * processing.  Such exit handlers leave malloc'ed memory,
sl@0: 	 * and Tcl_FinalizeThreadAlloc or Tcl_FinalizeMemorySubsystem
sl@0: 	 * will result in a corrupted heap.  The result can be a
sl@0: 	 * mysterious crash on process exit.  Check here that
sl@0: 	 * nobody's done this.
sl@0: 	 */
sl@0: 
sl@0: #ifdef TCL_MEM_DEBUG
sl@0: 	if ( firstExitPtr != NULL ) {
sl@0: 	    Tcl_Panic( "exit handlers were created during Tcl_Finalize" );
sl@0: 	}
sl@0: #endif
sl@0: 
sl@0: 	TclFinalizePreserve();
sl@0: 
sl@0: 	/*
sl@0: 	 * Free synchronization objects.  There really should only be one
sl@0: 	 * thread alive at this moment.
sl@0: 	 */
sl@0: 
sl@0: 	TclFinalizeSynchronization();
sl@0: 
sl@0: #if defined(TCL_THREADS) && defined(USE_THREAD_ALLOC) && !defined(TCL_MEM_DEBUG) && !defined(PURIFY)
sl@0: 	TclFinalizeThreadAlloc();
sl@0: #endif
sl@0: 
sl@0: 	/*
sl@0: 	 * We defer unloading of packages until very late 
sl@0: 	 * to avoid memory access issues.  Both exit callbacks and
sl@0: 	 * synchronization variables may be stored in packages.
sl@0: 	 * 
sl@0: 	 * Note that TclFinalizeLoad unloads packages in the reverse
sl@0: 	 * of the order they were loaded in (i.e. last to be loaded
sl@0: 	 * is the first to be unloaded).  This can be important for
sl@0: 	 * correct unloading when dependencies exist.
sl@0: 	 * 
sl@0: 	 * Once load has been finalized, we will have deleted any
sl@0: 	 * temporary copies of shared libraries and can therefore
sl@0: 	 * reset the filesystem to its original state.
sl@0: 	 */
sl@0: 
sl@0: 	TclFinalizeLoad();
sl@0: 	TclResetFilesystem();
sl@0: 	
sl@0: 	/*
sl@0: 	 * At this point, there should no longer be any ckalloc'ed memory.
sl@0: 	 */
sl@0: 
sl@0: 	TclFinalizeMemorySubsystem();
sl@0: 	inFinalize = 0;
sl@0:     }
sl@0:     TclFinalizeLock();
sl@0: }
sl@0: 
sl@0: /*
sl@0:  *----------------------------------------------------------------------
sl@0:  *
sl@0:  * Tcl_FinalizeThread --
sl@0:  *
sl@0:  *	Runs the exit handlers to allow Tcl to clean up its state
sl@0:  *	about a particular thread.
sl@0:  *
sl@0:  * Results:
sl@0:  *	None.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	Varied, see the respective finalization routines.
sl@0:  *
sl@0:  *----------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: EXPORT_C void
sl@0: Tcl_FinalizeThread()
sl@0: {
sl@0:     ExitHandler *exitPtr;
sl@0:     ThreadSpecificData *tsdPtr;
sl@0: 
sl@0:     tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey);
sl@0:     if (tsdPtr != NULL) {
sl@0: 	tsdPtr->inExit = 1;
sl@0: 
sl@0: 	/*
sl@0: 	 * Clean up the library path now, before we invalidate thread-local
sl@0: 	 * storage or calling thread exit handlers.
sl@0: 	 */
sl@0: 
sl@0: 	if (tsdPtr->tclLibraryPath != NULL) {
sl@0: 	    Tcl_DecrRefCount(tsdPtr->tclLibraryPath);
sl@0: 	    tsdPtr->tclLibraryPath = NULL;
sl@0: 	}
sl@0: 
sl@0: 	for (exitPtr = tsdPtr->firstExitPtr; exitPtr != NULL;
sl@0: 		exitPtr = tsdPtr->firstExitPtr) {
sl@0: 	    /*
sl@0: 	     * Be careful to remove the handler from the list before invoking
sl@0: 	     * its callback.  This protects us against double-freeing if the
sl@0: 	     * callback should call Tcl_DeleteThreadExitHandler on itself.
sl@0: 	     */
sl@0: 
sl@0: 	    tsdPtr->firstExitPtr = exitPtr->nextPtr;
sl@0: 	    (*exitPtr->proc)(exitPtr->clientData);
sl@0: 	    ckfree((char *) exitPtr);
sl@0: 	}
sl@0: 	TclFinalizeIOSubsystem();
sl@0: 	TclFinalizeNotifier();
sl@0: 	TclFinalizeAsync();
sl@0:     }
sl@0: 
sl@0:     /*
sl@0:      * Blow away all thread local storage blocks.
sl@0:      *
sl@0:      * Note that Tcl API allows creation of threads which do not use any
sl@0:      * Tcl interp or other Tcl subsytems. Those threads might, however,
sl@0:      * use thread local storage, so we must unconditionally finalize it.
sl@0:      *
sl@0:      * Fix [Bug #571002]
sl@0:      */
sl@0: 
sl@0:     TclFinalizeThreadData();
sl@0: }
sl@0: 
sl@0: /*
sl@0:  *----------------------------------------------------------------------
sl@0:  *
sl@0:  * TclInExit --
sl@0:  *
sl@0:  *	Determines if we are in the middle of exit-time cleanup.
sl@0:  *
sl@0:  * Results:
sl@0:  *	If we are in the middle of exiting, 1, otherwise 0.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	None.
sl@0:  *
sl@0:  *----------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: int
sl@0: TclInExit()
sl@0: {
sl@0:     return inFinalize;
sl@0: }
sl@0: 
sl@0: /*
sl@0:  *----------------------------------------------------------------------
sl@0:  *
sl@0:  * TclInThreadExit --
sl@0:  *
sl@0:  *	Determines if we are in the middle of thread exit-time cleanup.
sl@0:  *
sl@0:  * Results:
sl@0:  *	If we are in the middle of exiting this thread, 1, otherwise 0.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	None.
sl@0:  *
sl@0:  *----------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: int
sl@0: TclInThreadExit()
sl@0: {
sl@0:     ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
sl@0: 	    TclThreadDataKeyGet(&dataKey);
sl@0:     if (tsdPtr == NULL) {
sl@0: 	return 0;
sl@0:     } else {
sl@0: 	return tsdPtr->inExit;
sl@0:     }
sl@0: }
sl@0: 
sl@0: /*
sl@0:  *----------------------------------------------------------------------
sl@0:  *
sl@0:  * Tcl_VwaitObjCmd --
sl@0:  *
sl@0:  *	This procedure is invoked to process the "vwait" Tcl command.
sl@0:  *	See the user documentation for details on what it does.
sl@0:  *
sl@0:  * Results:
sl@0:  *	A standard Tcl result.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	See the user documentation.
sl@0:  *
sl@0:  *----------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: 	/* ARGSUSED */
sl@0: int
sl@0: Tcl_VwaitObjCmd(clientData, interp, objc, objv)
sl@0:     ClientData clientData;	/* Not used. */
sl@0:     Tcl_Interp *interp;		/* Current interpreter. */
sl@0:     int objc;			/* Number of arguments. */
sl@0:     Tcl_Obj *CONST objv[];	/* Argument objects. */
sl@0: {
sl@0:     int done, foundEvent;
sl@0:     char *nameString;
sl@0: 
sl@0:     if (objc != 2) {
sl@0:         Tcl_WrongNumArgs(interp, 1, objv, "name");
sl@0: 	return TCL_ERROR;
sl@0:     }
sl@0:     nameString = Tcl_GetString(objv[1]);
sl@0:     if (Tcl_TraceVar(interp, nameString,
sl@0: 	    TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
sl@0: 	    VwaitVarProc, (ClientData) &done) != TCL_OK) {
sl@0: 	return TCL_ERROR;
sl@0:     };
sl@0:     done = 0;
sl@0:     foundEvent = 1;
sl@0:     while (!done && foundEvent) {
sl@0: 	foundEvent = Tcl_DoOneEvent(TCL_ALL_EVENTS);
sl@0:     }
sl@0:     Tcl_UntraceVar(interp, nameString,
sl@0: 	    TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
sl@0: 	    VwaitVarProc, (ClientData) &done);
sl@0: 
sl@0:     /*
sl@0:      * Clear out the interpreter's result, since it may have been set
sl@0:      * by event handlers.
sl@0:      */
sl@0: 
sl@0:     Tcl_ResetResult(interp);
sl@0:     if (!foundEvent) {
sl@0: 	Tcl_AppendResult(interp, "can't wait for variable \"", nameString,
sl@0: 		"\":  would wait forever", (char *) NULL);
sl@0: 	return TCL_ERROR;
sl@0:     }
sl@0:     return TCL_OK;
sl@0: }
sl@0: 
sl@0: 	/* ARGSUSED */
sl@0: static char *
sl@0: VwaitVarProc(clientData, interp, name1, name2, flags)
sl@0:     ClientData clientData;	/* Pointer to integer to set to 1. */
sl@0:     Tcl_Interp *interp;		/* Interpreter containing variable. */
sl@0:     CONST char *name1;		/* Name of variable. */
sl@0:     CONST char *name2;		/* Second part of variable name. */
sl@0:     int flags;			/* Information about what happened. */
sl@0: {
sl@0:     int *donePtr = (int *) clientData;
sl@0: 
sl@0:     *donePtr = 1;
sl@0:     return (char *) NULL;
sl@0: }
sl@0: 
sl@0: /*
sl@0:  *----------------------------------------------------------------------
sl@0:  *
sl@0:  * Tcl_UpdateObjCmd --
sl@0:  *
sl@0:  *	This procedure is invoked to process the "update" Tcl command.
sl@0:  *	See the user documentation for details on what it does.
sl@0:  *
sl@0:  * Results:
sl@0:  *	A standard Tcl result.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	See the user documentation.
sl@0:  *
sl@0:  *----------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: 	/* ARGSUSED */
sl@0: int
sl@0: Tcl_UpdateObjCmd(clientData, interp, objc, objv)
sl@0:     ClientData clientData;	/* Not used. */
sl@0:     Tcl_Interp *interp;		/* Current interpreter. */
sl@0:     int objc;			/* Number of arguments. */
sl@0:     Tcl_Obj *CONST objv[];	/* Argument objects. */
sl@0: {
sl@0:     int optionIndex;
sl@0:     int flags = 0;		/* Initialized to avoid compiler warning. */
sl@0:     static CONST char *updateOptions[] = {"idletasks", (char *) NULL};
sl@0:     enum updateOptions {REGEXP_IDLETASKS};
sl@0: 
sl@0:     if (objc == 1) {
sl@0: 	flags = TCL_ALL_EVENTS|TCL_DONT_WAIT;
sl@0:     } else if (objc == 2) {
sl@0: 	if (Tcl_GetIndexFromObj(interp, objv[1], updateOptions,
sl@0: 		"option", 0, &optionIndex) != TCL_OK) {
sl@0: 	    return TCL_ERROR;
sl@0: 	}
sl@0: 	switch ((enum updateOptions) optionIndex) {
sl@0: 	    case REGEXP_IDLETASKS: {
sl@0: 		flags = TCL_WINDOW_EVENTS|TCL_IDLE_EVENTS|TCL_DONT_WAIT;
sl@0: 		break;
sl@0: 	    }
sl@0: 	    default: {
sl@0: 		panic("Tcl_UpdateObjCmd: bad option index to UpdateOptions");
sl@0: 	    }
sl@0: 	}
sl@0:     } else {
sl@0:         Tcl_WrongNumArgs(interp, 1, objv, "?idletasks?");
sl@0: 	return TCL_ERROR;
sl@0:     }
sl@0:     
sl@0:     while (Tcl_DoOneEvent(flags) != 0) {
sl@0: 	/* Empty loop body */
sl@0:     }
sl@0: 
sl@0:     /*
sl@0:      * Must clear the interpreter's result because event handlers could
sl@0:      * have executed commands.
sl@0:      */
sl@0: 
sl@0:     Tcl_ResetResult(interp);
sl@0:     return TCL_OK;
sl@0: }
sl@0: 
sl@0: #ifdef TCL_THREADS
sl@0: /*
sl@0:  *-----------------------------------------------------------------------------
sl@0:  *
sl@0:  *  NewThreadProc --
sl@0:  *
sl@0:  * 	Bootstrap function of a new Tcl thread.
sl@0:  *
sl@0:  * Results:
sl@0:  *	None.
sl@0:  *
sl@0:  * Side Effects:
sl@0:  *	Initializes Tcl notifier for the current thread.
sl@0:  *
sl@0:  *-----------------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: static Tcl_ThreadCreateType
sl@0: NewThreadProc(ClientData clientData)
sl@0: {
sl@0:     ThreadClientData *cdPtr;
sl@0:     ClientData threadClientData;
sl@0:     Tcl_ThreadCreateProc *threadProc;
sl@0: 
sl@0:     cdPtr = (ThreadClientData*)clientData;
sl@0:     threadProc = cdPtr->proc;
sl@0:     threadClientData = cdPtr->clientData;
sl@0:     ckfree((char*)clientData); /* Allocated in Tcl_CreateThread() */
sl@0: 
sl@0:     (*threadProc)(threadClientData);
sl@0: 
sl@0:     TCL_THREAD_CREATE_RETURN;
sl@0: }
sl@0: #endif
sl@0: /*
sl@0:  *----------------------------------------------------------------------
sl@0:  *
sl@0:  * Tcl_CreateThread --
sl@0:  *
sl@0:  *	This procedure creates a new thread. This actually belongs
sl@0:  *	to the tclThread.c file but since we use some private 
sl@0:  *	data structures local to this file, it is placed here.
sl@0:  *
sl@0:  * Results:
sl@0:  *	TCL_OK if the thread could be created.  The thread ID is
sl@0:  *	returned in a parameter.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	A new thread is created.
sl@0:  *
sl@0:  *----------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: EXPORT_C int
sl@0: Tcl_CreateThread(idPtr, proc, clientData, stackSize, flags)
sl@0:     Tcl_ThreadId *idPtr;		/* Return, the ID of the thread */
sl@0:     Tcl_ThreadCreateProc proc;		/* Main() function of the thread */
sl@0:     ClientData clientData;		/* The one argument to Main() */
sl@0:     int stackSize;			/* Size of stack for the new thread */
sl@0:     int flags;				/* Flags controlling behaviour of
sl@0: 					 * the new thread */
sl@0: {
sl@0: #ifdef TCL_THREADS
sl@0:     ThreadClientData *cdPtr;
sl@0: 
sl@0:     cdPtr = (ThreadClientData*)ckalloc(sizeof(ThreadClientData));
sl@0:     cdPtr->proc = proc;
sl@0:     cdPtr->clientData = clientData;
sl@0: 
sl@0:     return TclpThreadCreate(idPtr, NewThreadProc, (ClientData)cdPtr,
sl@0:                            stackSize, flags);
sl@0: #else
sl@0:     return TCL_ERROR;
sl@0: #endif /* TCL_THREADS */
sl@0: }