diff options
Diffstat (limited to 'generic/tclTrace.c')
| -rw-r--r-- | generic/tclTrace.c | 906 |
1 files changed, 410 insertions, 496 deletions
diff --git a/generic/tclTrace.c b/generic/tclTrace.c index 2ef358c..2e1b241 100644 --- a/generic/tclTrace.c +++ b/generic/tclTrace.c @@ -3,10 +3,10 @@ * * This file contains code to handle most trace management. * - * Copyright © 1987-1993 The Regents of the University of California. - * Copyright © 1994-1997 Sun Microsystems, Inc. - * Copyright © 1998-2000 Scriptics Corporation. - * Copyright © 2002 ActiveState Corporation. + * Copyright (c) 1987-1993 The Regents of the University of California. + * Copyright (c) 1994-1997 Sun Microsystems, Inc. + * Copyright (c) 1998-2000 Scriptics Corporation. + * Copyright (c) 2002 ActiveState Corporation. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. @@ -21,12 +21,12 @@ typedef struct { int flags; /* Operations for which Tcl command is to be * invoked. */ - Tcl_Size length; /* Number of non-NUL chars. in command. */ - char command[TCLFLEXARRAY]; /* Space for Tcl command to invoke. Actual + size_t length; /* Number of non-NUL chars. in 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 1 - * byte. */ + * structure, so that it can be larger than 4 + * bytes. */ } TraceVarInfo; typedef struct { @@ -41,10 +41,10 @@ typedef struct { typedef struct { int flags; /* Operations for which Tcl command is to be * invoked. */ - Tcl_Size length; /* Number of non-NUL chars. in command. */ + size_t length; /* Number of non-NUL chars. in command. */ Tcl_Trace stepTrace; /* Used for execution traces, when tracing * inside the given command */ - Tcl_Size startLevel; /* Used for bookkeeping with step execution + int startLevel; /* Used for bookkeeping with step execution * traces, store the level at which the step * trace was invoked */ char *startCmd; /* Used for bookkeeping with step execution @@ -52,15 +52,15 @@ typedef struct { * invoked step trace */ int curFlags; /* Trace flags for the current command */ int curCode; /* Return code for the current command */ - size_t refCount; /* Used to ensure this structure is not + int refCount; /* Used to ensure this structure is not * deleted too early. Keeps track of how many * pieces of code have a pointer to this * structure. */ - char command[TCLFLEXARRAY]; /* Space for Tcl command to invoke. Actual + 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 1 - * byte. */ + * structure, so that it can be larger than 4 + * bytes. */ } TraceCommandInfo; /* @@ -79,7 +79,8 @@ typedef struct { * TCL_TRACE_EXEC_DIRECT - This execution trace is triggered directly * by the command being traced, not because of * an internal trace. - * The flag 'TCL_TRACE_DESTROYED' may also be used in command execution traces. + * The flags 'TCL_TRACE_DESTROYED' and 'TCL_INTERP_DESTROYED' may also be used + * in command execution traces. */ #define TCL_TRACE_ENTER_DURING_EXEC 4 @@ -92,15 +93,8 @@ typedef struct { * Forward declarations for functions defined in this file: */ -/* 'OLD' options are pre-Tcl-8.4 style */ -enum traceOptionsEnum { - TRACE_ADD, TRACE_INFO, TRACE_REMOVE -#ifndef TCL_NO_DEPRECATED - ,TRACE_OLD_VARIABLE, TRACE_OLD_VDELETE, TRACE_OLD_VINFO -#endif -}; -typedef int (Tcl_TraceTypeObjCmd)(Tcl_Interp *interp, enum traceOptionsEnum optionIndex, - Tcl_Size objc, Tcl_Obj *const objv[]); +typedef int (Tcl_TraceTypeObjCmd)(Tcl_Interp *interp, int optionIndex, + int objc, Tcl_Obj *const objv[]); static Tcl_TraceTypeObjCmd TraceVariableObjCmd; static Tcl_TraceTypeObjCmd TraceCommandObjCmd; @@ -113,7 +107,7 @@ static Tcl_TraceTypeObjCmd TraceExecutionObjCmd; * add to the list of supported trace types. */ -static const char *const traceTypeOptions[] = { +static const char *traceTypeOptions[] = { "execution", "command", "variable", NULL }; static Tcl_TraceTypeObjCmd *const traceSubCmds[] = { @@ -127,47 +121,32 @@ static Tcl_TraceTypeObjCmd *const traceSubCmds[] = { */ static int CallTraceFunction(Tcl_Interp *interp, Trace *tracePtr, - Command *cmdPtr, const char *command, Tcl_Size numChars, - Tcl_Size objc, Tcl_Obj *const objv[]); -static char * TraceVarProc(void *clientData, Tcl_Interp *interp, + Command *cmdPtr, const char *command, int numChars, + int objc, Tcl_Obj *const objv[]); +static char * TraceVarProc(ClientData clientData, Tcl_Interp *interp, const char *name1, const char *name2, int flags); -static void TraceCommandProc(void *clientData, +static void TraceCommandProc(ClientData clientData, Tcl_Interp *interp, const char *oldName, const char *newName, int flags); static Tcl_CmdObjTraceProc TraceExecutionProc; -static int StringTraceProc(void *clientData, - Tcl_Interp *interp, Tcl_Size level, +static int StringTraceProc(ClientData clientData, + Tcl_Interp *interp, int level, const char *command, Tcl_Command commandInfo, - Tcl_Size objc, Tcl_Obj *const objv[]); -static void StringTraceDeleteProc(void *clientData); + int objc, Tcl_Obj *const objv[]); +static void StringTraceDeleteProc(ClientData clientData); static void DisposeTraceResult(int flags, char *result); static int TraceVarEx(Tcl_Interp *interp, const char *part1, - const char *part2, VarTrace *tracePtr); + const char *part2, register VarTrace *tracePtr); /* * The following structure holds the client data for string-based * trace procs */ -typedef struct { - void *clientData; /* Client data from Tcl_CreateTrace */ +typedef struct StringTraceData { + ClientData clientData; /* Client data from Tcl_CreateTrace */ Tcl_CmdTraceProc *proc; /* Trace function from Tcl_CreateTrace */ } StringTraceData; - -/* - * Convenience macros for iterating over the list of traces. Note that each of - * these *must* be treated as a command, and *must* have a block following it. - */ - -#define FOREACH_VAR_TRACE(interp, name, clientData) \ - (clientData) = NULL; \ - while (((clientData) = Tcl_VarTraceInfo2((interp), (name), NULL, \ - 0, TraceVarProc, (clientData))) != NULL) - -#define FOREACH_COMMAND_TRACE(interp, name, clientData) \ - (clientData) = NULL; \ - while (((clientData) = Tcl_CommandTraceInfo((interp), (name), 0, \ - TraceCommandProc, (clientData))) != NULL) /* *---------------------------------------------------------------------- @@ -188,51 +167,42 @@ typedef struct { *---------------------------------------------------------------------- */ + /* ARGSUSED */ int Tcl_TraceObjCmd( - TCL_UNUSED(void *), + ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ - Tcl_Size objc, /* Number of arguments. */ + int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { -#ifndef TCL_NO_DEPRECATED - const char *name; - const char *flagOps, *p; -#endif + int optionIndex; + char *name, *flagOps, *p; /* Main sub commands to 'trace' */ - static const char *const traceOptions[] = { + static const char *traceOptions[] = { "add", "info", "remove", -#ifndef TCL_NO_DEPRECATED +#ifndef TCL_REMOVE_OBSOLETE_TRACES "variable", "vdelete", "vinfo", #endif NULL }; - int optionIndex; -#ifndef TCL_NO_DEPRECATED - static const char *const traceShortOptions[] = { - "add", "info", "remove", NULL - }; + /* 'OLD' options are pre-Tcl-8.4 style */ + enum traceOptions { + TRACE_ADD, TRACE_INFO, TRACE_REMOVE, +#ifndef TCL_REMOVE_OBSOLETE_TRACES + TRACE_OLD_VARIABLE, TRACE_OLD_VDELETE, TRACE_OLD_VINFO #endif + }; if (objc < 2) { - Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?"); + Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?"); return TCL_ERROR; } -#ifdef TCL_NO_DEPRECATED - if (Tcl_GetIndexFromObj(interp, objv[1], traceOptions, "option", 0, - &optionIndex) != TCL_OK) { - return TCL_ERROR; - } -#else - if (Tcl_GetIndexFromObj(NULL, objv[1], traceOptions, "option", 0, - &optionIndex) != TCL_OK) { - Tcl_GetIndexFromObj(interp, objv[1], traceShortOptions, "option", 0, - &optionIndex); + if (Tcl_GetIndexFromObj(interp, objv[1], traceOptions, + "option", 0, &optionIndex) != TCL_OK) { return TCL_ERROR; } -#endif - switch ((enum traceOptionsEnum) optionIndex) { + switch ((enum traceOptions) optionIndex) { case TRACE_ADD: case TRACE_REMOVE: { /* @@ -244,14 +214,14 @@ Tcl_TraceObjCmd( int typeIndex; if (objc < 3) { - Tcl_WrongNumArgs(interp, 2, objv, "type ?arg ...?"); + Tcl_WrongNumArgs(interp, 2, objv, "type ?arg arg ...?"); return TCL_ERROR; } if (Tcl_GetIndexFromObj(interp, objv[2], traceTypeOptions, "option", 0, &typeIndex) != TCL_OK) { return TCL_ERROR; } - return traceSubCmds[typeIndex](interp, (enum traceOptionsEnum)optionIndex, objc, objv); + return (traceSubCmds[typeIndex])(interp, optionIndex, objc, objv); } case TRACE_INFO: { /* @@ -274,11 +244,11 @@ Tcl_TraceObjCmd( 0, &typeIndex) != TCL_OK) { return TCL_ERROR; } - return traceSubCmds[typeIndex](interp, (enum traceOptionsEnum)optionIndex, objc, objv); + return (traceSubCmds[typeIndex])(interp, optionIndex, objc, objv); break; } -#ifndef TCL_NO_DEPRECATED +#ifndef TCL_REMOVE_OBSOLETE_TRACES case TRACE_OLD_VARIABLE: case TRACE_OLD_VDELETE: { Tcl_Obj *copyObjv[6]; @@ -290,9 +260,9 @@ Tcl_TraceObjCmd( return TCL_ERROR; } - TclNewObj(opsList); + opsList = Tcl_NewObj(); Tcl_IncrRefCount(opsList); - flagOps = TclGetStringFromObj(objv[3], &numFlags); + flagOps = Tcl_GetStringFromObj(objv[3], &numFlags); if (numFlags == 0) { Tcl_DecrRefCount(opsList); goto badVarOps; @@ -318,15 +288,15 @@ Tcl_TraceObjCmd( memcpy(copyObjv+1, objv, objc*sizeof(Tcl_Obj *)); copyObjv[4] = opsList; if (optionIndex == TRACE_OLD_VARIABLE) { - code = traceSubCmds[2](interp, TRACE_ADD, objc+1, copyObjv); + code = (traceSubCmds[2])(interp, TRACE_ADD, objc+1, copyObjv); } else { - code = traceSubCmds[2](interp, TRACE_REMOVE, objc+1, copyObjv); + code = (traceSubCmds[2])(interp, TRACE_REMOVE, objc+1, copyObjv); } Tcl_DecrRefCount(opsList); return code; } case TRACE_OLD_VINFO: { - void *clientData; + ClientData clientData; char ops[5]; Tcl_Obj *resultListPtr, *pairObjPtr, *elemObjPtr; @@ -334,30 +304,33 @@ Tcl_TraceObjCmd( Tcl_WrongNumArgs(interp, 2, objv, "name"); return TCL_ERROR; } - TclNewObj(resultListPtr); + resultListPtr = Tcl_NewObj(); + clientData = 0; name = Tcl_GetString(objv[2]); - FOREACH_VAR_TRACE(interp, name, clientData) { - TraceVarInfo *tvarPtr = (TraceVarInfo *)clientData; - char *q = ops; + while ((clientData = Tcl_VarTraceInfo(interp, name, 0, + TraceVarProc, clientData)) != 0) { + + TraceVarInfo *tvarPtr = (TraceVarInfo *) clientData; pairObjPtr = Tcl_NewListObj(0, NULL); + p = ops; if (tvarPtr->flags & TCL_TRACE_READS) { - *q = 'r'; - q++; + *p = 'r'; + p++; } if (tvarPtr->flags & TCL_TRACE_WRITES) { - *q = 'w'; - q++; + *p = 'w'; + p++; } if (tvarPtr->flags & TCL_TRACE_UNSETS) { - *q = 'u'; - q++; + *p = 'u'; + p++; } if (tvarPtr->flags & TCL_TRACE_ARRAY) { - *q = 'a'; - q++; + *p = 'a'; + p++; } - *q = '\0'; + *p = '\0'; /* * Build a pair (2-item list) with the ops string as the first obj @@ -375,18 +348,14 @@ Tcl_TraceObjCmd( Tcl_SetObjResult(interp, resultListPtr); break; } -#endif /* TCL_NO_DEPRECATED */ +#endif /* TCL_REMOVE_OBSOLETE_TRACES */ } return TCL_OK; -#ifndef TCL_NO_DEPRECATED badVarOps: - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "bad operations \"%s\": should be one or more of rwua", - flagOps)); - Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRACE", "BADOPS", (void *)NULL); + Tcl_AppendResult(interp, "bad operations \"", flagOps, + "\": should be one or more of rwua", NULL); return TCL_ERROR; -#endif } /* @@ -411,26 +380,29 @@ Tcl_TraceObjCmd( static int TraceExecutionObjCmd( Tcl_Interp *interp, /* Current interpreter. */ - enum traceOptionsEnum optionIndex, /* Add, info or remove */ - Tcl_Size objc, /* Number of arguments. */ + int optionIndex, /* Add, info or remove */ + int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - const char *name, *command; - Tcl_Size length; - static const char *const opStrings[] = { + 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", NULL }; enum operations { TRACE_EXEC_ENTER, TRACE_EXEC_LEAVE, TRACE_EXEC_ENTER_STEP, TRACE_EXEC_LEAVE_STEP }; - int index; - switch (optionIndex) { + switch ((enum traceOptions) optionIndex) { case TRACE_ADD: case TRACE_REMOVE: { - int flags = 0, result; - Tcl_Size i, listLen; + int flags = 0; + int i, listLen, result; Tcl_Obj **elemPtrs; if (objc != 6) { @@ -443,22 +415,16 @@ TraceExecutionObjCmd( * pointer to its array of element pointers. */ - result = TclListObjLength(interp, objv[4], &listLen); + result = Tcl_ListObjGetElements(interp, objv[4], &listLen, &elemPtrs); if (result != TCL_OK) { return result; } if (listLen == 0) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "bad operation list \"\": must be one or more of" - " enter, leave, enterstep, or leavestep", -1)); - Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRACE", "NOOPS", - (void *)NULL); + Tcl_SetResult(interp, "bad operation list \"\": must be " + "one or more of enter, leave, enterstep, or leavestep", + TCL_STATIC); return TCL_ERROR; } - result = TclListObjGetElements(interp, objv[4], &listLen, &elemPtrs); - if (result != TCL_OK) { - return result; - } for (i = 0; i < listLen; i++) { if (Tcl_GetIndexFromObj(interp, elemPtrs[i], opStrings, "operation", TCL_EXACT, &index) != TCL_OK) { @@ -479,11 +445,14 @@ TraceExecutionObjCmd( break; } } - command = TclGetStringFromObj(objv[5], &length); - if ((enum traceOptionsEnum) optionIndex == TRACE_ADD) { - TraceCommandInfo *tcmdPtr = (TraceCommandInfo *)ckalloc( - offsetof(TraceCommandInfo, command) + 1 + length); + 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; @@ -498,8 +467,8 @@ TraceExecutionObjCmd( memcpy(tcmdPtr->command, command, length+1); name = Tcl_GetString(objv[3]); if (Tcl_TraceCommand(interp, name, flags, TraceCommandProc, - tcmdPtr) != TCL_OK) { - ckfree(tcmdPtr); + (ClientData) tcmdPtr) != TCL_OK) { + ckfree((char *) tcmdPtr); return TCL_ERROR; } } else { @@ -509,19 +478,21 @@ TraceExecutionObjCmd( * first one that matches. */ - void *clientData; + TraceCommandInfo *tcmdPtr; + ClientData clientData = NULL; + name = Tcl_GetString(objv[3]); /* * First ensure the name given is valid. */ - name = Tcl_GetString(objv[3]); if (Tcl_FindCommand(interp,name,NULL,TCL_LEAVE_ERR_MSG) == NULL) { return TCL_ERROR; } - FOREACH_COMMAND_TRACE(interp, name, clientData) { - TraceCommandInfo *tcmdPtr = (TraceCommandInfo *)clientData; + while ((clientData = Tcl_CommandTraceInfo(interp, name, 0, + TraceCommandProc, clientData)) != NULL) { + tcmdPtr = (TraceCommandInfo *) clientData; /* * In checking the 'flags' field we must remove any extraneous @@ -533,7 +504,7 @@ TraceExecutionObjCmd( && ((tcmdPtr->flags & (TCL_TRACE_ANY_EXEC | TCL_TRACE_RENAME | TCL_TRACE_DELETE)) == flags) && (strncmp(command, tcmdPtr->command, - length) == 0)) { + (size_t) length) == 0)) { flags |= TCL_TRACE_DELETE; if (flags & (TCL_TRACE_ENTER_DURING_EXEC | TCL_TRACE_LEAVE_DURING_EXEC)) { @@ -549,7 +520,9 @@ TraceExecutionObjCmd( Tcl_DeleteTrace(interp, tcmdPtr->stepTrace); tcmdPtr->stepTrace = NULL; - ckfree(tcmdPtr->startCmd); + if (tcmdPtr->startCmd != NULL) { + ckfree((char *) tcmdPtr->startCmd); + } } if (tcmdPtr->flags & TCL_TRACE_EXEC_IN_PROGRESS) { /* @@ -558,8 +531,8 @@ TraceExecutionObjCmd( tcmdPtr->flags = 0; } - if (tcmdPtr->refCount-- <= 1) { - ckfree(tcmdPtr); + if ((--tcmdPtr->refCount) <= 0) { + ckfree((char *) tcmdPtr); } break; } @@ -568,14 +541,15 @@ TraceExecutionObjCmd( break; } case TRACE_INFO: { - void *clientData; - Tcl_Obj *resultListPtr; + ClientData clientData; + Tcl_Obj *resultListPtr, *eachTraceObjPtr, *elemObjPtr; if (objc != 4) { Tcl_WrongNumArgs(interp, 3, objv, "name"); return TCL_ERROR; } + clientData = NULL; name = Tcl_GetString(objv[3]); /* @@ -587,10 +561,11 @@ TraceExecutionObjCmd( } resultListPtr = Tcl_NewListObj(0, NULL); - FOREACH_COMMAND_TRACE(interp, name, clientData) { - Tcl_Size numOps = 0; - Tcl_Obj *opObj, *eachTraceObjPtr, *elemObjPtr; - TraceCommandInfo *tcmdPtr = (TraceCommandInfo *)clientData; + while ((clientData = Tcl_CommandTraceInfo(interp, name, 0, + TraceCommandProc, clientData)) != NULL) { + int numOps = 0; + Tcl_Obj *opObj; + TraceCommandInfo *tcmdPtr = (TraceCommandInfo *) clientData; /* * Build a list with the ops list as the first obj element and the @@ -616,7 +591,7 @@ TraceExecutionObjCmd( TclNewLiteralStringObj(opObj, "leavestep"); Tcl_ListObjAppendElement(NULL, elemObjPtr, opObj); } - TclListObjLength(NULL, elemObjPtr, &numOps); + Tcl_ListObjLength(NULL, elemObjPtr, &numOps); if (0 == numOps) { Tcl_DecrRefCount(elemObjPtr); continue; @@ -633,10 +608,6 @@ TraceExecutionObjCmd( Tcl_SetObjResult(interp, resultListPtr); break; } -#ifndef TCL_NO_DEPRECATED - default: - break; -#endif } return TCL_OK; } @@ -663,21 +634,22 @@ TraceExecutionObjCmd( static int TraceCommandObjCmd( Tcl_Interp *interp, /* Current interpreter. */ - enum traceOptionsEnum optionIndex, /* Add, info or remove */ - Tcl_Size objc, /* Number of arguments. */ + int optionIndex, /* Add, info or remove */ + int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - const char *name, *command; - Tcl_Size length; - static const char *const opStrings[] = { "delete", "rename", NULL }; + int commandLength, index; + char *name, *command; + size_t length; + enum traceOptions { TRACE_ADD, TRACE_INFO, TRACE_REMOVE }; + static const char *opStrings[] = { "delete", "rename", NULL }; enum operations { TRACE_CMD_DELETE, TRACE_CMD_RENAME }; - int index; - switch (optionIndex) { + switch ((enum traceOptions) optionIndex) { case TRACE_ADD: case TRACE_REMOVE: { - int flags = 0, result; - Tcl_Size i, listLen; + int flags = 0; + int i, listLen, result; Tcl_Obj **elemPtrs; if (objc != 6) { @@ -690,22 +662,16 @@ TraceCommandObjCmd( * pointer to its array of element pointers. */ - result = TclListObjLength(interp, objv[4], &listLen); + result = Tcl_ListObjGetElements(interp, objv[4], &listLen, &elemPtrs); if (result != TCL_OK) { return result; } if (listLen == 0) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "bad operation list \"\": must be one or more of" - " delete or rename", -1)); - Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRACE", "NOOPS", - (void *)NULL); + Tcl_SetResult(interp, "bad operation list \"\": must be " + "one or more of delete or rename", TCL_STATIC); return TCL_ERROR; } - result = TclListObjGetElements(interp, objv[4], &listLen, &elemPtrs); - if (result != TCL_OK) { - return result; - } + for (i = 0; i < listLen; i++) { if (Tcl_GetIndexFromObj(interp, elemPtrs[i], opStrings, "operation", TCL_EXACT, &index) != TCL_OK) { @@ -721,11 +687,14 @@ TraceCommandObjCmd( } } - command = TclGetStringFromObj(objv[5], &length); - if ((enum traceOptionsEnum) optionIndex == TRACE_ADD) { - TraceCommandInfo *tcmdPtr = (TraceCommandInfo *)ckalloc( - offsetof(TraceCommandInfo, command) + 1 + length); + 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; @@ -736,8 +705,8 @@ TraceCommandObjCmd( memcpy(tcmdPtr->command, command, length+1); name = Tcl_GetString(objv[3]); if (Tcl_TraceCommand(interp, name, flags, TraceCommandProc, - tcmdPtr) != TCL_OK) { - ckfree(tcmdPtr); + (ClientData) tcmdPtr) != TCL_OK) { + ckfree((char *) tcmdPtr); return TCL_ERROR; } } else { @@ -747,28 +716,30 @@ TraceCommandObjCmd( * first one that matches. */ - void *clientData; + TraceCommandInfo *tcmdPtr; + ClientData clientData = NULL; + name = Tcl_GetString(objv[3]); /* * First ensure the name given is valid. */ - name = Tcl_GetString(objv[3]); if (Tcl_FindCommand(interp,name,NULL,TCL_LEAVE_ERR_MSG) == NULL) { return TCL_ERROR; } - FOREACH_COMMAND_TRACE(interp, name, clientData) { - TraceCommandInfo *tcmdPtr = (TraceCommandInfo *)clientData; - - if ((tcmdPtr->length == length) && (tcmdPtr->flags == flags) + while ((clientData = Tcl_CommandTraceInfo(interp, name, 0, + TraceCommandProc, clientData)) != NULL) { + tcmdPtr = (TraceCommandInfo *) clientData; + if ((tcmdPtr->length == length) + && (tcmdPtr->flags == flags) && (strncmp(command, tcmdPtr->command, - length) == 0)) { + (size_t) length) == 0)) { Tcl_UntraceCommand(interp, name, flags | TCL_TRACE_DELETE, TraceCommandProc, clientData); tcmdPtr->flags |= TCL_TRACE_DESTROYED; - if (tcmdPtr->refCount-- <= 1) { - ckfree(tcmdPtr); + if ((--tcmdPtr->refCount) <= 0) { + ckfree((char *) tcmdPtr); } break; } @@ -777,28 +748,31 @@ TraceCommandObjCmd( break; } case TRACE_INFO: { - void *clientData; - Tcl_Obj *resultListPtr; + ClientData clientData; + Tcl_Obj *resultListPtr, *eachTraceObjPtr, *elemObjPtr; if (objc != 4) { Tcl_WrongNumArgs(interp, 3, objv, "name"); return TCL_ERROR; } + clientData = NULL; + name = Tcl_GetString(objv[3]); + /* * First ensure the name given is valid. */ - name = Tcl_GetString(objv[3]); if (Tcl_FindCommand(interp, name, NULL, TCL_LEAVE_ERR_MSG) == NULL) { return TCL_ERROR; } resultListPtr = Tcl_NewListObj(0, NULL); - FOREACH_COMMAND_TRACE(interp, name, clientData) { - Tcl_Size numOps = 0; - Tcl_Obj *opObj, *eachTraceObjPtr, *elemObjPtr; - TraceCommandInfo *tcmdPtr = (TraceCommandInfo *)clientData; + while ((clientData = Tcl_CommandTraceInfo(interp, name, 0, + TraceCommandProc, clientData)) != NULL) { + int numOps = 0; + Tcl_Obj *opObj; + TraceCommandInfo *tcmdPtr = (TraceCommandInfo *) clientData; /* * Build a list with the ops list as the first obj element and the @@ -816,7 +790,7 @@ TraceCommandObjCmd( TclNewLiteralStringObj(opObj, "delete"); Tcl_ListObjAppendElement(NULL, elemObjPtr, opObj); } - TclListObjLength(NULL, elemObjPtr, &numOps); + Tcl_ListObjLength(NULL, elemObjPtr, &numOps); if (0 == numOps) { Tcl_DecrRefCount(elemObjPtr); continue; @@ -832,10 +806,6 @@ TraceCommandObjCmd( Tcl_SetObjResult(interp, resultListPtr); break; } -#ifndef TCL_NO_DEPRECATED - default: - break; -#endif } return TCL_OK; } @@ -862,26 +832,26 @@ TraceCommandObjCmd( static int TraceVariableObjCmd( Tcl_Interp *interp, /* Current interpreter. */ - enum traceOptionsEnum optionIndex, /* Add, info or remove */ - Tcl_Size objc, /* Number of arguments. */ + int optionIndex, /* Add, info or remove */ + int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - const char *name, *command; - Tcl_Size length; - void *clientData; - static const char *const opStrings[] = { + int commandLength, index; + char *name, *command; + size_t length; + enum traceOptions { TRACE_ADD, TRACE_INFO, TRACE_REMOVE }; + static const char *opStrings[] = { "array", "read", "unset", "write", NULL }; enum operations { TRACE_VAR_ARRAY, TRACE_VAR_READ, TRACE_VAR_UNSET, TRACE_VAR_WRITE }; - int index; - switch ((enum traceOptionsEnum) optionIndex) { + switch ((enum traceOptions) optionIndex) { case TRACE_ADD: case TRACE_REMOVE: { - int flags = 0, result; - Tcl_Size i, listLen; + int flags = 0; + int i, listLen, result; Tcl_Obj **elemPtrs; if (objc != 6) { @@ -894,22 +864,15 @@ TraceVariableObjCmd( * pointer to its array of element pointers. */ - result = TclListObjLength(interp, objv[4], &listLen); + result = Tcl_ListObjGetElements(interp, objv[4], &listLen, &elemPtrs); if (result != TCL_OK) { return result; } if (listLen == 0) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "bad operation list \"\": must be one or more of" - " array, read, unset, or write", -1)); - Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRACE", "NOOPS", - (void *)NULL); + Tcl_SetResult(interp, "bad operation list \"\": must be " + "one or more of array, read, unset, or write", TCL_STATIC); return TCL_ERROR; } - result = TclListObjGetElements(interp, objv[4], &listLen, &elemPtrs); - if (result != TCL_OK) { - return result; - } for (i = 0; i < listLen ; i++) { if (Tcl_GetIndexFromObj(interp, elemPtrs[i], opStrings, "operation", TCL_EXACT, &index) != TCL_OK) { @@ -930,28 +893,28 @@ TraceVariableObjCmd( break; } } - command = TclGetStringFromObj(objv[5], &length); - if ((enum traceOptionsEnum) optionIndex == TRACE_ADD) { - CombinedTraceVarInfo *ctvarPtr = (CombinedTraceVarInfo *)ckalloc( - offsetof(CombinedTraceVarInfo, traceCmdInfo.command) - + 1 + length); + command = Tcl_GetStringFromObj(objv[5], &commandLength); + length = (size_t) commandLength; + if ((enum traceOptions) optionIndex == TRACE_ADD) { + CombinedTraceVarInfo *ctvarPtr; + ctvarPtr = (CombinedTraceVarInfo *) ckalloc((unsigned) + (sizeof(CombinedTraceVarInfo) + length + 1 + - sizeof(ctvarPtr->traceCmdInfo.command))); ctvarPtr->traceCmdInfo.flags = flags; -#ifndef TCL_NO_DEPRECATED if (objv[0] == NULL) { ctvarPtr->traceCmdInfo.flags |= TCL_TRACE_OLD_STYLE; } -#endif ctvarPtr->traceCmdInfo.length = length; flags |= TCL_TRACE_UNSETS | TCL_TRACE_RESULT_OBJECT; memcpy(ctvarPtr->traceCmdInfo.command, command, length+1); ctvarPtr->traceInfo.traceProc = TraceVarProc; - ctvarPtr->traceInfo.clientData = &ctvarPtr->traceCmdInfo; + ctvarPtr->traceInfo.clientData = (ClientData) + &ctvarPtr->traceCmdInfo; ctvarPtr->traceInfo.flags = flags; name = Tcl_GetString(objv[3]); - if (TraceVarEx(interp, name, NULL, (VarTrace *) ctvarPtr) - != TCL_OK) { - ckfree(ctvarPtr); + if (TraceVarEx(interp,name,NULL,(VarTrace*)ctvarPtr) != TCL_OK) { + ckfree((char *) ctvarPtr); return TCL_ERROR; } } else { @@ -961,18 +924,16 @@ TraceVariableObjCmd( * first one that matches. */ + TraceVarInfo *tvarPtr; + ClientData clientData = 0; name = Tcl_GetString(objv[3]); - FOREACH_VAR_TRACE(interp, name, clientData) { - TraceVarInfo *tvarPtr = (TraceVarInfo *)clientData; - + while ((clientData = Tcl_VarTraceInfo(interp, name, 0, + TraceVarProc, clientData)) != 0) { + tvarPtr = (TraceVarInfo *) clientData; if ((tvarPtr->length == length) - && ((tvarPtr->flags -#ifndef TCL_NO_DEPRECATED -& ~TCL_TRACE_OLD_STYLE -#endif - )==flags) + && ((tvarPtr->flags & ~TCL_TRACE_OLD_STYLE)==flags) && (strncmp(command, tvarPtr->command, - length) == 0)) { + (size_t) length) == 0)) { Tcl_UntraceVar2(interp, name, NULL, flags | TCL_TRACE_UNSETS | TCL_TRACE_RESULT_OBJECT, TraceVarProc, clientData); @@ -983,18 +944,21 @@ TraceVariableObjCmd( break; } case TRACE_INFO: { - Tcl_Obj *resultListPtr; + ClientData clientData; + Tcl_Obj *resultListPtr, *eachTraceObjPtr, *elemObjPtr; if (objc != 4) { Tcl_WrongNumArgs(interp, 3, objv, "name"); return TCL_ERROR; } - TclNewObj(resultListPtr); + resultListPtr = Tcl_NewObj(); + clientData = 0; name = Tcl_GetString(objv[3]); - FOREACH_VAR_TRACE(interp, name, clientData) { - Tcl_Obj *opObjPtr, *eachTraceObjPtr, *elemObjPtr; - TraceVarInfo *tvarPtr = (TraceVarInfo *)clientData; + while ((clientData = Tcl_VarTraceInfo(interp, name, 0, TraceVarProc, + clientData)) != 0) { + Tcl_Obj *opObj; + TraceVarInfo *tvarPtr = (TraceVarInfo *) clientData; /* * Build a list with the ops list as the first obj element and the @@ -1004,20 +968,20 @@ TraceVariableObjCmd( elemObjPtr = Tcl_NewListObj(0, NULL); if (tvarPtr->flags & TCL_TRACE_ARRAY) { - TclNewLiteralStringObj(opObjPtr, "array"); - Tcl_ListObjAppendElement(NULL, elemObjPtr, opObjPtr); + TclNewLiteralStringObj(opObj, "array"); + Tcl_ListObjAppendElement(NULL, elemObjPtr, opObj); } if (tvarPtr->flags & TCL_TRACE_READS) { - TclNewLiteralStringObj(opObjPtr, "read"); - Tcl_ListObjAppendElement(NULL, elemObjPtr, opObjPtr); + TclNewLiteralStringObj(opObj, "read"); + Tcl_ListObjAppendElement(NULL, elemObjPtr, opObj); } if (tvarPtr->flags & TCL_TRACE_WRITES) { - TclNewLiteralStringObj(opObjPtr, "write"); - Tcl_ListObjAppendElement(NULL, elemObjPtr, opObjPtr); + TclNewLiteralStringObj(opObj, "write"); + Tcl_ListObjAppendElement(NULL, elemObjPtr, opObj); } if (tvarPtr->flags & TCL_TRACE_UNSETS) { - TclNewLiteralStringObj(opObjPtr, "unset"); - Tcl_ListObjAppendElement(NULL, elemObjPtr, opObjPtr); + TclNewLiteralStringObj(opObj, "unset"); + Tcl_ListObjAppendElement(NULL, elemObjPtr, opObj); } eachTraceObjPtr = Tcl_NewListObj(0, NULL); Tcl_ListObjAppendElement(NULL, eachTraceObjPtr, elemObjPtr); @@ -1030,10 +994,6 @@ TraceVariableObjCmd( Tcl_SetObjResult(interp, resultListPtr); break; } -#ifndef TCL_NO_DEPRECATED - default: - break; -#endif } return TCL_OK; } @@ -1063,19 +1023,20 @@ TraceVariableObjCmd( *---------------------------------------------------------------------- */ -void * +ClientData Tcl_CommandTraceInfo( Tcl_Interp *interp, /* Interpreter containing command. */ const char *cmdName, /* Name of command. */ - TCL_UNUSED(int) /*flags*/, + int flags, /* OR-ed combo or TCL_GLOBAL_ONLY, + * TCL_NAMESPACE_ONLY (can be 0). */ Tcl_CommandTraceProc *proc, /* Function assocated with trace. */ - void *prevClientData) /* If non-NULL, gives last value returned by + ClientData prevClientData) /* If non-NULL, gives last value returned by * this function, so this call will return the * next trace after that one. If NULL, this * call will return the first trace. */ { Command *cmdPtr; - CommandTrace *tracePtr; + register CommandTrace *tracePtr; cmdPtr = (Command *) Tcl_FindCommand(interp, cmdName, NULL, TCL_LEAVE_ERR_MSG); @@ -1121,7 +1082,7 @@ Tcl_CommandTraceInfo( * * Side effects: * A trace is set up on the command given by cmdName, such that future - * changes to the command will be mediated by proc. See the manual + * changes to the command will be intermediated by proc. See the manual * entry for complete details on the calling sequence for proc. * *---------------------------------------------------------------------- @@ -1137,10 +1098,10 @@ Tcl_TraceCommand( * of the TRACE_*_EXEC flags */ Tcl_CommandTraceProc *proc, /* Function to call when specified ops are * invoked upon cmdName. */ - void *clientData) /* Arbitrary argument to pass to proc. */ + ClientData clientData) /* Arbitrary argument to pass to proc. */ { Command *cmdPtr; - CommandTrace *tracePtr; + register CommandTrace *tracePtr; cmdPtr = (Command *) Tcl_FindCommand(interp, cmdName, NULL, TCL_LEAVE_ERR_MSG); @@ -1152,7 +1113,7 @@ Tcl_TraceCommand( * Set up trace information. */ - tracePtr = (CommandTrace *)ckalloc(sizeof(CommandTrace)); + tracePtr = (CommandTrace *) ckalloc(sizeof(CommandTrace)); tracePtr->traceProc = proc; tracePtr->clientData = clientData; tracePtr->flags = flags & @@ -1164,7 +1125,7 @@ Tcl_TraceCommand( /* * Bug 3484621: up the interp's epoch if this is a BC'ed command */ - + if ((cmdPtr->compileProc != NULL) && !(cmdPtr->flags & CMD_HAS_EXEC_TRACES)){ Interp *iPtr = (Interp *) interp; iPtr->compileEpoch++; @@ -1172,7 +1133,7 @@ Tcl_TraceCommand( cmdPtr->flags |= CMD_HAS_EXEC_TRACES; } - + return TCL_OK; } @@ -1201,12 +1162,12 @@ Tcl_UntraceCommand( * TCL_TRACE_RENAME, TCL_TRACE_DELETE, and any * of the TRACE_*_EXEC flags */ Tcl_CommandTraceProc *proc, /* Function assocated with trace. */ - void *clientData) /* Arbitrary argument to pass to proc. */ + ClientData clientData) /* Arbitrary argument to pass to proc. */ { - CommandTrace *tracePtr; + register CommandTrace *tracePtr; CommandTrace *prevPtr; Command *cmdPtr; - Interp *iPtr = (Interp *)interp; + Interp *iPtr = (Interp *) interp; ActiveCommandTrace *activePtr; int hasExecTraces = 0; @@ -1257,8 +1218,8 @@ Tcl_UntraceCommand( } tracePtr->flags = 0; - if (tracePtr->refCount-- <= 1) { - ckfree(tracePtr); + if ((--tracePtr->refCount) <= 0) { + ckfree((char *) tracePtr); } if (hasExecTraces) { @@ -1279,8 +1240,9 @@ Tcl_UntraceCommand( /* * Bug 3484621: up the interp's epoch if this is a BC'ed command */ - + if (cmdPtr->compileProc != NULL) { + Interp *iPtr = (Interp *) interp; iPtr->compileEpoch++; } } @@ -1304,9 +1266,10 @@ Tcl_UntraceCommand( *---------------------------------------------------------------------- */ + /* ARGSUSED */ static void TraceCommandProc( - void *clientData, /* Information about the command trace. */ + ClientData clientData, /* Information about the command trace. */ Tcl_Interp *interp, /* Interpreter containing command. */ const char *oldName, /* Name of command being changed. */ const char *newName, /* New name of command. Empty string or NULL @@ -1315,7 +1278,7 @@ TraceCommandProc( int flags) /* OR-ed bits giving operation and other * information. */ { - TraceCommandInfo *tcmdPtr = (TraceCommandInfo *)clientData; + TraceCommandInfo *tcmdPtr = (TraceCommandInfo *) clientData; int code; Tcl_DString cmd; @@ -1329,13 +1292,13 @@ TraceCommandProc( */ Tcl_DStringInit(&cmd); - Tcl_DStringAppend(&cmd, tcmdPtr->command, tcmdPtr->length); + Tcl_DStringAppend(&cmd, tcmdPtr->command, (int) tcmdPtr->length); Tcl_DStringAppendElement(&cmd, oldName); Tcl_DStringAppendElement(&cmd, (newName ? newName : "")); if (flags & TCL_TRACE_RENAME) { - TclDStringAppendLiteral(&cmd, " rename"); + Tcl_DStringAppend(&cmd, " rename", 7); } else if (flags & TCL_TRACE_DELETE) { - TclDStringAppendLiteral(&cmd, " delete"); + Tcl_DStringAppend(&cmd, " delete", 7); } /* @@ -1354,7 +1317,7 @@ TraceCommandProc( Tcl_DStringLength(&cmd), 0); if (code != TCL_OK) { /* We ignore errors in these traced commands */ - /*** QUESTION: Use Tcl_BackgroundException(interp, code); instead? ***/ + /*** QUESTION: Use Tcl_BackgroundError(interp); instead? ***/ } Tcl_DStringFree(&cmd); } @@ -1371,7 +1334,9 @@ TraceCommandProc( if (tcmdPtr->stepTrace != NULL) { Tcl_DeleteTrace(interp, tcmdPtr->stepTrace); tcmdPtr->stepTrace = NULL; - ckfree(tcmdPtr->startCmd); + if (tcmdPtr->startCmd != NULL) { + ckfree((char *) tcmdPtr->startCmd); + } } if (tcmdPtr->flags & TCL_TRACE_EXEC_IN_PROGRESS) { /* @@ -1409,11 +1374,11 @@ TraceCommandProc( state = Tcl_SaveInterpState(interp, TCL_OK); Tcl_UntraceCommand(interp, oldName, untraceFlags, TraceCommandProc, clientData); - Tcl_RestoreInterpState(interp, state); + (void) Tcl_RestoreInterpState(interp, state); tcmdPtr->refCount--; } - if (tcmdPtr->refCount-- <= 1) { - ckfree(tcmdPtr); + if ((--tcmdPtr->refCount) <= 0) { + ckfree((char *) tcmdPtr); } } @@ -1447,17 +1412,18 @@ TclCheckExecutionTraces( Tcl_Interp *interp, /* The current interpreter. */ const char *command, /* Pointer to beginning of the current command * string. */ - TCL_UNUSED(Tcl_Size) /*numChars*/, + 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. */ - Tcl_Size objc, /* Number of arguments for the command. */ + 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; - Tcl_Size curLevel; + int curLevel; int traceCode = TCL_OK; Tcl_InterpState state = NULL; @@ -1492,7 +1458,8 @@ TclCheckExecutionTraces( active.nextTracePtr = tracePtr->nextPtr; } if (tracePtr->traceProc == TraceCommandProc) { - TraceCommandInfo *tcmdPtr = (TraceCommandInfo *)tracePtr->clientData; + TraceCommandInfo *tcmdPtr = (TraceCommandInfo *) + tracePtr->clientData; if (tcmdPtr->flags != 0) { tcmdPtr->curFlags = traceFlags | TCL_TRACE_EXEC_DIRECT; @@ -1501,10 +1468,10 @@ TclCheckExecutionTraces( if (state == NULL) { state = Tcl_SaveInterpState(interp, code); } - traceCode = TraceExecutionProc(tcmdPtr, interp, curLevel, - command, (Tcl_Command) cmdPtr, objc, objv); - if (tcmdPtr->refCount-- <= 1) { - ckfree(tcmdPtr); + traceCode = TraceExecutionProc((ClientData) tcmdPtr, interp, + curLevel, command, (Tcl_Command) cmdPtr, objc, objv); + if ((--tcmdPtr->refCount) <= 0) { + ckfree((char *) tcmdPtr); } } } @@ -1521,7 +1488,7 @@ TclCheckExecutionTraces( } } - return traceCode; + return(traceCode); } /* @@ -1552,18 +1519,18 @@ TclCheckInterpTraces( Tcl_Interp *interp, /* The current interpreter. */ const char *command, /* Pointer to beginning of the current command * string. */ - Tcl_Size numChars, /* The number of characters in 'command' which + 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. */ - Tcl_Size objc, /* Number of arguments for the command. */ + 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; - Tcl_Size curLevel; + int curLevel; int traceCode = TCL_OK; Tcl_InterpState state = NULL; @@ -1619,7 +1586,7 @@ TclCheckInterpTraces( * it. */ - Tcl_Preserve(tracePtr); + Tcl_Preserve((ClientData) tracePtr); tracePtr->flags |= TCL_TRACE_EXEC_IN_PROGRESS; if (state == NULL) { state = Tcl_SaveInterpState(interp, code); @@ -1633,14 +1600,15 @@ TclCheckInterpTraces( if (tracePtr->flags & traceFlags) { if (tracePtr->proc == TraceExecutionProc) { - TraceCommandInfo *tcmdPtr = (TraceCommandInfo *)tracePtr->clientData; + TraceCommandInfo *tcmdPtr = (TraceCommandInfo *) + tracePtr->clientData; tcmdPtr->curFlags = traceFlags; tcmdPtr->curCode = code; } - traceCode = tracePtr->proc(tracePtr->clientData, interp, - curLevel, command, (Tcl_Command) cmdPtr, objc, - objv); + traceCode = (tracePtr->proc)(tracePtr->clientData, + interp, curLevel, command, (Tcl_Command) cmdPtr, + objc, objv); } } else { /* @@ -1658,19 +1626,19 @@ TclCheckInterpTraces( } } tracePtr->flags &= ~TCL_TRACE_EXEC_IN_PROGRESS; - Tcl_Release(tracePtr); + Tcl_Release((ClientData) tracePtr); } } iPtr->activeInterpTracePtr = active.nextPtr; if (state) { if (traceCode == TCL_OK) { - Tcl_RestoreInterpState(interp, state); + (void) Tcl_RestoreInterpState(interp, state); } else { Tcl_DiscardInterpState(state); } } - return traceCode; + return(traceCode); } /* @@ -1695,13 +1663,13 @@ TclCheckInterpTraces( static int CallTraceFunction( Tcl_Interp *interp, /* The current interpreter. */ - Trace *tracePtr, /* Describes the trace function to call. */ + register Trace *tracePtr, /* Describes the trace function to call. */ Command *cmdPtr, /* Points to command's Command struct. */ const char *command, /* Points to the first character of the * command's source before substitutions. */ - Tcl_Size numChars, /* The number of characters in the command's + int numChars, /* The number of characters in the command's * source. */ - Tcl_Size objc, /* Number of arguments for the command. */ + register int objc, /* Number of arguments for the command. */ Tcl_Obj *const objv[]) /* Pointers to Tcl_Obj of each argument. */ { Interp *iPtr = (Interp *) interp; @@ -1712,15 +1680,15 @@ CallTraceFunction( * Copy the command characters into a new string. */ - commandCopy = (char *)TclStackAlloc(interp, numChars + 1); - memcpy(commandCopy, command, numChars); + commandCopy = TclStackAlloc(interp, (unsigned) (numChars + 1)); + memcpy(commandCopy, command, (size_t) numChars); commandCopy[numChars] = '\0'; /* * Call the trace function then free allocated storage. */ - traceCode = tracePtr->proc(tracePtr->clientData, (Tcl_Interp *) iPtr, + traceCode = (tracePtr->proc)(tracePtr->clientData, (Tcl_Interp *) iPtr, iPtr->numLevels, commandCopy, (Tcl_Command) cmdPtr, objc, objv); TclStackFree(interp, commandCopy); @@ -1746,12 +1714,12 @@ CallTraceFunction( static void CommandObjTraceDeleted( - void *clientData) + ClientData clientData) { - TraceCommandInfo *tcmdPtr = (TraceCommandInfo *)clientData; + TraceCommandInfo *tcmdPtr = (TraceCommandInfo *) clientData; - if (tcmdPtr->refCount-- <= 1) { - ckfree(tcmdPtr); + if ((--tcmdPtr->refCount) <= 0) { + ckfree((char *) tcmdPtr); } } @@ -1782,17 +1750,17 @@ CommandObjTraceDeleted( static int TraceExecutionProc( - void *clientData, + ClientData clientData, Tcl_Interp *interp, - Tcl_Size level, + int level, const char *command, - TCL_UNUSED(Tcl_Command), - Tcl_Size objc, - Tcl_Obj *const objv[]) + Tcl_Command cmdInfo, + int objc, + struct Tcl_Obj *const objv[]) { int call = 0; Interp *iPtr = (Interp *) interp; - TraceCommandInfo *tcmdPtr = (TraceCommandInfo *)clientData; + TraceCommandInfo *tcmdPtr = (TraceCommandInfo *) clientData; int flags = tcmdPtr->curFlags; int code = tcmdPtr->curCode; int traceCode = TCL_OK; @@ -1833,7 +1801,9 @@ TraceExecutionProc( && (strcmp(command, tcmdPtr->startCmd) == 0)) { Tcl_DeleteTrace(interp, tcmdPtr->stepTrace); tcmdPtr->stepTrace = NULL; - ckfree(tcmdPtr->startCmd); + if (tcmdPtr->startCmd != NULL) { + ckfree((char *) tcmdPtr->startCmd); + } } /* @@ -1841,12 +1811,12 @@ TraceExecutionProc( */ if (call) { - Tcl_DString cmd, sub; - Tcl_Size i; - int saveInterpFlags; + Tcl_DString cmd; + Tcl_DString sub; + int i, saveInterpFlags; Tcl_DStringInit(&cmd); - Tcl_DStringAppend(&cmd, tcmdPtr->command, tcmdPtr->length); + Tcl_DStringAppend(&cmd, tcmdPtr->command, (int)tcmdPtr->length); /* * Append command with arguments. @@ -1871,13 +1841,13 @@ TraceExecutionProc( } } else if (flags & TCL_TRACE_LEAVE_EXEC) { Tcl_Obj *resultCode; - const char *resultCodeStr; + char *resultCodeStr; /* * Append result code. */ - TclNewIntObj(resultCode, code); + resultCode = Tcl_NewIntObj(code); resultCodeStr = Tcl_GetString(resultCode); Tcl_DStringAppendElement(&cmd, resultCodeStr); Tcl_DecrRefCount(resultCode); @@ -1917,8 +1887,7 @@ TraceExecutionProc( * interpreter. */ - traceCode = Tcl_EvalEx(interp, Tcl_DStringValue(&cmd), - Tcl_DStringLength(&cmd), 0); + traceCode = Tcl_Eval(interp, Tcl_DStringValue(&cmd)); tcmdPtr->flags &= ~TCL_TRACE_EXEC_IN_PROGRESS; /* @@ -1944,27 +1913,30 @@ TraceExecutionProc( if ((flags & TCL_TRACE_ENTER_EXEC) && (tcmdPtr->stepTrace == NULL) && (tcmdPtr->flags & (TCL_TRACE_ENTER_DURING_EXEC | TCL_TRACE_LEAVE_DURING_EXEC))) { - unsigned len = strlen(command) + 1; + register unsigned len = strlen(command) + 1; tcmdPtr->startLevel = level; - tcmdPtr->startCmd = (char *)ckalloc(len); + tcmdPtr->startCmd = ckalloc(len); memcpy(tcmdPtr->startCmd, command, len); tcmdPtr->refCount++; tcmdPtr->stepTrace = Tcl_CreateObjTrace(interp, 0, (tcmdPtr->flags & TCL_TRACE_ANY_EXEC) >> 2, - TraceExecutionProc, tcmdPtr, CommandObjTraceDeleted); + TraceExecutionProc, (ClientData)tcmdPtr, + CommandObjTraceDeleted); } } if (flags & TCL_TRACE_DESTROYED) { if (tcmdPtr->stepTrace != NULL) { Tcl_DeleteTrace(interp, tcmdPtr->stepTrace); tcmdPtr->stepTrace = NULL; - ckfree(tcmdPtr->startCmd); + if (tcmdPtr->startCmd != NULL) { + ckfree(tcmdPtr->startCmd); + } } } if (call) { - if (tcmdPtr->refCount-- <= 1) { - ckfree(tcmdPtr); + if ((--tcmdPtr->refCount) <= 0) { + ckfree((char *) tcmdPtr); } } return traceCode; @@ -1988,9 +1960,10 @@ TraceExecutionProc( *---------------------------------------------------------------------- */ + /* ARGSUSED */ static char * TraceVarProc( - void *clientData, /* Information about the variable trace. */ + ClientData clientData, /* Information about the variable trace. */ Tcl_Interp *interp, /* Interpreter containing variable. */ const char *name1, /* Name of variable or array. */ const char *name2, /* Name of element within array; NULL means @@ -1998,55 +1971,54 @@ TraceVarProc( int flags) /* OR-ed bits giving operation and other * information. */ { - TraceVarInfo *tvarPtr = (TraceVarInfo *)clientData; + TraceVarInfo *tvarPtr = (TraceVarInfo *) clientData; char *result; int code, destroy = 0; Tcl_DString cmd; - int rewind = ((Interp *)interp)->execEnvPtr->rewind; /* - * We might call Tcl_EvalEx() below, and that might evaluate - * [trace remove variable] 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. + * 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. */ result = NULL; if ((tvarPtr->flags & flags) && !Tcl_InterpDeleted(interp) && !Tcl_LimitExceeded(interp)) { - if (tvarPtr->length) { + if (tvarPtr->length != (size_t) 0) { /* * Generate a command to execute by appending list elements for * the two variable names and the operation. */ Tcl_DStringInit(&cmd); - Tcl_DStringAppend(&cmd, tvarPtr->command, tvarPtr->length); + Tcl_DStringAppend(&cmd, tvarPtr->command, (int) tvarPtr->length); Tcl_DStringAppendElement(&cmd, name1); Tcl_DStringAppendElement(&cmd, (name2 ? name2 : "")); -#ifndef TCL_NO_DEPRECATED +#ifndef TCL_REMOVE_OBSOLETE_TRACES if (tvarPtr->flags & TCL_TRACE_OLD_STYLE) { if (flags & TCL_TRACE_ARRAY) { - TclDStringAppendLiteral(&cmd, " a"); + Tcl_DStringAppend(&cmd, " a", 2); } else if (flags & TCL_TRACE_READS) { - TclDStringAppendLiteral(&cmd, " r"); + Tcl_DStringAppend(&cmd, " r", 2); } else if (flags & TCL_TRACE_WRITES) { - TclDStringAppendLiteral(&cmd, " w"); + Tcl_DStringAppend(&cmd, " w", 2); } else if (flags & TCL_TRACE_UNSETS) { - TclDStringAppendLiteral(&cmd, " u"); + Tcl_DStringAppend(&cmd, " u", 2); } } else { #endif if (flags & TCL_TRACE_ARRAY) { - TclDStringAppendLiteral(&cmd, " array"); + Tcl_DStringAppend(&cmd, " array", 6); } else if (flags & TCL_TRACE_READS) { - TclDStringAppendLiteral(&cmd, " read"); + Tcl_DStringAppend(&cmd, " read", 5); } else if (flags & TCL_TRACE_WRITES) { - TclDStringAppendLiteral(&cmd, " write"); + Tcl_DStringAppend(&cmd, " write", 6); } else if (flags & TCL_TRACE_UNSETS) { - TclDStringAppendLiteral(&cmd, " unset"); + Tcl_DStringAppend(&cmd, " unset", 6); } -#ifndef TCL_NO_DEPRECATED +#ifndef TCL_REMOVE_OBSOLETE_TRACES } #endif @@ -2064,23 +2036,10 @@ TraceVarProc( destroy = 1; tvarPtr->flags |= TCL_TRACE_DESTROYED; } - - /* - * Make sure that unset traces are rune even if the execEnv is - * rewinding (coroutine deletion, [Bug 2093947] - */ - - if (rewind && (flags & TCL_TRACE_UNSETS)) { - ((Interp *)interp)->execEnvPtr->rewind = 0; - } code = Tcl_EvalEx(interp, Tcl_DStringValue(&cmd), Tcl_DStringLength(&cmd), 0); - if (rewind) { - ((Interp *)interp)->execEnvPtr->rewind = rewind; - } if (code != TCL_OK) { /* copy error msg to result */ Tcl_Obj *errMsgObj = Tcl_GetObjResult(interp); - Tcl_IncrRefCount(errMsgObj); result = (char *) errMsgObj; } @@ -2088,7 +2047,7 @@ TraceVarProc( } } if (destroy && result != NULL) { - Tcl_Obj *errMsgObj = (Tcl_Obj *) result; + register Tcl_Obj *errMsgObj = (Tcl_Obj *) result; Tcl_DecrRefCount(errMsgObj); result = NULL; @@ -2099,7 +2058,7 @@ TraceVarProc( /* *---------------------------------------------------------------------- * - * Tcl_CreateObjTrace/Tcl_CreateObjTrace2 -- + * Tcl_CreateObjTrace -- * * Arrange for a function to be called to trace command execution. * @@ -2112,7 +2071,7 @@ TraceVarProc( * called to execute a Tcl command. Calls to proc will have the following * form: * - * void proc(void * clientData, + * void proc(ClientData clientData, * Tcl_Interp * interp, * int level, * const char * command, @@ -2129,6 +2088,10 @@ TraceVarProc( * 'objc' and 'objv' parameters give the parameter vector that will be * passed to the command procedure. Proc does not return a value. * + * It is permissible for 'proc' to call Tcl_SetCommandTokenInfo to change + * the command procedure or client data for the command being evaluated, + * and these changes will take effect with the current evaluation. + * * The 'level' argument specifies the maximum nesting level of calls to * be traced. If the execution depth of the interpreter exceeds 'level', * the trace callback is not executed. @@ -2154,15 +2117,15 @@ TraceVarProc( Tcl_Trace Tcl_CreateObjTrace( Tcl_Interp *interp, /* Tcl interpreter */ - Tcl_Size level, /* Maximum nesting level */ + int level, /* Maximum nesting level */ int flags, /* Flags, see above */ Tcl_CmdObjTraceProc *proc, /* Trace callback */ - void *clientData, /* Client data for the callback */ + ClientData clientData, /* Client data for the callback */ Tcl_CmdObjTraceDeleteProc *delProc) /* Function to call when trace is deleted */ { - Trace *tracePtr; - Interp *iPtr = (Interp *) interp; + register Trace *tracePtr; + register Interp *iPtr = (Interp *) interp; /* * Test if this trace allows inline compilation of commands. @@ -2186,7 +2149,7 @@ Tcl_CreateObjTrace( iPtr->tracesForbiddingInline++; } - tracePtr = (Trace *)ckalloc(sizeof(Trace)); + tracePtr = (Trace *) ckalloc(sizeof(Trace)); tracePtr->level = level; tracePtr->proc = proc; tracePtr->clientData = clientData; @@ -2217,12 +2180,12 @@ Tcl_CreateObjTrace( * void * proc(clientData, interp, level, command, cmdProc, cmdClientData, * argc, argv) - * void *clientData; + * ClientData clientData; * Tcl_Interp *interp; * int level; * char *command; * int (*cmdProc)(); - * void *cmdClientData; + * ClientData cmdClientData; * int argc; * char **argv; * { @@ -2243,18 +2206,19 @@ Tcl_CreateObjTrace( Tcl_Trace Tcl_CreateTrace( Tcl_Interp *interp, /* Interpreter in which to create trace. */ - Tcl_Size level, /* Only call proc for commands at nesting + int level, /* Only call proc for commands at nesting * level<=argument level (1=>top level). */ Tcl_CmdTraceProc *proc, /* Function to call before executing each * command. */ - void *clientData) /* Arbitrary value word to pass to proc. */ + ClientData clientData) /* Arbitrary value word to pass to proc. */ { - StringTraceData *data = (StringTraceData *)ckalloc(sizeof(StringTraceData)); + StringTraceData *data = (StringTraceData *) + ckalloc(sizeof(StringTraceData)); data->clientData = clientData; data->proc = proc; return Tcl_CreateObjTrace(interp, level, 0, StringTraceProc, - data, StringTraceDeleteProc); + (ClientData) data, StringTraceDeleteProc); } /* @@ -2275,18 +2239,18 @@ Tcl_CreateTrace( static int StringTraceProc( - void *clientData, + ClientData clientData, Tcl_Interp *interp, - Tcl_Size level, + int level, const char *command, Tcl_Command commandInfo, - Tcl_Size objc, + int objc, Tcl_Obj *const *objv) { - StringTraceData *data = (StringTraceData *)clientData; + StringTraceData *data = (StringTraceData *) clientData; Command *cmdPtr = (Command *) commandInfo; const char **argv; /* Args to pass to string trace proc */ - Tcl_Size i; + int i; /* * This is a bit messy because we have to emulate the old trace interface, @@ -2294,7 +2258,7 @@ StringTraceProc( */ argv = (const char **) TclStackAlloc(interp, - (objc + 1) * sizeof(const char *)); + (unsigned) ((objc + 1) * sizeof(const char *))); for (i = 0; i < objc; i++) { argv[i] = Tcl_GetString(objv[i]); } @@ -2306,7 +2270,7 @@ StringTraceProc( * either command or argv. */ - data->proc(data->clientData, interp, level, (char *) command, + (data->proc)(data->clientData, interp, level, (char *) command, cmdPtr->proc, cmdPtr->clientData, objc, argv); TclStackFree(interp, (void *) argv); @@ -2331,9 +2295,9 @@ StringTraceProc( static void StringTraceDeleteProc( - void *clientData) + ClientData clientData) { - ckfree(clientData); + ckfree((char *) clientData); } /* @@ -2361,7 +2325,7 @@ Tcl_DeleteTrace( { Interp *iPtr = (Interp *) interp; Trace *prevPtr, *tracePtr = (Trace *) trace; - Trace **tracePtr2 = &iPtr->tracePtr; + register Trace **tracePtr2 = &(iPtr->tracePtr); ActiveInterpTrace *activePtr; /* @@ -2370,14 +2334,14 @@ Tcl_DeleteTrace( */ prevPtr = NULL; - while (*tracePtr2 != NULL && *tracePtr2 != tracePtr) { + while ((*tracePtr2) != NULL && (*tracePtr2) != tracePtr) { prevPtr = *tracePtr2; - tracePtr2 = &prevPtr->nextPtr; + tracePtr2 = &((*tracePtr2)->nextPtr); } if (*tracePtr2 == NULL) { return; } - *tracePtr2 = (*tracePtr2)->nextPtr; + (*tracePtr2) = (*tracePtr2)->nextPtr; /* * The code below makes it possible to delete traces while traces are @@ -2416,7 +2380,7 @@ Tcl_DeleteTrace( */ if (tracePtr->delProc != NULL) { - tracePtr->delProc(tracePtr->clientData); + (tracePtr->delProc)(tracePtr->clientData); } /* @@ -2449,7 +2413,8 @@ TclVarTraceExists( Tcl_Interp *interp, /* The interpreter */ const char *varName) /* The variable name */ { - Var *varPtr, *arrayPtr; + Var *varPtr; + Var *arrayPtr; /* * The choice of "create" flag values is delicate here, and matches the @@ -2469,7 +2434,7 @@ TclVarTraceExists( if ((varPtr->flags & VAR_TRACED_READ) || (arrayPtr && (arrayPtr->flags & VAR_TRACED_READ))) { - TclCallVarTraces((Interp *) interp, arrayPtr, varPtr, varName, NULL, + TclCallVarTraces((Interp *)interp, arrayPtr, varPtr, varName, NULL, TCL_TRACE_READS, /* leaveErrMsg */ 0); } @@ -2489,47 +2454,6 @@ TclVarTraceExists( /* *---------------------------------------------------------------------- * - * TclCheckArrayTraces -- - * - * This function is invoked to when we operate on an array variable, - * to allow any array traces to fire. - * - * Results: - * Returns TCL_OK to indicate normal operation. Returns TCL_ERROR if - * invocation of a trace function indicated an error. When TCL_ERROR is - * returned, then error information is left in interp. - * - * Side effects: - * Almost anything can happen, depending on trace; this function itself - * doesn't have any side effects. - * - *---------------------------------------------------------------------- - */ - -int -TclCheckArrayTraces( - Tcl_Interp *interp, - Var *varPtr, - Var *arrayPtr, - Tcl_Obj *name, - int index) -{ - int code = TCL_OK; - - if (varPtr && (varPtr->flags & VAR_TRACED_ARRAY) - && (TclIsVarArray(varPtr) || TclIsVarUndefined(varPtr))) { - Interp *iPtr = (Interp *)interp; - - code = TclObjCallVarTraces(iPtr, arrayPtr, varPtr, name, NULL, - (TCL_NAMESPACE_ONLY|TCL_GLOBAL_ONLY| TCL_TRACE_ARRAY), - /* leaveErrMsg */ 1, index); - } - return code; -} - -/* - *---------------------------------------------------------------------- - * * TclCallVarTraces -- * * This function is invoked to find and invoke relevant trace functions @@ -2553,7 +2477,7 @@ TclCheckArrayTraces( int TclObjCallVarTraces( Interp *iPtr, /* Interpreter containing variable. */ - Var *arrayPtr, /* Pointer to array variable that contains the + register Var *arrayPtr, /* Pointer to array variable that contains the * variable, or NULL if the variable isn't an * element of an array. */ Var *varPtr, /* Variable whose traces are to be invoked. */ @@ -2569,14 +2493,11 @@ TclObjCallVarTraces( * variable, or -1. Only used when part1Ptr is * NULL. */ { - const char *part1, *part2; + char *part1, *part2; if (!part1Ptr) { part1Ptr = localName(iPtr->varFramePtr, index); } - if (!part1Ptr) { - Tcl_Panic("Cannot trace a variable with no name"); - } part1 = TclGetString(part1Ptr); part2 = part2Ptr? TclGetString(part2Ptr) : NULL; @@ -2584,13 +2505,10 @@ TclObjCallVarTraces( leaveErrMsg); } -#undef TCL_INTERP_DESTROYED -#define TCL_INTERP_DESTROYED 0x100 - int TclCallVarTraces( Interp *iPtr, /* Interpreter containing variable. */ - Var *arrayPtr, /* Pointer to array variable that contains the + register Var *arrayPtr, /* Pointer to array variable that contains the * variable, or NULL if the variable isn't an * element of an array. */ Var *varPtr, /* Variable whose traces are to be invoked. */ @@ -2603,7 +2521,7 @@ TclCallVarTraces( * error, then leave an error message and * stack trace information in *iPTr. */ { - VarTrace *tracePtr; + register VarTrace *tracePtr; ActiveVarTrace active; char *result; const char *openParen, *p; @@ -2653,7 +2571,7 @@ TclCallVarTraces( char *newPart1; Tcl_DStringInit(&nameCopy); - Tcl_DStringAppend(&nameCopy, part1, p-part1); + Tcl_DStringAppend(&nameCopy, part1, (p-part1)); newPart1 = Tcl_DStringValue(&nameCopy); newPart1[offset] = 0; part1 = newPart1; @@ -2679,25 +2597,25 @@ TclCallVarTraces( result = NULL; active.nextPtr = iPtr->activeVarTracePtr; iPtr->activeVarTracePtr = &active; - Tcl_Preserve(iPtr); + Tcl_Preserve((ClientData) iPtr); if (arrayPtr && !TclIsVarTraceActive(arrayPtr) && (arrayPtr->flags & traceflags)) { hPtr = Tcl_FindHashEntry(&iPtr->varTraces, (char *) arrayPtr); active.varPtr = arrayPtr; - for (tracePtr = (VarTrace *)Tcl_GetHashValue(hPtr); - tracePtr != NULL; tracePtr = active.nextTracePtr) { + for (tracePtr = (VarTrace *) Tcl_GetHashValue(hPtr); + tracePtr != NULL; tracePtr = active.nextTracePtr) { active.nextTracePtr = tracePtr->nextPtr; if (!(tracePtr->flags & flags)) { continue; } - Tcl_Preserve(tracePtr); + Tcl_Preserve((ClientData) tracePtr); if (state == NULL) { - state = Tcl_SaveInterpState((Tcl_Interp *) iPtr, code); + state = Tcl_SaveInterpState((Tcl_Interp *)iPtr, code); } - if (Tcl_InterpDeleted((Tcl_Interp *) iPtr)) { + if (Tcl_InterpDeleted((Tcl_Interp *)iPtr)) { flags |= TCL_INTERP_DESTROYED; } - result = tracePtr->traceProc(tracePtr->clientData, + result = (*tracePtr->traceProc)(tracePtr->clientData, (Tcl_Interp *) iPtr, part1, part2, flags); if (result != NULL) { if (flags & TCL_TRACE_UNSETS) { @@ -2711,7 +2629,7 @@ TclCallVarTraces( code = TCL_ERROR; } } - Tcl_Release(tracePtr); + Tcl_Release((ClientData) tracePtr); if (code == TCL_ERROR) { goto done; } @@ -2728,20 +2646,20 @@ TclCallVarTraces( active.varPtr = varPtr; if (varPtr->flags & traceflags) { hPtr = Tcl_FindHashEntry(&iPtr->varTraces, (char *) varPtr); - for (tracePtr = (VarTrace *)Tcl_GetHashValue(hPtr); - tracePtr != NULL; tracePtr = active.nextTracePtr) { + for (tracePtr = (VarTrace *) Tcl_GetHashValue(hPtr); + tracePtr != NULL; tracePtr = active.nextTracePtr) { active.nextTracePtr = tracePtr->nextPtr; if (!(tracePtr->flags & flags)) { continue; } - Tcl_Preserve(tracePtr); + Tcl_Preserve((ClientData) tracePtr); if (state == NULL) { - state = Tcl_SaveInterpState((Tcl_Interp *) iPtr, code); + state = Tcl_SaveInterpState((Tcl_Interp *)iPtr, code); } - if (Tcl_InterpDeleted((Tcl_Interp *) iPtr)) { + if (Tcl_InterpDeleted((Tcl_Interp *)iPtr)) { flags |= TCL_INTERP_DESTROYED; } - result = tracePtr->traceProc(tracePtr->clientData, + result = (*tracePtr->traceProc)(tracePtr->clientData, (Tcl_Interp *) iPtr, part1, part2, flags); if (result != NULL) { if (flags & TCL_TRACE_UNSETS) { @@ -2755,7 +2673,7 @@ TclCallVarTraces( code = TCL_ERROR; } } - Tcl_Release(tracePtr); + Tcl_Release((ClientData) tracePtr); if (code == TCL_ERROR) { goto done; } @@ -2791,8 +2709,7 @@ TclCallVarTraces( if (disposeFlags & TCL_TRACE_RESULT_OBJECT) { Tcl_SetObjResult((Tcl_Interp *)iPtr, (Tcl_Obj *) result); } else { - Tcl_SetObjResult((Tcl_Interp *)iPtr, - Tcl_NewStringObj(result, -1)); + Tcl_SetResult((Tcl_Interp *)iPtr, result, TCL_STATIC); } Tcl_AddErrorInfo((Tcl_Interp *)iPtr, ""); @@ -2809,12 +2726,12 @@ TclCallVarTraces( iPtr->flags &= ~(ERR_ALREADY_LOGGED); Tcl_DiscardInterpState(state); } else { - Tcl_RestoreInterpState((Tcl_Interp *) iPtr, state); + (void) Tcl_RestoreInterpState((Tcl_Interp *)iPtr, state); } DisposeTraceResult(disposeFlags,result); } else if (state) { if (code == TCL_OK) { - code = Tcl_RestoreInterpState((Tcl_Interp *) iPtr, state); + code = Tcl_RestoreInterpState((Tcl_Interp *)iPtr, state); } else { Tcl_DiscardInterpState(state); } @@ -2831,7 +2748,7 @@ TclCallVarTraces( VarHashRefCount(varPtr)--; } iPtr->activeVarTracePtr = active.nextPtr; - Tcl_Release(iPtr); + Tcl_Release((ClientData) iPtr); return code; } @@ -2884,7 +2801,6 @@ DisposeTraceResult( *---------------------------------------------------------------------- */ -#ifndef TCL_NO_DEPRECATED #undef Tcl_UntraceVar void Tcl_UntraceVar( @@ -2900,7 +2816,6 @@ Tcl_UntraceVar( { Tcl_UntraceVar2(interp, varName, NULL, flags, proc, clientData); } -#endif /* TCL_NO_DEPRECATED */ /* *---------------------------------------------------------------------- @@ -2930,10 +2845,10 @@ Tcl_UntraceVar2( * trace, including any of TCL_TRACE_READS, * TCL_TRACE_WRITES, TCL_TRACE_UNSETS, * TCL_GLOBAL_ONLY, and TCL_NAMESPACE_ONLY. */ - Tcl_VarTraceProc *proc, /* Function associated with trace. */ + Tcl_VarTraceProc *proc, /* Function assocated with trace. */ ClientData clientData) /* Arbitrary argument to pass to proc. */ { - VarTrace *tracePtr; + register VarTrace *tracePtr; VarTrace *prevPtr, *nextPtr; Var *varPtr, *arrayPtr; Interp *iPtr = (Interp *) interp; @@ -2960,13 +2875,14 @@ Tcl_UntraceVar2( flagMask = TCL_TRACE_READS | TCL_TRACE_WRITES | TCL_TRACE_UNSETS | TCL_TRACE_ARRAY | TCL_TRACE_RESULT_DYNAMIC | TCL_TRACE_RESULT_OBJECT; -#ifndef TCL_NO_DEPRECATED +#ifndef TCL_REMOVE_OBSOLETE_TRACES flagMask |= TCL_TRACE_OLD_STYLE; #endif flags &= flagMask; - hPtr = Tcl_FindHashEntry(&iPtr->varTraces, (char *) varPtr); - for (tracePtr = (VarTrace *)Tcl_GetHashValue(hPtr), prevPtr = NULL; ; + hPtr = Tcl_FindHashEntry(&iPtr->varTraces, + (char *) varPtr); + for (tracePtr = (VarTrace *) Tcl_GetHashValue(hPtr), prevPtr = NULL; ; prevPtr = tracePtr, tracePtr = tracePtr->nextPtr) { if (tracePtr == NULL) { goto updateFlags; @@ -3011,7 +2927,7 @@ Tcl_UntraceVar2( prevPtr->nextPtr = nextPtr; } tracePtr->nextPtr = NULL; - Tcl_EventuallyFree(tracePtr, TCL_DYNAMIC); + Tcl_EventuallyFree((ClientData) tracePtr, TCL_DYNAMIC); for (tracePtr = nextPtr; tracePtr != NULL; tracePtr = tracePtr->nextPtr) { @@ -3055,7 +2971,6 @@ Tcl_UntraceVar2( *---------------------------------------------------------------------- */ -#ifndef TCL_NO_DEPRECATED #undef Tcl_VarTraceInfo ClientData Tcl_VarTraceInfo( @@ -3064,7 +2979,7 @@ Tcl_VarTraceInfo( * signify an array reference. */ int flags, /* OR-ed combo or TCL_GLOBAL_ONLY, * TCL_NAMESPACE_ONLY (can be 0). */ - Tcl_VarTraceProc *proc, /* Function associated with trace. */ + Tcl_VarTraceProc *proc, /* Function assocated with trace. */ ClientData prevClientData) /* If non-NULL, gives last value returned by * this function, so this call will return the * next trace after that one. If NULL, this @@ -3073,7 +2988,6 @@ Tcl_VarTraceInfo( return Tcl_VarTraceInfo2(interp, varName, NULL, flags, proc, prevClientData); } -#endif /* TCL_NO_DEPRECATED */ /* *---------------------------------------------------------------------- @@ -3101,13 +3015,14 @@ Tcl_VarTraceInfo2( * as-a-whole. */ int flags, /* OR-ed combination of TCL_GLOBAL_ONLY, * TCL_NAMESPACE_ONLY. */ - Tcl_VarTraceProc *proc, /* Function associated with trace. */ + Tcl_VarTraceProc *proc, /* Function assocated with trace. */ ClientData prevClientData) /* If non-NULL, gives last value returned by * this function, so this call will return the * next trace after that one. If NULL, this * call will return the first trace. */ { Interp *iPtr = (Interp *) interp; + register VarTrace *tracePtr; Var *varPtr, *arrayPtr; Tcl_HashEntry *hPtr; @@ -3122,13 +3037,14 @@ Tcl_VarTraceInfo2( * Find the relevant trace, if any, and return its clientData. */ - hPtr = Tcl_FindHashEntry(&iPtr->varTraces, (char *) varPtr); + hPtr = Tcl_FindHashEntry(&iPtr->varTraces, + (char *) varPtr); if (hPtr) { - VarTrace *tracePtr = (VarTrace *)Tcl_GetHashValue(hPtr); + tracePtr = Tcl_GetHashValue(hPtr); if (prevClientData != NULL) { - for (; tracePtr != NULL; tracePtr = tracePtr->nextPtr) { + for ( ; tracePtr != NULL; tracePtr = tracePtr->nextPtr) { if ((tracePtr->clientData == prevClientData) && (tracePtr->traceProc == proc)) { tracePtr = tracePtr->nextPtr; @@ -3136,7 +3052,7 @@ Tcl_VarTraceInfo2( } } } - for (; tracePtr != NULL ; tracePtr = tracePtr->nextPtr) { + for (; tracePtr!=NULL ; tracePtr=tracePtr->nextPtr) { if (tracePtr->traceProc == proc) { return tracePtr->clientData; } @@ -3159,14 +3075,13 @@ Tcl_VarTraceInfo2( * * Side effects: * A trace is set up on the variable given by varName, such that future - * references to the variable will be mediated by proc. See the + * references to the variable will be intermediated by proc. See the * manual entry for complete details on the calling sequence for proc. * The variable's flags are updated. * *---------------------------------------------------------------------- */ -#ifndef TCL_NO_DEPRECATED #undef Tcl_TraceVar int Tcl_TraceVar( @@ -3184,7 +3099,6 @@ Tcl_TraceVar( { return Tcl_TraceVar2(interp, varName, NULL, flags, proc, clientData); } -#endif /* TCL_NO_DEPRECATED */ /* *---------------------------------------------------------------------- @@ -3200,7 +3114,7 @@ Tcl_TraceVar( * * Side effects: * A trace is set up on the variable given by part1 and part2, such that - * future references to the variable will be mediated by proc. See + * future references to the variable will be intermediated by proc. See * the manual entry for complete details on the calling sequence for * proc. The variable's flags are updated. * @@ -3221,12 +3135,12 @@ Tcl_TraceVar2( * TCL_NAMESPACE_ONLY. */ Tcl_VarTraceProc *proc, /* Function to call when specified ops are * invoked upon varName. */ - void *clientData) /* Arbitrary argument to pass to proc. */ + ClientData clientData) /* Arbitrary argument to pass to proc. */ { - VarTrace *tracePtr; + register VarTrace *tracePtr; int result; - tracePtr = (VarTrace *)ckalloc(sizeof(VarTrace)); + tracePtr = (VarTrace *) ckalloc(sizeof(VarTrace)); tracePtr->traceProc = proc; tracePtr->clientData = clientData; tracePtr->flags = flags; @@ -3234,7 +3148,7 @@ Tcl_TraceVar2( result = TraceVarEx(interp, part1, part2, tracePtr); if (result != TCL_OK) { - ckfree(tracePtr); + ckfree((char *) tracePtr); } return result; } @@ -3253,7 +3167,7 @@ Tcl_TraceVar2( * * Side effects: * A trace is set up on the variable given by part1 and part2, such that - * future references to the variable will be mediated by the + * future references to the variable will be intermediated by the * traceProc listed in tracePtr. See the manual entry for complete * details on the calling sequence for proc. * @@ -3268,7 +3182,7 @@ TraceVarEx( const char *part2, /* Name of element within array; NULL means * trace applies to scalar variable or array * as-a-whole. */ - VarTrace *tracePtr)/* Structure containing flags, traceProc and + register VarTrace *tracePtr)/* Structure containing flags, traceProc and * clientData fields. Others should be left * blank. Will be ckfree()d (eventually) if * this function returns TCL_OK, and up to @@ -3300,8 +3214,8 @@ TraceVarEx( * because there should be no code path that ever sets both flags. */ - if ((tracePtr->flags & TCL_TRACE_RESULT_DYNAMIC) - && (tracePtr->flags & TCL_TRACE_RESULT_OBJECT)) { + if ((tracePtr->flags&TCL_TRACE_RESULT_DYNAMIC) + && (tracePtr->flags&TCL_TRACE_RESULT_OBJECT)) { Tcl_Panic("bad result flag combination"); } @@ -3311,18 +3225,18 @@ TraceVarEx( flagMask = TCL_TRACE_READS | TCL_TRACE_WRITES | TCL_TRACE_UNSETS | TCL_TRACE_ARRAY | TCL_TRACE_RESULT_DYNAMIC | TCL_TRACE_RESULT_OBJECT; -#ifndef TCL_NO_DEPRECATED +#ifndef TCL_REMOVE_OBSOLETE_TRACES flagMask |= TCL_TRACE_OLD_STYLE; #endif tracePtr->flags = tracePtr->flags & flagMask; - hPtr = Tcl_CreateHashEntry(&iPtr->varTraces, varPtr, &isNew); + hPtr = Tcl_CreateHashEntry(&iPtr->varTraces, (char *) varPtr, &isNew); if (isNew) { tracePtr->nextPtr = NULL; } else { - tracePtr->nextPtr = (VarTrace *)Tcl_GetHashValue(hPtr); + tracePtr->nextPtr = (VarTrace *) Tcl_GetHashValue(hPtr); } - Tcl_SetHashValue(hPtr, tracePtr); + Tcl_SetHashValue(hPtr, (char *) tracePtr); /* * Mark the variable as traced so we know to call them. |