diff options
Diffstat (limited to 'generic')
| -rw-r--r-- | generic/tcl.h | 10 | ||||
| -rw-r--r-- | generic/tclBasic.c | 197 | ||||
| -rw-r--r-- | generic/tclCmdMZ.c | 775 | ||||
| -rw-r--r-- | generic/tclCompile.c | 3 | ||||
| -rw-r--r-- | generic/tclExecute.c | 13 | ||||
| -rw-r--r-- | generic/tclInt.decls | 14 | ||||
| -rw-r--r-- | generic/tclInt.h | 46 | ||||
| -rw-r--r-- | generic/tclIntDecls.h | 24 | ||||
| -rw-r--r-- | generic/tclStubInit.c | 4 | ||||
| -rw-r--r-- | generic/tclVar.c | 64 |
10 files changed, 984 insertions, 166 deletions
diff --git a/generic/tcl.h b/generic/tcl.h index 2376e04..85e63c1 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -13,7 +13,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tcl.h,v 1.126 2002/06/17 18:31:26 jenglish Exp $ + * RCS: @(#) $Id: tcl.h,v 1.127 2002/06/17 22:52:51 hobbs Exp $ */ #ifndef _TCL @@ -1028,6 +1028,14 @@ typedef struct Tcl_DString { #define TCL_ALLOW_INLINE_COMPILATION 0x20000 /* + * Flag values passed to Tcl_CreateObjTrace, and used internally + * by command execution traces. Slots 4,8,16 and 32 are + * used internally by execution traces (see tclCmdMZ.c) + */ +#define TCL_TRACE_ENTER_EXEC 1 +#define TCL_TRACE_LEAVE_EXEC 2 + +/* * The TCL_PARSE_PART1 flag is deprecated and has no effect. * The part1 is now always parsed whenever the part2 is NULL. * (This is to avoid a common error when converting code to diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 67456a2..32ff2d6 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -13,7 +13,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclBasic.c,v 1.59 2002/06/12 19:36:14 msofer Exp $ + * RCS: @(#) $Id: tclBasic.c,v 1.60 2002/06/17 22:52:51 hobbs Exp $ */ #include "tclInt.h" @@ -334,7 +334,7 @@ Tcl_CreateInterp() iPtr->maxNestingDepth = MAX_NESTING_DEPTH; iPtr->framePtr = NULL; iPtr->varFramePtr = NULL; - iPtr->activeTracePtr = NULL; + iPtr->activeVarTracePtr = NULL; iPtr->returnCode = TCL_OK; iPtr->errorInfo = NULL; iPtr->errorCode = NULL; @@ -357,6 +357,7 @@ Tcl_CreateInterp() iPtr->tracePtr = NULL; iPtr->tracesForbiddingInline = 0; iPtr->activeCmdTracePtr = NULL; + iPtr->activeInterpTracePtr = NULL; iPtr->assocData = (Tcl_HashTable *) NULL; iPtr->execEnvPtr = NULL; /* set after namespaces initialized */ iPtr->emptyObjPtr = Tcl_NewObj(); /* another empty object */ @@ -2501,15 +2502,15 @@ Tcl_DeleteCommandFromToken(interp, cmd) } static char * CallCommandTraces(iPtr, cmdPtr, oldName, newName, flags) - Interp *iPtr; /* Interpreter containing variable. */ - Command *cmdPtr; /* Variable whose traces are to be + Interp *iPtr; /* Interpreter containing command. */ + Command *cmdPtr; /* Command whose traces are to be * invoked. */ CONST char *oldName; /* Command's old name, or NULL if we * must get the name from cmdPtr */ CONST char *newName; /* Command's new name, or NULL if * the command is not being renamed */ int flags; /* Flags passed to trace procedures: - * indicates what's happening to variable, + * indicates what's happening to command, * plus other stuff like TCL_GLOBAL_ONLY, * TCL_NAMESPACE_ONLY, and * TCL_INTERP_DESTROYED. */ @@ -2540,6 +2541,9 @@ CallCommandTraces(iPtr, cmdPtr, oldName, newName, flags) active.nextPtr = iPtr->activeCmdTracePtr; iPtr->activeCmdTracePtr = &active; + if (flags & TCL_TRACE_DELETE) { + flags |= TCL_TRACE_DESTROYED; + } active.cmdPtr = cmdPtr; Tcl_Preserve((ClientData) iPtr); for (tracePtr = cmdPtr->tracePtr; tracePtr != NULL; @@ -2916,113 +2920,91 @@ TclEvalObjvInternal(interp, objc, objv, command, length, flags) Interp *iPtr = (Interp *) interp; Tcl_Obj **newObjv; int i; - Trace *tracePtr, *nextPtr; - char *commandCopy; CallFrame *savedVarFramePtr; /* Saves old copy of iPtr->varFramePtr * in case TCL_EVAL_GLOBAL was set. */ int code = TCL_OK; + int traceCode = TCL_OK; + int checkTraces = 1; if (objc == 0) { return TCL_OK; } /* - * Find the procedure to execute this command. If there isn't one, - * then see if there is a command "unknown". If so, create a new - * word array with "unknown" as the first word and the original - * command words as arguments. Then call ourselves recursively - * to execute it. + * If any execution traces rename or delete the current command, + * we may need (at most) two passes here. */ + while (1) { - cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, objv[0]); - if (cmdPtr == NULL) { - newObjv = (Tcl_Obj **) ckalloc((unsigned) + /* + * Find the procedure to execute this command. If there isn't one, + * then see if there is a command "unknown". If so, create a new + * word array with "unknown" as the first word and the original + * command words as arguments. Then call ourselves recursively + * to execute it. + */ + + cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, objv[0]); + if (cmdPtr == NULL) { + newObjv = (Tcl_Obj **) ckalloc((unsigned) ((objc + 1) * sizeof (Tcl_Obj *))); - for (i = objc-1; i >= 0; i--) { - newObjv[i+1] = objv[i]; - } - newObjv[0] = Tcl_NewStringObj("::unknown", -1); - Tcl_IncrRefCount(newObjv[0]); - cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, newObjv[0]); - if (cmdPtr == NULL) { - Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), + for (i = objc-1; i >= 0; i--) { + newObjv[i+1] = objv[i]; + } + newObjv[0] = Tcl_NewStringObj("::unknown", -1); + Tcl_IncrRefCount(newObjv[0]); + cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, newObjv[0]); + if (cmdPtr == NULL) { + Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "invalid command name \"", Tcl_GetString(objv[0]), "\"", (char *) NULL); - code = TCL_ERROR; - } else if (TclInterpReady(interp) == TCL_ERROR) { - code = TCL_ERROR; - } else { - iPtr->numLevels++; - code = TclEvalObjvInternal(interp, objc+1, newObjv, command, length, 0); - iPtr->numLevels--; - } - Tcl_DecrRefCount(newObjv[0]); - ckfree((char *) newObjv); - goto done; - } - - /* - * Call trace procedures if needed. - */ - - if ( command != NULL && iPtr->tracePtr != NULL ) { - commandCopy = command; - - /* - * Make a copy of the command if necessary, so that trace - * procs will see it. - */ - - if (length < 0) { - length = strlen(command); - } else if ((size_t)length < strlen(command)) { - commandCopy = (char *) ckalloc((unsigned) (length + 1)); - strncpy(commandCopy, command, (size_t) length); - commandCopy[length] = 0; - } - - /* - * Walk through the trace procs - */ - - for ( tracePtr = iPtr->tracePtr; - (code == TCL_OK) && (tracePtr != NULL); - tracePtr = nextPtr) { - nextPtr = tracePtr->nextPtr; - if (iPtr->numLevels > tracePtr->level) { - continue; + code = TCL_ERROR; + } else if (TclInterpReady(interp) == TCL_ERROR) { + code = TCL_ERROR; + } else { + iPtr->numLevels++; + code = TclEvalObjvInternal(interp, objc+1, newObjv, command, length, 0); + iPtr->numLevels--; } - - /* - * Invoke one trace proc - */ - - code = (tracePtr->proc)( tracePtr->clientData, - (Tcl_Interp*) iPtr, - iPtr->numLevels, - commandCopy, - (Tcl_Command) cmdPtr, - objc, - objv ); - } - - /* - * If we had to copy the command for the trace procs, free the - * copy. - */ - - if (commandCopy != command) { - ckfree((char *) commandCopy); - } - - } + Tcl_DecrRefCount(newObjv[0]); + ckfree((char *) newObjv); + goto done; + } + /* + * Call trace procedures if needed. + */ + if ((checkTraces) && (command != NULL)) { + int cmdEpoch = cmdPtr->cmdEpoch; + cmdPtr->refCount++; + /* If the first set of traces modifies/deletes the command or + * any existing traces, then the set checkTraces to 0 and + * go through this while loop one more time. + */ + if (iPtr->tracePtr != NULL && traceCode == TCL_OK) { + traceCode = TclCheckInterpTraces(interp, command, length, + cmdPtr, code, TCL_TRACE_ENTER_EXEC, objc, objv); + } + if (cmdPtr->flags & CMD_HAS_EXEC_TRACES && traceCode == TCL_OK) { + traceCode = TclCheckExecutionTraces(interp, command, length, + cmdPtr, code, TCL_TRACE_ENTER_EXEC, objc, objv); + } + cmdPtr->refCount--; + if (cmdEpoch != cmdPtr->cmdEpoch) { + /* The command has been modified in some way */ + checkTraces = 0; + continue; + } + } + break; + } + /* * Finally, invoke the command's Tcl_ObjCmdProc. */ iPtr->cmdCount++; - if ( code == TCL_OK ) { + if ( code == TCL_OK && traceCode == TCL_OK) { savedVarFramePtr = iPtr->varFramePtr; if (flags & TCL_EVAL_GLOBAL) { iPtr->varFramePtr = NULL; @@ -3035,6 +3017,29 @@ TclEvalObjvInternal(interp, objc, objv, command, length, flags) } /* + * Call 'leave' command traces + */ + if (cmdPtr->flags & CMD_HAS_EXEC_TRACES && traceCode == TCL_OK) { + traceCode = TclCheckExecutionTraces(interp, command, length, + cmdPtr, code, TCL_TRACE_LEAVE_EXEC, objc, objv); + } + if (iPtr->tracePtr != NULL && traceCode == TCL_OK) { + traceCode = TclCheckInterpTraces(interp, command, length, + cmdPtr, code, TCL_TRACE_LEAVE_EXEC, objc, objv); + } + + /* + * If one of the trace invocation resulted in error, then + * change the result code accordingly. Note, that the + * interp->result should already be set correctly by the + * call to TraceExecutionProc. + */ + + if (traceCode != TCL_OK) { + code = traceCode; + } + + /* * If the interpreter has a non-empty string result, the result * object is either empty or stale because some procedure set * interp->result directly. If so, move the string result to the @@ -3095,8 +3100,7 @@ Tcl_EvalObjv(interp, objc, objv, flags) int allowExceptions = (iPtr->evalFlags & TCL_ALLOW_EXCEPTIONS); for (tracePtr = iPtr->tracePtr; tracePtr; tracePtr = tracePtr->nextPtr) { - if (iPtr->numLevels <= tracePtr->level) { - + if ((tracePtr->level == 0) || (iPtr->numLevels <= tracePtr->level)) { /* * The command may be needed for an execution trace. Generate a * command string. @@ -4841,7 +4845,6 @@ Tcl_CreateTrace(interp, level, proc, clientData) * command. */ ClientData clientData; /* Arbitrary value word to pass to proc. */ { - StringTraceData* data; data = (StringTraceData*) ckalloc( sizeof( *data )); data->clientData = clientData; @@ -4901,15 +4904,13 @@ StringTraceProc( clientData, interp, level, command, commandInfo, objc, objv ) * 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, (char**) argv ); - ckfree( (char*) argv ); return TCL_OK; - } /* @@ -4974,7 +4975,7 @@ Tcl_DeleteTrace(interp, trace) return; } (*tracePtr2) = (*tracePtr2)->nextPtr; - + /* * If the trace forbids bytecode compilation, change the interpreter's * state. If bytecode compilation is now permitted, flag the fact and diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index cf30805..59346b4 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -14,7 +14,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclCmdMZ.c,v 1.71 2002/06/14 13:17:17 dkf Exp $ + * RCS: @(#) $Id: tclCmdMZ.c,v 1.72 2002/06/17 22:52:51 hobbs Exp $ */ #include "tclInt.h" @@ -37,10 +37,49 @@ typedef struct { } TraceVarInfo; /* - * The same structure is used for command traces at present + * Structure used to hold information about command traces: */ -typedef TraceVarInfo TraceCommandInfo; +typedef struct { + int flags; /* Operations for which Tcl command is + * to be invoked. */ + size_t length; /* Number of non-NULL chars. in command. */ + Tcl_Trace stepTrace; /* Used for execution traces, when tracing + * inside the given command */ + int startLevel; /* Used for bookkeeping with execution traces */ + int curFlags; /* Trace flags for the current command */ + int curCode; /* Return code for the current command */ + char command[4]; /* Space for Tcl command to invoke. Actual + * size will be as large as necessary to + * hold command. This field must be the + * last in the structure, so that it can + * be larger than 4 bytes. */ +} TraceCommandInfo; + +/* + * Used by command execution traces. Note that we assume in the code + * that the first two defines are exactly 4 times the + * 'TCL_TRACE_ENTER_EXEC' and 'TCL_TRACE_LEAVE_EXEC' constants. + * + * TCL_TRACE_ENTER_DURING_EXEC - Trace each command inside the command + * currently being traced, before execution. + * TCL_TRACE_LEAVE_DURING_EXEC - Trace each command inside the command + * currently being traced, after execution. + * TCL_TRACE_ANY_EXEC - OR'd combination of all EXEC flags. + * TCL_TRACE_EXEC_IN_PROGRESS - The callback procedure on this trace + * is currently executing. Therefore we + * don't let further traces execute. + * TCL_TRACE_EXEC_DIRECT - This execution trace is triggered directly + * by the command being traced, not because + * of an internal trace. + * The flags 'TCL_TRACE_DESTROYED' and 'TCL_INTERP_DESTROYED' may also + * be used in command execution traces. + */ +#define TCL_TRACE_ENTER_DURING_EXEC 4 +#define TCL_TRACE_LEAVE_DURING_EXEC 8 +#define TCL_TRACE_ANY_EXEC 15 +#define TCL_TRACE_EXEC_IN_PROGRESS 0x10 +#define TCL_TRACE_EXEC_DIRECT 0x20 /* * Forward declarations for procedures defined in this file: @@ -51,29 +90,38 @@ typedef int (Tcl_TraceTypeObjCmd) _ANSI_ARGS_((Tcl_Interp *interp, Tcl_TraceTypeObjCmd TclTraceVariableObjCmd; Tcl_TraceTypeObjCmd TclTraceCommandObjCmd; +Tcl_TraceTypeObjCmd TclTraceExecutionObjCmd; /* * Each subcommand has a number of 'types' to which it can apply. - * Currently 'command' and 'variable' are the only - * types supported. These two arrays MUST be kept in sync! + * Currently 'execution', 'command' and 'variable' are the only + * types supported. These three arrays MUST be kept in sync! * In the future we may provide an API to add to the list of * supported trace types. */ static CONST char *traceTypeOptions[] = { - "command", "variable", (char*) NULL + "execution", "command", "variable", (char*) NULL }; static Tcl_TraceTypeObjCmd* traceSubCmds[] = { + TclTraceExecutionObjCmd, TclTraceCommandObjCmd, TclTraceVariableObjCmd, }; +/* + * Declarations for local procedures to this file: + */ +static int CallTraceProcedure _ANSI_ARGS_((Tcl_Interp *interp, + Trace *tracePtr, Command *cmdPtr, + char *command, int numChars, + int objc, Tcl_Obj *CONST objv[])); static char * TraceVarProc _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, char *name1, CONST char *name2, int flags)); static void TraceCommandProc _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, CONST char *oldName, CONST char *newName, int flags)); - +static Tcl_CmdObjTraceProc TraceExecutionProc; /* *---------------------------------------------------------------------- @@ -2976,7 +3024,7 @@ Tcl_TraceObjCmd(dummy, interp, objc, objv) Tcl_UntraceVar2(interp, name, NULL, flags | TCL_TRACE_UNSETS | TCL_TRACE_RESULT_OBJECT, TraceVarProc, clientData); - ckfree((char *) tvarPtr); + Tcl_EventuallyFree((ClientData) tvarPtr, TCL_DYNAMIC); break; } } @@ -3049,6 +3097,215 @@ Tcl_TraceObjCmd(dummy, interp, objc, objv) /* *---------------------------------------------------------------------- * + * TclTraceExecutionObjCmd -- + * + * Helper function for Tcl_TraceObjCmd; implements the + * [trace {add|remove|info} execution ...] subcommands. + * See the user documentation for details on what these do. + * + * Results: + * Standard Tcl result. + * + * Side effects: + * Depends on the operation (add, remove, or info) being performed; + * may add or remove command traces on a command. + * + *---------------------------------------------------------------------- + */ + +int +TclTraceExecutionObjCmd(interp, optionIndex, objc, objv) + Tcl_Interp *interp; /* Current interpreter. */ + int optionIndex; /* Add, info or remove */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument objects. */ +{ + int commandLength, index; + char *name, *command; + size_t length; + enum traceOptions { TRACE_ADD, TRACE_INFO, TRACE_REMOVE }; + static CONST char *opStrings[] = { "enter", "leave", + "enterstep", "leavestep", (char *) NULL }; + enum operations { TRACE_EXEC_ENTER, TRACE_EXEC_LEAVE, + TRACE_EXEC_ENTER_STEP, TRACE_EXEC_LEAVE_STEP }; + + switch ((enum traceOptions) optionIndex) { + case TRACE_ADD: + case TRACE_REMOVE: { + int flags = 0; + int i, listLen, result; + Tcl_Obj **elemPtrs; + if (objc != 6) { + Tcl_WrongNumArgs(interp, 3, objv, "name opList execution"); + return TCL_ERROR; + } + /* + * Make sure the ops argument is a list object; get its length and + * a pointer to its array of element pointers. + */ + + result = Tcl_ListObjGetElements(interp, objv[4], &listLen, + &elemPtrs); + if (result != TCL_OK) { + return result; + } + if (listLen == 0) { + Tcl_SetResult(interp, "bad operation list \"\": must be " + "one or more of enter, leave, enterstep, or leavestep", TCL_STATIC); + return TCL_ERROR; + } + for (i = 0; i < listLen; i++) { + if (Tcl_GetIndexFromObj(interp, elemPtrs[i], opStrings, + "operation", TCL_EXACT, &index) != TCL_OK) { + return TCL_ERROR; + } + switch ((enum operations) index) { + case TRACE_EXEC_ENTER: + flags |= TCL_TRACE_ENTER_EXEC; + break; + case TRACE_EXEC_LEAVE: + flags |= TCL_TRACE_LEAVE_EXEC; + break; + case TRACE_EXEC_ENTER_STEP: + flags |= TCL_TRACE_ENTER_DURING_EXEC; + break; + case TRACE_EXEC_LEAVE_STEP: + 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->length = length; + flags |= TCL_TRACE_DELETE; + if (flags & (TRACE_EXEC_ENTER_STEP | TRACE_EXEC_LEAVE_STEP)) { + 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; + clientData = 0; + name = Tcl_GetString(objv[3]); + while ((clientData = Tcl_CommandTraceInfo(interp, name, 0, + TraceCommandProc, clientData)) != 0) { + 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. + */ + if ((tcmdPtr->length == length) + && ((tcmdPtr->flags & (TCL_TRACE_ANY_EXEC | TCL_TRACE_RENAME | + TCL_TRACE_DELETE)) == flags) + && (strncmp(command, tcmdPtr->command, + (size_t) length) == 0)) { + flags |= TCL_TRACE_DELETE; + if (flags & (TRACE_EXEC_ENTER_STEP | TRACE_EXEC_LEAVE_STEP)) { + flags |= (TCL_TRACE_ENTER_EXEC | TCL_TRACE_LEAVE_EXEC); + } + Tcl_UntraceCommand(interp, name, + flags, TraceCommandProc, clientData); + if (tcmdPtr->stepTrace != NULL) { + /* + * We need to remove the interpreter-wide trace + * which we created to allow 'step' traces. + */ + Tcl_DeleteTrace(interp, tcmdPtr->stepTrace); + tcmdPtr->stepTrace = NULL; + } + /* Postpone deletion */ + if (tcmdPtr->flags & TCL_TRACE_EXEC_IN_PROGRESS) { + tcmdPtr->flags = 0; + } else { + Tcl_EventuallyFree((ClientData) tcmdPtr, TCL_DYNAMIC); + } + 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_GetObjResult(interp); + clientData = 0; + name = Tcl_GetString(objv[3]); + while ((clientData = Tcl_CommandTraceInfo(interp, name, 0, + TraceCommandProc, clientData)) != 0) { + + TraceCommandInfo *tcmdPtr = (TraceCommandInfo *) clientData; + + eachTraceObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL); + + /* + * 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, (Tcl_Obj **) NULL); + if (tcmdPtr->flags & TCL_TRACE_ENTER_EXEC) { + Tcl_ListObjAppendElement(NULL, elemObjPtr, + Tcl_NewStringObj("enter",6)); + } + if (tcmdPtr->flags & TCL_TRACE_LEAVE_EXEC) { + Tcl_ListObjAppendElement(NULL, elemObjPtr, + Tcl_NewStringObj("leave",5)); + } + if (tcmdPtr->flags & TCL_TRACE_ENTER_DURING_EXEC) { + Tcl_ListObjAppendElement(NULL, elemObjPtr, + Tcl_NewStringObj("enterstep",9)); + } + if (tcmdPtr->flags & TCL_TRACE_LEAVE_DURING_EXEC) { + Tcl_ListObjAppendElement(NULL, elemObjPtr, + Tcl_NewStringObj("leavestep",10)); + } + Tcl_ListObjAppendElement(NULL, eachTraceObjPtr, elemObjPtr); + + elemObjPtr = Tcl_NewStringObj(tcmdPtr->command, -1); + Tcl_ListObjAppendElement(NULL, eachTraceObjPtr, elemObjPtr); + Tcl_ListObjAppendElement(interp, resultListPtr, + eachTraceObjPtr); + } + Tcl_SetObjResult(interp, resultListPtr); + break; + } + } + return TCL_OK; +} + + +/* + *---------------------------------------------------------------------- + * * TclTraceCommandObjCmd -- * * Helper function for Tcl_TraceObjCmd; implements the @@ -3330,7 +3587,7 @@ TclTraceVariableObjCmd(interp, optionIndex, objc, objv) Tcl_UntraceVar2(interp, name, NULL, flags | TCL_TRACE_UNSETS | TCL_TRACE_RESULT_OBJECT, TraceVarProc, clientData); - ckfree((char *) tvarPtr); + Tcl_EventuallyFree((ClientData) tvarPtr, TCL_DYNAMIC); break; } } @@ -3470,6 +3727,9 @@ Tcl_CommandTraceInfo(interp, cmdName, flags, proc, prevClientData) * * Arrange for rename/deletes to a command to cause a * procedure to be invoked, which can monitor the operations. + * + * Also optionally arrange for execution of that command + * to cause a procedure to be invoked. * * Results: * A standard Tcl return value. @@ -3489,7 +3749,8 @@ Tcl_TraceCommand(interp, cmdName, flags, proc, clientData) * to be traced. */ CONST char *cmdName; /* Name of command. */ int flags; /* OR-ed collection of bits, including any - * of TCL_TRACE_RENAME, TCL_TRACE_DELETE. */ + * of TCL_TRACE_RENAME, TCL_TRACE_DELETE, + * and any of the TRACE_*_EXEC flags */ Tcl_CommandTraceProc *proc; /* Procedure to call when specified ops are * invoked upon varName. */ ClientData clientData; /* Arbitrary argument to pass to proc. */ @@ -3510,9 +3771,13 @@ Tcl_TraceCommand(interp, cmdName, flags, proc, clientData) tracePtr = (CommandTrace *) ckalloc(sizeof(CommandTrace)); tracePtr->traceProc = proc; tracePtr->clientData = clientData; - tracePtr->flags = flags & (TCL_TRACE_RENAME | TCL_TRACE_DELETE); + tracePtr->flags = flags & (TCL_TRACE_RENAME | TCL_TRACE_DELETE + | TCL_TRACE_ANY_EXEC); tracePtr->nextPtr = cmdPtr->tracePtr; cmdPtr->tracePtr = tracePtr; + if (tracePtr->flags & TCL_TRACE_ANY_EXEC) { + cmdPtr->flags |= CMD_HAS_EXEC_TRACES; + } return TCL_OK; } @@ -3539,7 +3804,8 @@ Tcl_UntraceCommand(interp, cmdName, flags, proc, clientData) Tcl_Interp *interp; /* Interpreter containing command. */ CONST char *cmdName; /* Name of command. */ int flags; /* OR-ed collection of bits, including any - * of TCL_TRACE_RENAME, TCL_TRACE_DELETE. */ + * of TCL_TRACE_RENAME, TCL_TRACE_DELETE, + * and any of the TRACE_*_EXEC flags */ Tcl_CommandTraceProc *proc; /* Procedure assocated with trace. */ ClientData clientData; /* Arbitrary argument to pass to proc. */ { @@ -3548,29 +3814,34 @@ Tcl_UntraceCommand(interp, cmdName, flags, proc, clientData) Command *cmdPtr; Interp *iPtr = (Interp *) interp; ActiveCommandTrace *activePtr; - + int hasExecTraces = 0; + cmdPtr = (Command*)Tcl_FindCommand(interp, cmdName, NULL, TCL_LEAVE_ERR_MSG); if (cmdPtr == NULL) { return; } - flags &= (TCL_TRACE_RENAME | TCL_TRACE_DELETE); + flags &= (TCL_TRACE_RENAME | TCL_TRACE_DELETE | TCL_TRACE_ANY_EXEC); + for (tracePtr = cmdPtr->tracePtr, prevPtr = NULL; ; prevPtr = tracePtr, tracePtr = tracePtr->nextPtr) { if (tracePtr == NULL) { return; } - if ((tracePtr->traceProc == proc) && (tracePtr->flags == flags) + if ((tracePtr->traceProc == proc) && ((tracePtr->flags & (TCL_TRACE_RENAME | TCL_TRACE_DELETE | TCL_TRACE_ANY_EXEC)) == flags) && (tracePtr->clientData == clientData)) { + if (tracePtr->flags & TCL_TRACE_ANY_EXEC) { + hasExecTraces = 1; + } break; } } - + /* * The code below makes it possible to delete traces while traces * are active: it makes sure that the deleted trace won't be - * processed by CallTraces. + * processed by CallCommandTraces. */ for (activePtr = iPtr->activeCmdTracePtr; activePtr != NULL; @@ -3584,7 +3855,22 @@ Tcl_UntraceCommand(interp, cmdName, flags, proc, clientData) } else { prevPtr->nextPtr = tracePtr->nextPtr; } - Tcl_EventuallyFree((ClientData) tracePtr, TCL_DYNAMIC); + tracePtr->flags = 0; + Tcl_EventuallyFree((int*)tracePtr, TCL_DYNAMIC); + + if (hasExecTraces) { + for (tracePtr = cmdPtr->tracePtr, prevPtr = NULL; tracePtr != NULL ; + prevPtr = tracePtr, tracePtr = tracePtr->nextPtr) { + if (tracePtr->flags & TCL_TRACE_ANY_EXEC) { + return; + } + } + /* + * None of the remaining traces on this command are execution + * traces. We therefore remove this flag: + */ + cmdPtr->flags &= ~CMD_HAS_EXEC_TRACES; + } } /* @@ -3593,7 +3879,8 @@ Tcl_UntraceCommand(interp, cmdName, flags, proc, clientData) * TraceCommandProc -- * * This procedure is called to handle command changes that have - * been traced using the "trace" command. + * been traced using the "trace" command, when using the + * 'rename' or 'delete' options. * * Results: * None. @@ -3620,7 +3907,9 @@ TraceCommandProc(clientData, interp, oldName, newName, flags) TraceCommandInfo *tcmdPtr = (TraceCommandInfo *) clientData; int code; Tcl_DString cmd; - + + Tcl_Preserve((ClientData) tcmdPtr); + if ((tcmdPtr->flags & flags) && !(flags & TCL_INTERP_DESTROYED)) { /* * Generate a command to execute by appending list elements @@ -3666,14 +3955,445 @@ TraceCommandProc(clientData, interp, oldName, newName, flags) * because command deletes are unconditional, so the trace must go away. */ if (flags & (TCL_TRACE_DESTROYED | TCL_TRACE_DELETE)) { - ckfree((char *) tcmdPtr); + if (tcmdPtr->stepTrace != NULL) { + Tcl_DeleteTrace(interp, tcmdPtr->stepTrace); + tcmdPtr->stepTrace = NULL; + } + /* Postpone deletion, until exec trace returns */ + if (tcmdPtr->flags & TCL_TRACE_EXEC_IN_PROGRESS) { + tcmdPtr->flags = 0; + } else { + Tcl_EventuallyFree((ClientData) tcmdPtr, TCL_DYNAMIC); + } } + Tcl_Release((ClientData) tcmdPtr); return; } /* *---------------------------------------------------------------------- * + * TclCheckExecutionTraces -- + * + * Checks on all current command execution traces, and invokes + * procedures which have been registered. This procedure can be + * used by other code which performs execution to unify the + * tracing system, so that execution traces will function for that + * other code. + * + * For instance extensions like [incr Tcl] which use their + * own execution technique can make use of Tcl's tracing. + * + * This procedure is called by 'TclEvalObjvInternal' + * + * Results: + * The return value is a standard Tcl completion code such as + * TCL_OK or TCL_ERROR, etc. + * + * Side effects: + * Those side effects made by any trace procedures called. + * + *---------------------------------------------------------------------- + */ +int +TclCheckExecutionTraces(interp, command, numChars, cmdPtr, code, traceFlags, objc, objv) + Tcl_Interp *interp; /* The current interpreter. */ + char *command; /* Pointer to beginning of the current + * command string. */ + int numChars; /* The number of characters in 'command' + * which are part of the command string. */ + Command *cmdPtr; /* Points to command's Command struct. */ + int code; /* The current result code. */ + int traceFlags; /* Current tracing situation. */ + int objc; /* Number of arguments for the command. */ + Tcl_Obj *CONST objv[]; /* Pointers to Tcl_Obj of each argument. */ +{ + Interp *iPtr = (Interp *) interp; + CommandTrace *tracePtr, *lastTracePtr; + ActiveCommandTrace active; + int curLevel; + int traceCode = TCL_OK; + TraceCommandInfo* tcmdPtr; + + if (command == NULL || cmdPtr->tracePtr == NULL) { + return(traceCode); + } + + curLevel = ((iPtr->varFramePtr == NULL) ? 0 : iPtr->varFramePtr->level); + + active.nextPtr = iPtr->activeCmdTracePtr; + iPtr->activeCmdTracePtr = &active; + + active.cmdPtr = cmdPtr; + lastTracePtr = NULL; + for ( tracePtr = cmdPtr->tracePtr; + (traceCode == TCL_OK) && (tracePtr != NULL); + tracePtr = active.nextTracePtr) { + if (traceFlags & TCL_TRACE_LEAVE_EXEC) { + /* execute the trace command in order of creation for "leave" */ + active.nextTracePtr = NULL; + tracePtr = cmdPtr->tracePtr; + while (tracePtr->nextPtr != lastTracePtr) { + active.nextTracePtr = tracePtr; + tracePtr = tracePtr->nextPtr; + } + } else { + active.nextTracePtr = tracePtr->nextPtr; + } + tcmdPtr = (TraceCommandInfo*)tracePtr->clientData; + if (tcmdPtr->flags != 0) { + tcmdPtr->curFlags = traceFlags | TCL_TRACE_EXEC_DIRECT; + tcmdPtr->curCode = code; + traceCode = TraceExecutionProc((ClientData)tcmdPtr, interp, + curLevel, command, (Tcl_Command)cmdPtr, objc, objv); + } + lastTracePtr = tracePtr; + } + iPtr->activeCmdTracePtr = active.nextPtr; + return(traceCode); +} + +/* + *---------------------------------------------------------------------- + * + * TclCheckInterpTraces -- + * + * Checks on all current traces, and invokes procedures which + * have been registered. This procedure can be used by other + * code which performs execution to unify the tracing system. + * For instance extensions like [incr Tcl] which use their + * own execution technique can make use of Tcl's tracing. + * + * This procedure is called by 'TclEvalObjvInternal' + * + * Results: + * The return value is a standard Tcl completion code such as + * TCL_OK or TCL_ERROR, etc. + * + * Side effects: + * Those side effects made by any trace procedures called. + * + *---------------------------------------------------------------------- + */ +int +TclCheckInterpTraces(interp, command, numChars, cmdPtr, code, traceFlags, objc, objv) + Tcl_Interp *interp; /* The current interpreter. */ + char *command; /* Pointer to beginning of the current + * command string. */ + int numChars; /* The number of characters in 'command' + * which are part of the command string. */ + Command *cmdPtr; /* Points to command's Command struct. */ + int code; /* The current result code. */ + int traceFlags; /* Current tracing situation. */ + int objc; /* Number of arguments for the command. */ + Tcl_Obj *CONST objv[]; /* Pointers to Tcl_Obj of each argument. */ +{ + Interp *iPtr = (Interp *) interp; + Trace *tracePtr, *lastTracePtr; + ActiveInterpTrace active; + int curLevel; + int traceCode = TCL_OK; + TraceCommandInfo* tcmdPtr; + + if (command == NULL || iPtr->tracePtr == NULL || + (iPtr->flags & INTERP_TRACE_IN_PROGRESS)) { + return(traceCode); + } + + curLevel = ((iPtr->varFramePtr == NULL) ? 0 : iPtr->varFramePtr->level); + + active.nextPtr = iPtr->activeInterpTracePtr; + iPtr->activeInterpTracePtr = &active; + + lastTracePtr = NULL; + for ( tracePtr = iPtr->tracePtr; + (traceCode == TCL_OK) && (tracePtr != NULL); + tracePtr = active.nextTracePtr) { + if (traceFlags & TCL_TRACE_ENTER_EXEC) { + /* execute the trace command in reverse order of creation + * for "enterstep" operation. The order is changed for + * ""enterstep" instead of for "leavestep as was done in + * TclCheckExecutionTraces because for step traces, + * Tcl_CreateObjTrace creates one more linked list of traces + * which results in one more reversal of trace invocation. + */ + active.nextTracePtr = NULL; + tracePtr = iPtr->tracePtr; + while (tracePtr->nextPtr != lastTracePtr) { + active.nextTracePtr = tracePtr; + tracePtr = tracePtr->nextPtr; + } + } else { + active.nextTracePtr = tracePtr->nextPtr; + } + if (tracePtr->level > 0 && curLevel > tracePtr->level) { + continue; + } + if (!(tracePtr->flags & TCL_TRACE_EXEC_IN_PROGRESS)) { + tracePtr->flags |= TCL_TRACE_EXEC_IN_PROGRESS; + if ((tracePtr->flags != TCL_TRACE_EXEC_IN_PROGRESS) && + ((tracePtr->flags & traceFlags) != 0)) { + tcmdPtr = (TraceCommandInfo*)tracePtr->clientData; + tcmdPtr->curFlags = traceFlags; + tcmdPtr->curCode = code; + traceCode = (tracePtr->proc)((ClientData)tcmdPtr, + (Tcl_Interp*)interp, + curLevel, command, + (Tcl_Command)cmdPtr, + objc, objv); + } else { + if (traceFlags & TCL_TRACE_ENTER_EXEC) { + /* + * Old-style interpreter-wide traces only trigger + * before the command is executed. + */ + traceCode = CallTraceProcedure(interp, tracePtr, cmdPtr, + command, numChars, objc, objv); + } + } + tracePtr->flags &= ~TCL_TRACE_EXEC_IN_PROGRESS; + } + lastTracePtr = tracePtr; + } + iPtr->activeInterpTracePtr = active.nextPtr; + return(traceCode); +} + +/* + *---------------------------------------------------------------------- + * + * CallTraceProcedure -- + * + * Invokes a trace procedure registered with an interpreter. These + * procedures trace command execution. Currently this trace procedure + * is called with the address of the string-based Tcl_CmdProc for the + * command, not the Tcl_ObjCmdProc. + * + * Results: + * None. + * + * Side effects: + * Those side effects made by the trace procedure. + * + *---------------------------------------------------------------------- + */ + +static int +CallTraceProcedure(interp, tracePtr, cmdPtr, command, numChars, objc, objv) + Tcl_Interp *interp; /* The current interpreter. */ + register Trace *tracePtr; /* Describes the trace procedure to call. */ + Command *cmdPtr; /* Points to command's Command struct. */ + char *command; /* Points to the first character of the + * command's source before substitutions. */ + int numChars; /* The number of characters in the + * command's source. */ + register int objc; /* Number of arguments for the command. */ + Tcl_Obj *CONST objv[]; /* Pointers to Tcl_Obj of each argument. */ +{ + Interp *iPtr = (Interp *) interp; + char *commandCopy; + int traceCode; + + /* + * Copy the command characters into a new string. + */ + + commandCopy = (char *) ckalloc((unsigned) (numChars + 1)); + memcpy((VOID *) commandCopy, (VOID *) command, (size_t) numChars); + commandCopy[numChars] = '\0'; + + /* + * Call the trace procedure then free allocated storage. + */ + + traceCode = (tracePtr->proc)( tracePtr->clientData, (Tcl_Interp*) iPtr, + iPtr->numLevels, commandCopy, + (Tcl_Command) cmdPtr, objc, objv ); + + ckfree((char *) commandCopy); + return(traceCode); +} + +/* + *---------------------------------------------------------------------- + * + * TraceExecutionProc -- + * + * This procedure is invoked whenever code relevant to a + * 'trace execution' command is executed. It is called in one + * of two ways in Tcl's core: + * + * (i) by the TclCheckExecutionTraces, when an execution trace has been + * triggered. + * (ii) by TclCheckInterpTraces, when a prior execution trace has + * created a trace of the internals of a procedure, passing in + * this procedure as the one to be called. + * + * Results: + * The return value is a standard Tcl completion code such as + * TCL_OK or TCL_ERROR, etc. + * + * Side effects: + * May invoke an arbitrary Tcl procedure, and may create or + * delete an interpreter-wide trace. + * + *---------------------------------------------------------------------- + */ +int +TraceExecutionProc(ClientData clientData, Tcl_Interp *interp, + int level, 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 further execution trace callbacks to + * be called for the same trace. + */ + return(traceCode); + } + + if (!(flags & TCL_INTERP_DESTROYED)) { + /* + * Check whether the current call is going to eval arbitrary + * Tcl code with a generated trace, or whether we are only + * going to setup interpreter-wide traces to implement the + * 'step' traces. This latter situation can happen if + * we create a command trace without either before or after + * operations, but with either of the step operations. + */ + if (flags & TCL_TRACE_EXEC_DIRECT) { + call = flags & tcmdPtr->flags & (TCL_TRACE_ENTER_EXEC | TCL_TRACE_LEAVE_EXEC); + } else { + call = 1; + } + /* + * First, if we have returned back to the level at which we + * created an interpreter trace, we remove it + */ + if (flags & TCL_TRACE_LEAVE_EXEC) { + if ((tcmdPtr->stepTrace != NULL) && (level == tcmdPtr->startLevel)) { + Tcl_DeleteTrace(interp, tcmdPtr->stepTrace); + tcmdPtr->stepTrace = NULL; + } + + } + + /* + * Second, create the tcl callback, if required. + */ + if (call) { + Tcl_SavedResult state; + Tcl_DString cmd; + Tcl_DString sub; + int i; + + Tcl_DStringInit(&cmd); + Tcl_DStringAppend(&cmd, tcmdPtr->command, (int)tcmdPtr->length); + /* Append command with arguments */ + Tcl_DStringInit(&sub); + for (i = 0; i < objc; i++) { + char* str; + int len; + str = Tcl_GetStringFromObj(objv[i],&len); + Tcl_DStringAppendElement(&sub, str); + } + Tcl_DStringAppendElement(&cmd, Tcl_DStringValue(&sub)); + Tcl_DStringFree(&sub); + + if (flags & TCL_TRACE_ENTER_EXEC) { + /* Append trace operation */ + if (flags & TCL_TRACE_EXEC_DIRECT) { + Tcl_DStringAppendElement(&cmd, "enter"); + } else { + Tcl_DStringAppendElement(&cmd, "enterstep"); + } + } else if (flags & TCL_TRACE_LEAVE_EXEC) { + Tcl_Obj* resultCode; + char* resultCodeStr; + + /* Append result code */ + resultCode = Tcl_NewIntObj(code); + resultCodeStr = Tcl_GetString(resultCode); + Tcl_DStringAppendElement(&cmd, resultCodeStr); + Tcl_DecrRefCount(resultCode); + + /* Append result string */ + Tcl_DStringAppendElement(&cmd, Tcl_GetStringResult(interp)); + /* Append trace operation */ + if (flags & TCL_TRACE_EXEC_DIRECT) { + Tcl_DStringAppendElement(&cmd, "leave"); + } else { + Tcl_DStringAppendElement(&cmd, "leavestep"); + } + } else { + panic("TraceExecutionProc: bad flag combination"); + } + + /* + * Execute the command. Save the interp's result used for + * the command. We discard any object result the command returns. + */ + + Tcl_SaveResult(interp, &state); + + tcmdPtr->flags |= TCL_TRACE_EXEC_IN_PROGRESS; + iPtr->flags |= INTERP_TRACE_IN_PROGRESS; + Tcl_Preserve((ClientData)tcmdPtr); + /* + * This line can have quite arbitrary side-effects, + * including deleting the trace, the command being + * traced, or even the interpreter. + */ + traceCode = Tcl_Eval(interp, Tcl_DStringValue(&cmd)); + tcmdPtr->flags &= ~TCL_TRACE_EXEC_IN_PROGRESS; + iPtr->flags &= ~INTERP_TRACE_IN_PROGRESS; + if (tcmdPtr->flags == 0) { + flags |= TCL_TRACE_DESTROYED; + } + + if (traceCode == TCL_OK) { + /* Restore result if trace execution was successful */ + Tcl_RestoreResult(interp, &state); + } + + Tcl_DStringFree(&cmd); + } + + /* + * Third, create an interpreter trace, if we need one for + * subsequent internal execution traces. + */ + if ((flags & TCL_TRACE_ENTER_EXEC) && (tcmdPtr->stepTrace == NULL) + && (tcmdPtr->flags & (TCL_TRACE_ENTER_DURING_EXEC | TCL_TRACE_LEAVE_DURING_EXEC))) { + tcmdPtr->startLevel = level; + tcmdPtr->stepTrace = Tcl_CreateObjTrace(interp, 0, + (tcmdPtr->flags & TCL_TRACE_ANY_EXEC) >> 2, + TraceExecutionProc, (ClientData)tcmdPtr, NULL); + } + } + if (flags & TCL_TRACE_DESTROYED) { + if (tcmdPtr->stepTrace != NULL) { + Tcl_DeleteTrace(interp, tcmdPtr->stepTrace); + tcmdPtr->stepTrace = NULL; + } + Tcl_EventuallyFree((ClientData)tcmdPtr, TCL_DYNAMIC); + } + if (call) { + Tcl_Release((ClientData)tcmdPtr); + } + return(traceCode); +} + +/* + *---------------------------------------------------------------------- + * * TraceVarProc -- * * This procedure is called to handle variable accesses that have @@ -3706,6 +4426,16 @@ TraceVarProc(clientData, interp, name1, name2, flags) int code; 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 of this function, so we use + * Tcl_Preserve() and Tcl_Release() to be sure it is not + * freed while we still need it. + */ + + Tcl_Preserve((ClientData) tvarPtr); + result = NULL; if ((tvarPtr->flags & flags) && !(flags & TCL_INTERP_DESTROYED)) { if (tvarPtr->length != (size_t) 0) { @@ -3778,8 +4508,9 @@ TraceVarProc(clientData, interp, name1, name2, flags) Tcl_DecrRefCount(errMsgObj); result = NULL; } - ckfree((char *) tvarPtr); + Tcl_EventuallyFree((ClientData) tvarPtr, TCL_DYNAMIC); } + Tcl_Release((ClientData) tvarPtr); return result; } diff --git a/generic/tclCompile.c b/generic/tclCompile.c index 6034cf5..83ff215 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.c @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclCompile.c,v 1.36 2002/06/17 00:09:19 msofer Exp $ + * RCS: @(#) $Id: tclCompile.c,v 1.37 2002/06/17 22:52:51 hobbs Exp $ */ #include "tclInt.h" @@ -946,6 +946,7 @@ TclCompileScript(interp, script, numBytes, nested, envPtr) if ((cmdPtr != NULL) && (cmdPtr->compileProc != NULL) + && !(cmdPtr->flags & CMD_HAS_EXEC_TRACES) && !(iPtr->flags & DONT_COMPILE_CMDS_INLINE)) { code = (*(cmdPtr->compileProc))(interp, &parse, envPtr); diff --git a/generic/tclExecute.c b/generic/tclExecute.c index b1893f2..f5949af 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclExecute.c,v 1.69 2002/06/16 17:59:12 msofer Exp $ + * RCS: @(#) $Id: tclExecute.c,v 1.70 2002/06/17 22:52:51 hobbs Exp $ */ #include "tclInt.h" @@ -1240,7 +1240,8 @@ TclExecuteByteCode(interp, codePtr) for (tracePtr = iPtr->tracePtr; tracePtr != NULL; tracePtr = nextTracePtr) { nextTracePtr = tracePtr->nextPtr; - if (iPtr->numLevels <= tracePtr->level) { + if (tracePtr->level == 0 || + iPtr->numLevels <= tracePtr->level) { /* * Traces will be called: get command string */ @@ -1249,7 +1250,13 @@ TclExecuteByteCode(interp, codePtr) break; } } - } + } else { + Command *cmdPtr; + cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, objv[0]); + if (cmdPtr != NULL && cmdPtr->flags & CMD_HAS_EXEC_TRACES) { + bytes = GetSrcInfoForPc(pc, codePtr, &length); + } + } /* * A reference to part of the stack vector itself diff --git a/generic/tclInt.decls b/generic/tclInt.decls index 094b9df..973a7bd 100644 --- a/generic/tclInt.decls +++ b/generic/tclInt.decls @@ -12,7 +12,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: tclInt.decls,v 1.50 2002/05/29 09:09:57 hobbs Exp $ +# RCS: @(#) $Id: tclInt.decls,v 1.51 2002/06/17 22:52:51 hobbs Exp $ library tcl @@ -665,12 +665,20 @@ declare 167 generic { declare 168 generic { Tcl_Obj *TclGetStartupScriptPath(void) } - # variant of Tcl_UtfNCmp that takes n as bytes, not chars declare 169 generic { int TclpUtfNcmp2(CONST char *s1, CONST char *s2, unsigned long n) } - +declare 170 generic { + int TclCheckInterpTraces (Tcl_Interp *interp, char *command, int numChars, \ + Command *cmdPtr, int result, int traceFlags, int objc, \ + Tcl_Obj *CONST objv[]) +} +declare 171 generic { + int TclCheckExecutionTraces (Tcl_Interp *interp, char *command, int numChars, \ + Command *cmdPtr, int result, int traceFlags, int objc, \ + Tcl_Obj *CONST objv[]) +} ############################################################################## diff --git a/generic/tclInt.h b/generic/tclInt.h index 920d946..d16d02c 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -12,7 +12,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclInt.h,v 1.94 2002/06/13 09:40:00 vincentdarley Exp $ + * RCS: @(#) $Id: tclInt.h,v 1.95 2002/06/17 22:52:51 hobbs Exp $ */ #ifndef _TCLINT @@ -289,10 +289,18 @@ typedef struct CommandTrace { * a particular command. */ } CommandTrace; +/* + * When a command trace is active (i.e. its associated procedure is + * executing), one of the following structures is linked into a list + * associated with the command's interpreter. The information in + * the structure is needed in order for Tcl to behave reasonably + * if traces are deleted while traces are active. + */ + typedef struct ActiveCommandTrace { - struct Command *cmdPtr; /* Variable that's being traced. */ + struct Command *cmdPtr; /* Command that's being traced. */ struct ActiveCommandTrace *nextPtr; - /* Next in list of all active variable + /* Next in list of all active command * traces for the interpreter, or NULL * if no more. */ CommandTrace *nextTracePtr; /* Next trace to check after current @@ -656,6 +664,25 @@ typedef struct Trace { } Trace; /* + * When an interpreter trace is active (i.e. its associated procedure + * is executing), one of the following structures is linked into a list + * associated with the interpreter. The information in the structure + * is needed in order for Tcl to behave reasonably if traces are + * deleted while traces are active. + */ + +typedef struct ActiveInterpTrace { + struct ActiveInterpTrace *nextPtr; + /* Next in list of all active command + * traces for the interpreter, or NULL + * if no more. */ + Trace *nextTracePtr; /* Next trace to check after current + * trace procedure returns; if this + * trace gets deleted, must update pointer + * to avoid using free'd memory. */ +} ActiveInterpTrace; + +/* * The structure below defines an entry in the assocData hash table which * is associated with an interpreter. The entry contains a pointer to a * function to call when the interpreter is deleted, and a pointer to @@ -1080,6 +1107,9 @@ typedef struct Command { * underway for a rename/delete change. * See the two flags below for which is * currently being processed. + * CMD_HAS_EXEC_TRACES - 1 means that this command has at least + * one execution trace (as opposed to simple + * delete/rename traces) in its tracePtr list. * TCL_TRACE_RENAME - A rename trace is in progress. Further * recursive renames will not be traced. * TCL_TRACE_DELETE - A delete trace is in progress. Further @@ -1088,6 +1118,7 @@ typedef struct Command { */ #define CMD_IS_DELETED 0x1 #define CMD_TRACE_ACTIVE 0x2 +#define CMD_HAS_EXEC_TRACES 0x4 /* *---------------------------------------------------------------- @@ -1209,7 +1240,7 @@ typedef struct Interp { * unless an "uplevel" command is * executing). NULL means no procedure is * active or "uplevel 0" is executing. */ - ActiveVarTrace *activeTracePtr; + ActiveVarTrace *activeVarTracePtr; /* First in list of active traces for * interp, or NULL if no active traces. */ int returnCode; /* Completion code to return if current @@ -1305,6 +1336,9 @@ typedef struct Interp { ActiveCommandTrace *activeCmdTracePtr; /* First in list of active command traces for * interp, or NULL if no active traces. */ + ActiveInterpTrace *activeInterpTracePtr; + /* First in list of active traces for + * interp, or NULL if no active traces. */ int tracesForbiddingInline; /* Count of traces (in the list headed by * tracePtr) that forbid inline bytecode @@ -1367,6 +1401,9 @@ typedef struct Interp { * interpreter; instead, have Tcl_EvalObj call * Tcl_EvalEx. Used primarily for testing the * new parser. + * INTERP_TRACE_IN_PROGRESS: Non-zero means that an interp trace is currently + * active; so no further trace callbacks should be + * invoked. */ #define DELETED 1 @@ -1378,6 +1415,7 @@ typedef struct Interp { #define RAND_SEED_INITIALIZED 0x40 #define SAFE_INTERP 0x80 #define USE_EVAL_DIRECT 0x100 +#define INTERP_TRACE_IN_PROGRESS 0x200 /* *---------------------------------------------------------------- diff --git a/generic/tclIntDecls.h b/generic/tclIntDecls.h index db179b9..a03d113 100644 --- a/generic/tclIntDecls.h +++ b/generic/tclIntDecls.h @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclIntDecls.h,v 1.41 2002/05/29 09:09:57 hobbs Exp $ + * RCS: @(#) $Id: tclIntDecls.h,v 1.42 2002/06/17 22:52:51 hobbs Exp $ */ #ifndef _TCLINTDECLS @@ -506,6 +506,18 @@ EXTERN Tcl_Obj * TclGetStartupScriptPath _ANSI_ARGS_((void)); /* 169 */ EXTERN int TclpUtfNcmp2 _ANSI_ARGS_((CONST char * s1, CONST char * s2, unsigned long n)); +/* 170 */ +EXTERN int TclCheckInterpTraces _ANSI_ARGS_(( + Tcl_Interp * interp, char * command, + int numChars, Command * cmdPtr, int result, + int traceFlags, int objc, + Tcl_Obj *CONST objv[])); +/* 171 */ +EXTERN int TclCheckExecutionTraces _ANSI_ARGS_(( + Tcl_Interp * interp, char * command, + int numChars, Command * cmdPtr, int result, + int traceFlags, int objc, + Tcl_Obj *CONST objv[])); typedef struct TclIntStubs { int magic; @@ -713,6 +725,8 @@ typedef struct TclIntStubs { void (*tclSetStartupScriptPath) _ANSI_ARGS_((Tcl_Obj * pathPtr)); /* 167 */ Tcl_Obj * (*tclGetStartupScriptPath) _ANSI_ARGS_((void)); /* 168 */ int (*tclpUtfNcmp2) _ANSI_ARGS_((CONST char * s1, CONST char * s2, unsigned long n)); /* 169 */ + int (*tclCheckInterpTraces) _ANSI_ARGS_((Tcl_Interp * interp, char * command, int numChars, Command * cmdPtr, int result, int traceFlags, int objc, Tcl_Obj *CONST objv[])); /* 170 */ + int (*tclCheckExecutionTraces) _ANSI_ARGS_((Tcl_Interp * interp, char * command, int numChars, Command * cmdPtr, int result, int traceFlags, int objc, Tcl_Obj *CONST objv[])); /* 171 */ } TclIntStubs; #ifdef __cplusplus @@ -1333,6 +1347,14 @@ extern TclIntStubs *tclIntStubsPtr; #define TclpUtfNcmp2 \ (tclIntStubsPtr->tclpUtfNcmp2) /* 169 */ #endif +#ifndef TclCheckInterpTraces +#define TclCheckInterpTraces \ + (tclIntStubsPtr->tclCheckInterpTraces) /* 170 */ +#endif +#ifndef TclCheckExecutionTraces +#define TclCheckExecutionTraces \ + (tclIntStubsPtr->tclCheckExecutionTraces) /* 171 */ +#endif #endif /* defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) */ diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index 90f51ba..ef55072 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -8,7 +8,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclStubInit.c,v 1.71 2002/05/29 09:09:57 hobbs Exp $ + * RCS: @(#) $Id: tclStubInit.c,v 1.72 2002/06/17 22:52:51 hobbs Exp $ */ #include "tclInt.h" @@ -249,6 +249,8 @@ TclIntStubs tclIntStubs = { TclSetStartupScriptPath, /* 167 */ TclGetStartupScriptPath, /* 168 */ TclpUtfNcmp2, /* 169 */ + TclCheckInterpTraces, /* 170 */ + TclCheckExecutionTraces, /* 171 */ }; TclIntPlatStubs tclIntPlatStubs = { diff --git a/generic/tclVar.c b/generic/tclVar.c index 133b387..4a60c5e 100644 --- a/generic/tclVar.c +++ b/generic/tclVar.c @@ -15,7 +15,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclVar.c,v 1.52 2002/06/13 19:47:58 msofer Exp $ + * RCS: @(#) $Id: tclVar.c,v 1.53 2002/06/17 22:52:51 hobbs Exp $ */ #include "tclInt.h" @@ -40,7 +40,7 @@ static char *isArrayElement = "name refers to an element in an array"; * Forward references to procedures defined later in this file: */ -static int CallTraces _ANSI_ARGS_((Interp *iPtr, Var *arrayPtr, +static int CallVarTraces _ANSI_ARGS_((Interp *iPtr, Var *arrayPtr, Var *varPtr, char *part1, CONST char *part2, int flags, int leaveErrMsg)); static void CleanupVar _ANSI_ARGS_((Var *varPtr, @@ -636,7 +636,7 @@ Tcl_GetVar2Ex(interp, part1, part2, flags) if ((varPtr->tracePtr != NULL) || ((arrayPtr != NULL) && (arrayPtr->tracePtr != NULL))) { - if (TCL_ERROR == CallTraces(iPtr, arrayPtr, varPtr, part1, part2, + if (TCL_ERROR == CallVarTraces(iPtr, arrayPtr, varPtr, part1, part2, (flags & (TCL_NAMESPACE_ONLY|TCL_GLOBAL_ONLY)) | TCL_TRACE_READS, (flags & TCL_LEAVE_ERR_MSG))) { goto errorReturn; @@ -757,7 +757,7 @@ TclGetIndexedScalar(interp, localIndex, flags) */ if (varPtr->tracePtr != NULL) { - if (TCL_ERROR == CallTraces(iPtr, /*arrayPtr*/ NULL, varPtr, varName, + if (TCL_ERROR == CallVarTraces(iPtr, /*arrayPtr*/ NULL, varPtr, varName, NULL, TCL_TRACE_READS, (flags & TCL_LEAVE_ERR_MSG))) { return NULL; } @@ -910,7 +910,7 @@ TclGetElementOfIndexedArray(interp, localIndex, elemPtr, flags) if ((varPtr->tracePtr != NULL) || ((arrayPtr != NULL) && (arrayPtr->tracePtr != NULL))) { - if (TCL_ERROR == CallTraces(iPtr, arrayPtr, varPtr, arrayName, elem, + if (TCL_ERROR == CallVarTraces(iPtr, arrayPtr, varPtr, arrayName, elem, TCL_TRACE_READS, (flags & TCL_LEAVE_ERR_MSG))) { goto errorReturn; } @@ -1249,7 +1249,7 @@ Tcl_SetVar2Ex(interp, part1, part2, newValuePtr, flags) if ((flags & TCL_TRACE_READS) && ((varPtr->tracePtr != NULL) || ((arrayPtr != NULL) && (arrayPtr->tracePtr != NULL)))) { - if (TCL_ERROR == CallTraces(iPtr, arrayPtr, varPtr, part1, part2, + if (TCL_ERROR == CallVarTraces(iPtr, arrayPtr, varPtr, part1, part2, TCL_TRACE_READS, (flags & TCL_LEAVE_ERR_MSG))) { return NULL; } @@ -1328,7 +1328,7 @@ Tcl_SetVar2Ex(interp, part1, part2, newValuePtr, flags) if ((varPtr->tracePtr != NULL) || ((arrayPtr != NULL) && (arrayPtr->tracePtr != NULL))) { - if (TCL_ERROR == CallTraces(iPtr, arrayPtr, varPtr, part1, part2, + if (TCL_ERROR == CallVarTraces(iPtr, arrayPtr, varPtr, part1, part2, (flags & (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY)) | TCL_TRACE_WRITES, (flags & TCL_LEAVE_ERR_MSG))) { goto cleanup; @@ -1459,7 +1459,7 @@ TclSetIndexedScalar(interp, localIndex, newValuePtr, flags) */ if ((flags & TCL_TRACE_READS) && (varPtr->tracePtr != NULL)) { - if (TCL_ERROR == CallTraces(iPtr, /*arrayPtr*/ NULL, varPtr, varName, + if (TCL_ERROR == CallVarTraces(iPtr, /*arrayPtr*/ NULL, varPtr, varName, NULL, TCL_TRACE_READS, (flags & TCL_LEAVE_ERR_MSG))) { return NULL; } @@ -1559,7 +1559,7 @@ TclSetIndexedScalar(interp, localIndex, newValuePtr, flags) */ if (varPtr->tracePtr != NULL) { - if (TCL_ERROR == CallTraces(iPtr, /*arrayPtr*/ NULL, varPtr, varName, + if (TCL_ERROR == CallVarTraces(iPtr, /*arrayPtr*/ NULL, varPtr, varName, NULL, TCL_TRACE_WRITES, (flags & TCL_LEAVE_ERR_MSG))) { goto cleanup; } @@ -1760,7 +1760,7 @@ TclSetElementOfIndexedArray(interp, localIndex, elemPtr, newValuePtr, flags) if ((flags & TCL_TRACE_READS) && ((varPtr->tracePtr != NULL) || ((arrayPtr != NULL) && (arrayPtr->tracePtr != NULL)))) { - if (TCL_ERROR == CallTraces(iPtr, arrayPtr, varPtr, arrayName, elem, + if (TCL_ERROR == CallVarTraces(iPtr, arrayPtr, varPtr, arrayName, elem, TCL_TRACE_READS, (flags & TCL_LEAVE_ERR_MSG))) { goto errorReturn; } @@ -1831,7 +1831,7 @@ TclSetElementOfIndexedArray(interp, localIndex, elemPtr, newValuePtr, flags) if ((varPtr->tracePtr != NULL) || ((arrayPtr != NULL) && (arrayPtr->tracePtr != NULL))) { - if (TCL_ERROR == CallTraces(iPtr, arrayPtr, varPtr, arrayName, elem, + if (TCL_ERROR == CallVarTraces(iPtr, arrayPtr, varPtr, arrayName, elem, TCL_TRACE_WRITES, (flags & TCL_LEAVE_ERR_MSG))) { goto errorReturn; } @@ -2287,7 +2287,7 @@ Tcl_UnsetVar2(interp, part1, part2, flags) * Call trace procedures for the variable being deleted. Then delete * its traces. Be sure to abort any other traces for the variable * that are still pending. Special tricks: - * 1. We need to increment varPtr's refCount around this: CallTraces + * 1. We need to increment varPtr's refCount around this: CallVarTraces * will use dummyVar so it won't increment varPtr's refCount itself. * 2. Turn off the VAR_TRACE_ACTIVE flag in dummyVar: we want to * call unset traces even if other traces are pending. @@ -2297,7 +2297,7 @@ Tcl_UnsetVar2(interp, part1, part2, flags) || ((arrayPtr != NULL) && (arrayPtr->tracePtr != NULL))) { varPtr->refCount++; dummyVar.flags &= ~VAR_TRACE_ACTIVE; - CallTraces(iPtr, arrayPtr, &dummyVar, part1, part2, + CallVarTraces(iPtr, arrayPtr, &dummyVar, part1, part2, (flags & (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY)) | TCL_TRACE_UNSETS, /* leaveErrMsg */ 0); while (dummyVar.tracePtr != NULL) { @@ -2305,7 +2305,7 @@ Tcl_UnsetVar2(interp, part1, part2, flags) dummyVar.tracePtr = tracePtr->nextPtr; Tcl_EventuallyFree((ClientData) tracePtr, TCL_DYNAMIC); } - for (activePtr = iPtr->activeTracePtr; activePtr != NULL; + for (activePtr = iPtr->activeVarTracePtr; activePtr != NULL; activePtr = activePtr->nextPtr) { if (activePtr->varPtr == varPtr) { activePtr->nextTracePtr = NULL; @@ -2610,10 +2610,10 @@ Tcl_UntraceVar2(interp, part1, part2, flags, proc, clientData) /* * The code below makes it possible to delete traces while traces * are active: it makes sure that the deleted trace won't be - * processed by CallTraces. + * processed by CallVarTraces. */ - for (activePtr = iPtr->activeTracePtr; activePtr != NULL; + for (activePtr = iPtr->activeVarTracePtr; activePtr != NULL; activePtr = activePtr->nextPtr) { if (activePtr->nextTracePtr == tracePtr) { activePtr->nextTracePtr = tracePtr->nextPtr; @@ -3120,7 +3120,7 @@ Tcl_ArrayObjCmd(dummy, interp, objc, objv) if (varPtr != NULL && varPtr->tracePtr != NULL && (TclIsVarArray(varPtr) || TclIsVarUndefined(varPtr))) { - if (TCL_ERROR == CallTraces(iPtr, arrayPtr, varPtr, varName, NULL, + if (TCL_ERROR == CallVarTraces(iPtr, arrayPtr, varPtr, varName, NULL, (TCL_LEAVE_ERR_MSG|TCL_NAMESPACE_ONLY|TCL_GLOBAL_ONLY| TCL_TRACE_ARRAY), /* leaveErrMsg */ 1)) { return TCL_ERROR; @@ -3141,7 +3141,7 @@ Tcl_ArrayObjCmd(dummy, interp, objc, objv) /* * We have to wait to get the resultPtr until here because - * CallTraces can affect the result. + * CallVarTraces can affect the result. */ resultPtr = Tcl_GetObjResult(interp); @@ -4407,7 +4407,7 @@ DisposeTraceResult(flags, result) /* *---------------------------------------------------------------------- * - * CallTraces -- + * CallVarTraces -- * * This procedure is invoked to find and invoke relevant * trace procedures associated with a particular operation on @@ -4429,7 +4429,7 @@ DisposeTraceResult(flags, result) */ int -CallTraces(iPtr, arrayPtr, varPtr, part1, part2, flags, leaveErrMsg) +CallVarTraces(iPtr, arrayPtr, varPtr, part1, part2, flags, leaveErrMsg) Interp *iPtr; /* Interpreter containing variable. */ register Var *arrayPtr; /* Pointer to array variable that contains * the variable, or NULL if the variable @@ -4506,8 +4506,8 @@ CallTraces(iPtr, arrayPtr, varPtr, part1, part2, flags, leaveErrMsg) */ result = NULL; - active.nextPtr = iPtr->activeTracePtr; - iPtr->activeTracePtr = &active; + active.nextPtr = iPtr->activeVarTracePtr; + iPtr->activeVarTracePtr = &active; Tcl_Preserve((ClientData) iPtr); if (arrayPtr != NULL && !(arrayPtr->flags & VAR_TRACE_ACTIVE)) { active.varPtr = arrayPtr; @@ -4609,7 +4609,7 @@ CallTraces(iPtr, arrayPtr, varPtr, part1, part2, flags, leaveErrMsg) } varPtr->flags &= ~VAR_TRACE_ACTIVE; varPtr->refCount--; - iPtr->activeTracePtr = active.nextPtr; + iPtr->activeVarTracePtr = active.nextPtr; Tcl_Release((ClientData) iPtr); return code; } @@ -4909,7 +4909,7 @@ TclDeleteVars(iPtr, tablePtr) * free up the variable's space (no need to free the hash entry * here, unless we're dealing with a global variable: the * hash entries will be deleted automatically when the whole - * table is deleted). Note that we give CallTraces the variable's + * table is deleted). Note that we give CallVarTraces the variable's * fully-qualified name so that any called trace procedures can * refer to these variables being deleted. */ @@ -4918,7 +4918,7 @@ TclDeleteVars(iPtr, tablePtr) objPtr = Tcl_NewObj(); Tcl_IncrRefCount(objPtr); /* until done with traces */ Tcl_GetVariableFullName(interp, (Tcl_Var) varPtr, objPtr); - CallTraces(iPtr, (Var *) NULL, varPtr, Tcl_GetString(objPtr), + CallVarTraces(iPtr, (Var *) NULL, varPtr, Tcl_GetString(objPtr), NULL, flags, /* leaveErrMsg */ 0); Tcl_DecrRefCount(objPtr); /* free no longer needed obj */ @@ -4927,7 +4927,7 @@ TclDeleteVars(iPtr, tablePtr) varPtr->tracePtr = tracePtr->nextPtr; Tcl_EventuallyFree((ClientData) tracePtr, TCL_DYNAMIC); } - for (activePtr = iPtr->activeTracePtr; activePtr != NULL; + for (activePtr = iPtr->activeVarTracePtr; activePtr != NULL; activePtr = activePtr->nextPtr) { if (activePtr->varPtr == varPtr) { activePtr->nextTracePtr = NULL; @@ -5044,14 +5044,14 @@ TclDeleteCompiledLocalVars(iPtr, framePtr) */ if (varPtr->tracePtr != NULL) { - CallTraces(iPtr, (Var *) NULL, varPtr, varPtr->name, NULL, + CallVarTraces(iPtr, (Var *) NULL, varPtr, varPtr->name, NULL, flags, /* leaveErrMsg */ 0); while (varPtr->tracePtr != NULL) { VarTrace *tracePtr = varPtr->tracePtr; varPtr->tracePtr = tracePtr->nextPtr; Tcl_EventuallyFree((ClientData) tracePtr, TCL_DYNAMIC); } - for (activePtr = iPtr->activeTracePtr; activePtr != NULL; + for (activePtr = iPtr->activeVarTracePtr; activePtr != NULL; activePtr = activePtr->nextPtr) { if (activePtr->varPtr == varPtr) { activePtr->nextTracePtr = NULL; @@ -5108,7 +5108,7 @@ DeleteArray(iPtr, arrayName, varPtr, flags) char *arrayName; /* Name of array (used for trace * callbacks). */ Var *varPtr; /* Pointer to variable structure. */ - int flags; /* Flags to pass to CallTraces: + int flags; /* Flags to pass to CallVarTraces: * TCL_TRACE_UNSETS and sometimes * TCL_INTERP_DESTROYED, * TCL_NAMESPACE_ONLY, or @@ -5132,7 +5132,7 @@ DeleteArray(iPtr, arrayName, varPtr, flags) elPtr->hPtr = NULL; if (elPtr->tracePtr != NULL) { elPtr->flags &= ~VAR_TRACE_ACTIVE; - CallTraces(iPtr, (Var *) NULL, elPtr, arrayName, + CallVarTraces(iPtr, (Var *) NULL, elPtr, arrayName, Tcl_GetHashKey(varPtr->value.tablePtr, hPtr), flags, /* leaveErrMsg */ 0); while (elPtr->tracePtr != NULL) { @@ -5140,7 +5140,7 @@ DeleteArray(iPtr, arrayName, varPtr, flags) elPtr->tracePtr = tracePtr->nextPtr; Tcl_EventuallyFree((ClientData) tracePtr,TCL_DYNAMIC); } - for (activePtr = iPtr->activeTracePtr; activePtr != NULL; + for (activePtr = iPtr->activeVarTracePtr; activePtr != NULL; activePtr = activePtr->nextPtr) { if (activePtr->varPtr == elPtr) { activePtr->nextTracePtr = NULL; @@ -5289,7 +5289,7 @@ TclVarTraceExists(interp, varName) if ((varPtr->tracePtr != NULL) || ((arrayPtr != NULL) && (arrayPtr->tracePtr != NULL))) { - CallTraces((Interp *)interp, arrayPtr, varPtr, varName, NULL, + CallVarTraces((Interp *)interp, arrayPtr, varPtr, varName, NULL, TCL_TRACE_READS, /* leaveErrMsg */ 0); } |