/*
 * tclTrace.c --
 *
 *	This file contains code to handle most trace management.
 *
 * Copyright (c) 1987-1993 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 * Copyright (c) 1998-2000 Scriptics Corporation.
 * Copyright (c) 2002 ActiveState Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclTrace.c,v 1.47 2007/12/13 15:23:20 dgp Exp $
 */

#include "tclInt.h"

/*
 * Structures used to hold information about variable traces:
 */

 * trace procs
 */

typedef struct StringTraceData {
    ClientData clientData;	/* Client data from Tcl_CreateTrace */
    Tcl_CmdTraceProc *proc;	/* Trace function from Tcl_CreateTrace */
} StringTraceData;
















/*
 *----------------------------------------------------------------------
 *
 * Tcl_TraceObjCmd --
 *
 *	This function is invoked to process the "trace" Tcl command. See the

    };

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?");
	return TCL_ERROR;
    }

    if (Tcl_GetIndexFromObj(interp, objv[1], traceOptions,
		"option", 0, &optionIndex) != TCL_OK) {
	return TCL_ERROR;
    }
    switch ((enum traceOptions) optionIndex) {
    case TRACE_ADD:
    case TRACE_REMOVE: {
	/*
	 * All sub commands of trace add/remove must take at least one more

	Tcl_Obj *resultListPtr, *pairObjPtr, *elemObjPtr;

	if (objc != 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "name");
	    return TCL_ERROR;
	}
	resultListPtr = Tcl_NewObj();
	clientData = 0;
	name = Tcl_GetString(objv[2]);
	while ((clientData = Tcl_VarTraceInfo(interp, name, 0,
		TraceVarProc, clientData)) != 0) {

	    TraceVarInfo *tvarPtr = (TraceVarInfo *) clientData;

	    pairObjPtr = Tcl_NewListObj(0, NULL);
	    p = ops;
	    if (tvarPtr->flags & TCL_TRACE_READS) {
		*p = 'r';
		p++;
	    }

		flags |= TCL_TRACE_LEAVE_DURING_EXEC;
		break;
	    }
	}
	command = Tcl_GetStringFromObj(objv[5], &commandLength);
	length = (size_t) commandLength;
	if ((enum traceOptions) optionIndex == TRACE_ADD) {
	    TraceCommandInfo *tcmdPtr;

	    tcmdPtr = (TraceCommandInfo *) ckalloc((unsigned)
		    (sizeof(TraceCommandInfo) - sizeof(tcmdPtr->command)
			    + length + 1));
	    tcmdPtr->flags = flags;
	    tcmdPtr->stepTrace = NULL;
	    tcmdPtr->startLevel = 0;
	    tcmdPtr->startCmd = NULL;
	    tcmdPtr->length = length;
	    tcmdPtr->refCount = 1;
	    flags |= TCL_TRACE_DELETE;
	    if (flags & (TCL_TRACE_ENTER_DURING_EXEC |
		    TCL_TRACE_LEAVE_DURING_EXEC)) {
		flags |= (TCL_TRACE_ENTER_EXEC | TCL_TRACE_LEAVE_EXEC);
	    }
	    strcpy(tcmdPtr->command, command);
	    name = Tcl_GetString(objv[3]);
	    if (Tcl_TraceCommand(interp, name, flags, TraceCommandProc,
		    (ClientData) tcmdPtr) != TCL_OK) {
		ckfree((char *) tcmdPtr);
		return TCL_ERROR;
	    }
	} else {
	    /*
	     * Search through all of our traces on this command to see if
	     * there's one with the given command. If so, then delete the
	     * first one that matches.
	     */

	    TraceCommandInfo *tcmdPtr;
	    ClientData clientData = NULL;
	    name = Tcl_GetString(objv[3]);

	    /*
	     * First ensure the name given is valid.
	     */


	    if (Tcl_FindCommand(interp,name,NULL,TCL_LEAVE_ERR_MSG) == NULL) {
		return TCL_ERROR;
	    }

	    while ((clientData = Tcl_CommandTraceInfo(interp, name, 0,
		    TraceCommandProc, clientData)) != NULL) {
		tcmdPtr = (TraceCommandInfo *) clientData;

		/*
		 * In checking the 'flags' field we must remove any extraneous
		 * flags which may have been temporarily added by various
		 * pieces of the trace mechanism.
		 */

		}
	    }
	}
	break;
    }
    case TRACE_INFO: {
	ClientData clientData;
	Tcl_Obj *resultListPtr, *eachTraceObjPtr, *elemObjPtr;

	if (objc != 4) {
	    Tcl_WrongNumArgs(interp, 3, objv, "name");
	    return TCL_ERROR;
	}

	clientData = NULL;
	name = Tcl_GetString(objv[3]);

	/*
	 * First ensure the name given is valid.
	 */

	if (Tcl_FindCommand(interp, name, NULL, TCL_LEAVE_ERR_MSG) == NULL) {
	    return TCL_ERROR;
	}

	resultListPtr = Tcl_NewListObj(0, NULL);
	while ((clientData = Tcl_CommandTraceInfo(interp, name, 0,
		TraceCommandProc, clientData)) != NULL) {
	    int numOps = 0;
	    Tcl_Obj *opObj;
	    TraceCommandInfo *tcmdPtr = (TraceCommandInfo *) clientData;

	    /*
	     * Build a list with the ops list as the first obj element and the
	     * tcmdPtr->command string as the second obj element. Append this
	     * list (as an element) to the end of the result object list.
	     */

		break;
	    }
	}

	command = Tcl_GetStringFromObj(objv[5], &commandLength);
	length = (size_t) commandLength;
	if ((enum traceOptions) optionIndex == TRACE_ADD) {
	    TraceCommandInfo *tcmdPtr;

	    tcmdPtr = (TraceCommandInfo *) ckalloc((unsigned)
		    (sizeof(TraceCommandInfo) - sizeof(tcmdPtr->command)
			    + length + 1));
	    tcmdPtr->flags = flags;
	    tcmdPtr->stepTrace = NULL;
	    tcmdPtr->startLevel = 0;
	    tcmdPtr->startCmd = NULL;
	    tcmdPtr->length = length;
	    tcmdPtr->refCount = 1;
	    flags |= TCL_TRACE_DELETE;
	    strcpy(tcmdPtr->command, command);
	    name = Tcl_GetString(objv[3]);
	    if (Tcl_TraceCommand(interp, name, flags, TraceCommandProc,
		    (ClientData) tcmdPtr) != TCL_OK) {
		ckfree((char *) tcmdPtr);
		return TCL_ERROR;
	    }
	} else {
	    /*
	     * Search through all of our traces on this command to see if
	     * there's one with the given command. If so, then delete the
	     * first one that matches.
	     */

	    TraceCommandInfo *tcmdPtr;
	    ClientData clientData = NULL;
	    name = Tcl_GetString(objv[3]);

	    /*
	     * First ensure the name given is valid.
	     */


	    if (Tcl_FindCommand(interp,name,NULL,TCL_LEAVE_ERR_MSG) == NULL) {
		return TCL_ERROR;
	    }

	    while ((clientData = Tcl_CommandTraceInfo(interp, name, 0,
		    TraceCommandProc, clientData)) != NULL) {
		tcmdPtr = (TraceCommandInfo *) clientData;
		if ((tcmdPtr->length == length)
			&& (tcmdPtr->flags == flags)
			&& (strncmp(command, tcmdPtr->command,
				(size_t) length) == 0)) {
		    Tcl_UntraceCommand(interp, name, flags | TCL_TRACE_DELETE,
			    TraceCommandProc, clientData);
		    tcmdPtr->flags |= TCL_TRACE_DESTROYED;
		    if ((--tcmdPtr->refCount) <= 0) {
			ckfree((char *) tcmdPtr);
		    }
		    break;
		}
	    }
	}
	break;
    }
    case TRACE_INFO: {
	ClientData clientData;
	Tcl_Obj *resultListPtr, *eachTraceObjPtr, *elemObjPtr;

	if (objc != 4) {
	    Tcl_WrongNumArgs(interp, 3, objv, "name");
	    return TCL_ERROR;
	}

	clientData = NULL;
	name = Tcl_GetString(objv[3]);

	/*
	 * First ensure the name given is valid.
	 */


	if (Tcl_FindCommand(interp, name, NULL, TCL_LEAVE_ERR_MSG) == NULL) {
	    return TCL_ERROR;
	}

	resultListPtr = Tcl_NewListObj(0, NULL);
	while ((clientData = Tcl_CommandTraceInfo(interp, name, 0,
		TraceCommandProc, clientData)) != NULL) {
	    int numOps = 0;
	    Tcl_Obj *opObj;
	    TraceCommandInfo *tcmdPtr = (TraceCommandInfo *) clientData;

	    /*
	     * Build a list with the ops list as the first obj element and the
	     * tcmdPtr->command string as the second obj element. Append this
	     * list (as an element) to the end of the result object list.
	     */

		flags |= TCL_TRACE_WRITES;
		break;
	    }
	}
	command = Tcl_GetStringFromObj(objv[5], &commandLength);
	length = (size_t) commandLength;
	if ((enum traceOptions) optionIndex == TRACE_ADD) {
	    CombinedTraceVarInfo *ctvarPtr;

	    ctvarPtr = (CombinedTraceVarInfo *) ckalloc((unsigned)
		    (sizeof(CombinedTraceVarInfo) + length + 1
		    - sizeof(ctvarPtr->traceCmdInfo.command)));
	    ctvarPtr->traceCmdInfo.flags = flags;
	    if (objv[0] == NULL) {
		ctvarPtr->traceCmdInfo.flags |= TCL_TRACE_OLD_STYLE;
	    }
	    ctvarPtr->traceCmdInfo.length = length;
	    flags |= TCL_TRACE_UNSETS | TCL_TRACE_RESULT_OBJECT;
	    strcpy(ctvarPtr->traceCmdInfo.command, command);
	    ctvarPtr->traceInfo.traceProc = TraceVarProc;
	    ctvarPtr->traceInfo.clientData = (ClientData)
		    &ctvarPtr->traceCmdInfo;
	    ctvarPtr->traceInfo.flags = flags;
	    name = Tcl_GetString(objv[3]);
	    if (TraceVarEx(interp,name,NULL,(VarTrace*)ctvarPtr) != TCL_OK) {

		ckfree((char *) ctvarPtr);
		return TCL_ERROR;
	    }
	} else {
	    /*
	     * Search through all of our traces on this variable to see if
	     * there's one with the given command. If so, then delete the
	     * first one that matches.
	     */

	    TraceVarInfo *tvarPtr;
	    ClientData clientData = 0;

	    name = Tcl_GetString(objv[3]);
	    while ((clientData = Tcl_VarTraceInfo(interp, name, 0,
		    TraceVarProc, clientData)) != 0) {
		tvarPtr = (TraceVarInfo *) clientData;
		if ((tvarPtr->length == length)
			&& ((tvarPtr->flags & ~TCL_TRACE_OLD_STYLE)==flags)
			&& (strncmp(command, tvarPtr->command,
				(size_t) length) == 0)) {
		    Tcl_UntraceVar2(interp, name, NULL,
			    flags | TCL_TRACE_UNSETS | TCL_TRACE_RESULT_OBJECT,
			    TraceVarProc, clientData);
		    break;
		}
	    }
	}
	break;
    }
    case TRACE_INFO: {
	ClientData clientData;
	Tcl_Obj *resultListPtr, *eachTraceObjPtr, *elemObjPtr;

	if (objc != 4) {
	    Tcl_WrongNumArgs(interp, 3, objv, "name");
	    return TCL_ERROR;
	}

	resultListPtr = Tcl_NewObj();
	clientData = 0;
	name = Tcl_GetString(objv[3]);
	while ((clientData = Tcl_VarTraceInfo(interp, name, 0, TraceVarProc,
		clientData)) != 0) {
	    Tcl_Obj *opObj;
	    TraceVarInfo *tvarPtr = (TraceVarInfo *) clientData;

	    /*
	     * Build a list with the ops list as the first obj element and the
	     * tcmdPtr->command string as the second obj element. Append this
	     * list (as an element) to the end of the result object list.
	     */

	    elemObjPtr = Tcl_NewListObj(0, NULL);
	    if (tvarPtr->flags & TCL_TRACE_ARRAY) {
		TclNewLiteralStringObj(opObj, "array");
		Tcl_ListObjAppendElement(NULL, elemObjPtr, opObj);
	    }
	    if (tvarPtr->flags & TCL_TRACE_READS) {
		TclNewLiteralStringObj(opObj, "read");
		Tcl_ListObjAppendElement(NULL, elemObjPtr, opObj);
	    }
	    if (tvarPtr->flags & TCL_TRACE_WRITES) {
		TclNewLiteralStringObj(opObj, "write");
		Tcl_ListObjAppendElement(NULL, elemObjPtr, opObj);
	    }
	    if (tvarPtr->flags & TCL_TRACE_UNSETS) {
		TclNewLiteralStringObj(opObj, "unset");
		Tcl_ListObjAppendElement(NULL, elemObjPtr, opObj);
	    }
	    eachTraceObjPtr = Tcl_NewListObj(0, NULL);
	    Tcl_ListObjAppendElement(NULL, eachTraceObjPtr, elemObjPtr);

	    elemObjPtr = Tcl_NewStringObj(tvarPtr->command, -1);
	    Tcl_ListObjAppendElement(NULL, eachTraceObjPtr, elemObjPtr);
	    Tcl_ListObjAppendElement(interp, resultListPtr,

    const char *oldName,	/* Name of command being changed. */
    const char *newName,	/* New name of command. Empty string or NULL
				 * means command is being deleted (renamed to
				 * ""). */
    int flags)			/* OR-ed bits giving operation and other
				 * information. */
{
    TraceCommandInfo *tcmdPtr = (TraceCommandInfo *) clientData;
    int code;
    Tcl_DString cmd;

    tcmdPtr->refCount++;

    if ((tcmdPtr->flags & flags) && !Tcl_InterpDeleted(interp)
	    && !Tcl_LimitExceeded(interp)) {

	 * Note that we save the (return) state of the interpreter to prevent
	 * bizarre error messages.
	 */

	state = Tcl_SaveInterpState(interp, TCL_OK);
	Tcl_UntraceCommand(interp, oldName, untraceFlags,
		TraceCommandProc, clientData);
	(void) Tcl_RestoreInterpState(interp, state);
	tcmdPtr->refCount--;
    }
    if ((--tcmdPtr->refCount) <= 0) {
	ckfree((char *) tcmdPtr);
    }
}


		tracePtr = tracePtr->nextPtr;
	    }
	} else {
	    active.reverseScan = 0;
	    active.nextTracePtr = tracePtr->nextPtr;
	}
	if (tracePtr->traceProc == TraceCommandProc) {
	    TraceCommandInfo *tcmdPtr = (TraceCommandInfo *)
		    tracePtr->clientData;

	    if (tcmdPtr->flags != 0) {
		tcmdPtr->curFlags = traceFlags | TCL_TRACE_EXEC_DIRECT;
		tcmdPtr->curCode  = code;
		tcmdPtr->refCount++;
		if (state == NULL) {
		    state = Tcl_SaveInterpState(interp, code);
		}
		traceCode = TraceExecutionProc((ClientData) tcmdPtr, interp,
			curLevel, command, (Tcl_Command) cmdPtr, objc, objv);
		if ((--tcmdPtr->refCount) <= 0) {
		    ckfree((char *) tcmdPtr);
		}
	    }
	}
	if (active.nextTracePtr) {
	    lastTracePtr = active.nextTracePtr->nextPtr;
	}
    }
    iPtr->activeCmdTracePtr = active.nextPtr;
    if (state) {
	(void) Tcl_RestoreInterpState(interp, state);
    }

    return(traceCode);
}

