summaryrefslogtreecommitdiffstats
path: root/generic/tclTrace.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclTrace.c')
-rw-r--r--generic/tclTrace.c538
1 files changed, 266 insertions, 272 deletions
diff --git a/generic/tclTrace.c b/generic/tclTrace.c
index 92b1faf..2e1b241 100644
--- a/generic/tclTrace.c
+++ b/generic/tclTrace.c
@@ -22,11 +22,11 @@ typedef struct {
int flags; /* Operations for which Tcl command is to be
* invoked. */
size_t length; /* Number of non-NUL chars. in command. */
- char command[1]; /* 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. */
} TraceVarInfo;
typedef struct {
@@ -56,11 +56,11 @@ typedef struct {
* deleted too early. Keeps track of how many
* pieces of code have a pointer to this
* structure. */
- char command[1]; /* 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;
/*
@@ -94,7 +94,7 @@ typedef struct {
*/
typedef int (Tcl_TraceTypeObjCmd)(Tcl_Interp *interp, int optionIndex,
- size_t objc, Tcl_Obj *const objv[]);
+ int objc, Tcl_Obj *const objv[]);
static Tcl_TraceTypeObjCmd TraceVariableObjCmd;
static Tcl_TraceTypeObjCmd TraceCommandObjCmd;
@@ -107,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[] = {
@@ -121,9 +121,8 @@ static Tcl_TraceTypeObjCmd *const traceSubCmds[] = {
*/
static int CallTraceFunction(Tcl_Interp *interp, Trace *tracePtr,
- Command *cmdPtr, const char *command,
- size_t numChars, size_t objc,
- Tcl_Obj *const objv[]);
+ 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(ClientData clientData,
@@ -133,7 +132,7 @@ static Tcl_CmdObjTraceProc TraceExecutionProc;
static int StringTraceProc(ClientData clientData,
Tcl_Interp *interp, int level,
const char *command, Tcl_Command commandInfo,
- size_t objc, Tcl_Obj *const objv[]);
+ 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,
@@ -148,21 +147,6 @@ 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_VarTraceInfo((interp), (name), 0, \
- TraceVarProc, (clientData))) != NULL)
-
-#define FOREACH_COMMAND_TRACE(interp, name, clientData) \
- (clientData) = NULL; \
- while ((clientData = Tcl_CommandTraceInfo(interp, name, 0, \
- TraceCommandProc, clientData)) != NULL)
/*
*----------------------------------------------------------------------
@@ -188,14 +172,13 @@ int
Tcl_TraceObjCmd(
ClientData dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
- size_t objc, /* Number of arguments. */
+ int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
int optionIndex;
- const char *name;
- const char *flagOps, *p;
+ char *name, *flagOps, *p;
/* Main sub commands to 'trace' */
- static const char *const traceOptions[] = {
+ static const char *traceOptions[] = {
"add", "info", "remove",
#ifndef TCL_REMOVE_OBSOLETE_TRACES
"variable", "vdelete", "vinfo",
@@ -211,12 +194,12 @@ Tcl_TraceObjCmd(
};
if (objc < 2) {
- Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
+ Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?");
return TCL_ERROR;
}
- if (Tcl_GetIndexFromObj(interp, objv[1], traceOptions, "option", 0,
- &optionIndex) != TCL_OK) {
+ if (Tcl_GetIndexFromObj(interp, objv[1], traceOptions,
+ "option", 0, &optionIndex) != TCL_OK) {
return TCL_ERROR;
}
switch ((enum traceOptions) optionIndex) {
@@ -231,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, optionIndex, objc, objv);
+ return (traceSubCmds[typeIndex])(interp, optionIndex, objc, objv);
}
case TRACE_INFO: {
/*
@@ -261,7 +244,7 @@ Tcl_TraceObjCmd(
0, &typeIndex) != TCL_OK) {
return TCL_ERROR;
}
- return traceSubCmds[typeIndex](interp, optionIndex, objc, objv);
+ return (traceSubCmds[typeIndex])(interp, optionIndex, objc, objv);
break;
}
@@ -270,8 +253,7 @@ Tcl_TraceObjCmd(
case TRACE_OLD_VDELETE: {
Tcl_Obj *copyObjv[6];
Tcl_Obj *opsList;
- int code;
- size_t numFlags;
+ int code, numFlags;
if (objc != 5) {
Tcl_WrongNumArgs(interp, 2, objv, "name ops command");
@@ -306,9 +288,9 @@ 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;
@@ -323,29 +305,32 @@ Tcl_TraceObjCmd(
return TCL_ERROR;
}
resultListPtr = Tcl_NewObj();
+ clientData = 0;
name = Tcl_GetString(objv[2]);
- FOREACH_VAR_TRACE(interp, name, clientData) {
- TraceVarInfo *tvarPtr = 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
@@ -354,9 +339,9 @@ Tcl_TraceObjCmd(
* result object list.
*/
- elemObjPtr = Tcl_NewStringObj(ops, TCL_STRLEN);
+ elemObjPtr = Tcl_NewStringObj(ops, -1);
Tcl_ListObjAppendElement(NULL, pairObjPtr, elemObjPtr);
- elemObjPtr = Tcl_NewStringObj(tvarPtr->command, TCL_STRLEN);
+ elemObjPtr = Tcl_NewStringObj(tvarPtr->command, -1);
Tcl_ListObjAppendElement(NULL, pairObjPtr, elemObjPtr);
Tcl_ListObjAppendElement(interp, resultListPtr, pairObjPtr);
}
@@ -368,10 +353,8 @@ Tcl_TraceObjCmd(
return TCL_OK;
badVarOps:
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "bad operations \"%s\": should be one or more of rwua",
- flagOps));
- Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRACE", "BADOPS", NULL);
+ Tcl_AppendResult(interp, "bad operations \"", flagOps,
+ "\": should be one or more of rwua", NULL);
return TCL_ERROR;
}
@@ -398,16 +381,16 @@ static int
TraceExecutionObjCmd(
Tcl_Interp *interp, /* Current interpreter. */
int optionIndex, /* Add, info or remove */
- size_t objc, /* Number of arguments. */
+ int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
- int index;
- const char *name, *command;
- size_t commandLength, length;
+ int commandLength, index;
+ char *name, *command;
+ size_t length;
enum traceOptions {
TRACE_ADD, TRACE_INFO, TRACE_REMOVE
};
- static const char *const opStrings[] = {
+ static const char *opStrings[] = {
"enter", "leave", "enterstep", "leavestep", NULL
};
enum operations {
@@ -418,9 +401,9 @@ TraceExecutionObjCmd(
switch ((enum traceOptions) optionIndex) {
case TRACE_ADD:
case TRACE_REMOVE: {
- int flags = 0, result;
+ int flags = 0;
+ int i, listLen, result;
Tcl_Obj **elemPtrs;
- size_t i, listLen;
if (objc != 6) {
Tcl_WrongNumArgs(interp, 3, objv, "name opList command");
@@ -437,11 +420,9 @@ TraceExecutionObjCmd(
return result;
}
if (listLen == 0) {
- Tcl_SetObjResult(interp, Tcl_NewStringObj(
- "bad operation list \"\": must be one or more of"
- " enter, leave, enterstep, or leavestep", TCL_STRLEN));
- Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRACE", "NOOPS",
- NULL);
+ Tcl_SetResult(interp, "bad operation list \"\": must be "
+ "one or more of enter, leave, enterstep, or leavestep",
+ TCL_STATIC);
return TCL_ERROR;
}
for (i = 0; i < listLen; i++) {
@@ -467,9 +448,11 @@ TraceExecutionObjCmd(
command = Tcl_GetStringFromObj(objv[5], &commandLength);
length = (size_t) commandLength;
if ((enum traceOptions) optionIndex == TRACE_ADD) {
- TraceCommandInfo *tcmdPtr = ckalloc(
- TclOffset(TraceCommandInfo, command) + 1 + length);
+ TraceCommandInfo *tcmdPtr;
+ tcmdPtr = (TraceCommandInfo *) ckalloc((unsigned)
+ (sizeof(TraceCommandInfo) - sizeof(tcmdPtr->command)
+ + length + 1));
tcmdPtr->flags = flags;
tcmdPtr->stepTrace = NULL;
tcmdPtr->startLevel = 0;
@@ -484,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 {
@@ -495,19 +478,21 @@ TraceExecutionObjCmd(
* first one that matches.
*/
- ClientData 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 = clientData;
+ while ((clientData = Tcl_CommandTraceInfo(interp, name, 0,
+ TraceCommandProc, clientData)) != NULL) {
+ tcmdPtr = (TraceCommandInfo *) clientData;
/*
* In checking the 'flags' field we must remove any extraneous
@@ -536,7 +521,7 @@ TraceExecutionObjCmd(
Tcl_DeleteTrace(interp, tcmdPtr->stepTrace);
tcmdPtr->stepTrace = NULL;
if (tcmdPtr->startCmd != NULL) {
- ckfree(tcmdPtr->startCmd);
+ ckfree((char *) tcmdPtr->startCmd);
}
}
if (tcmdPtr->flags & TCL_TRACE_EXEC_IN_PROGRESS) {
@@ -547,7 +532,7 @@ TraceExecutionObjCmd(
tcmdPtr->flags = 0;
}
if ((--tcmdPtr->refCount) <= 0) {
- ckfree(tcmdPtr);
+ ckfree((char *) tcmdPtr);
}
break;
}
@@ -557,13 +542,14 @@ TraceExecutionObjCmd(
}
case TRACE_INFO: {
ClientData clientData;
- Tcl_Obj *resultListPtr;
+ Tcl_Obj *resultListPtr, *eachTraceObjPtr, *elemObjPtr;
if (objc != 4) {
Tcl_WrongNumArgs(interp, 3, objv, "name");
return TCL_ERROR;
}
+ clientData = NULL;
name = Tcl_GetString(objv[3]);
/*
@@ -575,10 +561,11 @@ TraceExecutionObjCmd(
}
resultListPtr = Tcl_NewListObj(0, NULL);
- FOREACH_COMMAND_TRACE(interp, name, clientData) {
- size_t numOps = 0;
- Tcl_Obj *opObj, *eachTraceObjPtr, *elemObjPtr;
- TraceCommandInfo *tcmdPtr = 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
@@ -615,7 +602,7 @@ TraceExecutionObjCmd(
elemObjPtr = NULL;
Tcl_ListObjAppendElement(NULL, eachTraceObjPtr,
- Tcl_NewStringObj(tcmdPtr->command, TCL_STRLEN));
+ Tcl_NewStringObj(tcmdPtr->command, -1));
Tcl_ListObjAppendElement(interp, resultListPtr, eachTraceObjPtr);
}
Tcl_SetObjResult(interp, resultListPtr);
@@ -648,21 +635,21 @@ static int
TraceCommandObjCmd(
Tcl_Interp *interp, /* Current interpreter. */
int optionIndex, /* Add, info or remove */
- size_t objc, /* Number of arguments. */
+ int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
- int index;
- const char *name, *command;
- size_t commandLength, length;
+ int commandLength, index;
+ char *name, *command;
+ size_t length;
enum traceOptions { TRACE_ADD, TRACE_INFO, TRACE_REMOVE };
- static const char *const opStrings[] = { "delete", "rename", NULL };
+ static const char *opStrings[] = { "delete", "rename", NULL };
enum operations { TRACE_CMD_DELETE, TRACE_CMD_RENAME };
switch ((enum traceOptions) optionIndex) {
case TRACE_ADD:
case TRACE_REMOVE: {
- int flags = 0, result;
- size_t i, listLen;
+ int flags = 0;
+ int i, listLen, result;
Tcl_Obj **elemPtrs;
if (objc != 6) {
@@ -680,11 +667,8 @@ TraceCommandObjCmd(
return result;
}
if (listLen == 0) {
- Tcl_SetObjResult(interp, Tcl_NewStringObj(
- "bad operation list \"\": must be one or more of"
- " delete or rename", TCL_STRLEN));
- Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRACE", "NOOPS",
- NULL);
+ Tcl_SetResult(interp, "bad operation list \"\": must be "
+ "one or more of delete or rename", TCL_STATIC);
return TCL_ERROR;
}
@@ -706,9 +690,11 @@ TraceCommandObjCmd(
command = Tcl_GetStringFromObj(objv[5], &commandLength);
length = (size_t) commandLength;
if ((enum traceOptions) optionIndex == TRACE_ADD) {
- TraceCommandInfo *tcmdPtr = ckalloc(
- TclOffset(TraceCommandInfo, command) + 1 + length);
+ TraceCommandInfo *tcmdPtr;
+ tcmdPtr = (TraceCommandInfo *) ckalloc((unsigned)
+ (sizeof(TraceCommandInfo) - sizeof(tcmdPtr->command)
+ + length + 1));
tcmdPtr->flags = flags;
tcmdPtr->stepTrace = NULL;
tcmdPtr->startLevel = 0;
@@ -719,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 {
@@ -730,28 +716,30 @@ TraceCommandObjCmd(
* first one that matches.
*/
- ClientData 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 = 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,
(size_t) length) == 0)) {
Tcl_UntraceCommand(interp, name, flags | TCL_TRACE_DELETE,
TraceCommandProc, clientData);
tcmdPtr->flags |= TCL_TRACE_DESTROYED;
if ((--tcmdPtr->refCount) <= 0) {
- ckfree(tcmdPtr);
+ ckfree((char *) tcmdPtr);
}
break;
}
@@ -761,27 +749,30 @@ TraceCommandObjCmd(
}
case TRACE_INFO: {
ClientData clientData;
- Tcl_Obj *resultListPtr;
+ 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) {
- size_t numOps = 0;
- Tcl_Obj *opObj, *eachTraceObjPtr, *elemObjPtr;
- TraceCommandInfo *tcmdPtr = 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
@@ -808,7 +799,7 @@ TraceCommandObjCmd(
Tcl_ListObjAppendElement(NULL, eachTraceObjPtr, elemObjPtr);
Tcl_DecrRefCount(elemObjPtr);
- elemObjPtr = Tcl_NewStringObj(tcmdPtr->command, TCL_STRLEN);
+ elemObjPtr = Tcl_NewStringObj(tcmdPtr->command, -1);
Tcl_ListObjAppendElement(NULL, eachTraceObjPtr, elemObjPtr);
Tcl_ListObjAppendElement(interp, resultListPtr, eachTraceObjPtr);
}
@@ -842,15 +833,14 @@ static int
TraceVariableObjCmd(
Tcl_Interp *interp, /* Current interpreter. */
int optionIndex, /* Add, info or remove */
- size_t objc, /* Number of arguments. */
+ int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
- int index;
- const char *name, *command;
- size_t commandLength, length;
- ClientData clientData;
+ int commandLength, index;
+ char *name, *command;
+ size_t length;
enum traceOptions { TRACE_ADD, TRACE_INFO, TRACE_REMOVE };
- static const char *const opStrings[] = {
+ static const char *opStrings[] = {
"array", "read", "unset", "write", NULL
};
enum operations {
@@ -860,8 +850,8 @@ TraceVariableObjCmd(
switch ((enum traceOptions) optionIndex) {
case TRACE_ADD:
case TRACE_REMOVE: {
- int flags = 0, result;
- size_t i, listLen;
+ int flags = 0;
+ int i, listLen, result;
Tcl_Obj **elemPtrs;
if (objc != 6) {
@@ -879,11 +869,8 @@ TraceVariableObjCmd(
return result;
}
if (listLen == 0) {
- Tcl_SetObjResult(interp, Tcl_NewStringObj(
- "bad operation list \"\": must be one or more of"
- " array, read, unset, or write", TCL_STRLEN));
- Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRACE", "NOOPS",
- NULL);
+ Tcl_SetResult(interp, "bad operation list \"\": must be "
+ "one or more of array, read, unset, or write", TCL_STATIC);
return TCL_ERROR;
}
for (i = 0; i < listLen ; i++) {
@@ -909,10 +896,11 @@ TraceVariableObjCmd(
command = Tcl_GetStringFromObj(objv[5], &commandLength);
length = (size_t) commandLength;
if ((enum traceOptions) optionIndex == TRACE_ADD) {
- CombinedTraceVarInfo *ctvarPtr = ckalloc(
- TclOffset(CombinedTraceVarInfo, traceCmdInfo.command)
- + 1 + length);
+ CombinedTraceVarInfo *ctvarPtr;
+ ctvarPtr = (CombinedTraceVarInfo *) ckalloc((unsigned)
+ (sizeof(CombinedTraceVarInfo) + length + 1
+ - sizeof(ctvarPtr->traceCmdInfo.command)));
ctvarPtr->traceCmdInfo.flags = flags;
if (objv[0] == NULL) {
ctvarPtr->traceCmdInfo.flags |= TCL_TRACE_OLD_STYLE;
@@ -921,12 +909,12 @@ TraceVariableObjCmd(
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 {
@@ -936,10 +924,12 @@ TraceVariableObjCmd(
* first one that matches.
*/
+ TraceVarInfo *tvarPtr;
+ ClientData clientData = 0;
name = Tcl_GetString(objv[3]);
- FOREACH_VAR_TRACE(interp, name, clientData) {
- TraceVarInfo *tvarPtr = clientData;
-
+ while ((clientData = Tcl_VarTraceInfo(interp, name, 0,
+ TraceVarProc, clientData)) != 0) {
+ tvarPtr = (TraceVarInfo *) clientData;
if ((tvarPtr->length == length)
&& ((tvarPtr->flags & ~TCL_TRACE_OLD_STYLE)==flags)
&& (strncmp(command, tvarPtr->command,
@@ -954,7 +944,8 @@ TraceVariableObjCmd(
break;
}
case TRACE_INFO: {
- Tcl_Obj *resultListPtr;
+ ClientData clientData;
+ Tcl_Obj *resultListPtr, *eachTraceObjPtr, *elemObjPtr;
if (objc != 4) {
Tcl_WrongNumArgs(interp, 3, objv, "name");
@@ -962,10 +953,12 @@ TraceVariableObjCmd(
}
resultListPtr = Tcl_NewObj();
+ clientData = 0;
name = Tcl_GetString(objv[3]);
- FOREACH_VAR_TRACE(interp, name, clientData) {
- Tcl_Obj *opObjPtr, *eachTraceObjPtr, *elemObjPtr;
- TraceVarInfo *tvarPtr = 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
@@ -975,25 +968,25 @@ 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);
- elemObjPtr = Tcl_NewStringObj(tvarPtr->command, TCL_STRLEN);
+ elemObjPtr = Tcl_NewStringObj(tvarPtr->command, -1);
Tcl_ListObjAppendElement(NULL, eachTraceObjPtr, elemObjPtr);
Tcl_ListObjAppendElement(interp, resultListPtr,
eachTraceObjPtr);
@@ -1120,7 +1113,7 @@ Tcl_TraceCommand(
* Set up trace information.
*/
- tracePtr = ckalloc(sizeof(CommandTrace));
+ tracePtr = (CommandTrace *) ckalloc(sizeof(CommandTrace));
tracePtr->traceProc = proc;
tracePtr->clientData = clientData;
tracePtr->flags = flags &
@@ -1133,8 +1126,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)) {
+ if ((cmdPtr->compileProc != NULL) && !(cmdPtr->flags & CMD_HAS_EXEC_TRACES)){
Interp *iPtr = (Interp *) interp;
iPtr->compileEpoch++;
}
@@ -1227,7 +1219,7 @@ Tcl_UntraceCommand(
tracePtr->flags = 0;
if ((--tracePtr->refCount) <= 0) {
- ckfree(tracePtr);
+ ckfree((char *) tracePtr);
}
if (hasExecTraces) {
@@ -1250,6 +1242,7 @@ Tcl_UntraceCommand(
*/
if (cmdPtr->compileProc != NULL) {
+ Interp *iPtr = (Interp *) interp;
iPtr->compileEpoch++;
}
}
@@ -1285,7 +1278,7 @@ TraceCommandProc(
int flags) /* OR-ed bits giving operation and other
* information. */
{
- TraceCommandInfo *tcmdPtr = clientData;
+ TraceCommandInfo *tcmdPtr = (TraceCommandInfo *) clientData;
int code;
Tcl_DString cmd;
@@ -1303,9 +1296,9 @@ TraceCommandProc(
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);
}
/*
@@ -1342,7 +1335,7 @@ TraceCommandProc(
Tcl_DeleteTrace(interp, tcmdPtr->stepTrace);
tcmdPtr->stepTrace = NULL;
if (tcmdPtr->startCmd != NULL) {
- ckfree(tcmdPtr->startCmd);
+ ckfree((char *) tcmdPtr->startCmd);
}
}
if (tcmdPtr->flags & TCL_TRACE_EXEC_IN_PROGRESS) {
@@ -1381,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) <= 0) {
- ckfree(tcmdPtr);
+ ckfree((char *) tcmdPtr);
}
}
@@ -1419,12 +1412,12 @@ TclCheckExecutionTraces(
Tcl_Interp *interp, /* The current interpreter. */
const char *command, /* Pointer to beginning of the current command
* string. */
- size_t 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. */
- size_t 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;
@@ -1465,7 +1458,8 @@ TclCheckExecutionTraces(
active.nextTracePtr = tracePtr->nextPtr;
}
if (tracePtr->traceProc == TraceCommandProc) {
- TraceCommandInfo *tcmdPtr = tracePtr->clientData;
+ TraceCommandInfo *tcmdPtr = (TraceCommandInfo *)
+ tracePtr->clientData;
if (tcmdPtr->flags != 0) {
tcmdPtr->curFlags = traceFlags | TCL_TRACE_EXEC_DIRECT;
@@ -1474,10 +1468,10 @@ TclCheckExecutionTraces(
if (state == NULL) {
state = Tcl_SaveInterpState(interp, code);
}
- traceCode = TraceExecutionProc(tcmdPtr, interp, curLevel,
- command, (Tcl_Command) cmdPtr, objc, objv);
+ traceCode = TraceExecutionProc((ClientData) tcmdPtr, interp,
+ curLevel, command, (Tcl_Command) cmdPtr, objc, objv);
if ((--tcmdPtr->refCount) <= 0) {
- ckfree(tcmdPtr);
+ ckfree((char *) tcmdPtr);
}
}
}
@@ -1487,10 +1481,14 @@ TclCheckExecutionTraces(
}
iPtr->activeCmdTracePtr = active.nextPtr;
if (state) {
- Tcl_RestoreInterpState(interp, state);
+ if (traceCode == TCL_OK) {
+ (void) Tcl_RestoreInterpState(interp, state);
+ } else {
+ Tcl_DiscardInterpState(state);
+ }
}
- return traceCode;
+ return(traceCode);
}
/*
@@ -1521,12 +1519,12 @@ TclCheckInterpTraces(
Tcl_Interp *interp, /* The current interpreter. */
const char *command, /* Pointer to beginning of the current command
* string. */
- size_t 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. */
- size_t 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;
@@ -1538,7 +1536,7 @@ TclCheckInterpTraces(
if ((iPtr->tracePtr == NULL)
|| (iPtr->flags & INTERP_TRACE_IN_PROGRESS)) {
- return traceCode;
+ return(traceCode);
}
curLevel = iPtr->numLevels;
@@ -1588,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);
@@ -1602,14 +1600,15 @@ TclCheckInterpTraces(
if (tracePtr->flags & traceFlags) {
if (tracePtr->proc == TraceExecutionProc) {
- TraceCommandInfo *tcmdPtr = 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 {
/*
@@ -1627,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);
}
/*
@@ -1668,9 +1667,9 @@ CallTraceFunction(
Command *cmdPtr, /* Points to command's Command struct. */
const char *command, /* Points to the first character of the
* command's source before substitutions. */
- size_t numChars, /* The number of characters in the command's
+ int numChars, /* The number of characters in the command's
* source. */
- register size_t 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;
@@ -1681,15 +1680,15 @@ CallTraceFunction(
* Copy the command characters into a new string.
*/
- commandCopy = 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);
@@ -1717,10 +1716,10 @@ static void
CommandObjTraceDeleted(
ClientData clientData)
{
- TraceCommandInfo *tcmdPtr = clientData;
+ TraceCommandInfo *tcmdPtr = (TraceCommandInfo *) clientData;
if ((--tcmdPtr->refCount) <= 0) {
- ckfree(tcmdPtr);
+ ckfree((char *) tcmdPtr);
}
}
@@ -1756,12 +1755,12 @@ TraceExecutionProc(
int level,
const char *command,
Tcl_Command cmdInfo,
- size_t objc,
+ int objc,
struct Tcl_Obj *const objv[])
{
int call = 0;
Interp *iPtr = (Interp *) interp;
- TraceCommandInfo *tcmdPtr = clientData;
+ TraceCommandInfo *tcmdPtr = (TraceCommandInfo *) clientData;
int flags = tcmdPtr->curFlags;
int code = tcmdPtr->curCode;
int traceCode = TCL_OK;
@@ -1803,7 +1802,7 @@ TraceExecutionProc(
Tcl_DeleteTrace(interp, tcmdPtr->stepTrace);
tcmdPtr->stepTrace = NULL;
if (tcmdPtr->startCmd != NULL) {
- ckfree(tcmdPtr->startCmd);
+ ckfree((char *) tcmdPtr->startCmd);
}
}
@@ -1812,7 +1811,8 @@ TraceExecutionProc(
*/
if (call) {
- Tcl_DString cmd, sub;
+ Tcl_DString cmd;
+ Tcl_DString sub;
int i, saveInterpFlags;
Tcl_DStringInit(&cmd);
@@ -1841,7 +1841,7 @@ TraceExecutionProc(
}
} else if (flags & TCL_TRACE_LEAVE_EXEC) {
Tcl_Obj *resultCode;
- const char *resultCodeStr;
+ char *resultCodeStr;
/*
* Append result code.
@@ -1921,7 +1921,8 @@ TraceExecutionProc(
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) {
@@ -1935,7 +1936,7 @@ TraceExecutionProc(
}
if (call) {
if ((--tcmdPtr->refCount) <= 0) {
- ckfree(tcmdPtr);
+ ckfree((char *) tcmdPtr);
}
}
return traceCode;
@@ -1970,11 +1971,10 @@ TraceVarProc(
int flags) /* OR-ed bits giving operation and other
* information. */
{
- TraceVarInfo *tvarPtr = clientData;
+ TraceVarInfo *tvarPtr = (TraceVarInfo *) clientData;
char *result;
int code, destroy = 0;
Tcl_DString cmd;
- int rewind = ((Interp *)interp)->execEnvPtr->rewind;
/*
* We might call Tcl_Eval() below, and that might evaluate [trace vdelete]
@@ -1993,30 +1993,30 @@ TraceVarProc(
*/
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_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_REMOVE_OBSOLETE_TRACES
}
@@ -2036,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;
}
@@ -2162,7 +2149,7 @@ Tcl_CreateObjTrace(
iPtr->tracesForbiddingInline++;
}
- tracePtr = ckalloc(sizeof(Trace));
+ tracePtr = (Trace *) ckalloc(sizeof(Trace));
tracePtr->level = level;
tracePtr->proc = proc;
tracePtr->clientData = clientData;
@@ -2225,12 +2212,13 @@ Tcl_CreateTrace(
* command. */
ClientData clientData) /* Arbitrary value word to pass to proc. */
{
- StringTraceData *data = 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);
}
/*
@@ -2256,13 +2244,13 @@ StringTraceProc(
int level,
const char *command,
Tcl_Command commandInfo,
- size_t objc,
+ int objc,
Tcl_Obj *const *objv)
{
- StringTraceData *data = clientData;
+ StringTraceData *data = (StringTraceData *) clientData;
Command *cmdPtr = (Command *) commandInfo;
const char **argv; /* Args to pass to string trace proc */
- size_t i;
+ int i;
/*
* This is a bit messy because we have to emulate the old trace interface,
@@ -2270,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]);
}
@@ -2282,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);
@@ -2309,7 +2297,7 @@ static void
StringTraceDeleteProc(
ClientData clientData)
{
- ckfree(clientData);
+ ckfree((char *) clientData);
}
/*
@@ -2337,7 +2325,7 @@ Tcl_DeleteTrace(
{
Interp *iPtr = (Interp *) interp;
Trace *prevPtr, *tracePtr = (Trace *) trace;
- register Trace **tracePtr2 = &iPtr->tracePtr;
+ register Trace **tracePtr2 = &(iPtr->tracePtr);
ActiveInterpTrace *activePtr;
/*
@@ -2346,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
@@ -2392,7 +2380,7 @@ Tcl_DeleteTrace(
*/
if (tracePtr->delProc != NULL) {
- tracePtr->delProc(tracePtr->clientData);
+ (tracePtr->delProc)(tracePtr->clientData);
}
/*
@@ -2425,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
@@ -2445,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);
}
@@ -2504,7 +2493,7 @@ TclObjCallVarTraces(
* variable, or -1. Only used when part1Ptr is
* NULL. */
{
- const char *part1, *part2;
+ char *part1, *part2;
if (!part1Ptr) {
part1Ptr = localName(iPtr->varFramePtr, index);
@@ -2582,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;
@@ -2608,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 = 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) {
@@ -2640,7 +2629,7 @@ TclCallVarTraces(
code = TCL_ERROR;
}
}
- Tcl_Release(tracePtr);
+ Tcl_Release((ClientData) tracePtr);
if (code == TCL_ERROR) {
goto done;
}
@@ -2657,20 +2646,20 @@ TclCallVarTraces(
active.varPtr = varPtr;
if (varPtr->flags & traceflags) {
hPtr = Tcl_FindHashEntry(&iPtr->varTraces, (char *) varPtr);
- for (tracePtr = 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) {
@@ -2684,7 +2673,7 @@ TclCallVarTraces(
code = TCL_ERROR;
}
}
- Tcl_Release(tracePtr);
+ Tcl_Release((ClientData) tracePtr);
if (code == TCL_ERROR) {
goto done;
}
@@ -2720,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, TCL_STRLEN));
+ Tcl_SetResult((Tcl_Interp *)iPtr, result, TCL_STATIC);
}
Tcl_AddErrorInfo((Tcl_Interp *)iPtr, "");
@@ -2738,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);
}
@@ -2760,7 +2748,7 @@ TclCallVarTraces(
VarHashRefCount(varPtr)--;
}
iPtr->activeVarTracePtr = active.nextPtr;
- Tcl_Release(iPtr);
+ Tcl_Release((ClientData) iPtr);
return code;
}
@@ -2813,6 +2801,7 @@ DisposeTraceResult(
*----------------------------------------------------------------------
*/
+#undef Tcl_UntraceVar
void
Tcl_UntraceVar(
Tcl_Interp *interp, /* Interpreter containing variable. */
@@ -2891,8 +2880,9 @@ Tcl_UntraceVar2(
#endif
flags &= flagMask;
- hPtr = Tcl_FindHashEntry(&iPtr->varTraces, (char *) varPtr);
- for (tracePtr = 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;
@@ -2937,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) {
@@ -2981,6 +2971,7 @@ Tcl_UntraceVar2(
*----------------------------------------------------------------------
*/
+#undef Tcl_VarTraceInfo
ClientData
Tcl_VarTraceInfo(
Tcl_Interp *interp, /* Interpreter containing variable. */
@@ -3031,6 +3022,7 @@ Tcl_VarTraceInfo2(
* call will return the first trace. */
{
Interp *iPtr = (Interp *) interp;
+ register VarTrace *tracePtr;
Var *varPtr, *arrayPtr;
Tcl_HashEntry *hPtr;
@@ -3045,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) {
- register VarTrace *tracePtr = 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;
@@ -3059,7 +3052,7 @@ Tcl_VarTraceInfo2(
}
}
}
- for (; tracePtr != NULL ; tracePtr = tracePtr->nextPtr) {
+ for (; tracePtr!=NULL ; tracePtr=tracePtr->nextPtr) {
if (tracePtr->traceProc == proc) {
return tracePtr->clientData;
}
@@ -3089,6 +3082,7 @@ Tcl_VarTraceInfo2(
*----------------------------------------------------------------------
*/
+#undef Tcl_TraceVar
int
Tcl_TraceVar(
Tcl_Interp *interp, /* Interpreter in which variable is to be
@@ -3146,7 +3140,7 @@ Tcl_TraceVar2(
register VarTrace *tracePtr;
int result;
- tracePtr = ckalloc(sizeof(VarTrace));
+ tracePtr = (VarTrace *) ckalloc(sizeof(VarTrace));
tracePtr->traceProc = proc;
tracePtr->clientData = clientData;
tracePtr->flags = flags;
@@ -3154,7 +3148,7 @@ Tcl_TraceVar2(
result = TraceVarEx(interp, part1, part2, tracePtr);
if (result != TCL_OK) {
- ckfree(tracePtr);
+ ckfree((char *) tracePtr);
}
return result;
}
@@ -3220,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");
}
@@ -3236,13 +3230,13 @@ TraceVarEx(
#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 = 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.
generated by cgit v0.12 at 2025-12-18 16:23:45 (GMT)