summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--generic/tclTrace.c251
-rw-r--r--generic/tclVar.c126
2 files changed, 206 insertions, 171 deletions
diff --git a/generic/tclTrace.c b/generic/tclTrace.c
index c67515f..b614b45 100644
--- a/generic/tclTrace.c
+++ b/generic/tclTrace.c
@@ -11,7 +11,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclTrace.c,v 1.45 2007/09/17 10:44:05 dkf Exp $
+ * RCS: @(#) $Id: tclTrace.c,v 1.46 2007/11/15 09:40:00 dkf Exp $
*/
#include "tclInt.h"
@@ -96,7 +96,7 @@ typedef struct {
*/
typedef int (Tcl_TraceTypeObjCmd)(Tcl_Interp *interp, int optionIndex,
- int objc, Tcl_Obj *CONST objv[]);
+ int objc, Tcl_Obj *const objv[]);
static Tcl_TraceTypeObjCmd TraceVariableObjCmd;
static Tcl_TraceTypeObjCmd TraceCommandObjCmd;
@@ -109,7 +109,7 @@ static Tcl_TraceTypeObjCmd TraceExecutionObjCmd;
* add to the list of supported trace types.
*/
-static CONST char *traceTypeOptions[] = {
+static const char *traceTypeOptions[] = {
"execution", "command", "variable", NULL
};
static Tcl_TraceTypeObjCmd *traceSubCmds[] = {
@@ -123,22 +123,22 @@ static Tcl_TraceTypeObjCmd *traceSubCmds[] = {
*/
static int CallTraceFunction(Tcl_Interp *interp, Trace *tracePtr,
- Command *cmdPtr, CONST char *command, int numChars,
- int 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);
+ const char *name1, const char *name2, int flags);
static void TraceCommandProc(ClientData clientData,
- Tcl_Interp *interp, CONST char *oldName,
- CONST char *newName, int flags);
+ Tcl_Interp *interp, const char *oldName,
+ const char *newName, int flags);
static Tcl_CmdObjTraceProc TraceExecutionProc;
static int StringTraceProc(ClientData clientData,
- Tcl_Interp* interp, int level,
- CONST char* command, Tcl_Command commandInfo,
- int objc, Tcl_Obj *CONST objv[]);
+ Tcl_Interp *interp, int level,
+ const char *command, Tcl_Command commandInfo,
+ 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, register VarTrace *tracePtr);
+static int TraceVarEx(Tcl_Interp *interp, const char *part1,
+ const char *part2, register VarTrace *tracePtr);
/*
* The following structure holds the client data for string-based
@@ -147,7 +147,7 @@ static int TraceVarEx(Tcl_Interp *interp, CONST char *part1,
typedef struct StringTraceData {
ClientData clientData; /* Client data from Tcl_CreateTrace */
- Tcl_CmdTraceProc* proc; /* Trace function from Tcl_CreateTrace */
+ Tcl_CmdTraceProc *proc; /* Trace function from Tcl_CreateTrace */
} StringTraceData;
/*
@@ -175,12 +175,12 @@ Tcl_TraceObjCmd(
ClientData dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
- Tcl_Obj *CONST objv[]) /* Argument objects. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
int optionIndex;
char *name, *flagOps, *p;
/* Main sub commands to 'trace' */
- static CONST char *traceOptions[] = {
+ static const char *traceOptions[] = {
"add", "info", "remove",
#ifndef TCL_REMOVE_OBSOLETE_TRACES
"variable", "vdelete", "vinfo",
@@ -384,7 +384,7 @@ TraceExecutionObjCmd(
Tcl_Interp *interp, /* Current interpreter. */
int optionIndex, /* Add, info or remove */
int objc, /* Number of arguments. */
- Tcl_Obj *CONST objv[]) /* Argument objects. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
int commandLength, index;
char *name, *command;
@@ -392,7 +392,7 @@ TraceExecutionObjCmd(
enum traceOptions {
TRACE_ADD, TRACE_INFO, TRACE_REMOVE
};
- static CONST char *opStrings[] = {
+ static const char *opStrings[] = {
"enter", "leave", "enterstep", "leavestep", NULL
};
enum operations {
@@ -523,7 +523,7 @@ TraceExecutionObjCmd(
Tcl_DeleteTrace(interp, tcmdPtr->stepTrace);
tcmdPtr->stepTrace = NULL;
if (tcmdPtr->startCmd != NULL) {
- ckfree((char *)tcmdPtr->startCmd);
+ ckfree((char *) tcmdPtr->startCmd);
}
}
if (tcmdPtr->flags & TCL_TRACE_EXEC_IN_PROGRESS) {
@@ -534,7 +534,7 @@ TraceExecutionObjCmd(
tcmdPtr->flags = 0;
}
if ((--tcmdPtr->refCount) <= 0) {
- ckfree((char*)tcmdPtr);
+ ckfree((char *) tcmdPtr);
}
break;
}
@@ -638,13 +638,13 @@ TraceCommandObjCmd(
Tcl_Interp *interp, /* Current interpreter. */
int optionIndex, /* Add, info or remove */
int objc, /* Number of arguments. */
- Tcl_Obj *CONST objv[]) /* Argument objects. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
int commandLength, index;
char *name, *command;
size_t length;
enum traceOptions { TRACE_ADD, TRACE_INFO, TRACE_REMOVE };
- static CONST char *opStrings[] = { "delete", "rename", NULL };
+ static const char *opStrings[] = { "delete", "rename", NULL };
enum operations { TRACE_CMD_DELETE, TRACE_CMD_RENAME };
switch ((enum traceOptions) optionIndex) {
@@ -836,13 +836,13 @@ TraceVariableObjCmd(
Tcl_Interp *interp, /* Current interpreter. */
int optionIndex, /* Add, info or remove */
int objc, /* Number of arguments. */
- Tcl_Obj *CONST objv[]) /* Argument objects. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
int commandLength, index;
char *name, *command;
size_t length;
enum traceOptions { TRACE_ADD, TRACE_INFO, TRACE_REMOVE };
- static CONST char *opStrings[] = {
+ static const char *opStrings[] = {
"array", "read", "unset", "write", NULL
};
enum operations {
@@ -1028,7 +1028,7 @@ TraceVariableObjCmd(
ClientData
Tcl_CommandTraceInfo(
Tcl_Interp *interp, /* Interpreter containing command. */
- CONST char *cmdName, /* Name of command. */
+ const char *cmdName, /* Name of command. */
int flags, /* OR-ed combo or TCL_GLOBAL_ONLY,
* TCL_NAMESPACE_ONLY (can be 0). */
Tcl_CommandTraceProc *proc, /* Function assocated with trace. */
@@ -1094,7 +1094,7 @@ int
Tcl_TraceCommand(
Tcl_Interp *interp, /* Interpreter in which command is to be
* traced. */
- CONST char *cmdName, /* Name of command. */
+ const char *cmdName, /* Name of command. */
int flags, /* OR-ed collection of bits, including any of
* TCL_TRACE_RENAME, TCL_TRACE_DELETE, and any
* of the TRACE_*_EXEC flags */
@@ -1149,7 +1149,7 @@ Tcl_TraceCommand(
void
Tcl_UntraceCommand(
Tcl_Interp *interp, /* Interpreter containing command. */
- CONST char *cmdName, /* Name of command. */
+ const char *cmdName, /* Name of command. */
int flags, /* OR-ed collection of bits, including any of
* TCL_TRACE_RENAME, TCL_TRACE_DELETE, and any
* of the TRACE_*_EXEC flags */
@@ -1163,7 +1163,7 @@ Tcl_UntraceCommand(
ActiveCommandTrace *activePtr;
int hasExecTraces = 0;
- cmdPtr = (Command*)Tcl_FindCommand(interp, cmdName, NULL,
+ cmdPtr = (Command *) Tcl_FindCommand(interp, cmdName, NULL,
TCL_LEAVE_ERR_MSG);
if (cmdPtr == NULL) {
return;
@@ -1211,7 +1211,7 @@ Tcl_UntraceCommand(
tracePtr->flags = 0;
if ((--tracePtr->refCount) <= 0) {
- ckfree((char*)tracePtr);
+ ckfree((char *) tracePtr);
}
if (hasExecTraces) {
@@ -1254,8 +1254,8 @@ static void
TraceCommandProc(
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
+ const char *oldName, /* Name of command being changed. */
+ const char *newName, /* New name of command. Empty string or NULL
* means command is being deleted (renamed to
* ""). */
int flags) /* OR-ed bits giving operation and other
@@ -1318,7 +1318,7 @@ TraceCommandProc(
Tcl_DeleteTrace(interp, tcmdPtr->stepTrace);
tcmdPtr->stepTrace = NULL;
if (tcmdPtr->startCmd != NULL) {
- ckfree((char *)tcmdPtr->startCmd);
+ ckfree((char *) tcmdPtr->startCmd);
}
}
if (tcmdPtr->flags & TCL_TRACE_EXEC_IN_PROGRESS) {
@@ -1361,7 +1361,7 @@ TraceCommandProc(
tcmdPtr->refCount--;
}
if ((--tcmdPtr->refCount) <= 0) {
- ckfree((char*)tcmdPtr);
+ ckfree((char *) tcmdPtr);
}
}
@@ -1393,7 +1393,7 @@ TraceCommandProc(
int
TclCheckExecutionTraces(
Tcl_Interp *interp, /* The current interpreter. */
- CONST char *command, /* Pointer to beginning of the current command
+ const char *command, /* Pointer to beginning of the current command
* string. */
int numChars, /* The number of characters in 'command' which
* are part of the command string. */
@@ -1401,14 +1401,13 @@ TclCheckExecutionTraces(
int code, /* The current result code. */
int traceFlags, /* Current tracing situation. */
int objc, /* Number of arguments for the command. */
- Tcl_Obj *CONST objv[]) /* Pointers to Tcl_Obj of each argument. */
+ Tcl_Obj *const objv[]) /* Pointers to Tcl_Obj of each argument. */
{
Interp *iPtr = (Interp *) interp;
CommandTrace *tracePtr, *lastTracePtr;
ActiveCommandTrace active;
int curLevel;
int traceCode = TCL_OK;
- TraceCommandInfo* tcmdPtr;
Tcl_InterpState state = NULL;
if (cmdPtr->tracePtr == NULL) {
@@ -1442,7 +1441,9 @@ TclCheckExecutionTraces(
active.nextTracePtr = tracePtr->nextPtr;
}
if (tracePtr->traceProc == TraceCommandProc) {
- tcmdPtr = (TraceCommandInfo*)tracePtr->clientData;
+ TraceCommandInfo *tcmdPtr = (TraceCommandInfo *)
+ tracePtr->clientData;
+
if (tcmdPtr->flags != 0) {
tcmdPtr->curFlags = traceFlags | TCL_TRACE_EXEC_DIRECT;
tcmdPtr->curCode = code;
@@ -1450,10 +1451,10 @@ TclCheckExecutionTraces(
if (state == NULL) {
state = Tcl_SaveInterpState(interp, code);
}
- traceCode = TraceExecutionProc((ClientData)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((char*)tcmdPtr);
+ ckfree((char *) tcmdPtr);
}
}
}
@@ -1495,7 +1496,7 @@ TclCheckExecutionTraces(
int
TclCheckInterpTraces(
Tcl_Interp *interp, /* The current interpreter. */
- CONST char *command, /* Pointer to beginning of the current command
+ const char *command, /* Pointer to beginning of the current command
* string. */
int numChars, /* The number of characters in 'command' which
* are part of the command string. */
@@ -1503,7 +1504,7 @@ TclCheckInterpTraces(
int code, /* The current result code. */
int traceFlags, /* Current tracing situation. */
int objc, /* Number of arguments for the command. */
- Tcl_Obj *CONST objv[]) /* Pointers to Tcl_Obj of each argument. */
+ Tcl_Obj *const objv[]) /* Pointers to Tcl_Obj of each argument. */
{
Interp *iPtr = (Interp *) interp;
Trace *tracePtr, *lastTracePtr;
@@ -1578,10 +1579,11 @@ 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;
+ tcmdPtr->curCode = code;
}
traceCode = (tracePtr->proc)(tracePtr->clientData,
interp, curLevel, command, (Tcl_Command) cmdPtr,
@@ -1642,12 +1644,12 @@ CallTraceFunction(
Tcl_Interp *interp, /* The current interpreter. */
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
+ const char *command, /* Points to the first character of the
* command's source before substitutions. */
int numChars, /* The number of characters in the command's
* source. */
register int objc, /* Number of arguments for the command. */
- Tcl_Obj *CONST objv[]) /* Pointers to Tcl_Obj of each argument. */
+ Tcl_Obj *const objv[]) /* Pointers to Tcl_Obj of each argument. */
{
Interp *iPtr = (Interp *) interp;
char *commandCopy;
@@ -1658,14 +1660,14 @@ CallTraceFunction(
*/
commandCopy = TclStackAlloc(interp, (unsigned) (numChars + 1));
- memcpy((void *) commandCopy, (void *) command, (size_t) numChars);
+ 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);
@@ -1693,9 +1695,10 @@ static void
CommandObjTraceDeleted(
ClientData clientData)
{
- TraceCommandInfo* tcmdPtr = (TraceCommandInfo*)clientData;
+ TraceCommandInfo *tcmdPtr = (TraceCommandInfo *) clientData;
+
if ((--tcmdPtr->refCount) <= 0) {
- ckfree((char*)tcmdPtr);
+ ckfree((char *) tcmdPtr);
}
}
@@ -1729,17 +1732,17 @@ TraceExecutionProc(
ClientData clientData,
Tcl_Interp *interp,
int level,
- CONST char *command,
+ const char *command,
Tcl_Command cmdInfo,
int objc,
- struct Tcl_Obj *CONST objv[])
+ 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;
+ int code = tcmdPtr->curCode;
+ int traceCode = TCL_OK;
if (tcmdPtr->flags & TCL_TRACE_EXEC_IN_PROGRESS) {
/*
@@ -1778,7 +1781,7 @@ TraceExecutionProc(
Tcl_DeleteTrace(interp, tcmdPtr->stepTrace);
tcmdPtr->stepTrace = NULL;
if (tcmdPtr->startCmd != NULL) {
- ckfree((char *)tcmdPtr->startCmd);
+ ckfree((char *) tcmdPtr->startCmd);
}
}
@@ -1816,8 +1819,8 @@ TraceExecutionProc(
Tcl_DStringAppendElement(&cmd, "enterstep");
}
} else if (flags & TCL_TRACE_LEAVE_EXEC) {
- Tcl_Obj* resultCode;
- char* resultCodeStr;
+ Tcl_Obj *resultCode;
+ char *resultCodeStr;
/*
* Append result code.
@@ -1866,10 +1869,11 @@ TraceExecutionProc(
traceCode = Tcl_Eval(interp, Tcl_DStringValue(&cmd));
tcmdPtr->flags &= ~TCL_TRACE_EXEC_IN_PROGRESS;
- /*
- * Restore the interp tracing flag to prevent cmd traces
- * from affecting interp traces.
+ /*
+ * Restore the interp tracing flag to prevent cmd traces from
+ * affecting interp traces.
*/
+
iPtr->flags = saveInterpFlags;
if (tcmdPtr->flags == 0) {
flags |= TCL_TRACE_DESTROYED;
@@ -1888,10 +1892,11 @@ TraceExecutionProc(
if ((flags & TCL_TRACE_ENTER_EXEC) && (tcmdPtr->stepTrace == NULL)
&& (tcmdPtr->flags & (TCL_TRACE_ENTER_DURING_EXEC |
TCL_TRACE_LEAVE_DURING_EXEC))) {
+ register unsigned len = strlen(command) + 1;
+
tcmdPtr->startLevel = level;
- tcmdPtr->startCmd =
- (char *) ckalloc((unsigned) (strlen(command) + 1));
- strcpy(tcmdPtr->startCmd, command);
+ tcmdPtr->startCmd = ckalloc(len);
+ memcpy(tcmdPtr->startCmd, command, len);
tcmdPtr->refCount++;
tcmdPtr->stepTrace = Tcl_CreateObjTrace(interp, 0,
(tcmdPtr->flags & TCL_TRACE_ANY_EXEC) >> 2,
@@ -1904,13 +1909,13 @@ TraceExecutionProc(
Tcl_DeleteTrace(interp, tcmdPtr->stepTrace);
tcmdPtr->stepTrace = NULL;
if (tcmdPtr->startCmd != NULL) {
- ckfree((char *)tcmdPtr->startCmd);
+ ckfree(tcmdPtr->startCmd);
}
}
}
if (call) {
if ((--tcmdPtr->refCount) <= 0) {
- ckfree((char*)tcmdPtr);
+ ckfree((char *) tcmdPtr);
}
}
return traceCode;
@@ -1939,8 +1944,8 @@ static char *
TraceVarProc(
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
+ const char *name1, /* Name of variable or array. */
+ const char *name2, /* Name of element within array; NULL means
* scalar variable is being referenced. */
int flags) /* OR-ed bits giving operation and other
* information. */
@@ -2046,12 +2051,12 @@ TraceVarProc(
* form:
*
* void proc(ClientData clientData,
- * Tcl_Interp* interp,
+ * Tcl_Interp * interp,
* int level,
- * CONST char* command,
+ * const char * command,
* Tcl_Command commandInfo,
* int objc,
- * Tcl_Obj *CONST objv[]);
+ * Tcl_Obj *const objv[]);
*
* The 'clientData' and 'interp' arguments to 'proc' will be the same as
* the arguments to Tcl_CreateObjTrace. The 'level' argument gives the
@@ -2090,12 +2095,12 @@ TraceVarProc(
Tcl_Trace
Tcl_CreateObjTrace(
- Tcl_Interp* interp, /* Tcl interpreter */
+ Tcl_Interp *interp, /* Tcl interpreter */
int level, /* Maximum nesting level */
int flags, /* Flags, see above */
- Tcl_CmdObjTraceProc* proc, /* Trace callback */
+ Tcl_CmdObjTraceProc *proc, /* Trace callback */
ClientData clientData, /* Client data for the callback */
- Tcl_CmdObjTraceDeleteProc* delProc)
+ Tcl_CmdObjTraceDeleteProc *delProc)
/* Function to call when trace is deleted */
{
register Trace *tracePtr;
@@ -2186,8 +2191,9 @@ Tcl_CreateTrace(
* command. */
ClientData clientData) /* Arbitrary value word to pass to proc. */
{
- StringTraceData* data;
- data = (StringTraceData *) ckalloc(sizeof(*data));
+ StringTraceData *data = (StringTraceData *)
+ ckalloc(sizeof(StringTraceData));
+
data->clientData = clientData;
data->proc = proc;
return Tcl_CreateObjTrace(interp, level, 0, StringTraceProc,
@@ -2213,16 +2219,16 @@ Tcl_CreateTrace(
static int
StringTraceProc(
ClientData clientData,
- Tcl_Interp* interp,
+ Tcl_Interp *interp,
int level,
- CONST char* command,
+ const char *command,
Tcl_Command commandInfo,
int objc,
- Tcl_Obj *CONST *objv)
+ Tcl_Obj *const *objv)
{
- StringTraceData* data = (StringTraceData*) clientData;
- Command* cmdPtr = (Command*) commandInfo;
- CONST char** argv; /* Args to pass to string trace proc */
+ StringTraceData *data = (StringTraceData *) clientData;
+ Command *cmdPtr = (Command *) commandInfo;
+ const char **argv; /* Args to pass to string trace proc */
int i;
/*
@@ -2230,8 +2236,8 @@ StringTraceProc(
* which uses strings for everything.
*/
- argv = (CONST char **) TclStackAlloc(interp,
- (unsigned) ((objc + 1) * sizeof(CONST char *)));
+ argv = (const char **) TclStackAlloc(interp,
+ (unsigned) ((objc + 1) * sizeof(const char *)));
for (i = 0; i < objc; i++) {
argv[i] = Tcl_GetString(objv[i]);
}
@@ -2245,7 +2251,7 @@ StringTraceProc(
(data->proc)(data->clientData, interp, level, (char *) command,
cmdPtr->proc, cmdPtr->clientData, objc, argv);
- TclStackFree(interp, (void *)argv);
+ TclStackFree(interp, (void *) argv);
return TCL_OK;
}
@@ -2360,7 +2366,7 @@ Tcl_DeleteTrace(
* Delete the trace object.
*/
- Tcl_EventuallyFree((char*)tracePtr, TCL_DYNAMIC);
+ Tcl_EventuallyFree((char *) tracePtr, TCL_DYNAMIC);
}
/*
@@ -2384,7 +2390,7 @@ Tcl_DeleteTrace(
Var *
TclVarTraceExists(
Tcl_Interp *interp, /* The interpreter */
- CONST char *varName) /* The variable name */
+ const char *varName) /* The variable name */
{
Var *varPtr;
Var *arrayPtr;
@@ -2462,7 +2468,9 @@ TclObjCallVarTraces(
int leaveErrMsg, /* If true, and one of the traces indicates an
* error, then leave an error message and
* stack trace information in *iPTr. */
- int index)
+ int index) /* Index into the local variable table of the
+ * variable, or -1. Only used when part1Ptr is
+ * NULL. */
{
char *part1, *part2;
@@ -2471,8 +2479,9 @@ TclObjCallVarTraces(
}
part1 = TclGetString(part1Ptr);
part2 = part2Ptr? TclGetString(part2Ptr) : NULL;
-
- return TclCallVarTraces(iPtr, arrayPtr, varPtr, part1, part2, flags, leaveErrMsg);
+
+ return TclCallVarTraces(iPtr, arrayPtr, varPtr, part1, part2, flags,
+ leaveErrMsg);
}
int
@@ -2482,8 +2491,8 @@ TclCallVarTraces(
* variable, or NULL if the variable isn't an
* element of an array. */
Var *varPtr, /* Variable whose traces are to be invoked. */
- CONST char *part1,
- CONST char *part2, /* Variable's two-part name. */
+ const char *part1,
+ const char *part2, /* Variable's two-part name. */
int flags, /* Flags passed to trace functions: indicates
* what's happening to variable, plus maybe
* TCL_GLOBAL_ONLY or TCL_NAMESPACE_ONLY */
@@ -2494,7 +2503,7 @@ TclCallVarTraces(
register VarTrace *tracePtr;
ActiveVarTrace active;
char *result;
- CONST char *openParen, *p;
+ const char *openParen, *p;
Tcl_DString nameCopy;
int copiedName;
int code = TCL_OK;
@@ -2502,7 +2511,7 @@ TclCallVarTraces(
Tcl_InterpState state = NULL;
Tcl_HashEntry *hPtr;
int traceflags = flags & VAR_ALL_TRACES;
-
+
/*
* If there are already similar trace functions active for the variable,
* don't call them again.
@@ -2568,9 +2577,9 @@ TclCallVarTraces(
active.nextPtr = iPtr->activeVarTracePtr;
iPtr->activeVarTracePtr = &active;
Tcl_Preserve((ClientData) iPtr);
- if (arrayPtr && !TclIsVarTraceActive(arrayPtr) && (arrayPtr->flags & traceflags)) {
- hPtr = Tcl_FindHashEntry(&iPtr->varTraces,
- (char *) arrayPtr);
+ 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) {
@@ -2615,8 +2624,7 @@ TclCallVarTraces(
}
active.varPtr = varPtr;
if (varPtr->flags & traceflags) {
- hPtr = Tcl_FindHashEntry(&iPtr->varTraces,
- (char *) varPtr);
+ hPtr = Tcl_FindHashEntry(&iPtr->varTraces, (char *) varPtr);
for (tracePtr = (VarTrace *) Tcl_GetHashValue(hPtr);
tracePtr != NULL; tracePtr = active.nextTracePtr) {
active.nextTracePtr = tracePtr->nextPtr;
@@ -2637,7 +2645,7 @@ TclCallVarTraces(
/*
* Ignore errors in unset traces.
*/
-
+
DisposeTraceResult(tracePtr->flags, result);
} else {
disposeFlags = tracePtr->flags;
@@ -2659,7 +2667,7 @@ TclCallVarTraces(
done:
if (code == TCL_ERROR) {
if (leaveErrMsg) {
- CONST char *type = "";
+ const char *type = "";
Tcl_Obj *options = Tcl_GetReturnOptions((Tcl_Interp *)iPtr, code);
Tcl_Obj *errorInfoKey, *errorInfo;
@@ -2787,7 +2795,7 @@ DisposeTraceResult(
void
Tcl_UntraceVar(
Tcl_Interp *interp, /* Interpreter containing variable. */
- CONST char *varName, /* Name of variable; may end with "(index)" to
+ const char *varName, /* Name of variable; may end with "(index)" to
* signify an array reference. */
int flags, /* OR-ed collection of bits describing current
* trace, including any of TCL_TRACE_READS,
@@ -2819,8 +2827,8 @@ Tcl_UntraceVar(
void
Tcl_UntraceVar2(
Tcl_Interp *interp, /* Interpreter containing variable. */
- CONST char *part1, /* Name of variable or array. */
- CONST char *part2, /* Name of element within array; NULL means
+ const char *part1, /* Name of variable or array. */
+ const char *part2, /* Name of element within array; NULL means
* trace applies to scalar variable or array
* as-a-whole. */
int flags, /* OR-ed collection of bits describing current
@@ -2904,8 +2912,8 @@ Tcl_UntraceVar2(
tracePtr = tracePtr->nextPtr) {
allFlags |= tracePtr->flags;
}
-
- updateFlags:
+
+ updateFlags:
varPtr->flags &= ~VAR_ALL_TRACES;
if (allFlags & VAR_ALL_TRACES) {
varPtr->flags |= (allFlags & VAR_ALL_TRACES);
@@ -2914,6 +2922,7 @@ Tcl_UntraceVar2(
* If this is the last trace on the variable, and the variable is
* unset and unused, then free up the variable.
*/
+
TclCleanupVar(varPtr, NULL);
}
}
@@ -2944,7 +2953,7 @@ Tcl_UntraceVar2(
ClientData
Tcl_VarTraceInfo(
Tcl_Interp *interp, /* Interpreter containing variable. */
- CONST char *varName, /* Name of variable; may end with "(index)" to
+ const char *varName, /* Name of variable; may end with "(index)" to
* signify an array reference. */
int flags, /* OR-ed combo or TCL_GLOBAL_ONLY,
* TCL_NAMESPACE_ONLY (can be 0). */
@@ -2978,8 +2987,8 @@ Tcl_VarTraceInfo(
ClientData
Tcl_VarTraceInfo2(
Tcl_Interp *interp, /* Interpreter containing variable. */
- CONST char *part1, /* Name of variable or array. */
- CONST char *part2, /* Name of element within array; NULL means
+ const char *part1, /* Name of variable or array. */
+ const char *part2, /* Name of element within array; NULL means
* trace applies to scalar variable or array
* as-a-whole. */
int flags, /* OR-ed combination of TCL_GLOBAL_ONLY,
@@ -3055,7 +3064,7 @@ int
Tcl_TraceVar(
Tcl_Interp *interp, /* Interpreter in which variable is to be
* traced. */
- CONST char *varName, /* Name of variable; may end with "(index)" to
+ const char *varName, /* Name of variable; may end with "(index)" to
* signify an array reference. */
int flags, /* OR-ed collection of bits, including any of
* TCL_TRACE_READS, TCL_TRACE_WRITES,
@@ -3093,8 +3102,8 @@ int
Tcl_TraceVar2(
Tcl_Interp *interp, /* Interpreter in which variable is to be
* traced. */
- CONST char *part1, /* Name of scalar variable or array. */
- CONST char *part2, /* Name of element within array; NULL means
+ const char *part1, /* Name of scalar variable or array. */
+ const char *part2, /* Name of element within array; NULL means
* trace applies to scalar variable or array
* as-a-whole. */
int flags, /* OR-ed collection of bits, including any of
@@ -3146,8 +3155,8 @@ static int
TraceVarEx(
Tcl_Interp *interp, /* Interpreter in which variable is to be
* traced. */
- CONST char *part1, /* Name of scalar variable or array. */
- CONST char *part2, /* Name of element within array; NULL means
+ const char *part1, /* Name of scalar variable or array. */
+ const char *part2, /* Name of element within array; NULL means
* trace applies to scalar variable or array
* as-a-whole. */
register VarTrace *tracePtr)/* Structure containing flags, traceProc and
@@ -3159,9 +3168,8 @@ TraceVarEx(
{
Interp *iPtr = (Interp *) interp;
Var *varPtr, *arrayPtr;
- int flagMask;
+ int flagMask, isNew;
Tcl_HashEntry *hPtr;
- int new;
/*
* We strip 'flags' down to just the parts which are relevant to
@@ -3199,15 +3207,18 @@ TraceVarEx(
#endif
tracePtr->flags = tracePtr->flags & flagMask;
- hPtr = Tcl_CreateHashEntry(&iPtr->varTraces,
- (char *) varPtr, &new);
- if (new) {
+ hPtr = Tcl_CreateHashEntry(&iPtr->varTraces, (char *) varPtr, &isNew);
+ if (isNew) {
tracePtr->nextPtr = NULL;
} else {
tracePtr->nextPtr = (VarTrace *) Tcl_GetHashValue(hPtr);
}
Tcl_SetHashValue(hPtr, (char *) tracePtr);
+ /*
+ * Mark the variable as traced so we know to call them.
+ */
+
varPtr->flags |= (tracePtr->flags & VAR_ALL_TRACES);
return TCL_OK;
diff --git a/generic/tclVar.c b/generic/tclVar.c
index 02c049b..ba33a1c 100644
--- a/generic/tclVar.c
+++ b/generic/tclVar.c
@@ -16,7 +16,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclVar.c,v 1.155 2007/11/11 19:32:17 msofer Exp $
+ * RCS: @(#) $Id: tclVar.c,v 1.156 2007/11/15 09:40:00 dkf Exp $
*/
#include "tclInt.h"
@@ -148,8 +148,9 @@ static void AppendLocals(Tcl_Interp *interp, Tcl_Obj *listPtr,
static void DeleteSearches(Interp *iPtr, Var *arrayVarPtr);
static void DeleteArray(Interp *iPtr, Tcl_Obj *arrayNamePtr,
Var *varPtr, int flags);
-static Tcl_Var ObjFindNamespaceVar(Tcl_Interp *interp, Tcl_Obj *namePtr,
- Tcl_Namespace *contextNsPtr, int flags);
+static Tcl_Var ObjFindNamespaceVar(Tcl_Interp *interp,
+ Tcl_Obj *namePtr, Tcl_Namespace *contextNsPtr,
+ int flags);
static int ObjMakeUpvar(Tcl_Interp *interp,
CallFrame *framePtr, Tcl_Obj *otherP1Ptr,
const char *otherP2, const int otherFlags,
@@ -245,11 +246,11 @@ Tcl_ObjType tclArraySearchType = {
"array search",
NULL, NULL, NULL, SetArraySearchObj
};
-
+
Var *
TclVarHashCreateVar(
TclVarHashTable *tablePtr,
- const char *key,
+ const char *key,
int *newPtr)
{
Tcl_Obj *keyPtr;
@@ -400,7 +401,7 @@ TclLookupVar(
/*
*----------------------------------------------------------------------
*
- * TclObjLookupVar --
+ * TclObjLookupVar, TclObjLookupVarEx --
*
* This function is used by virtually all of the variable code to locate
* a variable given its name(s). The parsing into array/element
@@ -483,14 +484,27 @@ TclObjLookupVar(
Var *
TclObjLookupVarEx(
- Tcl_Interp *interp,
- Tcl_Obj *part1Ptr,
- Tcl_Obj *part2Ptr,
- int flags,
- const char *msg,
- const int createPart1,
- const int createPart2,
- Var **arrayPtrPtr)
+ Tcl_Interp *interp, /* Interpreter to use for lookup. */
+ Tcl_Obj *part1Ptr, /* If part2Ptr isn't NULL, this is the name of
+ * an array. Otherwise, this is a full
+ * variable name that could include a
+ * parenthesized array element. */
+ Tcl_Obj *part2Ptr, /* Name of element within array, or NULL. */
+ int flags, /* Only TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY,
+ * and TCL_LEAVE_ERR_MSG bits matter. */
+ const char *msg, /* Verb to use in error messages, e.g. "read"
+ * or "set". Only needed if TCL_LEAVE_ERR_MSG
+ * is set in flags. */
+ const int createPart1, /* If 1, create hash table entry for part 1 of
+ * name, if it doesn't already exist. If 0,
+ * return error if it doesn't exist. */
+ const int createPart2, /* If 1, create hash table entry for part 2 of
+ * name, if it doesn't already exist. If 0,
+ * return error if it doesn't exist. */
+ Var **arrayPtrPtr) /* If the name refers to an element of an
+ * array, *arrayPtrPtr gets filled in with
+ * address of array variable. Otherwise this
+ * is set to NULL. */
{
Interp *iPtr = (Interp *) interp;
register Var *varPtr; /* Points to the variable's in-frame Var
@@ -522,8 +536,7 @@ TclObjLookupVarEx(
if (typePtr == &localVarNameType) {
int localIndex;
- localVarNameTypeHandling:
-
+ localVarNameTypeHandling:
localIndex = (int) part1Ptr->internalRep.ptrAndLongRep.value;
if (HasLocalVars(varFramePtr)
&& !(flags & (TCL_GLOBAL_ONLY | TCL_NAMESPACE_ONLY))
@@ -532,7 +545,8 @@ TclObjLookupVarEx(
* Use the cached index if the names coincide.
*/
- Tcl_Obj *namePtr = (Tcl_Obj *) part1Ptr->internalRep.ptrAndLongRep.ptr;
+ Tcl_Obj *namePtr = (Tcl_Obj *)
+ part1Ptr->internalRep.ptrAndLongRep.ptr;
Tcl_Obj *checkNamePtr = localName(iPtr->varFramePtr, localIndex);
if ((!namePtr && (checkNamePtr == part1Ptr)) ||
@@ -711,8 +725,10 @@ TclObjLookupVarEx(
part1Ptr->typePtr = &localVarNameType;
if (part1Ptr != localName(iPtr->varFramePtr, index)) {
- part1Ptr->internalRep.ptrAndLongRep.ptr = localName(iPtr->varFramePtr, index);
- Tcl_IncrRefCount((Tcl_Obj *)part1Ptr->internalRep.ptrAndLongRep.ptr);
+ part1Ptr->internalRep.ptrAndLongRep.ptr =
+ localName(iPtr->varFramePtr, index);
+ Tcl_IncrRefCount((Tcl_Obj *)
+ part1Ptr->internalRep.ptrAndLongRep.ptr);
} else {
part1Ptr->internalRep.ptrAndLongRep.ptr = NULL;
}
@@ -919,11 +935,10 @@ TclLookupSimpleVar(
|| !HasLocalVars(varFramePtr)
|| (strstr(varName, "::") != NULL)) {
const char *tail;
- int lookGlobal;
-
- lookGlobal = (flags & TCL_GLOBAL_ONLY)
+ int lookGlobal = (flags & TCL_GLOBAL_ONLY)
|| (cxtNsPtr == iPtr->globalNsPtr)
|| ((*varName == ':') && (*(varName+1) == ':'));
+
if (lookGlobal) {
*indexPtr = -1;
flags = (flags | TCL_GLOBAL_ONLY) & ~TCL_NAMESPACE_ONLY;
@@ -942,7 +957,8 @@ TclLookupSimpleVar(
*/
varPtr = (Var *) ObjFindNamespaceVar(interp, varNamePtr,
- (Tcl_Namespace *) cxtNsPtr, (flags | AVOID_RESOLVERS) & ~TCL_LEAVE_ERR_MSG);
+ (Tcl_Namespace *) cxtNsPtr,
+ (flags | AVOID_RESOLVERS) & ~TCL_LEAVE_ERR_MSG);
if (varPtr == NULL) {
Tcl_Obj *tailPtr;
@@ -952,11 +968,11 @@ TclLookupSimpleVar(
if (varNsPtr == NULL) {
*errMsgPtr = badNamespace;
return NULL;
- }
- if (tail == NULL) {
+ } else if (tail == NULL) {
*errMsgPtr = missingName;
return NULL;
- } else if (tail != varName) {
+ }
+ if (tail != varName) {
tailPtr = Tcl_NewStringObj(tail, -1);
} else {
tailPtr = varNamePtr;
@@ -984,9 +1000,11 @@ TclLookupSimpleVar(
Tcl_Obj **objPtrPtr = &varFramePtr->localCachePtr->varName0;
for (i=0 ; i<localCt ; i++, objPtrPtr++) {
- Tcl_Obj *objPtr = *objPtrPtr;
+ register Tcl_Obj *objPtr = *objPtrPtr;
+
if (objPtr) {
char *localName = TclGetString(objPtr);
+
if ((varName[0] == localName[0])
&& (strcmp(varName, localName) == 0)) {
*indexPtr = i;
@@ -1366,7 +1384,9 @@ TclPtrGetVar(
* in the array part1. */
const int flags, /* OR-ed combination of TCL_GLOBAL_ONLY, and
* TCL_LEAVE_ERR_MSG bits. */
- int index)
+ int index) /* Index into the local variable table of the
+ * variable, or -1. Only used when part1Ptr is
+ * NULL. */
{
Interp *iPtr = (Interp *) interp;
const char *msg;
@@ -2011,7 +2031,9 @@ TclPtrIncrObjVar(
* any of TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY,
* TCL_APPEND_VALUE, TCL_LIST_ELEMENT,
* TCL_LEAVE_ERR_MSG. */
- int index)
+ int index) /* Index into the local variable table of the
+ * variable, or -1. Only used when part1Ptr is
+ * NULL. */
{
register Tcl_Obj *varValuePtr, *newValuePtr = NULL;
int duplicated, code;
@@ -2322,7 +2344,8 @@ UnsetVarStruct(
dummyVar.flags &= ~VAR_TRACE_ACTIVE;
TclObjCallVarTraces(iPtr, arrayPtr, (Var *) &dummyVar,
part1Ptr, part2Ptr,
- (flags & (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY))| TCL_TRACE_UNSETS,
+ (flags & (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY))
+ | TCL_TRACE_UNSETS,
/* leaveErrMsg */ 0, -1);
if (tPtr) {
Tcl_DeleteHashEntry(tPtr);
@@ -4205,11 +4228,11 @@ ParseSearchId(
* optimize this address arithmetic!
*/
- id = (int)(((char*)handleObj->internalRep.twoPtrValue.ptr1) -
- ((char*)NULL));
+ id = (int)(((char *) handleObj->internalRep.twoPtrValue.ptr1) -
+ ((char *) NULL));
string = TclGetString(handleObj);
- offset = (((char*)handleObj->internalRep.twoPtrValue.ptr2) -
- ((char*)NULL));
+ offset = (((char *) handleObj->internalRep.twoPtrValue.ptr2) -
+ ((char *) NULL));
/*
* This test cannot be placed inside the Tcl_Obj machinery, since it is
@@ -4219,9 +4242,7 @@ ParseSearchId(
if (strcmp(string+offset, varName) != 0) {
Tcl_AppendResult(interp, "search identifier \"", string,
"\" isn't for variable \"", varName, "\"", NULL);
- Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ARRAYSEARCH", string,
- NULL);
- return NULL;
+ goto badLookup;
}
/*
@@ -4235,7 +4256,7 @@ ParseSearchId(
if (varPtr->flags & VAR_SEARCH_ACTIVE) {
Tcl_HashEntry *hPtr =
- Tcl_FindHashEntry(&iPtr->varSearches,(char *) varPtr);
+ Tcl_FindHashEntry(&iPtr->varSearches, (char *) varPtr);
for (searchPtr = (ArraySearch *) Tcl_GetHashValue(hPtr);
searchPtr != NULL; searchPtr = searchPtr->nextPtr) {
@@ -4245,6 +4266,7 @@ ParseSearchId(
}
}
Tcl_AppendResult(interp, "couldn't find search \"", string, "\"", NULL);
+ badLookup:
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ARRAYSEARCH", string, NULL);
return NULL;
}
@@ -4610,11 +4632,13 @@ TclObjVarErrMsg(
const char *operation, /* String describing operation that failed,
* e.g. "read", "set", or "unset". */
const char *reason, /* String describing why operation failed. */
- int index)
+ int index) /* Index into the local variable table of the
+ * variable, or -1. Only used when part1Ptr is
+ * NULL. */
{
Tcl_ResetResult(interp);
if (!part1Ptr) {
- part1Ptr = localName(((Interp*)interp)->varFramePtr, index);
+ part1Ptr = localName(((Interp *)interp)->varFramePtr, index);
}
Tcl_AppendResult(interp, "can't ", operation, " \"",
TclGetString(part1Ptr), NULL);
@@ -4685,8 +4709,9 @@ DupLocalVarName(
}
dupPtr->internalRep.ptrAndLongRep.ptr = namePtr;
Tcl_IncrRefCount(namePtr);
-
- dupPtr->internalRep.ptrAndLongRep.value = srcPtr->internalRep.ptrAndLongRep.value;
+
+ dupPtr->internalRep.ptrAndLongRep.value =
+ srcPtr->internalRep.ptrAndLongRep.value;
dupPtr->typePtr = &localVarNameType;
}
@@ -4894,7 +4919,7 @@ ObjFindNamespaceVar(
Tcl_Var var;
Tcl_Obj *simpleNamePtr;
char *name = TclGetString(namePtr);
-
+
/*
* If this namespace has a variable resolver, then give it first crack at
* the variable resolution. It may return a Tcl_Var value, it may signal
@@ -4955,7 +4980,7 @@ ObjFindNamespaceVar(
} else {
simpleNamePtr = namePtr;
}
-
+
for (search = 0; (search < 2) && (varPtr == NULL); search++) {
if ((nsPtr[search] != NULL) && (simpleName != NULL)) {
varPtr = VarHashFindVar(&nsPtr[search]->varTable, simpleNamePtr);
@@ -4964,13 +4989,12 @@ ObjFindNamespaceVar(
if (simpleName != name) {
Tcl_DecrRefCount(simpleNamePtr);
}
- if (varPtr != NULL) {
- return (Tcl_Var) varPtr;
- } else if (flags & TCL_LEAVE_ERR_MSG) {
+ if ((varPtr == NULL) && (flags & TCL_LEAVE_ERR_MSG)) {
Tcl_ResetResult(interp);
Tcl_AppendResult(interp, "unknown variable \"", name, "\"", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARIABLE", name, NULL);
}
- return (Tcl_Var) NULL;
+ return (Tcl_Var) varPtr;
}
/*
@@ -5489,8 +5513,8 @@ CompareVarKeys(
}
/*
- * Don't use Tcl_GetStringFromObj as it would prevent l1 and l2 being
- * in a register.
+ * Don't use Tcl_GetStringFromObj as it would prevent l1 and l2 being in a
+ * register.
*/
p1 = TclGetString(objPtr1);
@@ -5540,7 +5564,7 @@ HashVarKey(
* character's bits hang around in the low-order bits of the hash value
* for ever, plus they spread fairly rapidly up to the high-order bits
* to fill out the hash value. This seems works well both for decimal
- * and *non-decimal strings.
+ * and non-decimal strings.
*/
for (i=0 ; i<length ; i++) {