/*
 *----------------------------------------------------------------------
 *
 * TclCheckInterpTraces --
 *

	     * The proc invoked might delete the traced command which which
	     * might try to free tracePtr. We want to use tracePtr until the
	     * end of this if section, so we use Tcl_Preserve() and
	     * Tcl_Release() to be sure it is not freed while we still need
	     * it.
	     */

	    Tcl_Preserve((ClientData) tracePtr);
	    tracePtr->flags |= TCL_TRACE_EXEC_IN_PROGRESS;
	    if (state == NULL) {
		state = Tcl_SaveInterpState(interp, code);
	    }

	    if (tracePtr->flags &
		    (TCL_TRACE_ENTER_EXEC | TCL_TRACE_LEAVE_EXEC)) {
		/*
		 * New style trace.
		 */

		if (tracePtr->flags & traceFlags) {
		    if (tracePtr->proc == TraceExecutionProc) {
			TraceCommandInfo *tcmdPtr = (TraceCommandInfo *)
				tracePtr->clientData;

			tcmdPtr->curFlags = traceFlags;
			tcmdPtr->curCode = code;
		    }
		    traceCode = (tracePtr->proc)(tracePtr->clientData,
			    interp, curLevel, command, (Tcl_Command) cmdPtr,
			    objc, objv);

		     */

		    traceCode = CallTraceFunction(interp, tracePtr, cmdPtr,
			    command, numChars, objc, objv);
		}
	    }
	    tracePtr->flags &= ~TCL_TRACE_EXEC_IN_PROGRESS;
	    Tcl_Release((ClientData) tracePtr);
	}
    }
    iPtr->activeInterpTracePtr = active.nextPtr;
    if (state) {
	if (traceCode == TCL_OK) {
	    (void) Tcl_RestoreInterpState(interp, state);
	} else {
	    Tcl_DiscardInterpState(state);
	}
    }

    return(traceCode);
}

