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