diff -C 3 -r -X traceignore.txt tcl8.2/generic/tcl.decls tcl8.2orig/generic/tcl.decls *** tcl8.2/generic/tcl.decls Sat Sep 18 19:52:50 1999 --- tcl8.2orig/generic/tcl.decls Wed Aug 18 20:59:08 1999 *************** *** 1343,1353 **** declare 389 generic { int Tcl_GetChannelNamesEx(Tcl_Interp *interp, char *pattern) } ! declare 390 generic { ! Tcl_Trace Tcl_CreateTraceObj(Tcl_Interp* interp, Tcl_Obj* insideCmd, \ ! int traceFlags, int maxLevel, int minLevel, \ ! Tcl_CmdTraceObjProc *proc, ClientData clientData) ! } ############################################################################## --- 1343,1349 ---- declare 389 generic { int Tcl_GetChannelNamesEx(Tcl_Interp *interp, char *pattern) } ! ############################################################################## diff -C 3 -r -X traceignore.txt tcl8.2/generic/tcl.h tcl8.2orig/generic/tcl.h *** tcl8.2/generic/tcl.h Tue Sep 21 09:03:50 1999 --- tcl8.2orig/generic/tcl.h Tue Aug 10 17:16:25 1999 *************** *** 503,512 **** typedef void (Tcl_CmdTraceProc) _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, int level, char *command, Tcl_CmdProc *proc, ClientData cmdClientData, int argc, char *argv[])); - typedef void (Tcl_CmdTraceObjProc) _ANSI_ARGS_((ClientData clientData, - Tcl_Interp *interp, int level, int startLevel, int flags, int code, - char* command, int length, Tcl_Command currentCmd, - int objc, struct Tcl_Obj *CONST objv[])); typedef void (Tcl_DupInternalRepProc) _ANSI_ARGS_((struct Tcl_Obj *srcPtr, struct Tcl_Obj *dupPtr)); typedef int (Tcl_EncodingConvertProc)_ANSI_ARGS_((ClientData clientData, --- 503,508 ---- *************** *** 867,878 **** #define TCL_INTERP_DESTROYED 0x100 #define TCL_LEAVE_ERR_MSG 0x200 #define TCL_TRACE_ARRAY 0x800 - - /* - * Flag values passed to Tcl_CreateTraceObj - */ - #define TCL_CMD_TRACE_BEFORE 1 - #define TCL_CMD_TRACE_AFTER 2 /* * The TCL_PARSE_PART1 flag is deprecated and has no effect. --- 863,868 ---- diff -C 3 -r -X traceignore.txt tcl8.2/generic/tclBasic.c tcl8.2orig/generic/tclBasic.c *** tcl8.2/generic/tclBasic.c Tue Sep 21 12:28:02 1999 --- tcl8.2orig/generic/tclBasic.c Fri May 14 17:16:54 1999 *************** *** 3837,3964 **** tracePtr = (Trace *) ckalloc(sizeof(Trace)); tracePtr->level = level; tracePtr->proc = proc; - tracePtr->traceFlags = 0; tracePtr->clientData = clientData; - tracePtr->nextPtr = iPtr->tracePtr; - iPtr->tracePtr = tracePtr; - - return (Tcl_Trace) tracePtr; - } - - /* - *---------------------------------------------------------------------- - * - * Tcl_CreateTraceObj -- - * - * Arrange for a procedure to be called to trace command execution. - * - * Results: - * The return value is a token for the trace, which may be passed - * to Tcl_DeleteTrace to eliminate the trace. - * - * Side effects: - * From now on, proc will be called just before a command procedure - * is called to execute a Tcl command, provided certain conditions - * are met. These conditions may include: current execution - * level is at least 'minLevel'; current execution level is at - * most 'maxLevel'; execution is currently inside the command/proc - * 'insideCmd'. For any given occasion on which those conditions - * are met, there are two times at which this procedure may - * be called: before the command is executed, and after the - * command is executed. Depending on the value to 'traceFlags' - * the procedure will be called in one or both of those situations. - * - * Calls to proc will have the following form: - * - * void - * proc(clientData, interp, level, startLevel, flags, code, - * command, length, currentCmd, objc, objv) - * ClientData clientData; - * Tcl_Interp *interp; - * int level; - * int startLevel; - * int flags; - * int code; - * char *command; - * int length; - * Tcl_Command currentCmd; - * int objc; - * struct Tcl_Obj *CONST objv[]; - * { - * } - * - * The clientData, interp and flags arguments to proc will be the - * same as the corresponding arguments to this procedure. Level - * gives the nesting level of command interpretation for this - * interpreter (0 corresponds to top level). StartLevel gives the - * level at which the first command trace was triggered (so - * Level-StartLevel gives a relative level). The first 'length' - * characters of Command gives the ASCII text of the raw command, - * and currentCmd is the Tcl_Command structure referring to the - * current command. will receive, and objc and objv give the - * arguments to the command, after any argument parsing and - * substitution. Proc does not return a value. - * - *---------------------------------------------------------------------- - */ - - Tcl_Trace - Tcl_CreateTraceObj(interp, insideCmd, traceFlags, maxLevel, minLevel, - proc, clientData) - Tcl_Interp *interp; /* Interpreter in which to create trace. */ - Tcl_Obj* insideCmd; /* Only activate this trace when execution - * is inside a call to this command, and - * after it is inside, later deactivate the - * trace when execution of this command is - * complete. */ - int traceFlags; /* Or'd combination of TCL_CMD_TRACE_ flags, - * to indicate whether to call the given - * procedure before command execution, - * or after command execution (with the - * result of the command execution). If - * zero, then equivalent to the default - * of tracing before and after. */ - int maxLevel; /* Only call proc for commands at nesting - * level<=argument level (1=>top level). - * If zero, then ignore minimum level. */ - int minLevel; /* Only call proc for commands at nesting - * level>=argument level (1=>top level). - * If zero then ignore maximum level. */ - Tcl_CmdTraceObjProc *proc; /* Procedure to call before executing each - * command. */ - ClientData clientData; /* Arbitrary value word to pass to proc. */ - { - register Trace *tracePtr; - register Interp *iPtr = (Interp *) interp; - - /* - * Invalidate existing compiled code for this interpreter and arrange - * (by setting the DONT_COMPILE_CMDS_INLINE flag) that when compiling - * new code, no commands will be compiled inline (i.e., into an inline - * sequence of instructions). We do this because commands that were - * compiled inline will never result in a command trace being called. - */ - - iPtr->compileEpoch++; - iPtr->flags |= DONT_COMPILE_CMDS_INLINE; - - tracePtr = (Trace *) ckalloc(sizeof(Trace)); - tracePtr->level = minLevel; - tracePtr->objProc = proc; - if((traceFlags & 3) == 0) { - tracePtr->traceFlags = TCL_CMD_TRACE_BEFORE | TCL_CMD_TRACE_AFTER; - } else { - tracePtr->traceFlags = traceFlags & 3; - } - tracePtr->clientData = clientData; - tracePtr->minLevel = minLevel; - tracePtr->cmdPtr = NULL; - if(insideCmd != NULL) { - tracePtr->cmdPtr = Tcl_FindCommand(interp, - Tcl_GetString(insideCmd), (Tcl_Namespace *) NULL, /*flags*/ 0); - } - tracePtr->tracingCmdDepth = 0; - tracePtr->tracingInitialDepth = 0; tracePtr->nextPtr = iPtr->tracePtr; iPtr->tracePtr = tracePtr; --- 3837,3843 ---- diff -C 3 -r -X traceignore.txt tcl8.2/generic/tclExecute.c tcl8.2orig/generic/tclExecute.c *** tcl8.2/generic/tclExecute.c Wed Sep 22 18:55:43 1999 --- tcl8.2orig/generic/tclExecute.c Wed Jun 16 15:56:33 1999 *************** *** 208,214 **** static void CallTraceProcedure _ANSI_ARGS_((Tcl_Interp *interp, Trace *tracePtr, Command *cmdPtr, char *command, int numChars, ! int objc, Tcl_Obj *CONST objv[])); static void DupCmdNameInternalRep _ANSI_ARGS_((Tcl_Obj *objPtr, Tcl_Obj *copyPtr)); static int ExprAbsFunc _ANSI_ARGS_((Tcl_Interp *interp, --- 208,214 ---- static void CallTraceProcedure _ANSI_ARGS_((Tcl_Interp *interp, Trace *tracePtr, Command *cmdPtr, char *command, int numChars, ! int objc, Tcl_Obj *objv[])); static void DupCmdNameInternalRep _ANSI_ARGS_((Tcl_Obj *objPtr, Tcl_Obj *copyPtr)); static int ExprAbsFunc _ANSI_ARGS_((Tcl_Interp *interp, *************** *** 726,737 **** doInvocation: { ! int objc = opnd; /* The number of arguments. */ ! Tcl_Obj **objv; /* The array of argument objects. */ ! Command *cmdPtr; /* Points to command's Command struct. */ ! int newPcOffset; /* New inst offset for break, continue. */ ! char *command; /* String starting with actual command */ ! int numChars; /* Number of chars of command to use */ #ifdef TCL_COMPILE_DEBUG int isUnknownCmd = 0; char cmdNameBuf[21]; --- 726,735 ---- doInvocation: { ! int objc = opnd; /* The number of arguments. */ ! Tcl_Obj **objv; /* The array of argument objects. */ ! Command *cmdPtr; /* Points to command's Command struct. */ ! int newPcOffset; /* New inst offset for break, continue. */ #ifdef TCL_COMPILE_DEBUG int isUnknownCmd = 0; char cmdNameBuf[21]; *************** *** 789,799 **** */ if (iPtr->tracePtr != NULL) { ! command = GetSrcInfoForPc(pc, codePtr, &numChars); ! DECACHE_STACK_INFO(); ! TclCheckTraces(interp,command,numChars,cmdPtr,TCL_OK, ! TCL_CMD_TRACE_BEFORE,objc,objv); ! CACHE_STACK_INFO(); } /* --- 787,809 ---- */ if (iPtr->tracePtr != NULL) { ! Trace *tracePtr, *nextTracePtr; ! ! for (tracePtr = iPtr->tracePtr; tracePtr != NULL; ! tracePtr = nextTracePtr) { ! nextTracePtr = tracePtr->nextPtr; ! if (iPtr->numLevels <= tracePtr->level) { ! int numChars; ! char *cmd = GetSrcInfoForPc(pc, codePtr, ! &numChars); ! if (cmd != NULL) { ! DECACHE_STACK_INFO(); ! CallTraceProcedure(interp, tracePtr, cmdPtr, ! cmd, numChars, objc, objv); ! CACHE_STACK_INFO(); ! } ! } ! } } /* *************** *** 849,861 **** (void) Tcl_GetObjResult(interp); } - if (iPtr->tracePtr != NULL) { - DECACHE_STACK_INFO(); - TclCheckTraces(interp,command,numChars,cmdPtr,result, - TCL_CMD_TRACE_AFTER,objc,objv); - CACHE_STACK_INFO(); - } - /* * Pop the objc top stack elements and decrement their ref * counts. --- 859,864 ---- *************** *** 3083,3185 **** /* *---------------------------------------------------------------------- * - * TclCheckTraces -- - * - * 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 used by 'EvalObjv' and 'TclExecuteByteCode' - * - * Results: - * None. - * - * Side effects: - * Those side effects made by any trace procedures called. - * - *---------------------------------------------------------------------- - */ - void - TclCheckTraces(interp, command, numChars, cmdPtr, result, 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 result; /* 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; - - if (command == NULL) { - return; - } - - for (tracePtr = iPtr->tracePtr;tracePtr != NULL;tracePtr = tracePtr->nextPtr) { - if (tracePtr->level != 0 && iPtr->numLevels > tracePtr->level) { - continue; - } - if (tracePtr->traceFlags != 0) { - /* The trace was created with Tcl_CreateTraceObj */ - if (iPtr->numLevels < tracePtr->minLevel) { - continue; - } - - if (traceFlags & TCL_CMD_TRACE_BEFORE) { - if (tracePtr->cmdPtr != NULL) { - if (tracePtr->tracingCmdDepth == 0) { - if (cmdPtr == (Command*)tracePtr->cmdPtr) { - tracePtr->tracingInitialDepth = iPtr->numLevels; - } else { - continue; - } - } - /* If we reach here, we are inside the command - * we wish to trace. */ - tracePtr->tracingCmdDepth++; - } - if (tracePtr->traceFlags & TCL_CMD_TRACE_BEFORE) { - (*tracePtr->objProc)(tracePtr->clientData, interp, - iPtr->numLevels, tracePtr->tracingInitialDepth, - TCL_CMD_TRACE_BEFORE, 0, - command, numChars, (Tcl_Command)cmdPtr, - objc, objv); - } - } else { - if (tracePtr->cmdPtr != NULL) { - if (tracePtr->tracingCmdDepth == 0) { - continue; - } - /* If we reach here, we are inside the command - * we wish to trace. */ - tracePtr->tracingCmdDepth--; - } - if (tracePtr->traceFlags & TCL_CMD_TRACE_AFTER) { - (*tracePtr->objProc)(tracePtr->clientData, interp, - iPtr->numLevels, tracePtr->tracingInitialDepth, - tracePtr->traceFlags & TCL_CMD_TRACE_AFTER, - result, command, numChars, (Tcl_Command)cmdPtr, - objc, objv); - } - } - } else { - /* The trace was created with Tcl_CreateTrace */ - CallTraceProcedure(interp, tracePtr, cmdPtr, - command, numChars, objc, objv); - } - } - } - - - /* - *---------------------------------------------------------------------- - * * CallTraceProcedure -- * * Invokes a trace procedure registered with an interpreter. These --- 3086,3091 ---- *************** *** 3206,3212 **** 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; register char **argv; --- 3112,3118 ---- int numChars; /* The number of characters in the * command's source. */ register int objc; /* Number of arguments for the command. */ ! Tcl_Obj *objv[]; /* Pointers to Tcl_Obj of each argument. */ { Interp *iPtr = (Interp *) interp; register char **argv; diff -C 3 -r -X traceignore.txt tcl8.2/generic/tclInt.decls tcl8.2orig/generic/tclInt.decls *** tcl8.2/generic/tclInt.decls Wed Sep 22 18:49:37 1999 --- tcl8.2orig/generic/tclInt.decls Mon Aug 09 20:42:14 1999 *************** *** 543,548 **** --- 543,549 ---- declare 145 generic { struct AuxDataType *TclGetAuxDataType(char *typeName) } + declare 146 generic { TclHandle TclHandleCreate(VOID *ptr) } *************** *** 590,606 **** } declare 157 generic { Var * TclVarTraceExists (Tcl_Interp *interp, char *varName) - } - - declare 159 generic { - void TclCheckTraces (Tcl_Interp *interp, char *command, int numChars, \ - Command *cmdPtr, int result, int traceFlags, int objc, \ - Tcl_Obj *CONST objv[]) } ############################################################################## --- 591,596 ---- diff -C 3 -r -X traceignore.txt tcl8.2/generic/tclInt.h tcl8.2orig/generic/tclInt.h *** tcl8.2/generic/tclInt.h Sun Sep 19 03:13:53 1999 --- tcl8.2orig/generic/tclInt.h Mon Aug 02 11:45:37 1999 *************** *** 612,637 **** */ typedef struct Trace { ! int level; /* Only trace commands at nesting level ! * less than or equal to this. */ ! union { ! Tcl_CmdTraceProc *proc; /* Procedure to call to trace command. */ ! Tcl_CmdTraceObjProc *objProc; /* Procedure to call to trace command. */ ! }; ! ClientData clientData; /* Arbitrary value to pass to proc. */ ! struct Trace *nextPtr; /* Next in list of traces for this ! * interp. */ ! int traceFlags; /* If zero, then this is an old trace ! * strcture, and the following fields are ! * ignored. Otherwise it is an or'd ! * combination of TCL_CMD_TRACE_ flags. ! * Old trace structures use the 'proc' ! * above, new ones use 'objProc'. */ ! int minLevel; /* Only trace commands at nesting level ! * greater than or equal to this. */ ! Tcl_Command cmdPtr; /* Only trace inside this command */ ! int tracingCmdDepth; /* Used to keep track of depth. */ ! int tracingInitialDepth; /* Used to keep track of depth. */ } Trace; /* --- 612,622 ---- */ typedef struct Trace { ! int level; /* Only trace commands at nesting level ! * less than or equal to this. */ ! Tcl_CmdTraceProc *proc; /* Procedure to call to trace command. */ ! ClientData clientData; /* Arbitrary value to pass to proc. */ ! struct Trace *nextPtr; /* Next in list of traces for this interp. */ } Trace; /* *************** *** 1495,1518 **** typedef struct TclpTime_t_ *TclpTime_t; /* *---------------------------------------------------------------- * Variables shared among Tcl modules but not used by the outside world. diff -C 3 -r -X traceignore.txt tcl8.2/generic/tclParse.c tcl8.2orig/generic/tclParse.c *** tcl8.2/generic/tclParse.c Wed Sep 22 18:51:37 1999 --- tcl8.2orig/generic/tclParse.c Thu Aug 12 17:14:42 1999 *************** *** 799,804 **** --- 799,806 ---- Interp *iPtr = (Interp *) interp; Tcl_Obj **newObjv; int i, code; + Trace *tracePtr, *nextPtr; + char **argv, *commandCopy; CallFrame *savedVarFramePtr; /* Saves old copy of iPtr->varFramePtr * in case TCL_EVAL_GLOBAL was set. */ *************** *** 878,886 **** * Call trace procedures if needed. */ ! if (iPtr->tracePtr != NULL) { ! TclCheckTraces(interp, command, length, cmdPtr, TCL_OK, ! TCL_CMD_TRACE_BEFORE, objc, objv); } /* --- 880,923 ---- * Call trace procedures if needed. */ ! argv = NULL; ! commandCopy = command; ! ! for (tracePtr = iPtr->tracePtr; tracePtr != NULL; tracePtr = nextPtr) { ! nextPtr = tracePtr->nextPtr; ! if (iPtr->numLevels > tracePtr->level) { ! continue; ! } ! ! /* ! * This is a bit messy because we have to emulate the old trace ! * interface, which uses strings for everything. ! */ ! ! if (argv == NULL) { ! argv = (char **) ckalloc((unsigned) (objc + 1) * sizeof(char *)); ! for (i = 0; i < objc; i++) { ! argv[i] = Tcl_GetString(objv[i]); ! } ! argv[objc] = 0; ! ! 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; ! } ! } ! (*tracePtr->proc)(tracePtr->clientData, interp, iPtr->numLevels, ! commandCopy, cmdPtr->proc, cmdPtr->clientData, ! objc, argv); ! } ! if (argv != NULL) { ! ckfree((char *) argv); ! } ! if (commandCopy != command) { ! ckfree((char *) commandCopy); } /* *************** *** 909,919 **** (void) Tcl_GetObjResult(interp); } - if (iPtr->tracePtr != NULL) { - TclCheckTraces(interp,command, length, cmdPtr, code, - TCL_CMD_TRACE_AFTER, objc, objv); - } - done: iPtr->numLevels--; return code; --- 946,951 ---- *************** *** 962,972 **** /* * EvalObjv will increment numLevels so use "<" rather than "<=" */ ! if ((tracePtr->level == 0 || (iPtr->numLevels < tracePtr->level)) ! && !(tracePtr->traceFlags != 0 ! && (iPtr->numLevels < (tracePtr->minLevel - 1)))) { ! /* It's either an old-style trace, or a new-style trace ! * whose level is acceptable. */ int i; /* * The command will be needed for an execution trace or stack trace --- 994,1000 ---- /* * EvalObjv will increment numLevels so use "<" rather than "<=" */ ! if (iPtr->numLevels < tracePtr->level) { int i; /* * The command will be needed for an execution trace or stack trace