/*
 *----------------------------------------------------------------------
 *
 * CallTraceFunction --
 *

    char *commandCopy;
    int traceCode;

    /*
     * Copy the command characters into a new string.
     */

    commandCopy = TclStackAlloc(interp, (unsigned) (numChars + 1));
    memcpy(commandCopy, command, (size_t) numChars);
    commandCopy[numChars] = '\0';

    /*
     * Call the trace function then free allocated storage.
     */

    traceCode = (tracePtr->proc)(tracePtr->clientData, (Tcl_Interp *) iPtr,
	    iPtr->numLevels, commandCopy, (Tcl_Command) cmdPtr, objc, objv);

    TclStackFree(interp, commandCopy);
    return traceCode;
}

/*

 *----------------------------------------------------------------------
 */

static void
CommandObjTraceDeleted(
    ClientData clientData)
{
    TraceCommandInfo *tcmdPtr = (TraceCommandInfo *) clientData;

    if ((--tcmdPtr->refCount) <= 0) {
	ckfree((char *) tcmdPtr);
    }
}

/*

    const char *command,
    Tcl_Command cmdInfo,
    int objc,
    struct Tcl_Obj *const objv[])
{
    int call = 0;
    Interp *iPtr = (Interp *) interp;
    TraceCommandInfo *tcmdPtr = (TraceCommandInfo *) clientData;
    int flags = tcmdPtr->curFlags;
    int code = tcmdPtr->curCode;
    int traceCode = TCL_OK;

    if (tcmdPtr->flags & TCL_TRACE_EXEC_IN_PROGRESS) {
	/*
	 * Inside any kind of execution trace callback, we do not allow any

	}

	/*
	 * Second, create the tcl callback, if required.
	 */

	if (call) {
	    Tcl_DString cmd;
	    Tcl_DString sub;
	    int i, saveInterpFlags;

	    Tcl_DStringInit(&cmd);
	    Tcl_DStringAppend(&cmd, tcmdPtr->command, (int)tcmdPtr->length);

	    /*
	     * Append command with arguments.

	    tcmdPtr->startLevel = level;
	    tcmdPtr->startCmd = ckalloc(len);
	    memcpy(tcmdPtr->startCmd, command, len);
	    tcmdPtr->refCount++;
	    tcmdPtr->stepTrace = Tcl_CreateObjTrace(interp, 0,
		   (tcmdPtr->flags & TCL_TRACE_ANY_EXEC) >> 2,
		   TraceExecutionProc, (ClientData)tcmdPtr,
		   CommandObjTraceDeleted);
	}
    }
    if (flags & TCL_TRACE_DESTROYED) {
	if (tcmdPtr->stepTrace != NULL) {
	    Tcl_DeleteTrace(interp, tcmdPtr->stepTrace);
	    tcmdPtr->stepTrace = NULL;
	    if (tcmdPtr->startCmd != NULL) {

    Tcl_Interp *interp,		/* Interpreter containing variable. */
    const char *name1,		/* Name of variable or array. */
    const char *name2,		/* Name of element within array; NULL means
				 * scalar variable is being referenced. */
    int flags)			/* OR-ed bits giving operation and other
				 * information. */
{
    TraceVarInfo *tvarPtr = (TraceVarInfo *) clientData;
    char *result;
    int code, destroy = 0;
    Tcl_DString cmd;

    /*
     * We might call Tcl_Eval() below, and that might evaluate [trace vdelete]
     * which might try to free tvarPtr. We want to use tvarPtr until the end

{
    StringTraceData *data = (StringTraceData *)
	    ckalloc(sizeof(StringTraceData));

    data->clientData = clientData;
    data->proc = proc;
    return Tcl_CreateObjTrace(interp, level, 0, StringTraceProc,
	    (ClientData) data, StringTraceDeleteProc);
}

/*
 *----------------------------------------------------------------------
 *
 * StringTraceProc --
 *

    Tcl_Interp *interp,
    int level,
    const char *command,
    Tcl_Command commandInfo,
    int objc,
    Tcl_Obj *const *objv)
{
    StringTraceData *data = (StringTraceData *) clientData;
    Command *cmdPtr = (Command *) commandInfo;
    const char **argv;		/* Args to pass to string trace proc */
    int i;

    /*
     * This is a bit messy because we have to emulate the old trace interface,
     * which uses strings for everything.

    /*
     * Invoke the command function. Note that we cast away const-ness on two
     * parameters for compatibility with legacy code; the code MUST NOT modify
     * either command or argv.
     */

    (data->proc)(data->clientData, interp, level, (char *) command,
	    cmdPtr->proc, cmdPtr->clientData, objc, argv);
    TclStackFree(interp, (void *) argv);

    return TCL_OK;
}

/*

 */

Var *
TclVarTraceExists(
    Tcl_Interp *interp,		/* The interpreter */
    const char *varName)	/* The variable name */
{
    Var *varPtr;
    Var *arrayPtr;

    /*
     * The choice of "create" flag values is delicate here, and matches the
     * semantics of GetVar. Things are still not perfect, however, because if
     * you do "info exists x" you get a varPtr and therefore trigger traces.
     * However, if you do "info exists x(i)", then you only get a varPtr if x
     * is already known to be an array. Otherwise you get NULL, and no trace
     * is triggered. This matches Tcl 7.6 semantics.
     */

    varPtr = TclLookupVar(interp, varName, NULL, 0, "access",
	    /*createPart1*/ 0, /*createPart2*/ 1, &arrayPtr);

    if (varPtr == NULL) {
	return NULL;
    }

    if ((varPtr->flags & VAR_TRACED_READ)
	    || (arrayPtr && (arrayPtr->flags & VAR_TRACED_READ))) {
	TclCallVarTraces((Interp *)interp, arrayPtr, varPtr, varName, NULL,
		TCL_TRACE_READS, /* leaveErrMsg */ 0);
    }

    /*
     * If the variable doesn't exist anymore and no-one's using it, then free
     * up the relevant structures and hash table entries.
     */

    /*
     * Invoke traces on the array containing the variable, if relevant.
     */

    result = NULL;
    active.nextPtr = iPtr->activeVarTracePtr;
    iPtr->activeVarTracePtr = &active;
    Tcl_Preserve((ClientData) iPtr);
    if (arrayPtr && !TclIsVarTraceActive(arrayPtr)
	    && (arrayPtr->flags & traceflags)) {
	hPtr = Tcl_FindHashEntry(&iPtr->varTraces, (char *) arrayPtr);
	active.varPtr = arrayPtr;
	for (tracePtr = (VarTrace *) Tcl_GetHashValue(hPtr);
	     tracePtr != NULL; tracePtr = active.nextTracePtr) {
	    active.nextTracePtr = tracePtr->nextPtr;
	    if (!(tracePtr->flags & flags)) {
		continue;
	    }
	    Tcl_Preserve((ClientData) tracePtr);
	    if (state == NULL) {
		state = Tcl_SaveInterpState((Tcl_Interp *)iPtr, code);
	    }
	    if (Tcl_InterpDeleted((Tcl_Interp *)iPtr)) {
		flags |= TCL_INTERP_DESTROYED;
	    }
	    result = (*tracePtr->traceProc)(tracePtr->clientData,
		    (Tcl_Interp *) iPtr, part1, part2, flags);
	    if (result != NULL) {
		if (flags & TCL_TRACE_UNSETS) {
		    /*
		     * Ignore errors in unset traces.
		     */

		    DisposeTraceResult(tracePtr->flags, result);
		} else {
		    disposeFlags = tracePtr->flags;
		    code = TCL_ERROR;
		}
	    }
	    Tcl_Release((ClientData) tracePtr);
	    if (code == TCL_ERROR) {
		goto done;
	    }
	}
    }

    /*
     * Invoke traces on the variable itself.
     */

    if (flags & TCL_TRACE_UNSETS) {
	flags |= TCL_TRACE_DESTROYED;
    }
    active.varPtr = varPtr;
    if (varPtr->flags & traceflags) {
	hPtr = Tcl_FindHashEntry(&iPtr->varTraces, (char *) varPtr);
	for (tracePtr = (VarTrace *) Tcl_GetHashValue(hPtr);
	     tracePtr != NULL; tracePtr = active.nextTracePtr) {
	    active.nextTracePtr = tracePtr->nextPtr;
	    if (!(tracePtr->flags & flags)) {
		continue;
	    }
	    Tcl_Preserve((ClientData) tracePtr);
	    if (state == NULL) {
		state = Tcl_SaveInterpState((Tcl_Interp *)iPtr, code);
	    }
	    if (Tcl_InterpDeleted((Tcl_Interp *)iPtr)) {
		flags |= TCL_INTERP_DESTROYED;
	    }
	    result = (*tracePtr->traceProc)(tracePtr->clientData,
		    (Tcl_Interp *) iPtr, part1, part2, flags);
	    if (result != NULL) {
		if (flags & TCL_TRACE_UNSETS) {
		    /*
		     * Ignore errors in unset traces.
		     */

		    DisposeTraceResult(tracePtr->flags, result);
		} else {
		    disposeFlags = tracePtr->flags;
		    code = TCL_ERROR;
		}
	    }
	    Tcl_Release((ClientData) tracePtr);
	    if (code == TCL_ERROR) {
		goto done;
	    }
	}
    }

    /*

		Tcl_AppendToObj(errorInfo, part1, -1);
		Tcl_AppendToObj(errorInfo, ")", -1);
	    }
	    Tcl_AppendToObj(errorInfo, "\")", -1);
	    Tcl_DictObjPut(NULL, options, errorInfoKey, errorInfo);
	    Tcl_DecrRefCount(errorInfoKey);
	    Tcl_DecrRefCount(errorInfo);
	    code = Tcl_SetReturnOptions((Tcl_Interp *)iPtr, options);
	    iPtr->flags &= ~(ERR_ALREADY_LOGGED);
	    Tcl_DiscardInterpState(state);
	} else {
	    (void) Tcl_RestoreInterpState((Tcl_Interp *)iPtr, state);
	}
	DisposeTraceResult(disposeFlags,result);
    } else if (state) {
	if (code == TCL_OK) {
	    code = Tcl_RestoreInterpState((Tcl_Interp *)iPtr, state);
	} else {
	    Tcl_DiscardInterpState(state);
	}
    }

    if (arrayPtr && TclIsVarInHash(arrayPtr)) {
	VarHashRefCount(arrayPtr)--;
    }
    if (copiedName) {
	Tcl_DStringFree(&nameCopy);
    }
    TclClearVarTraceActive(varPtr);
    if (TclIsVarInHash(varPtr)) {
	VarHashRefCount(varPtr)--;
    }
    iPtr->activeVarTracePtr = active.nextPtr;
    Tcl_Release((ClientData) iPtr);
    return code;
}

/*
 *----------------------------------------------------------------------
 *
 * DisposeTraceResult--

    flagMask = TCL_TRACE_READS | TCL_TRACE_WRITES | TCL_TRACE_UNSETS |
	  TCL_TRACE_ARRAY | TCL_TRACE_RESULT_DYNAMIC | TCL_TRACE_RESULT_OBJECT;
#ifndef TCL_REMOVE_OBSOLETE_TRACES
    flagMask |= TCL_TRACE_OLD_STYLE;
#endif
    flags &= flagMask;

    hPtr = Tcl_FindHashEntry(&iPtr->varTraces,
	    (char *) varPtr);
    for (tracePtr = (VarTrace *) Tcl_GetHashValue(hPtr), prevPtr = NULL; ;
	    prevPtr = tracePtr, tracePtr = tracePtr->nextPtr) {
	if (tracePtr == NULL) {
	    goto updateFlags;
	}
	if ((tracePtr->traceProc == proc) && (tracePtr->flags == flags)
		&& (tracePtr->clientData == clientData)) {
	    break;

	    Tcl_SetHashValue(hPtr, nextPtr);
	} else {
	    Tcl_DeleteHashEntry(hPtr);
	}
    } else {
	prevPtr->nextPtr = nextPtr;
    }
    Tcl_EventuallyFree((ClientData) tracePtr, TCL_DYNAMIC);

    for (tracePtr = nextPtr; tracePtr != NULL;
	    tracePtr = tracePtr->nextPtr) {
	allFlags |= tracePtr->flags;
    }

  updateFlags:

    Tcl_VarTraceProc *proc,	/* Function assocated with trace. */
    ClientData prevClientData)	/* If non-NULL, gives last value returned by
				 * this function, so this call will return the
				 * next trace after that one. If NULL, this
				 * call will return the first trace. */
{
    Interp *iPtr = (Interp *) interp;
    register VarTrace *tracePtr;
    Var *varPtr, *arrayPtr;
    Tcl_HashEntry *hPtr;

    varPtr = TclLookupVar(interp, part1, part2,
	    flags & (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY), /*msg*/ NULL,
	    /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr);
    if (varPtr == NULL) {
	return NULL;
    }

    /*
     * Find the relevant trace, if any, and return its clientData.
     */

    hPtr = Tcl_FindHashEntry(&iPtr->varTraces,
	    (char *) varPtr);

    if (hPtr) {
	tracePtr = Tcl_GetHashValue(hPtr);

	if (prevClientData != NULL) {
	    for ( ;  tracePtr != NULL;  tracePtr = tracePtr->nextPtr) {
		if ((tracePtr->clientData == prevClientData)
			&& (tracePtr->traceProc == proc)) {
		    tracePtr = tracePtr->nextPtr;
		    break;
		}
	    }
	}
	for (; tracePtr!=NULL ; tracePtr=tracePtr->nextPtr) {
	    if (tracePtr->traceProc == proc) {
		return tracePtr->clientData;
	    }
	}
    }
    return NULL;
}

    }

    /*
     * Check for a nonsense flag combination. Note that this is a Tcl_Panic()
     * because there should be no code path that ever sets both flags.
     */

    if ((tracePtr->flags&TCL_TRACE_RESULT_DYNAMIC)
	    && (tracePtr->flags&TCL_TRACE_RESULT_OBJECT)) {
	Tcl_Panic("bad result flag combination");
    }

    /*
     * Set up trace information.
     */

    flagMask = TCL_TRACE_READS | TCL_TRACE_WRITES | TCL_TRACE_UNSETS |
	  TCL_TRACE_ARRAY | TCL_TRACE_RESULT_DYNAMIC | TCL_TRACE_RESULT_OBJECT;
#ifndef TCL_REMOVE_OBSOLETE_TRACES
    flagMask |= TCL_TRACE_OLD_STYLE;
#endif
    tracePtr->flags = tracePtr->flags & flagMask;

    hPtr = Tcl_CreateHashEntry(&iPtr->varTraces, (char *) varPtr, &isNew);
    if (isNew) {
	tracePtr->nextPtr = NULL;
    } else {
	tracePtr->nextPtr = (VarTrace *) Tcl_GetHashValue(hPtr);
    }
    Tcl_SetHashValue(hPtr, (char *) tracePtr);

    /*
     * Mark the variable as traced so we know to call them.
     */

    varPtr->flags |= (tracePtr->flags & VAR_ALL_TRACES);