summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--generic/tclResolve.c14
-rw-r--r--generic/tclTrace.c2619
-rw-r--r--generic/tclVar.c46
3 files changed, 1371 insertions, 1308 deletions
diff --git a/generic/tclResolve.c b/generic/tclResolve.c
index e61e49d..e9c7cc5 100644
--- a/generic/tclResolve.c
+++ b/generic/tclResolve.c
@@ -8,10 +8,10 @@
*
* Copyright (c) 1998 Lucent Technologies, Inc.
*
- * See the file "license.terms" for information on usage and redistribution
- * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclResolve.c,v 1.6 2005/07/15 15:09:31 dkf Exp $
+ * RCS: @(#) $Id: tclResolve.c,v 1.7 2005/07/23 00:04:31 dkf Exp $
*/
#include "tclInt.h"
@@ -403,3 +403,11 @@ Tcl_GetNamespaceResolvers(namespacePtr, resInfoPtr)
}
return 0;
}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclTrace.c b/generic/tclTrace.c
index c3aaa82..9d7ab86 100644
--- a/generic/tclTrace.c
+++ b/generic/tclTrace.c
@@ -1,4 +1,4 @@
-/*
+/*
* tclTrace.c --
*
* This file contains code to handle most trace management.
@@ -8,10 +8,10 @@
* 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.
+ * 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.25 2005/06/21 18:33:05 dgp Exp $
+ * RCS: @(#) $Id: tclTrace.c,v 1.26 2005/07/23 00:04:31 dkf Exp $
*/
#include "tclInt.h"
@@ -21,14 +21,14 @@
*/
typedef struct {
- int flags; /* Operations for which Tcl command is
- * to be invoked. */
+ int flags; /* Operations for which Tcl command is to be
+ * invoked. */
size_t length; /* Number of non-NULL 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 4 bytes. */
+ 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 4
+ * bytes. */
} TraceVarInfo;
/*
@@ -36,57 +36,58 @@ typedef struct {
*/
typedef struct {
- int flags; /* Operations for which Tcl command is
- * to be invoked. */
+ int flags; /* Operations for which Tcl command is to be
+ * invoked. */
size_t length; /* Number of non-NULL chars. in command. */
- Tcl_Trace stepTrace; /* Used for execution traces, when tracing
- * inside the given command */
- 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
- * traces, store the command name which invoked
- * step trace */
- int curFlags; /* Trace flags for the current command */
- int curCode; /* Return code for the current command */
- 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[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 4 bytes. */
+ Tcl_Trace stepTrace; /* Used for execution traces, when tracing
+ * inside the given command */
+ 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
+ * traces, store the command name which
+ * invoked step trace */
+ int curFlags; /* Trace flags for the current command */
+ int curCode; /* Return code for the current command */
+ 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[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 4
+ * bytes. */
} TraceCommandInfo;
-/*
- * Used by command execution traces. Note that we assume in the code
- * that TCL_TRACE_ENTER_DURING_EXEC == 4 * TCL_TRACE_ENTER_EXEC and
- * that TCL_TRACE_LEAVE_DURING_EXEC == 4 * TCL_TRACE_LEAVE_EXEC.
- *
+/*
+ * Used by command execution traces. Note that we assume in the code that
+ * TCL_TRACE_ENTER_DURING_EXEC == 4 * TCL_TRACE_ENTER_EXEC and that
+ * TCL_TRACE_LEAVE_DURING_EXEC == 4 * TCL_TRACE_LEAVE_EXEC.
+ *
* TCL_TRACE_ENTER_DURING_EXEC - Trace each command inside the command
- * currently being traced, before execution.
+ * currently being traced, before execution.
* TCL_TRACE_LEAVE_DURING_EXEC - Trace each command inside the command
- * currently being traced, after execution.
- * TCL_TRACE_ANY_EXEC - OR'd combination of all EXEC flags.
- * TCL_TRACE_EXEC_IN_PROGRESS - The callback procedure on this trace
- * is currently executing. Therefore we
- * don't let further traces execute.
- * TCL_TRACE_EXEC_DIRECT - This execution trace is triggered directly
- * by the command being traced, not because
- * of an internal trace.
- * The flags 'TCL_TRACE_DESTROYED' and 'TCL_INTERP_DESTROYED' may also
- * be used in command execution traces.
+ * currently being traced, after execution.
+ * TCL_TRACE_ANY_EXEC - OR'd combination of all EXEC flags.
+ * TCL_TRACE_EXEC_IN_PROGRESS - The callback function on this trace is
+ * currently executing. Therefore we don't let
+ * further traces execute.
+ * TCL_TRACE_EXEC_DIRECT - This execution trace is triggered directly
+ * by the command being traced, not because of
+ * an internal trace.
+ * The flags 'TCL_TRACE_DESTROYED' and 'TCL_INTERP_DESTROYED' may also be used
+ * in command execution traces.
*/
+
#define TCL_TRACE_ENTER_DURING_EXEC 4
#define TCL_TRACE_LEAVE_DURING_EXEC 8
-#define TCL_TRACE_ANY_EXEC 15
-#define TCL_TRACE_EXEC_IN_PROGRESS 0x10
-#define TCL_TRACE_EXEC_DIRECT 0x20
+#define TCL_TRACE_ANY_EXEC 15
+#define TCL_TRACE_EXEC_IN_PROGRESS 0x10
+#define TCL_TRACE_EXEC_DIRECT 0x20
/*
- * Forward declarations for procedures defined in this file:
+ * Forward declarations for functions defined in this file:
*/
typedef int (Tcl_TraceTypeObjCmd) _ANSI_ARGS_((Tcl_Interp *interp,
@@ -96,13 +97,13 @@ Tcl_TraceTypeObjCmd TclTraceVariableObjCmd;
Tcl_TraceTypeObjCmd TclTraceCommandObjCmd;
Tcl_TraceTypeObjCmd TclTraceExecutionObjCmd;
-/*
- * Each subcommand has a number of 'types' to which it can apply.
- * Currently 'execution', 'command' and 'variable' are the only
- * types supported. These three arrays MUST be kept in sync!
- * In the future we may provide an API to add to the list of
- * supported trace types.
+/*
+ * Each subcommand has a number of 'types' to which it can apply. Currently
+ * 'execution', 'command' and 'variable' are the only types supported. These
+ * three arrays MUST be kept in sync! In the future we may provide an API to
+ * add to the list of supported trace types.
*/
+
static CONST char *traceTypeOptions[] = {
"execution", "command", "variable", (char*) NULL
};
@@ -113,27 +114,26 @@ static Tcl_TraceTypeObjCmd* traceSubCmds[] = {
};
/*
- * Declarations for local procedures to this file:
+ * Declarations for local functions to this file:
*/
-static int CallTraceProcedure _ANSI_ARGS_((Tcl_Interp *interp,
- Trace *tracePtr, Command *cmdPtr,
- CONST char *command, int numChars,
- int objc, Tcl_Obj *CONST objv[]));
+
+static int CallTraceFunction _ANSI_ARGS_((Tcl_Interp *interp,
+ Trace *tracePtr, Command *cmdPtr,
+ CONST char *command, int numChars,
+ int objc, Tcl_Obj *CONST objv[]));
static char * TraceVarProc _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, CONST char *name1,
- CONST char *name2, int flags));
+ Tcl_Interp *interp, CONST char *name1,
+ CONST char *name2, int flags));
static void TraceCommandProc _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, CONST char *oldName,
- CONST char *newName, int flags));
+ CONST char *newName, int flags));
static Tcl_CmdObjTraceProc TraceExecutionProc;
-static int StringTraceProc _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp* interp,
- int level,
- CONST char* command,
- Tcl_Command commandInfo,
- int objc,
- Tcl_Obj *CONST objv[]));
-static void StringTraceDeleteProc _ANSI_ARGS_((ClientData clientData));
+static int StringTraceProc _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp* interp, int level,
+ CONST char* command, Tcl_Command commandInfo,
+ int objc, Tcl_Obj *CONST objv[]));
+static void StringTraceDeleteProc _ANSI_ARGS_((
+ ClientData clientData));
static void DisposeTraceResult _ANSI_ARGS_((int flags,
char *result));
@@ -144,7 +144,7 @@ static void DisposeTraceResult _ANSI_ARGS_((int flags,
typedef struct StringTraceData {
ClientData clientData; /* Client data from Tcl_CreateTrace */
- Tcl_CmdTraceProc* proc; /* Trace procedure from Tcl_CreateTrace */
+ Tcl_CmdTraceProc* proc; /* Trace function from Tcl_CreateTrace */
} StringTraceData;
/*
@@ -152,13 +152,11 @@ typedef struct StringTraceData {
*
* Tcl_TraceObjCmd --
*
- * This procedure is invoked to process the "trace" Tcl command.
- * See the user documentation for details on what it does.
- *
- * Standard syntax as of Tcl 8.4 is
- *
- * trace {add|info|remove} {command|variable} name ops cmd
+ * This function is invoked to process the "trace" Tcl command. See the
+ * user documentation for details on what it does.
*
+ * Standard syntax as of Tcl 8.4 is:
+ * trace {add|info|remove} {command|variable} name ops cmd
*
* Results:
* A standard Tcl result.
@@ -180,15 +178,15 @@ Tcl_TraceObjCmd(dummy, interp, objc, objv)
char *name, *flagOps, *p;
/* Main sub commands to 'trace' */
static CONST char *traceOptions[] = {
- "add", "info", "remove",
+ "add", "info", "remove",
#ifndef TCL_REMOVE_OBSOLETE_TRACES
- "variable", "vdelete", "vinfo",
+ "variable", "vdelete", "vinfo",
#endif
(char *) NULL
};
/* 'OLD' options are pre-Tcl-8.4 style */
enum traceOptions {
- TRACE_ADD, TRACE_INFO, TRACE_REMOVE,
+ TRACE_ADD, TRACE_INFO, TRACE_REMOVE,
#ifndef TCL_REMOVE_OBSOLETE_TRACES
TRACE_OLD_VARIABLE, TRACE_OLD_VDELETE, TRACE_OLD_VINFO
#endif
@@ -204,174 +202,177 @@ Tcl_TraceObjCmd(dummy, interp, objc, objv)
return TCL_ERROR;
}
switch ((enum traceOptions) optionIndex) {
- case TRACE_ADD:
- case TRACE_REMOVE: {
- /*
- * All sub commands of trace add/remove must take at least
- * one more argument. Beyond that we let the subcommand itself
- * control the argument structure.
- */
- int typeIndex;
- if (objc < 3) {
- 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);
+ case TRACE_ADD:
+ case TRACE_REMOVE: {
+ /*
+ * All sub commands of trace add/remove must take at least one more
+ * argument. Beyond that we let the subcommand itself control the
+ * argument structure.
+ */
+
+ int typeIndex;
+
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "type ?arg arg ...?");
+ return TCL_ERROR;
}
- case TRACE_INFO: {
- /*
- * All sub commands of trace info must take exactly two
- * more arguments which name the type of thing being
- * traced and the name of the thing being traced.
+ if (Tcl_GetIndexFromObj(interp, objv[2], traceTypeOptions, "option",
+ 0, &typeIndex) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ return (traceSubCmds[typeIndex])(interp, optionIndex, objc, objv);
+ }
+ case TRACE_INFO: {
+ /*
+ * All sub commands of trace info must take exactly two more arguments
+ * which name the type of thing being traced and the name of the thing
+ * being traced.
+ */
+
+ int typeIndex;
+ if (objc < 3) {
+ /*
+ * Delegate other complaints to the type-specific code which can
+ * give a better error message.
*/
- int typeIndex;
- if (objc < 3) {
- /*
- * Delegate other complaints to the type-specific code
- * which can give a better error message.
- */
- Tcl_WrongNumArgs(interp, 2, objv, "type name");
- 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);
- break;
+
+ Tcl_WrongNumArgs(interp, 2, objv, "type name");
+ 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);
+ break;
+ }
#ifndef TCL_REMOVE_OBSOLETE_TRACES
- case TRACE_OLD_VARIABLE:
- case TRACE_OLD_VDELETE: {
- Tcl_Obj *copyObjv[6];
- Tcl_Obj *opsList;
- int code, numFlags;
-
- if (objc != 5) {
- Tcl_WrongNumArgs(interp, 2, objv, "name ops command");
- return TCL_ERROR;
- }
+ case TRACE_OLD_VARIABLE:
+ case TRACE_OLD_VDELETE: {
+ Tcl_Obj *copyObjv[6];
+ Tcl_Obj *opsList;
+ int code, numFlags;
+
+ if (objc != 5) {
+ Tcl_WrongNumArgs(interp, 2, objv, "name ops command");
+ return TCL_ERROR;
+ }
- opsList = Tcl_NewObj();
- Tcl_IncrRefCount(opsList);
- flagOps = Tcl_GetStringFromObj(objv[3], &numFlags);
- if (numFlags == 0) {
+ opsList = Tcl_NewObj();
+ Tcl_IncrRefCount(opsList);
+ flagOps = Tcl_GetStringFromObj(objv[3], &numFlags);
+ if (numFlags == 0) {
+ Tcl_DecrRefCount(opsList);
+ goto badVarOps;
+ }
+ for (p = flagOps; *p != 0; p++) {
+ if (*p == 'r') {
+ Tcl_ListObjAppendElement(NULL, opsList,
+ Tcl_NewStringObj("read", -1));
+ } else if (*p == 'w') {
+ Tcl_ListObjAppendElement(NULL, opsList,
+ Tcl_NewStringObj("write", -1));
+ } else if (*p == 'u') {
+ Tcl_ListObjAppendElement(NULL, opsList,
+ Tcl_NewStringObj("unset", -1));
+ } else if (*p == 'a') {
+ Tcl_ListObjAppendElement(NULL, opsList,
+ Tcl_NewStringObj("array", -1));
+ } else {
Tcl_DecrRefCount(opsList);
goto badVarOps;
}
- for (p = flagOps; *p != 0; p++) {
- if (*p == 'r') {
- Tcl_ListObjAppendElement(NULL, opsList,
- Tcl_NewStringObj("read", -1));
- } else if (*p == 'w') {
- Tcl_ListObjAppendElement(NULL, opsList,
- Tcl_NewStringObj("write", -1));
- } else if (*p == 'u') {
- Tcl_ListObjAppendElement(NULL, opsList,
- Tcl_NewStringObj("unset", -1));
- } else if (*p == 'a') {
- Tcl_ListObjAppendElement(NULL, opsList,
- Tcl_NewStringObj("array", -1));
- } else {
- Tcl_DecrRefCount(opsList);
- goto badVarOps;
- }
+ }
+ copyObjv[0] = NULL;
+ 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);
+ } else {
+ code = (traceSubCmds[2])(interp,TRACE_REMOVE,objc+1,copyObjv);
+ }
+ Tcl_DecrRefCount(opsList);
+ return code;
+ }
+ case TRACE_OLD_VINFO: {
+ ClientData clientData;
+ char ops[5];
+ Tcl_Obj *resultListPtr, *pairObjPtr, *elemObjPtr;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "name");
+ return TCL_ERROR;
+ }
+ resultListPtr = Tcl_NewObj();
+ clientData = 0;
+ name = Tcl_GetString(objv[2]);
+ while ((clientData = Tcl_VarTraceInfo(interp, name, 0,
+ TraceVarProc, clientData)) != 0) {
+
+ TraceVarInfo *tvarPtr = (TraceVarInfo *) clientData;
+
+ pairObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
+ p = ops;
+ if (tvarPtr->flags & TCL_TRACE_READS) {
+ *p = 'r';
+ p++;
}
- copyObjv[0] = NULL;
- 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);
- } else {
- code = (traceSubCmds[2])(interp,TRACE_REMOVE,objc+1,copyObjv);
+ if (tvarPtr->flags & TCL_TRACE_WRITES) {
+ *p = 'w';
+ p++;
}
- Tcl_DecrRefCount(opsList);
- return code;
- }
- case TRACE_OLD_VINFO: {
- ClientData clientData;
- char ops[5];
- Tcl_Obj *resultListPtr, *pairObjPtr, *elemObjPtr;
-
- if (objc != 3) {
- Tcl_WrongNumArgs(interp, 2, objv, "name");
- return TCL_ERROR;
+ if (tvarPtr->flags & TCL_TRACE_UNSETS) {
+ *p = 'u';
+ p++;
}
- resultListPtr = Tcl_NewObj();
- clientData = 0;
- name = Tcl_GetString(objv[2]);
- while ((clientData = Tcl_VarTraceInfo(interp, name, 0,
- TraceVarProc, clientData)) != 0) {
-
- TraceVarInfo *tvarPtr = (TraceVarInfo *) clientData;
-
- pairObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
- p = ops;
- if (tvarPtr->flags & TCL_TRACE_READS) {
- *p = 'r';
- p++;
- }
- if (tvarPtr->flags & TCL_TRACE_WRITES) {
- *p = 'w';
- p++;
- }
- if (tvarPtr->flags & TCL_TRACE_UNSETS) {
- *p = 'u';
- p++;
- }
- if (tvarPtr->flags & TCL_TRACE_ARRAY) {
- *p = 'a';
- p++;
- }
- *p = '\0';
+ if (tvarPtr->flags & TCL_TRACE_ARRAY) {
+ *p = 'a';
+ p++;
+ }
+ *p = '\0';
- /*
- * Build a pair (2-item list) with the ops string as
- * the first obj element and the tvarPtr->command string
- * as the second obj element. Append the pair (as an
- * element) to the end of the result object list.
- */
+ /*
+ * Build a pair (2-item list) with the ops string as the first obj
+ * element and the tvarPtr->command string as the second obj
+ * element. Append the pair (as an element) to the end of the
+ * result object list.
+ */
- elemObjPtr = Tcl_NewStringObj(ops, -1);
- Tcl_ListObjAppendElement(NULL, pairObjPtr, elemObjPtr);
- elemObjPtr = Tcl_NewStringObj(tvarPtr->command, -1);
- Tcl_ListObjAppendElement(NULL, pairObjPtr, elemObjPtr);
- Tcl_ListObjAppendElement(interp, resultListPtr, pairObjPtr);
- }
- Tcl_SetObjResult(interp, resultListPtr);
- break;
+ elemObjPtr = Tcl_NewStringObj(ops, -1);
+ Tcl_ListObjAppendElement(NULL, pairObjPtr, elemObjPtr);
+ elemObjPtr = Tcl_NewStringObj(tvarPtr->command, -1);
+ Tcl_ListObjAppendElement(NULL, pairObjPtr, elemObjPtr);
+ Tcl_ListObjAppendElement(interp, resultListPtr, pairObjPtr);
}
+ Tcl_SetObjResult(interp, resultListPtr);
+ break;
+ }
#endif /* TCL_REMOVE_OBSOLETE_TRACES */
}
return TCL_OK;
- badVarOps:
+ badVarOps:
Tcl_AppendResult(interp, "bad operations \"", flagOps,
"\": should be one or more of rwua", (char *) NULL);
return TCL_ERROR;
}
-
/*
*----------------------------------------------------------------------
*
* TclTraceExecutionObjCmd --
*
- * Helper function for Tcl_TraceObjCmd; implements the
- * [trace {add|remove|info} execution ...] subcommands.
- * See the user documentation for details on what these do.
+ * Helper function for Tcl_TraceObjCmd; implements the [trace
+ * {add|remove|info} execution ...] subcommands. See the user
+ * documentation for details on what these do.
*
* Results:
* Standard Tcl result.
*
* Side effects:
- * Depends on the operation (add, remove, or info) being performed;
- * may add or remove command traces on a command.
+ * Depends on the operation (add, remove, or info) being performed; may
+ * add or remove command traces on a command.
*
*----------------------------------------------------------------------
*/
@@ -386,233 +387,239 @@ TclTraceExecutionObjCmd(interp, optionIndex, objc, objv)
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", (char *) NULL };
- enum operations { TRACE_EXEC_ENTER, TRACE_EXEC_LEAVE,
- TRACE_EXEC_ENTER_STEP, TRACE_EXEC_LEAVE_STEP };
-
+ enum traceOptions {
+ TRACE_ADD, TRACE_INFO, TRACE_REMOVE
+ };
+ static CONST char *opStrings[] = {
+ "enter", "leave", "enterstep", "leavestep", (char *) NULL
+ };
+ enum operations {
+ TRACE_EXEC_ENTER, TRACE_EXEC_LEAVE,
+ TRACE_EXEC_ENTER_STEP, TRACE_EXEC_LEAVE_STEP
+ };
+
switch ((enum traceOptions) optionIndex) {
- case TRACE_ADD:
- case TRACE_REMOVE: {
- int flags = 0;
- int i, listLen, result;
- Tcl_Obj **elemPtrs;
- if (objc != 6) {
- Tcl_WrongNumArgs(interp, 3, objv, "name opList command");
- return TCL_ERROR;
- }
- /*
- * Make sure the ops argument is a list object; get its length and
- * a pointer to its array of element pointers.
- */
+ case TRACE_ADD:
+ case TRACE_REMOVE: {
+ int flags = 0;
+ int i, listLen, result;
+ Tcl_Obj **elemPtrs;
+
+ if (objc != 6) {
+ Tcl_WrongNumArgs(interp, 3, objv, "name opList command");
+ return TCL_ERROR;
+ }
- result = Tcl_ListObjGetElements(interp, objv[4], &listLen,
- &elemPtrs);
- if (result != TCL_OK) {
- return result;
- }
- if (listLen == 0) {
- Tcl_SetResult(interp, "bad operation list \"\": must be "
- "one or more of enter, leave, enterstep, or leavestep",
- TCL_STATIC);
+ /*
+ * Make sure the ops argument is a list object; get its length and a
+ * pointer to its array of element pointers.
+ */
+
+ result = Tcl_ListObjGetElements(interp, objv[4], &listLen, &elemPtrs);
+ if (result != TCL_OK) {
+ return result;
+ }
+ if (listLen == 0) {
+ 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++) {
+ if (Tcl_GetIndexFromObj(interp, elemPtrs[i], opStrings,
+ "operation", TCL_EXACT, &index) != TCL_OK) {
return TCL_ERROR;
}
- for (i = 0; i < listLen; i++) {
- if (Tcl_GetIndexFromObj(interp, elemPtrs[i], opStrings,
- "operation", TCL_EXACT, &index) != TCL_OK) {
- return TCL_ERROR;
- }
- switch ((enum operations) index) {
- case TRACE_EXEC_ENTER:
- flags |= TCL_TRACE_ENTER_EXEC;
- break;
- case TRACE_EXEC_LEAVE:
- flags |= TCL_TRACE_LEAVE_EXEC;
- break;
- case TRACE_EXEC_ENTER_STEP:
- flags |= TCL_TRACE_ENTER_DURING_EXEC;
- break;
- case TRACE_EXEC_LEAVE_STEP:
- flags |= TCL_TRACE_LEAVE_DURING_EXEC;
- break;
- }
- }
- 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;
- tcmdPtr->startCmd = NULL;
- tcmdPtr->length = length;
- tcmdPtr->refCount = 1;
- flags |= TCL_TRACE_DELETE;
- if (flags & (TCL_TRACE_ENTER_DURING_EXEC |
- TCL_TRACE_LEAVE_DURING_EXEC)) {
- flags |= (TCL_TRACE_ENTER_EXEC | TCL_TRACE_LEAVE_EXEC);
- }
- strcpy(tcmdPtr->command, command);
- name = Tcl_GetString(objv[3]);
- if (Tcl_TraceCommand(interp, name, flags, TraceCommandProc,
- (ClientData) tcmdPtr) != TCL_OK) {
- ckfree((char *) tcmdPtr);
- return TCL_ERROR;
- }
- } else {
- /*
- * Search through all of our traces on this command to
- * see if there's one with the given command. If so, then
- * delete the first one that matches.
- */
-
- TraceCommandInfo *tcmdPtr;
- ClientData clientData = NULL;
- name = Tcl_GetString(objv[3]);
-
- /* First ensure the name given is valid */
- if (Tcl_FindCommand(interp, name, NULL,
- TCL_LEAVE_ERR_MSG) == NULL) {
- return TCL_ERROR;
- }
-
- while ((clientData = Tcl_CommandTraceInfo(interp, name, 0,
- TraceCommandProc, clientData)) != NULL) {
- tcmdPtr = (TraceCommandInfo *) clientData;
- /*
- * In checking the 'flags' field we must remove any
- * extraneous flags which may have been temporarily
- * added by various pieces of the trace mechanism.
- */
- if ((tcmdPtr->length == length)
- && ((tcmdPtr->flags & (TCL_TRACE_ANY_EXEC |
- TCL_TRACE_RENAME |
- TCL_TRACE_DELETE)) == flags)
- && (strncmp(command, tcmdPtr->command,
- (size_t) length) == 0)) {
- flags |= TCL_TRACE_DELETE;
- if (flags & (TCL_TRACE_ENTER_DURING_EXEC |
- TCL_TRACE_LEAVE_DURING_EXEC)) {
- flags |= (TCL_TRACE_ENTER_EXEC |
- TCL_TRACE_LEAVE_EXEC);
- }
- Tcl_UntraceCommand(interp, name,
- flags, TraceCommandProc, clientData);
- if (tcmdPtr->stepTrace != NULL) {
- /*
- * We need to remove the interpreter-wide trace
- * which we created to allow 'step' traces.
- */
- Tcl_DeleteTrace(interp, tcmdPtr->stepTrace);
- tcmdPtr->stepTrace = NULL;
- if (tcmdPtr->startCmd != NULL) {
- ckfree((char *)tcmdPtr->startCmd);
- }
- }
- if (tcmdPtr->flags & TCL_TRACE_EXEC_IN_PROGRESS) {
- /* Postpone deletion */
- tcmdPtr->flags = 0;
- }
- if ((--tcmdPtr->refCount) <= 0) {
- ckfree((char*)tcmdPtr);
- }
- break;
- }
- }
+ switch ((enum operations) index) {
+ case TRACE_EXEC_ENTER:
+ flags |= TCL_TRACE_ENTER_EXEC;
+ break;
+ case TRACE_EXEC_LEAVE:
+ flags |= TCL_TRACE_LEAVE_EXEC;
+ break;
+ case TRACE_EXEC_ENTER_STEP:
+ flags |= TCL_TRACE_ENTER_DURING_EXEC;
+ break;
+ case TRACE_EXEC_LEAVE_STEP:
+ flags |= TCL_TRACE_LEAVE_DURING_EXEC;
+ break;
}
- break;
}
- case TRACE_INFO: {
- ClientData clientData;
- Tcl_Obj *resultListPtr, *eachTraceObjPtr, *elemObjPtr;
- if (objc != 4) {
- Tcl_WrongNumArgs(interp, 3, objv, "name");
+ 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;
+ tcmdPtr->startCmd = NULL;
+ tcmdPtr->length = length;
+ tcmdPtr->refCount = 1;
+ flags |= TCL_TRACE_DELETE;
+ if (flags & (TCL_TRACE_ENTER_DURING_EXEC |
+ TCL_TRACE_LEAVE_DURING_EXEC)) {
+ flags |= (TCL_TRACE_ENTER_EXEC | TCL_TRACE_LEAVE_EXEC);
+ }
+ strcpy(tcmdPtr->command, command);
+ name = Tcl_GetString(objv[3]);
+ if (Tcl_TraceCommand(interp, name, flags, TraceCommandProc,
+ (ClientData) tcmdPtr) != TCL_OK) {
+ ckfree((char *) tcmdPtr);
return TCL_ERROR;
}
+ } else {
+ /*
+ * Search through all of our traces on this command to see if
+ * there's one with the given command. If so, then delete the
+ * first one that matches.
+ */
- clientData = NULL;
+ TraceCommandInfo *tcmdPtr;
+ ClientData clientData = NULL;
name = Tcl_GetString(objv[3]);
-
+
/* First ensure the name given is valid */
- if (Tcl_FindCommand(interp, name, NULL,
- TCL_LEAVE_ERR_MSG) == NULL) {
+ if (Tcl_FindCommand(interp, name, NULL,
+ TCL_LEAVE_ERR_MSG) == NULL) {
return TCL_ERROR;
}
-
- resultListPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
+
while ((clientData = Tcl_CommandTraceInfo(interp, name, 0,
TraceCommandProc, clientData)) != NULL) {
- int numOps = 0;
-
- TraceCommandInfo *tcmdPtr = (TraceCommandInfo *) clientData;
+ tcmdPtr = (TraceCommandInfo *) clientData;
/*
- * Build a list with the ops list as the first obj
- * element and the tcmdPtr->command string as the
- * second obj element. Append this list (as an
- * element) to the end of the result object list.
+ * In checking the 'flags' field we must remove any extraneous
+ * flags which may have been temporarily added by various
+ * pieces of the trace mechanism.
*/
- elemObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
- Tcl_IncrRefCount(elemObjPtr);
- if (tcmdPtr->flags & TCL_TRACE_ENTER_EXEC) {
- Tcl_ListObjAppendElement(NULL, elemObjPtr,
- Tcl_NewStringObj("enter",5));
- }
- if (tcmdPtr->flags & TCL_TRACE_LEAVE_EXEC) {
- Tcl_ListObjAppendElement(NULL, elemObjPtr,
- Tcl_NewStringObj("leave",5));
- }
- if (tcmdPtr->flags & TCL_TRACE_ENTER_DURING_EXEC) {
- Tcl_ListObjAppendElement(NULL, elemObjPtr,
- Tcl_NewStringObj("enterstep",9));
- }
- if (tcmdPtr->flags & TCL_TRACE_LEAVE_DURING_EXEC) {
- Tcl_ListObjAppendElement(NULL, elemObjPtr,
- Tcl_NewStringObj("leavestep",9));
- }
- Tcl_ListObjLength(NULL, elemObjPtr, &numOps);
- if (0 == numOps) {
- Tcl_DecrRefCount(elemObjPtr);
- continue;
+ if ((tcmdPtr->length == length)
+ && ((tcmdPtr->flags & (TCL_TRACE_ANY_EXEC |
+ TCL_TRACE_RENAME | TCL_TRACE_DELETE)) == flags)
+ && (strncmp(command, tcmdPtr->command,
+ (size_t) length) == 0)) {
+ flags |= TCL_TRACE_DELETE;
+ if (flags & (TCL_TRACE_ENTER_DURING_EXEC |
+ TCL_TRACE_LEAVE_DURING_EXEC)) {
+ flags |= (TCL_TRACE_ENTER_EXEC | TCL_TRACE_LEAVE_EXEC);
+ }
+ Tcl_UntraceCommand(interp, name, flags,
+ TraceCommandProc, clientData);
+ if (tcmdPtr->stepTrace != NULL) {
+ /*
+ * We need to remove the interpreter-wide trace which
+ * we created to allow 'step' traces.
+ */
+
+ Tcl_DeleteTrace(interp, tcmdPtr->stepTrace);
+ tcmdPtr->stepTrace = NULL;
+ if (tcmdPtr->startCmd != NULL) {
+ ckfree((char *)tcmdPtr->startCmd);
+ }
+ }
+ if (tcmdPtr->flags & TCL_TRACE_EXEC_IN_PROGRESS) {
+ /* Postpone deletion */
+ tcmdPtr->flags = 0;
+ }
+ if ((--tcmdPtr->refCount) <= 0) {
+ ckfree((char*)tcmdPtr);
+ }
+ break;
}
- eachTraceObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
- Tcl_ListObjAppendElement(NULL, eachTraceObjPtr, elemObjPtr);
+ }
+ }
+ break;
+ }
+ case TRACE_INFO: {
+ 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 */
+ if (Tcl_FindCommand(interp, name, NULL, TCL_LEAVE_ERR_MSG) == NULL) {
+ return TCL_ERROR;
+ }
+
+ resultListPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
+ while ((clientData = Tcl_CommandTraceInfo(interp, name, 0,
+ TraceCommandProc, clientData)) != NULL) {
+ int numOps = 0;
+
+ TraceCommandInfo *tcmdPtr = (TraceCommandInfo *) clientData;
+
+ /*
+ * Build a list with the ops list as the first obj element and the
+ * tcmdPtr->command string as the second obj element. Append this
+ * list (as an element) to the end of the result object list.
+ */
+
+ elemObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
+ Tcl_IncrRefCount(elemObjPtr);
+ if (tcmdPtr->flags & TCL_TRACE_ENTER_EXEC) {
+ Tcl_ListObjAppendElement(NULL, elemObjPtr,
+ Tcl_NewStringObj("enter",5));
+ }
+ if (tcmdPtr->flags & TCL_TRACE_LEAVE_EXEC) {
+ Tcl_ListObjAppendElement(NULL, elemObjPtr,
+ Tcl_NewStringObj("leave",5));
+ }
+ if (tcmdPtr->flags & TCL_TRACE_ENTER_DURING_EXEC) {
+ Tcl_ListObjAppendElement(NULL, elemObjPtr,
+ Tcl_NewStringObj("enterstep",9));
+ }
+ if (tcmdPtr->flags & TCL_TRACE_LEAVE_DURING_EXEC) {
+ Tcl_ListObjAppendElement(NULL, elemObjPtr,
+ Tcl_NewStringObj("leavestep",9));
+ }
+ Tcl_ListObjLength(NULL, elemObjPtr, &numOps);
+ if (0 == numOps) {
Tcl_DecrRefCount(elemObjPtr);
- elemObjPtr = NULL;
-
- Tcl_ListObjAppendElement(NULL, eachTraceObjPtr,
- Tcl_NewStringObj(tcmdPtr->command, -1));
- Tcl_ListObjAppendElement(interp, resultListPtr,
- eachTraceObjPtr);
- }
- Tcl_SetObjResult(interp, resultListPtr);
- break;
+ continue;
+ }
+ eachTraceObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
+ Tcl_ListObjAppendElement(NULL, eachTraceObjPtr, elemObjPtr);
+ Tcl_DecrRefCount(elemObjPtr);
+ elemObjPtr = NULL;
+
+ Tcl_ListObjAppendElement(NULL, eachTraceObjPtr,
+ Tcl_NewStringObj(tcmdPtr->command, -1));
+ Tcl_ListObjAppendElement(interp, resultListPtr,
+ eachTraceObjPtr);
}
+ Tcl_SetObjResult(interp, resultListPtr);
+ break;
+ }
}
return TCL_OK;
}
-
/*
*----------------------------------------------------------------------
*
* TclTraceCommandObjCmd --
*
- * Helper function for Tcl_TraceObjCmd; implements the
- * [trace {add|info|remove} command ...] subcommands.
- * See the user documentation for details on what these do.
+ * Helper function for Tcl_TraceObjCmd; implements the [trace
+ * {add|info|remove} command ...] subcommands. See the user documentation
+ * for details on what these do.
*
* Results:
* Standard Tcl result.
*
* Side effects:
- * Depends on the operation (add, remove, or info) being performed;
- * may add or remove command traces on a command.
+ * Depends on the operation (add, remove, or info) being performed; may
+ * add or remove command traces on a command.
*
*----------------------------------------------------------------------
*/
@@ -630,182 +637,182 @@ TclTraceCommandObjCmd(interp, optionIndex, objc, objv)
enum traceOptions { TRACE_ADD, TRACE_INFO, TRACE_REMOVE };
static CONST char *opStrings[] = { "delete", "rename", (char *) NULL };
enum operations { TRACE_CMD_DELETE, TRACE_CMD_RENAME };
-
+
switch ((enum traceOptions) optionIndex) {
- case TRACE_ADD:
- case TRACE_REMOVE: {
- int flags = 0;
- int i, listLen, result;
- Tcl_Obj **elemPtrs;
- if (objc != 6) {
- Tcl_WrongNumArgs(interp, 3, objv, "name opList command");
- return TCL_ERROR;
- }
- /*
- * Make sure the ops argument is a list object; get its length and
- * a pointer to its array of element pointers.
- */
+ case TRACE_ADD:
+ case TRACE_REMOVE: {
+ int flags = 0;
+ int i, listLen, result;
+ Tcl_Obj **elemPtrs;
+
+ if (objc != 6) {
+ Tcl_WrongNumArgs(interp, 3, objv, "name opList command");
+ return TCL_ERROR;
+ }
- result = Tcl_ListObjGetElements(interp, objv[4], &listLen,
- &elemPtrs);
- if (result != TCL_OK) {
- return result;
- }
- if (listLen == 0) {
- Tcl_SetResult(interp, "bad operation list \"\": must be "
- "one or more of delete or rename", TCL_STATIC);
+ /*
+ * Make sure the ops argument is a list object; get its length and a
+ * pointer to its array of element pointers.
+ */
+
+ result = Tcl_ListObjGetElements(interp, objv[4], &listLen, &elemPtrs);
+ if (result != TCL_OK) {
+ return result;
+ }
+ if (listLen == 0) {
+ Tcl_SetResult(interp, "bad operation list \"\": must be "
+ "one or more of delete or rename", TCL_STATIC);
+ return TCL_ERROR;
+ }
+
+ for (i = 0; i < listLen; i++) {
+ if (Tcl_GetIndexFromObj(interp, elemPtrs[i], opStrings,
+ "operation", TCL_EXACT, &index) != TCL_OK) {
return TCL_ERROR;
}
- for (i = 0; i < listLen; i++) {
- if (Tcl_GetIndexFromObj(interp, elemPtrs[i], opStrings,
- "operation", TCL_EXACT, &index) != TCL_OK) {
- return TCL_ERROR;
- }
- switch ((enum operations) index) {
- case TRACE_CMD_RENAME:
- flags |= TCL_TRACE_RENAME;
- break;
- case TRACE_CMD_DELETE:
- flags |= TCL_TRACE_DELETE;
- break;
- }
- }
- 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;
- tcmdPtr->startCmd = NULL;
- tcmdPtr->length = length;
- tcmdPtr->refCount = 1;
+ switch ((enum operations) index) {
+ case TRACE_CMD_RENAME:
+ flags |= TCL_TRACE_RENAME;
+ break;
+ case TRACE_CMD_DELETE:
flags |= TCL_TRACE_DELETE;
- strcpy(tcmdPtr->command, command);
- name = Tcl_GetString(objv[3]);
- if (Tcl_TraceCommand(interp, name, flags, TraceCommandProc,
- (ClientData) tcmdPtr) != TCL_OK) {
- ckfree((char *) tcmdPtr);
- return TCL_ERROR;
- }
- } else {
- /*
- * Search through all of our traces on this command to
- * see if there's one with the given command. If so, then
- * delete the first one that matches.
- */
-
- TraceCommandInfo *tcmdPtr;
- ClientData clientData = NULL;
- name = Tcl_GetString(objv[3]);
-
- /* First ensure the name given is valid */
- if (Tcl_FindCommand(interp, name, NULL,
- TCL_LEAVE_ERR_MSG) == NULL) {
- return TCL_ERROR;
- }
-
- 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((char *) tcmdPtr);
- }
- break;
- }
- }
+ break;
}
- break;
}
- case TRACE_INFO: {
- ClientData clientData;
- Tcl_Obj *resultListPtr, *eachTraceObjPtr, *elemObjPtr;
- if (objc != 4) {
- Tcl_WrongNumArgs(interp, 3, objv, "name");
+
+ 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;
+ tcmdPtr->startCmd = NULL;
+ tcmdPtr->length = length;
+ tcmdPtr->refCount = 1;
+ flags |= TCL_TRACE_DELETE;
+ strcpy(tcmdPtr->command, command);
+ name = Tcl_GetString(objv[3]);
+ if (Tcl_TraceCommand(interp, name, flags, TraceCommandProc,
+ (ClientData) tcmdPtr) != TCL_OK) {
+ ckfree((char *) tcmdPtr);
return TCL_ERROR;
}
+ } else {
+ /*
+ * Search through all of our traces on this command to see if
+ * there's one with the given command. If so, then delete the
+ * first one that matches.
+ */
- clientData = NULL;
+ TraceCommandInfo *tcmdPtr;
+ ClientData clientData = NULL;
name = Tcl_GetString(objv[3]);
-
+
/* First ensure the name given is valid */
- if (Tcl_FindCommand(interp, name, NULL,
- TCL_LEAVE_ERR_MSG) == NULL) {
+ if (Tcl_FindCommand(interp, name, NULL,
+ TCL_LEAVE_ERR_MSG) == NULL) {
return TCL_ERROR;
}
-
- resultListPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
+
while ((clientData = Tcl_CommandTraceInfo(interp, name, 0,
TraceCommandProc, clientData)) != NULL) {
- int numOps = 0;
+ 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((char *) tcmdPtr);
+ }
+ break;
+ }
+ }
+ }
+ break;
+ }
+ case TRACE_INFO: {
+ ClientData clientData;
+ Tcl_Obj *resultListPtr, *eachTraceObjPtr, *elemObjPtr;
- TraceCommandInfo *tcmdPtr = (TraceCommandInfo *) clientData;
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 3, objv, "name");
+ return TCL_ERROR;
+ }
- /*
- * Build a list with the ops list as
- * the first obj element and the tcmdPtr->command string
- * as the second obj element. Append this list (as an
- * element) to the end of the result object list.
- */
+ clientData = NULL;
+ name = Tcl_GetString(objv[3]);
- elemObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
- Tcl_IncrRefCount(elemObjPtr);
- if (tcmdPtr->flags & TCL_TRACE_RENAME) {
- Tcl_ListObjAppendElement(NULL, elemObjPtr,
- Tcl_NewStringObj("rename",6));
- }
- if (tcmdPtr->flags & TCL_TRACE_DELETE) {
- Tcl_ListObjAppendElement(NULL, elemObjPtr,
- Tcl_NewStringObj("delete",6));
- }
- Tcl_ListObjLength(NULL, elemObjPtr, &numOps);
- if (0 == numOps) {
- Tcl_DecrRefCount(elemObjPtr);
- continue;
- }
- eachTraceObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
- Tcl_ListObjAppendElement(NULL, eachTraceObjPtr, elemObjPtr);
- Tcl_DecrRefCount(elemObjPtr);
+ /* First ensure the name given is valid */
+ if (Tcl_FindCommand(interp, name, NULL, TCL_LEAVE_ERR_MSG) == NULL) {
+ return TCL_ERROR;
+ }
+
+ resultListPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
+ while ((clientData = Tcl_CommandTraceInfo(interp, name, 0,
+ TraceCommandProc, clientData)) != NULL) {
+ int numOps = 0;
+
+ TraceCommandInfo *tcmdPtr = (TraceCommandInfo *) clientData;
- elemObjPtr = Tcl_NewStringObj(tcmdPtr->command, -1);
- Tcl_ListObjAppendElement(NULL, eachTraceObjPtr, elemObjPtr);
- Tcl_ListObjAppendElement(interp, resultListPtr,
- eachTraceObjPtr);
+ /*
+ * Build a list with the ops list as the first obj element and the
+ * tcmdPtr->command string as the second obj element. Append this
+ * list (as an element) to the end of the result object list.
+ */
+
+ elemObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
+ Tcl_IncrRefCount(elemObjPtr);
+ if (tcmdPtr->flags & TCL_TRACE_RENAME) {
+ Tcl_ListObjAppendElement(NULL, elemObjPtr,
+ Tcl_NewStringObj("rename",6));
}
- Tcl_SetObjResult(interp, resultListPtr);
- break;
+ if (tcmdPtr->flags & TCL_TRACE_DELETE) {
+ Tcl_ListObjAppendElement(NULL, elemObjPtr,
+ Tcl_NewStringObj("delete",6));
+ }
+ Tcl_ListObjLength(NULL, elemObjPtr, &numOps);
+ if (0 == numOps) {
+ Tcl_DecrRefCount(elemObjPtr);
+ continue;
+ }
+ eachTraceObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
+ Tcl_ListObjAppendElement(NULL, eachTraceObjPtr, elemObjPtr);
+ Tcl_DecrRefCount(elemObjPtr);
+
+ elemObjPtr = Tcl_NewStringObj(tcmdPtr->command, -1);
+ Tcl_ListObjAppendElement(NULL, eachTraceObjPtr, elemObjPtr);
+ Tcl_ListObjAppendElement(interp, resultListPtr, eachTraceObjPtr);
}
+ Tcl_SetObjResult(interp, resultListPtr);
+ break;
+ }
}
return TCL_OK;
}
-
/*
*----------------------------------------------------------------------
*
* TclTraceVariableObjCmd --
*
- * Helper function for Tcl_TraceObjCmd; implements the
- * [trace {add|info|remove} variable ...] subcommands.
- * See the user documentation for details on what these do.
+ * Helper function for Tcl_TraceObjCmd; implements the [trace
+ * {add|info|remove} variable ...] subcommands. See the user
+ * documentation for details on what these do.
*
* Results:
* Standard Tcl result.
*
* Side effects:
- * Depends on the operation (add, remove, or info) being performed;
- * may add or remove variable traces on a variable.
+ * Depends on the operation (add, remove, or info) being performed; may
+ * add or remove variable traces on a variable.
*
*----------------------------------------------------------------------
*/
@@ -821,180 +828,179 @@ TclTraceVariableObjCmd(interp, optionIndex, objc, objv)
char *name, *command;
size_t length;
enum traceOptions { TRACE_ADD, TRACE_INFO, TRACE_REMOVE };
- static CONST char *opStrings[] = { "array", "read", "unset", "write",
- (char *) NULL };
- enum operations { TRACE_VAR_ARRAY, TRACE_VAR_READ, TRACE_VAR_UNSET,
- TRACE_VAR_WRITE };
-
+ static CONST char *opStrings[] = {
+ "array", "read", "unset", "write", (char *) NULL
+ };
+ enum operations {
+ TRACE_VAR_ARRAY, TRACE_VAR_READ, TRACE_VAR_UNSET, TRACE_VAR_WRITE
+ };
+
switch ((enum traceOptions) optionIndex) {
- case TRACE_ADD:
- case TRACE_REMOVE: {
- int flags = 0;
- int i, listLen, result;
- Tcl_Obj **elemPtrs;
- if (objc != 6) {
- Tcl_WrongNumArgs(interp, 3, objv, "name opList command");
- return TCL_ERROR;
- }
- /*
- * Make sure the ops argument is a list object; get its length and
- * a pointer to its array of element pointers.
- */
+ case TRACE_ADD:
+ case TRACE_REMOVE: {
+ int flags = 0;
+ int i, listLen, result;
+ Tcl_Obj **elemPtrs;
+
+ if (objc != 6) {
+ Tcl_WrongNumArgs(interp, 3, objv, "name opList command");
+ return TCL_ERROR;
+ }
- result = Tcl_ListObjGetElements(interp, objv[4], &listLen,
- &elemPtrs);
- if (result != TCL_OK) {
- return result;
- }
- if (listLen == 0) {
- Tcl_SetResult(interp, "bad operation list \"\": must be "
- "one or more of array, read, unset, or write",
- TCL_STATIC);
+ /*
+ * Make sure the ops argument is a list object; get its length and a
+ * pointer to its array of element pointers.
+ */
+
+ result = Tcl_ListObjGetElements(interp, objv[4], &listLen, &elemPtrs);
+ if (result != TCL_OK) {
+ return result;
+ }
+ if (listLen == 0) {
+ 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++) {
+ if (Tcl_GetIndexFromObj(interp, elemPtrs[i], opStrings,
+ "operation", TCL_EXACT, &index) != TCL_OK) {
return TCL_ERROR;
}
- for (i = 0; i < listLen ; i++) {
- if (Tcl_GetIndexFromObj(interp, elemPtrs[i], opStrings,
- "operation", TCL_EXACT, &index) != TCL_OK) {
- return TCL_ERROR;
- }
- switch ((enum operations) index) {
- case TRACE_VAR_ARRAY:
- flags |= TCL_TRACE_ARRAY;
- break;
- case TRACE_VAR_READ:
- flags |= TCL_TRACE_READS;
- break;
- case TRACE_VAR_UNSET:
- flags |= TCL_TRACE_UNSETS;
- break;
- case TRACE_VAR_WRITE:
- flags |= TCL_TRACE_WRITES;
- break;
- }
- }
- command = Tcl_GetStringFromObj(objv[5], &commandLength);
- length = (size_t) commandLength;
- if ((enum traceOptions) optionIndex == TRACE_ADD) {
- TraceVarInfo *tvarPtr;
- tvarPtr = (TraceVarInfo *) ckalloc((unsigned)
- (sizeof(TraceVarInfo) - sizeof(tvarPtr->command)
- + length + 1));
- tvarPtr->flags = flags;
- if (objv[0] == NULL) {
- tvarPtr->flags |= TCL_TRACE_OLD_STYLE;
- }
- tvarPtr->length = length;
- flags |= TCL_TRACE_UNSETS | TCL_TRACE_RESULT_OBJECT;
- strcpy(tvarPtr->command, command);
- name = Tcl_GetString(objv[3]);
- if (Tcl_TraceVar(interp, name, flags, TraceVarProc,
- (ClientData) tvarPtr) != TCL_OK) {
- ckfree((char *) tvarPtr);
- return TCL_ERROR;
- }
- } else {
- /*
- * Search through all of our traces on this variable to
- * see if there's one with the given command. If so, then
- * delete the first one that matches.
- */
-
- TraceVarInfo *tvarPtr;
- ClientData clientData = 0;
- name = Tcl_GetString(objv[3]);
- 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,
- (size_t) length) == 0)) {
- Tcl_UntraceVar2(interp, name, NULL,
- flags | TCL_TRACE_UNSETS | TCL_TRACE_RESULT_OBJECT,
- TraceVarProc, clientData);
- Tcl_EventuallyFree((ClientData) tvarPtr, TCL_DYNAMIC);
- break;
- }
- }
+ switch ((enum operations) index) {
+ case TRACE_VAR_ARRAY:
+ flags |= TCL_TRACE_ARRAY;
+ break;
+ case TRACE_VAR_READ:
+ flags |= TCL_TRACE_READS;
+ break;
+ case TRACE_VAR_UNSET:
+ flags |= TCL_TRACE_UNSETS;
+ break;
+ case TRACE_VAR_WRITE:
+ flags |= TCL_TRACE_WRITES;
+ break;
}
- break;
}
- case TRACE_INFO: {
- ClientData clientData;
- Tcl_Obj *resultListPtr, *eachTraceObjPtr, *elemObjPtr;
- if (objc != 4) {
- Tcl_WrongNumArgs(interp, 3, objv, "name");
+ command = Tcl_GetStringFromObj(objv[5], &commandLength);
+ length = (size_t) commandLength;
+ if ((enum traceOptions) optionIndex == TRACE_ADD) {
+ TraceVarInfo *tvarPtr;
+ tvarPtr = (TraceVarInfo *) ckalloc((unsigned)
+ (sizeof(TraceVarInfo) - sizeof(tvarPtr->command)
+ + length + 1));
+ tvarPtr->flags = flags;
+ if (objv[0] == NULL) {
+ tvarPtr->flags |= TCL_TRACE_OLD_STYLE;
+ }
+ tvarPtr->length = length;
+ flags |= TCL_TRACE_UNSETS | TCL_TRACE_RESULT_OBJECT;
+ strcpy(tvarPtr->command, command);
+ name = Tcl_GetString(objv[3]);
+ if (Tcl_TraceVar(interp, name, flags, TraceVarProc,
+ (ClientData) tvarPtr) != TCL_OK) {
+ ckfree((char *) tvarPtr);
return TCL_ERROR;
}
+ } else {
+ /*
+ * Search through all of our traces on this variable to see if
+ * there's one with the given command. If so, then delete the
+ * first one that matches.
+ */
- resultListPtr = Tcl_NewObj();
- clientData = 0;
+ TraceVarInfo *tvarPtr;
+ ClientData clientData = 0;
name = Tcl_GetString(objv[3]);
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,
+ (size_t) length) == 0)) {
+ Tcl_UntraceVar2(interp, name, NULL,
+ flags | TCL_TRACE_UNSETS | TCL_TRACE_RESULT_OBJECT,
+ TraceVarProc, clientData);
+ Tcl_EventuallyFree((ClientData) tvarPtr, TCL_DYNAMIC);
+ break;
+ }
+ }
+ }
+ break;
+ }
+ case TRACE_INFO: {
+ ClientData clientData;
+ Tcl_Obj *resultListPtr, *eachTraceObjPtr, *elemObjPtr;
- TraceVarInfo *tvarPtr = (TraceVarInfo *) clientData;
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 3, objv, "name");
+ return TCL_ERROR;
+ }
- /*
- * Build a list with the ops list as
- * the first obj element and the tcmdPtr->command string
- * as the second obj element. Append this list (as an
- * element) to the end of the result object list.
- */
+ resultListPtr = Tcl_NewObj();
+ clientData = 0;
+ name = Tcl_GetString(objv[3]);
+ while ((clientData = Tcl_VarTraceInfo(interp, name, 0, TraceVarProc,
+ clientData)) != 0) {
- elemObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
- if (tvarPtr->flags & TCL_TRACE_ARRAY) {
- Tcl_ListObjAppendElement(NULL, elemObjPtr,
- Tcl_NewStringObj("array", 5));
- }
- if (tvarPtr->flags & TCL_TRACE_READS) {
- Tcl_ListObjAppendElement(NULL, elemObjPtr,
- Tcl_NewStringObj("read", 4));
- }
- if (tvarPtr->flags & TCL_TRACE_WRITES) {
- Tcl_ListObjAppendElement(NULL, elemObjPtr,
- Tcl_NewStringObj("write", 5));
- }
- if (tvarPtr->flags & TCL_TRACE_UNSETS) {
- Tcl_ListObjAppendElement(NULL, elemObjPtr,
- Tcl_NewStringObj("unset", 5));
- }
- eachTraceObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
- Tcl_ListObjAppendElement(NULL, eachTraceObjPtr, elemObjPtr);
+ TraceVarInfo *tvarPtr = (TraceVarInfo *) clientData;
+
+ /*
+ * Build a list with the ops list as the first obj element and the
+ * tcmdPtr->command string as the second obj element. Append this
+ * list (as an element) to the end of the result object list.
+ */
- elemObjPtr = Tcl_NewStringObj(tvarPtr->command, -1);
- Tcl_ListObjAppendElement(NULL, eachTraceObjPtr, elemObjPtr);
- Tcl_ListObjAppendElement(interp, resultListPtr,
- eachTraceObjPtr);
+ elemObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
+ if (tvarPtr->flags & TCL_TRACE_ARRAY) {
+ Tcl_ListObjAppendElement(NULL, elemObjPtr,
+ Tcl_NewStringObj("array", 5));
}
- Tcl_SetObjResult(interp, resultListPtr);
- break;
+ if (tvarPtr->flags & TCL_TRACE_READS) {
+ Tcl_ListObjAppendElement(NULL, elemObjPtr,
+ Tcl_NewStringObj("read", 4));
+ }
+ if (tvarPtr->flags & TCL_TRACE_WRITES) {
+ Tcl_ListObjAppendElement(NULL, elemObjPtr,
+ Tcl_NewStringObj("write", 5));
+ }
+ if (tvarPtr->flags & TCL_TRACE_UNSETS) {
+ Tcl_ListObjAppendElement(NULL, elemObjPtr,
+ Tcl_NewStringObj("unset", 5));
+ }
+ eachTraceObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
+ Tcl_ListObjAppendElement(NULL, eachTraceObjPtr, elemObjPtr);
+
+ elemObjPtr = Tcl_NewStringObj(tvarPtr->command, -1);
+ Tcl_ListObjAppendElement(NULL, eachTraceObjPtr, elemObjPtr);
+ Tcl_ListObjAppendElement(interp, resultListPtr,
+ eachTraceObjPtr);
}
+ Tcl_SetObjResult(interp, resultListPtr);
+ break;
+ }
}
return TCL_OK;
}
-
/*
*----------------------------------------------------------------------
*
* Tcl_CommandTraceInfo --
*
- * Return the clientData value associated with a trace on a
- * command. This procedure can also be used to step through
- * all of the traces on a particular command that have the
- * same trace procedure.
+ * Return the clientData value associated with a trace on a command.
+ * This function can also be used to step through all of the traces on a
+ * particular command that have the same trace function.
*
* Results:
- * The return value is the clientData value associated with
- * a trace on the given command. Information will only be
- * returned for a trace with proc as trace procedure. If
- * the clientData argument is NULL then the first such trace is
- * returned; otherwise, the next relevant one after the one
- * given by clientData will be returned. If the command
- * doesn't exist then an error message is left in the interpreter
- * and NULL is returned. Also, if there are no (more) traces for
- * the given command, NULL is returned.
+ * The return value is the clientData value associated with a trace on
+ * the given command. Information will only be returned for a trace with
+ * proc as trace function. If the clientData argument is NULL then the
+ * first such trace is returned; otherwise, the next relevant one after
+ * the one given by clientData will be returned. If the command doesn't
+ * exist then an error message is left in the interpreter and NULL is
+ * returned. Also, if there are no (more) traces for the given command,
+ * NULL is returned.
*
* Side effects:
* None.
@@ -1008,18 +1014,17 @@ Tcl_CommandTraceInfo(interp, cmdName, flags, proc, prevClientData)
CONST char *cmdName; /* Name of command. */
int flags; /* OR-ed combo or TCL_GLOBAL_ONLY,
* TCL_NAMESPACE_ONLY (can be 0). */
- Tcl_CommandTraceProc *proc; /* Procedure assocated with trace. */
- ClientData prevClientData; /* If non-NULL, gives last value returned
- * by this procedure, so this call will
- * return the next trace after that one.
- * If NULL, this call will return the
- * first trace. */
+ Tcl_CommandTraceProc *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. */
{
Command *cmdPtr;
register CommandTrace *tracePtr;
- cmdPtr = (Command*)Tcl_FindCommand(interp, cmdName,
- NULL, TCL_LEAVE_ERR_MSG);
+ cmdPtr = (Command *) Tcl_FindCommand(interp, cmdName, NULL,
+ TCL_LEAVE_ERR_MSG);
if (cmdPtr == NULL) {
return NULL;
}
@@ -1030,7 +1035,7 @@ Tcl_CommandTraceInfo(interp, cmdName, flags, proc, prevClientData)
tracePtr = cmdPtr->tracePtr;
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;
@@ -1038,7 +1043,7 @@ Tcl_CommandTraceInfo(interp, cmdName, flags, proc, prevClientData)
}
}
}
- for ( ; tracePtr != NULL; tracePtr = tracePtr->nextPtr) {
+ for (; tracePtr!=NULL ; tracePtr=tracePtr->nextPtr) {
if (tracePtr->traceProc == proc) {
return tracePtr->clientData;
}
@@ -1051,41 +1056,40 @@ Tcl_CommandTraceInfo(interp, cmdName, flags, proc, prevClientData)
*
* Tcl_TraceCommand --
*
- * Arrange for rename/deletes to a command to cause a
- * procedure to be invoked, which can monitor the operations.
- *
- * Also optionally arrange for execution of that command
- * to cause a procedure to be invoked.
+ * Arrange for rename/deletes to a command to cause a function to be
+ * invoked, which can monitor the operations.
+ *
+ * Also optionally arrange for execution of that command to cause a
+ * function to be invoked.
*
* Results:
* A standard Tcl return value.
*
* Side effects:
- * A trace is set up on the command given by cmdName, such that
- * future changes to the command will be intermediated by
- * proc. See the manual entry for complete details on the calling
- * sequence for proc.
+ * A trace is set up on the command given by cmdName, such that future
+ * changes to the command will be intermediated by proc. See the manual
+ * entry for complete details on the calling sequence for proc.
*
*----------------------------------------------------------------------
*/
int
Tcl_TraceCommand(interp, cmdName, flags, proc, clientData)
- Tcl_Interp *interp; /* Interpreter in which command is
- * to be traced. */
+ Tcl_Interp *interp; /* Interpreter in which command is to be
+ * traced. */
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 */
- Tcl_CommandTraceProc *proc; /* Procedure to call when specified ops are
+ int flags; /* OR-ed collection of bits, including any of
+ * TCL_TRACE_RENAME, TCL_TRACE_DELETE, and any
+ * of the TRACE_*_EXEC flags */
+ Tcl_CommandTraceProc *proc; /* Function to call when specified ops are
* invoked upon cmdName. */
ClientData clientData; /* Arbitrary argument to pass to proc. */
{
Command *cmdPtr;
register CommandTrace *tracePtr;
- cmdPtr = (Command*)Tcl_FindCommand(interp, cmdName,
- NULL, TCL_LEAVE_ERR_MSG);
+ cmdPtr = (Command *) Tcl_FindCommand(interp, cmdName, NULL,
+ TCL_LEAVE_ERR_MSG);
if (cmdPtr == NULL) {
return TCL_ERROR;
}
@@ -1097,13 +1101,13 @@ Tcl_TraceCommand(interp, cmdName, flags, proc, clientData)
tracePtr = (CommandTrace *) ckalloc(sizeof(CommandTrace));
tracePtr->traceProc = proc;
tracePtr->clientData = clientData;
- tracePtr->flags = flags & (TCL_TRACE_RENAME | TCL_TRACE_DELETE
- | TCL_TRACE_ANY_EXEC);
+ tracePtr->flags = flags &
+ (TCL_TRACE_RENAME | TCL_TRACE_DELETE | TCL_TRACE_ANY_EXEC);
tracePtr->nextPtr = cmdPtr->tracePtr;
tracePtr->refCount = 1;
cmdPtr->tracePtr = tracePtr;
if (tracePtr->flags & TCL_TRACE_ANY_EXEC) {
- cmdPtr->flags |= CMD_HAS_EXEC_TRACES;
+ cmdPtr->flags |= CMD_HAS_EXEC_TRACES;
}
return TCL_OK;
}
@@ -1119,9 +1123,8 @@ Tcl_TraceCommand(interp, cmdName, flags, proc, clientData)
* None.
*
* Side effects:
- * If there exists a trace for the command given by cmdName
- * with the given flags, proc, and clientData, then that trace
- * is removed.
+ * If there exists a trace for the command given by cmdName with the
+ * given flags, proc, and clientData, then that trace is removed.
*
*----------------------------------------------------------------------
*/
@@ -1130,10 +1133,10 @@ void
Tcl_UntraceCommand(interp, cmdName, flags, proc, clientData)
Tcl_Interp *interp; /* Interpreter containing 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 */
- Tcl_CommandTraceProc *proc; /* Procedure assocated with trace. */
+ int flags; /* OR-ed collection of bits, including any of
+ * TCL_TRACE_RENAME, TCL_TRACE_DELETE, and any
+ * of the TRACE_*_EXEC flags */
+ Tcl_CommandTraceProc *proc; /* Function assocated with trace. */
ClientData clientData; /* Arbitrary argument to pass to proc. */
{
register CommandTrace *tracePtr;
@@ -1142,9 +1145,9 @@ Tcl_UntraceCommand(interp, cmdName, flags, proc, clientData)
Interp *iPtr = (Interp *) interp;
ActiveCommandTrace *activePtr;
int hasExecTraces = 0;
-
- cmdPtr = (Command*)Tcl_FindCommand(interp, cmdName,
- NULL, TCL_LEAVE_ERR_MSG);
+
+ cmdPtr = (Command*)Tcl_FindCommand(interp, cmdName, NULL,
+ TCL_LEAVE_ERR_MSG);
if (cmdPtr == NULL) {
return;
}
@@ -1152,13 +1155,13 @@ Tcl_UntraceCommand(interp, cmdName, flags, proc, clientData)
flags &= (TCL_TRACE_RENAME | TCL_TRACE_DELETE | TCL_TRACE_ANY_EXEC);
for (tracePtr = cmdPtr->tracePtr, prevPtr = NULL; ;
- prevPtr = tracePtr, tracePtr = tracePtr->nextPtr) {
+ prevPtr = tracePtr, tracePtr = tracePtr->nextPtr) {
if (tracePtr == NULL) {
return;
}
- if ((tracePtr->traceProc == proc)
- && ((tracePtr->flags & (TCL_TRACE_RENAME | TCL_TRACE_DELETE |
- TCL_TRACE_ANY_EXEC)) == flags)
+ if ((tracePtr->traceProc == proc)
+ && ((tracePtr->flags & (TCL_TRACE_RENAME | TCL_TRACE_DELETE |
+ TCL_TRACE_ANY_EXEC)) == flags)
&& (tracePtr->clientData == clientData)) {
if (tracePtr->flags & TCL_TRACE_ANY_EXEC) {
hasExecTraces = 1;
@@ -1166,15 +1169,15 @@ Tcl_UntraceCommand(interp, cmdName, flags, proc, clientData)
break;
}
}
-
+
/*
- * The code below makes it possible to delete traces while traces
- * are active: it makes sure that the deleted trace won't be
- * processed by CallCommandTraces.
+ * The code below makes it possible to delete traces while traces are
+ * active: it makes sure that the deleted trace won't be processed by
+ * CallCommandTraces.
*/
for (activePtr = iPtr->activeCmdTracePtr; activePtr != NULL;
- activePtr = activePtr->nextPtr) {
+ activePtr = activePtr->nextPtr) {
if (activePtr->nextTracePtr == tracePtr) {
if (activePtr->reverseScan) {
activePtr->nextTracePtr = prevPtr;
@@ -1189,22 +1192,24 @@ Tcl_UntraceCommand(interp, cmdName, flags, proc, clientData)
prevPtr->nextPtr = tracePtr->nextPtr;
}
tracePtr->flags = 0;
-
+
if ((--tracePtr->refCount) <= 0) {
ckfree((char*)tracePtr);
}
-
+
if (hasExecTraces) {
for (tracePtr = cmdPtr->tracePtr, prevPtr = NULL; tracePtr != NULL ;
- prevPtr = tracePtr, tracePtr = tracePtr->nextPtr) {
+ prevPtr = tracePtr, tracePtr = tracePtr->nextPtr) {
if (tracePtr->flags & TCL_TRACE_ANY_EXEC) {
- return;
+ return;
}
}
- /*
- * None of the remaining traces on this command are execution
- * traces. We therefore remove this flag:
+
+ /*
+ * None of the remaining traces on this command are execution traces.
+ * We therefore remove this flag:
*/
+
cmdPtr->flags &= ~CMD_HAS_EXEC_TRACES;
}
}
@@ -1214,9 +1219,9 @@ Tcl_UntraceCommand(interp, cmdName, flags, proc, clientData)
*
* TraceCommandProc --
*
- * This procedure is called to handle command changes that have
- * been traced using the "trace" command, when using the
- * 'rename' or 'delete' options.
+ * This function is called to handle command changes that have been
+ * traced using the "trace" command, when using the 'rename' or 'delete'
+ * options.
*
* Results:
* None.
@@ -1233,23 +1238,23 @@ TraceCommandProc(clientData, interp, oldName, newName, flags)
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 means command is being deleted
- * (renamed to ""). */
+ 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
* information. */
{
TraceCommandInfo *tcmdPtr = (TraceCommandInfo *) clientData;
int code;
Tcl_DString cmd;
-
+
tcmdPtr->refCount++;
-
+
if ((tcmdPtr->flags & flags) && !(flags & TCL_INTERP_DESTROYED)
&& !Tcl_LimitExceeded(interp)) {
/*
- * Generate a command to execute by appending list elements
- * for the old and new command name and the operation.
+ * Generate a command to execute by appending list elements for the
+ * old and new command name and the operation.
*/
Tcl_DStringInit(&cmd);
@@ -1263,12 +1268,12 @@ TraceCommandProc(clientData, interp, oldName, newName, flags)
}
/*
- * Execute the command.
- * We discard any object result the command returns.
+ * Execute the command. We discard any object result the command
+ * returns.
*
- * Add the TCL_TRACE_DESTROYED flag to tcmdPtr to indicate to
- * other areas that this will be destroyed by us, otherwise a
- * double-free might occur depending on what the eval does.
+ * Add the TCL_TRACE_DESTROYED flag to tcmdPtr to indicate to other
+ * areas that this will be destroyed by us, otherwise a double-free
+ * might occur depending on what the eval does.
*/
if (flags & TCL_TRACE_DESTROYED) {
@@ -1276,16 +1281,18 @@ TraceCommandProc(clientData, interp, oldName, newName, flags)
}
code = Tcl_EvalEx(interp, Tcl_DStringValue(&cmd),
Tcl_DStringLength(&cmd), 0);
- if (code != TCL_OK) {
+ if (code != TCL_OK) {
/* We ignore errors in these traced commands */
/*** QUESTION: Use Tcl_BackgroundError(interp); instead? ***/
}
Tcl_DStringFree(&cmd);
}
+
/*
* We delete when the trace was destroyed or if this is a delete trace,
* because command deletes are unconditional, so the trace must go away.
*/
+
if (flags & (TCL_TRACE_DESTROYED | TCL_TRACE_DELETE)) {
int untraceFlags = tcmdPtr->flags;
Tcl_InterpState state;
@@ -1293,37 +1300,43 @@ TraceCommandProc(clientData, interp, oldName, newName, flags)
if (tcmdPtr->stepTrace != NULL) {
Tcl_DeleteTrace(interp, tcmdPtr->stepTrace);
tcmdPtr->stepTrace = NULL;
- if (tcmdPtr->startCmd != NULL) {
- ckfree((char *)tcmdPtr->startCmd);
+ if (tcmdPtr->startCmd != NULL) {
+ ckfree((char *)tcmdPtr->startCmd);
}
}
if (tcmdPtr->flags & TCL_TRACE_EXEC_IN_PROGRESS) {
- /* Postpone deletion, until exec trace returns */
+ /*
+ * Postpone deletion, until exec trace returns.
+ */
+
tcmdPtr->flags = 0;
}
+
/*
- * We need to construct the same flags for Tcl_UntraceCommand
- * as were passed to Tcl_TraceCommand. Reproduce the processing
- * of [trace add execution/command]. Be careful to keep this
- * code in sync with that.
+ * We need to construct the same flags for Tcl_UntraceCommand as were
+ * passed to Tcl_TraceCommand. Reproduce the processing of [trace add
+ * execution/command]. Be careful to keep this code in sync with that.
*/
+
if (untraceFlags & TCL_TRACE_ANY_EXEC) {
untraceFlags |= TCL_TRACE_DELETE;
- if (untraceFlags & (TCL_TRACE_ENTER_DURING_EXEC
+ if (untraceFlags & (TCL_TRACE_ENTER_DURING_EXEC
| TCL_TRACE_LEAVE_DURING_EXEC)) {
untraceFlags |= (TCL_TRACE_ENTER_EXEC | TCL_TRACE_LEAVE_EXEC);
}
} else if (untraceFlags & TCL_TRACE_RENAME) {
untraceFlags |= TCL_TRACE_DELETE;
}
+
/*
* Remove the trace since TCL_TRACE_DESTROYED tells us to, or the
- * command we're tracing has just gone away. Then decrement the
+ * command we're tracing has just gone away. Then decrement the
* clientData refCount that was set up by trace creation.
*
- * Note that we save the (return) state of the interpreter to
- * prevent bizarre error messages.
+ * Note that we save the (return) state of the interpreter to prevent
+ * bizarre error messages.
*/
+
state = Tcl_SaveInterpState(interp, TCL_OK);
Tcl_UntraceCommand(interp, oldName, untraceFlags,
TraceCommandProc, clientData);
@@ -1331,7 +1344,7 @@ TraceCommandProc(clientData, interp, oldName, newName, flags)
tcmdPtr->refCount--;
}
if ((--tcmdPtr->refCount) <= 0) {
- ckfree((char*)tcmdPtr);
+ ckfree((char*)tcmdPtr);
}
return;
}
@@ -1341,37 +1354,37 @@ TraceCommandProc(clientData, interp, oldName, newName, flags)
*
* TclCheckExecutionTraces --
*
- * Checks on all current command execution traces, and invokes
- * procedures which have been registered. This procedure can be
- * used by other code which performs execution to unify the
- * tracing system, so that execution traces will function for that
- * other code.
- *
- * For instance extensions like [incr Tcl] which use their
- * own execution technique can make use of Tcl's tracing.
- *
- * This procedure is called by 'TclEvalObjvInternal'
+ * Checks on all current command execution traces, and invokes functions
+ * which have been registered. This function can be used by other code
+ * which performs execution to unify the tracing system, so that
+ * execution traces will function for that other code.
+ *
+ * For instance extensions like [incr Tcl] which use their own execution
+ * technique can make use of Tcl's tracing.
+ *
+ * This function is called by 'TclEvalObjvInternal'
*
* Results:
- * The return value is a standard Tcl completion code such as
- * TCL_OK or TCL_ERROR, etc.
+ * The return value is a standard Tcl completion code such as TCL_OK or
+ * TCL_ERROR, etc.
*
* Side effects:
- * Those side effects made by any trace procedures called.
+ * Those side effects made by any trace functions called.
*
*----------------------------------------------------------------------
*/
-int
-TclCheckExecutionTraces(interp, command, numChars, cmdPtr, code,
- traceFlags, objc, objv)
+
+int
+TclCheckExecutionTraces(interp, command, numChars, cmdPtr, code, traceFlags,
+ objc, objv)
Tcl_Interp *interp; /* The current interpreter. */
- 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. */
+ 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. */
Command *cmdPtr; /* Points to command's Command struct. */
- int code; /* The current result code. */
- int traceFlags; /* Current tracing situation. */
+ 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. */
{
@@ -1382,46 +1395,49 @@ TclCheckExecutionTraces(interp, command, numChars, cmdPtr, code,
int traceCode = TCL_OK;
TraceCommandInfo* tcmdPtr;
Tcl_InterpState state = NULL;
-
+
if (command == NULL || cmdPtr->tracePtr == NULL) {
return traceCode;
}
-
+
curLevel = ((iPtr->varFramePtr == NULL) ? 0 : iPtr->varFramePtr->level);
-
+
active.nextPtr = iPtr->activeCmdTracePtr;
iPtr->activeCmdTracePtr = &active;
active.cmdPtr = cmdPtr;
lastTracePtr = NULL;
- for (tracePtr = cmdPtr->tracePtr;
- (traceCode == TCL_OK) && (tracePtr != NULL);
- tracePtr = active.nextTracePtr) {
- if (traceFlags & TCL_TRACE_LEAVE_EXEC) {
- /* execute the trace command in order of creation for "leave" */
+ for (tracePtr = cmdPtr->tracePtr;
+ (traceCode == TCL_OK) && (tracePtr != NULL);
+ tracePtr = active.nextTracePtr) {
+ if (traceFlags & TCL_TRACE_LEAVE_EXEC) {
+ /*
+ * Execute the trace command in order of creation for "leave".
+ */
+
active.reverseScan = 1;
active.nextTracePtr = NULL;
- tracePtr = cmdPtr->tracePtr;
- while (tracePtr->nextPtr != lastTracePtr) {
- active.nextTracePtr = tracePtr;
- tracePtr = tracePtr->nextPtr;
- }
- } else {
+ tracePtr = cmdPtr->tracePtr;
+ while (tracePtr->nextPtr != lastTracePtr) {
+ active.nextTracePtr = tracePtr;
+ tracePtr = tracePtr->nextPtr;
+ }
+ } else {
active.reverseScan = 0;
active.nextTracePtr = tracePtr->nextPtr;
- }
+ }
tcmdPtr = (TraceCommandInfo*)tracePtr->clientData;
if (tcmdPtr->flags != 0) {
- tcmdPtr->curFlags = traceFlags | TCL_TRACE_EXEC_DIRECT;
- tcmdPtr->curCode = code;
+ tcmdPtr->curFlags = traceFlags | TCL_TRACE_EXEC_DIRECT;
+ tcmdPtr->curCode = code;
tcmdPtr->refCount++;
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);
}
}
if (active.nextTracePtr) {
@@ -1440,34 +1456,35 @@ TclCheckExecutionTraces(interp, command, numChars, cmdPtr, code,
*
* TclCheckInterpTraces --
*
- * Checks on all current traces, and invokes procedures which
- * have been registered. This procedure can be used by other
- * code which performs execution to unify the tracing system.
- * For instance extensions like [incr Tcl] which use their
- * own execution technique can make use of Tcl's tracing.
- *
- * This procedure is called by 'TclEvalObjvInternal'
+ * Checks on all current traces, and invokes functions which have been
+ * registered. This function can be used by other code which performs
+ * execution to unify the tracing system. For instance extensions like
+ * [incr Tcl] which use their own execution technique can make use of
+ * Tcl's tracing.
+ *
+ * This function is called by 'TclEvalObjvInternal'
*
* Results:
- * The return value is a standard Tcl completion code such as
- * TCL_OK or TCL_ERROR, etc.
+ * The return value is a standard Tcl completion code such as TCL_OK or
+ * TCL_ERROR, etc.
*
* Side effects:
- * Those side effects made by any trace procedures called.
+ * Those side effects made by any trace functions called.
*
*----------------------------------------------------------------------
*/
-int
-TclCheckInterpTraces(interp, command, numChars, cmdPtr, code,
- traceFlags, objc, objv)
+
+int
+TclCheckInterpTraces(interp, command, numChars, cmdPtr, code, traceFlags,
+ objc, objv)
Tcl_Interp *interp; /* The current interpreter. */
- 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. */
+ 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. */
Command *cmdPtr; /* Points to command's Command struct. */
- int code; /* The current result code. */
- int traceFlags; /* Current tracing situation. */
+ 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. */
{
@@ -1477,60 +1494,68 @@ TclCheckInterpTraces(interp, command, numChars, cmdPtr, code,
int curLevel;
int traceCode = TCL_OK;
Tcl_InterpState state = NULL;
-
- if (command == NULL || iPtr->tracePtr == NULL ||
- (iPtr->flags & INTERP_TRACE_IN_PROGRESS)) {
+
+ if (command == NULL || iPtr->tracePtr == NULL
+ || (iPtr->flags & INTERP_TRACE_IN_PROGRESS)) {
return(traceCode);
}
-
+
curLevel = iPtr->numLevels;
-
+
active.nextPtr = iPtr->activeInterpTracePtr;
iPtr->activeInterpTracePtr = &active;
lastTracePtr = NULL;
- for ( tracePtr = iPtr->tracePtr;
- (traceCode == TCL_OK) && (tracePtr != NULL);
- tracePtr = active.nextTracePtr) {
- if (traceFlags & TCL_TRACE_ENTER_EXEC) {
- /*
- * Execute the trace command in reverse order of creation
- * for "enterstep" operation. The order is changed for
- * "enterstep" instead of for "leavestep" as was done in
- * TclCheckExecutionTraces because for step traces,
- * Tcl_CreateObjTrace creates one more linked list of traces
- * which results in one more reversal of trace invocation.
- */
+ for (tracePtr = iPtr->tracePtr;
+ (traceCode == TCL_OK) && (tracePtr != NULL);
+ tracePtr = active.nextTracePtr) {
+ if (traceFlags & TCL_TRACE_ENTER_EXEC) {
+ /*
+ * Execute the trace command in reverse order of creation for
+ * "enterstep" operation. The order is changed for "enterstep"
+ * instead of for "leavestep" as was done in
+ * TclCheckExecutionTraces because for step traces,
+ * Tcl_CreateObjTrace creates one more linked list of traces which
+ * results in one more reversal of trace invocation.
+ */
+
active.reverseScan = 1;
active.nextTracePtr = NULL;
- tracePtr = iPtr->tracePtr;
- while (tracePtr->nextPtr != lastTracePtr) {
- active.nextTracePtr = tracePtr;
- tracePtr = tracePtr->nextPtr;
- }
- } else {
+ tracePtr = iPtr->tracePtr;
+ while (tracePtr->nextPtr != lastTracePtr) {
+ active.nextTracePtr = tracePtr;
+ tracePtr = tracePtr->nextPtr;
+ }
+ } else {
active.reverseScan = 0;
active.nextTracePtr = tracePtr->nextPtr;
- }
+ }
+
if (tracePtr->level > 0 && curLevel > tracePtr->level) {
continue;
}
+
if (!(tracePtr->flags & TCL_TRACE_EXEC_IN_PROGRESS)) {
- /*
- * The proc invoked might delete the traced command which
- * which might try to free tracePtr. We want to use tracePtr
- * until the end of this if section, so we use
- * Tcl_Preserve() and Tcl_Release() to be sure it is not
- * freed while we still need it.
+ /*
+ * The proc invoked might delete the traced command which which
+ * might try to free tracePtr. We want to use tracePtr until the
+ * end of this if section, so we use Tcl_Preserve() and
+ * Tcl_Release() to be sure it is not freed while we still need
+ * it.
*/
+
Tcl_Preserve((ClientData) tracePtr);
tracePtr->flags |= TCL_TRACE_EXEC_IN_PROGRESS;
if (state == NULL) {
state = Tcl_SaveInterpState(interp, code);
}
-
- if (tracePtr->flags & (TCL_TRACE_ENTER_EXEC | TCL_TRACE_LEAVE_EXEC)) {
- /* New style trace */
+
+ if (tracePtr->flags &
+ (TCL_TRACE_ENTER_EXEC | TCL_TRACE_LEAVE_EXEC)) {
+ /*
+ * New style trace.
+ */
+
if (tracePtr->flags & traceFlags) {
if (tracePtr->proc == TraceExecutionProc) {
TraceCommandInfo* tcmdPtr =
@@ -1543,15 +1568,18 @@ TclCheckInterpTraces(interp, command, numChars, cmdPtr, code,
objc, objv);
}
} else {
- /* Old-style trace */
-
+ /*
+ * Old-style trace.
+ */
+
if (traceFlags & TCL_TRACE_ENTER_EXEC) {
- /*
- * Old-style interpreter-wide traces only trigger
- * before the command is executed.
+ /*
+ * Old-style interpreter-wide traces only trigger before
+ * the command is executed.
*/
- traceCode = CallTraceProcedure(interp, tracePtr, cmdPtr,
- command, numChars, objc, objv);
+
+ traceCode = CallTraceFunction(interp, tracePtr, cmdPtr,
+ command, numChars, objc, objv);
}
}
tracePtr->flags &= ~TCL_TRACE_EXEC_IN_PROGRESS;
@@ -1575,31 +1603,31 @@ TclCheckInterpTraces(interp, command, numChars, cmdPtr, code,
/*
*----------------------------------------------------------------------
*
- * CallTraceProcedure --
+ * CallTraceFunction --
*
- * Invokes a trace procedure registered with an interpreter. These
- * procedures trace command execution. Currently this trace procedure
- * is called with the address of the string-based Tcl_CmdProc for the
+ * Invokes a trace function registered with an interpreter. These
+ * functions trace command execution. Currently this trace function is
+ * called with the address of the string-based Tcl_CmdProc for the
* command, not the Tcl_ObjCmdProc.
*
* Results:
* None.
*
* Side effects:
- * Those side effects made by the trace procedure.
+ * Those side effects made by the trace function.
*
*----------------------------------------------------------------------
*/
static int
-CallTraceProcedure(interp, tracePtr, cmdPtr, command, numChars, objc, objv)
+CallTraceFunction(interp, tracePtr, cmdPtr, command, numChars, objc, objv)
Tcl_Interp *interp; /* The current interpreter. */
- register Trace *tracePtr; /* Describes the trace procedure 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. */
- int numChars; /* The number of characters in the
- * command's source. */
+ 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. */
{
@@ -1607,21 +1635,20 @@ CallTraceProcedure(interp, tracePtr, cmdPtr, command, numChars, objc, objv)
char *commandCopy;
int traceCode;
- /*
+ /*
* Copy the command characters into a new string.
*/
commandCopy = (char *) ckalloc((unsigned) (numChars + 1));
memcpy((VOID *) commandCopy, (VOID *) command, (size_t) numChars);
commandCopy[numChars] = '\0';
-
+
/*
- * Call the trace procedure then free allocated storage.
+ * Call the trace function then free allocated storage.
*/
-
- traceCode = (tracePtr->proc)( tracePtr->clientData, (Tcl_Interp*) iPtr,
- iPtr->numLevels, commandCopy,
- (Tcl_Command) cmdPtr, objc, objv );
+
+ traceCode = (tracePtr->proc)(tracePtr->clientData, (Tcl_Interp*) iPtr,
+ iPtr->numLevels, commandCopy, (Tcl_Command) cmdPtr, objc, objv);
ckfree((char *) commandCopy);
return(traceCode);
@@ -1632,18 +1659,19 @@ CallTraceProcedure(interp, tracePtr, cmdPtr, command, numChars, objc, objv)
*
* CommandObjTraceDeleted --
*
- * Ensure the trace is correctly deleted by decrementing its
- * refCount and only deleting if no other references exist.
+ * Ensure the trace is correctly deleted by decrementing its refCount and
+ * only deleting if no other references exist.
*
* Results:
- * None.
+ * None.
*
* Side effects:
* May release memory.
*
*----------------------------------------------------------------------
*/
-static void
+
+static void
CommandObjTraceDeleted(ClientData clientData) {
TraceCommandInfo* tcmdPtr = (TraceCommandInfo*)clientData;
if ((--tcmdPtr->refCount) <= 0) {
@@ -1656,80 +1684,82 @@ CommandObjTraceDeleted(ClientData clientData) {
*
* TraceExecutionProc --
*
- * This procedure is invoked whenever code relevant to a
- * 'trace execution' command is executed. It is called in one
- * of two ways in Tcl's core:
- *
- * (i) by the TclCheckExecutionTraces, when an execution trace
- * has been triggered.
- * (ii) by TclCheckInterpTraces, when a prior execution trace has
- * created a trace of the internals of a procedure, passing in
- * this procedure as the one to be called.
+ * This function is invoked whenever code relevant to a 'trace execution'
+ * command is executed. It is called in one of two ways in Tcl's core:
+ *
+ * (i) by the TclCheckExecutionTraces, when an execution trace has been
+ * triggered.
+ * (ii) by TclCheckInterpTraces, when a prior execution trace has created
+ * a trace of the internals of a procedure, passing in this function as
+ * the one to be called.
*
* Results:
- * The return value is a standard Tcl completion code such as
- * TCL_OK or TCL_ERROR, etc.
+ * The return value is a standard Tcl completion code such as TCL_OK or
+ * TCL_ERROR, etc.
*
* Side effects:
- * May invoke an arbitrary Tcl procedure, and may create or
- * delete an interpreter-wide trace.
+ * May invoke an arbitrary Tcl procedure, and may create or delete an
+ * interpreter-wide trace.
*
*----------------------------------------------------------------------
*/
+
static int
-TraceExecutionProc(ClientData clientData, Tcl_Interp *interp,
- int level, CONST char* command, Tcl_Command cmdInfo,
- int objc, struct Tcl_Obj *CONST objv[]) {
+TraceExecutionProc(ClientData clientData, Tcl_Interp *interp, int level,
+ CONST char* command, Tcl_Command cmdInfo, int objc,
+ struct Tcl_Obj *CONST objv[]) {
int call = 0;
Interp *iPtr = (Interp *) interp;
TraceCommandInfo* tcmdPtr = (TraceCommandInfo*)clientData;
int flags = tcmdPtr->curFlags;
int code = tcmdPtr->curCode;
int traceCode = TCL_OK;
-
+
if (tcmdPtr->flags & TCL_TRACE_EXEC_IN_PROGRESS) {
- /*
- * Inside any kind of execution trace callback, we do
- * not allow any further execution trace callbacks to
- * be called for the same trace.
+ /*
+ * Inside any kind of execution trace callback, we do not allow any
+ * further execution trace callbacks to be called for the same trace.
*/
+
return traceCode;
}
-
+
if (!(flags & TCL_INTERP_DESTROYED) && !Tcl_LimitExceeded(interp)) {
/*
- * Check whether the current call is going to eval arbitrary
- * Tcl code with a generated trace, or whether we are only
- * going to setup interpreter-wide traces to implement the
- * 'step' traces. This latter situation can happen if
- * we create a command trace without either before or after
- * operations, but with either of the step operations.
+ * Check whether the current call is going to eval arbitrary Tcl code
+ * with a generated trace, or whether we are only going to setup
+ * interpreter-wide traces to implement the 'step' traces. This latter
+ * situation can happen if we create a command trace without either
+ * before or after operations, but with either of the step operations.
*/
+
if (flags & TCL_TRACE_EXEC_DIRECT) {
- call = flags & tcmdPtr->flags & (TCL_TRACE_ENTER_EXEC |
- TCL_TRACE_LEAVE_EXEC);
+ call = flags & tcmdPtr->flags &
+ (TCL_TRACE_ENTER_EXEC | TCL_TRACE_LEAVE_EXEC);
} else {
call = 1;
}
+
/*
- * First, if we have returned back to the level at which we
- * created an interpreter trace for enterstep and/or leavestep
- * execution traces, we remove it here.
+ * First, if we have returned back to the level at which we created an
+ * interpreter trace for enterstep and/or leavestep execution traces,
+ * we remove it here.
*/
- if (flags & TCL_TRACE_LEAVE_EXEC) {
- if ((tcmdPtr->stepTrace != NULL) && (level == tcmdPtr->startLevel)
- && (strcmp(command, tcmdPtr->startCmd) == 0)) {
- Tcl_DeleteTrace(interp, tcmdPtr->stepTrace);
- tcmdPtr->stepTrace = NULL;
- if (tcmdPtr->startCmd != NULL) {
- ckfree((char *)tcmdPtr->startCmd);
- }
+
+ if ((flags & TCL_TRACE_LEAVE_EXEC) && (tcmdPtr->stepTrace != NULL)
+ && (level == tcmdPtr->startLevel)
+ && (strcmp(command, tcmdPtr->startCmd) == 0)) {
+ Tcl_DeleteTrace(interp, tcmdPtr->stepTrace);
+ tcmdPtr->stepTrace = NULL;
+ if (tcmdPtr->startCmd != NULL) {
+ ckfree((char *)tcmdPtr->startCmd);
}
}
-
+
/*
* Second, create the tcl callback, if required.
*/
+
if (call) {
Tcl_DString cmd;
Tcl_DString sub;
@@ -1737,19 +1767,23 @@ TraceExecutionProc(ClientData clientData, Tcl_Interp *interp,
Tcl_DStringInit(&cmd);
Tcl_DStringAppend(&cmd, tcmdPtr->command, (int)tcmdPtr->length);
- /* Append command with arguments */
+
+ /*
+ * Append command with arguments.
+ */
+
Tcl_DStringInit(&sub);
for (i = 0; i < objc; i++) {
- char* str;
- int len;
- str = Tcl_GetStringFromObj(objv[i],&len);
- Tcl_DStringAppendElement(&sub, str);
+ Tcl_DStringAppendElement(&sub, Tcl_GetString(objv[i]));
}
Tcl_DStringAppendElement(&cmd, Tcl_DStringValue(&sub));
Tcl_DStringFree(&sub);
if (flags & TCL_TRACE_ENTER_EXEC) {
- /* Append trace operation */
+ /*
+ * Append trace operation.
+ */
+
if (flags & TCL_TRACE_EXEC_DIRECT) {
Tcl_DStringAppendElement(&cmd, "enter");
} else {
@@ -1759,15 +1793,25 @@ TraceExecutionProc(ClientData clientData, Tcl_Interp *interp,
Tcl_Obj* resultCode;
char* resultCodeStr;
- /* Append result code */
+ /*
+ * Append result code.
+ */
+
resultCode = Tcl_NewIntObj(code);
resultCodeStr = Tcl_GetString(resultCode);
Tcl_DStringAppendElement(&cmd, resultCodeStr);
Tcl_DecrRefCount(resultCode);
-
- /* Append result string */
+
+ /*
+ * Append result string.
+ */
+
Tcl_DStringAppendElement(&cmd, Tcl_GetStringResult(interp));
- /* Append trace operation */
+
+ /*
+ * Append trace operation.
+ */
+
if (flags & TCL_TRACE_EXEC_DIRECT) {
Tcl_DStringAppendElement(&cmd, "leave");
} else {
@@ -1776,20 +1820,22 @@ TraceExecutionProc(ClientData clientData, Tcl_Interp *interp,
} else {
Tcl_Panic("TraceExecutionProc: bad flag combination");
}
-
+
/*
- * Execute the command.
- * We discard any object result the command returns.
+ * Execute the command. We discard any object result the command
+ * returns.
*/
tcmdPtr->flags |= TCL_TRACE_EXEC_IN_PROGRESS;
iPtr->flags |= INTERP_TRACE_IN_PROGRESS;
tcmdPtr->refCount++;
- /*
- * This line can have quite arbitrary side-effects,
- * including deleting the trace, the command being
- * traced, or even the interpreter.
+
+ /*
+ * This line can have quite arbitrary side-effects, including
+ * deleting the trace, the command being traced, or even the
+ * interpreter.
*/
+
traceCode = Tcl_Eval(interp, Tcl_DStringValue(&cmd));
tcmdPtr->flags &= ~TCL_TRACE_EXEC_IN_PROGRESS;
iPtr->flags &= ~INTERP_TRACE_IN_PROGRESS;
@@ -1798,26 +1844,26 @@ TraceExecutionProc(ClientData clientData, Tcl_Interp *interp,
}
Tcl_DStringFree(&cmd);
}
-
+
/*
- * Third, if there are any step execution traces for this proc,
- * we register an interpreter trace to invoke enterstep and/or
- * leavestep traces.
- * We also need to save the current stack level and the proc
- * string in startLevel and startCmd so that we can delete this
- * interpreter trace when it reaches the end of this proc.
+ * Third, if there are any step execution traces for this proc, we
+ * register an interpreter trace to invoke enterstep and/or leavestep
+ * traces. We also need to save the current stack level and the proc
+ * string in startLevel and startCmd so that we can delete this
+ * interpreter trace when it reaches the end of this proc.
*/
+
if ((flags & TCL_TRACE_ENTER_EXEC) && (tcmdPtr->stepTrace == NULL)
- && (tcmdPtr->flags & (TCL_TRACE_ENTER_DURING_EXEC |
- TCL_TRACE_LEAVE_DURING_EXEC))) {
- tcmdPtr->startLevel = level;
- tcmdPtr->startCmd =
+ && (tcmdPtr->flags & (TCL_TRACE_ENTER_DURING_EXEC |
+ TCL_TRACE_LEAVE_DURING_EXEC))) {
+ tcmdPtr->startLevel = level;
+ tcmdPtr->startCmd =
(char *) ckalloc((unsigned) (strlen(command) + 1));
- strcpy(tcmdPtr->startCmd, command);
- tcmdPtr->refCount++;
- tcmdPtr->stepTrace = Tcl_CreateObjTrace(interp, 0,
- (tcmdPtr->flags & TCL_TRACE_ANY_EXEC) >> 2,
- TraceExecutionProc, (ClientData)tcmdPtr,
+ strcpy(tcmdPtr->startCmd, command);
+ tcmdPtr->refCount++;
+ tcmdPtr->stepTrace = Tcl_CreateObjTrace(interp, 0,
+ (tcmdPtr->flags & TCL_TRACE_ANY_EXEC) >> 2,
+ TraceExecutionProc, (ClientData)tcmdPtr,
CommandObjTraceDeleted);
}
}
@@ -1825,8 +1871,8 @@ TraceExecutionProc(ClientData clientData, Tcl_Interp *interp,
if (tcmdPtr->stepTrace != NULL) {
Tcl_DeleteTrace(interp, tcmdPtr->stepTrace);
tcmdPtr->stepTrace = NULL;
- if (tcmdPtr->startCmd != NULL) {
- ckfree((char *)tcmdPtr->startCmd);
+ if (tcmdPtr->startCmd != NULL) {
+ ckfree((char *)tcmdPtr->startCmd);
}
}
}
@@ -1843,12 +1889,12 @@ TraceExecutionProc(ClientData clientData, Tcl_Interp *interp,
*
* TraceVarProc --
*
- * This procedure is called to handle variable accesses that have
- * been traced using the "trace" command.
+ * This function is called to handle variable accesses that have been
+ * traced using the "trace" command.
*
* Results:
- * Normally returns NULL. If the trace command returns an error,
- * then this procedure returns an error string.
+ * Normally returns NULL. If the trace command returns an error, then
+ * this function returns an error string.
*
* Side effects:
* Depends on the command associated with the trace.
@@ -1862,7 +1908,7 @@ TraceVarProc(clientData, interp, name1, name2, flags)
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 *name2; /* Name of element within array; NULL means
* scalar variable is being referenced. */
int flags; /* OR-ed bits giving operation and other
* information. */
@@ -1872,12 +1918,11 @@ TraceVarProc(clientData, interp, name1, name2, flags)
int code;
Tcl_DString cmd;
- /*
- * 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.
+ /*
+ * 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.
*/
Tcl_Preserve((ClientData) tvarPtr);
@@ -1887,8 +1932,8 @@ TraceVarProc(clientData, interp, name1, name2, flags)
&& !Tcl_LimitExceeded(interp)) {
if (tvarPtr->length != (size_t) 0) {
/*
- * Generate a command to execute by appending list elements
- * for the two variable names and the operation.
+ * Generate a command to execute by appending list elements for
+ * the two variable names and the operation.
*/
Tcl_DStringInit(&cmd);
@@ -1920,10 +1965,10 @@ TraceVarProc(clientData, interp, name1, name2, flags)
#ifndef TCL_REMOVE_OBSOLETE_TRACES
}
#endif
-
+
/*
- * Execute the command.
- * We discard any object result the command returns.
+ * Execute the command. We discard any object result the command
+ * returns.
*
* Add the TCL_TRACE_DESTROYED flag to tvarPtr to indicate to
* other areas that this will be destroyed by us, otherwise a
@@ -1935,7 +1980,7 @@ TraceVarProc(clientData, interp, name1, name2, flags)
}
code = Tcl_EvalEx(interp, Tcl_DStringValue(&cmd),
Tcl_DStringLength(&cmd), 0);
- if (code != TCL_OK) { /* copy error msg to result */
+ if (code != TCL_OK) { /* copy error msg to result */
Tcl_Obj *errMsgObj = Tcl_GetObjResult(interp);
Tcl_IncrRefCount(errMsgObj);
result = (char *) errMsgObj;
@@ -1961,88 +2006,86 @@ TraceVarProc(clientData, interp, name1, name2, flags)
*
* Tcl_CreateObjTrace --
*
- * Arrange for a procedure to be called to trace command execution.
+ * Arrange for a function to be called to trace command execution.
*
* Results:
- * The return value is a token for the trace, which may be passed
- * to Tcl_DeleteTrace to eliminate the trace.
+ * The return value is a token for the trace, which may be passed to
+ * Tcl_DeleteTrace to eliminate the trace.
*
* Side effects:
- * From now on, proc will be called just before a command procedure
- * is called to execute a Tcl command. Calls to proc will have the
- * following form:
- *
- * void proc( ClientData clientData,
- * Tcl_Interp* interp,
- * int level,
- * CONST char* command,
- * Tcl_Command commandInfo,
- * int objc,
- * 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 nesting depth of command interpretation within
- * the interpreter. The 'command' argument is the ASCII text of
- * the command being evaluated -- before any substitutions are
- * performed. The 'commandInfo' argument gives a handle to the
- * command procedure that will be evaluated. The '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.
- *
- * The 'flags' argument is either zero or the value,
- * TCL_ALLOW_INLINE_COMPILATION. If the TCL_ALLOW_INLINE_COMPILATION
- * flag is not present, the bytecode compiler will not generate inline
- * code for Tcl's built-in commands. This behavior will have a significant
- * impact on performance, but will ensure that all command evaluations are
- * traced. If the TCL_ALLOW_INLINE_COMPILATION flag is present, the
- * bytecode compiler will have its normal behavior of compiling in-line
- * code for some of Tcl's built-in commands. In this case, the tracing
- * will be imprecise -- in-line code will not be traced -- but run-time
- * performance will be improved. The latter behavior is desired for
- * many applications such as profiling of run time.
- *
- * When the trace is deleted, the 'delProc' procedure will be invoked,
- * passing it the original client data.
+ * From now on, proc will be called just before a command function is
+ * called to execute a Tcl command. Calls to proc will have the following
+ * form:
+ *
+ * void proc(ClientData clientData,
+ * Tcl_Interp* interp,
+ * int level,
+ * CONST char* command,
+ * Tcl_Command commandInfo,
+ * int objc,
+ * 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
+ * nesting depth of command interpretation within the interpreter. The
+ * 'command' argument is the ASCII text of the command being evaluated -
+ * before any substitutions are performed. The 'commandInfo' argument
+ * gives a handle to the command procedure that will be evaluated. The
+ * '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.
+ *
+ * The 'flags' argument is either zero or the value,
+ * TCL_ALLOW_INLINE_COMPILATION. If the TCL_ALLOW_INLINE_COMPILATION flag
+ * is not present, the bytecode compiler will not generate inline code
+ * for Tcl's built-in commands. This behavior will have a significant
+ * impact on performance, but will ensure that all command evaluations
+ * are traced. If the TCL_ALLOW_INLINE_COMPILATION flag is present, the
+ * bytecode compiler will have its normal behavior of compiling in-line
+ * code for some of Tcl's built-in commands. In this case, the tracing
+ * will be imprecise - in-line code will not be traced - but run-time
+ * performance will be improved. The latter behavior is desired for many
+ * applications such as profiling of run time.
+ *
+ * When the trace is deleted, the 'delProc' function will be invoked,
+ * passing it the original client data.
*
*----------------------------------------------------------------------
*/
Tcl_Trace
-Tcl_CreateObjTrace( interp, level, flags, proc, clientData, delProc )
+Tcl_CreateObjTrace(interp, level, flags, proc, clientData, delProc)
Tcl_Interp* interp; /* Tcl interpreter */
int level; /* Maximum nesting level */
int flags; /* Flags, see above */
Tcl_CmdObjTraceProc* proc; /* Trace callback */
ClientData clientData; /* Client data for the callback */
Tcl_CmdObjTraceDeleteProc* delProc;
- /* Procedure to call when trace is deleted */
+ /* Function to call when trace is deleted */
{
register Trace *tracePtr;
register Interp *iPtr = (Interp *) interp;
- /* Test if this trace allows inline compilation of commands */
+ /*
+ * Test if this trace allows inline compilation of commands.
+ */
if (!(flags & TCL_ALLOW_INLINE_COMPILATION)) {
if (iPtr->tracesForbiddingInline == 0) {
-
/*
- * When the first trace forbidding inline compilation is
- * created, invalidate existing compiled code for this
- * interpreter and arrange (by setting the
- * DONT_COMPILE_CMDS_INLINE flag) that when compiling new
- * code, no commands will be compiled inline (i.e., into
- * an inline sequence of instructions). We do this because
- * commands that were compiled inline will never result in
+ * When the first trace forbidding inline compilation is created,
+ * invalidate existing compiled code for this interpreter and
+ * arrange (by setting the DONT_COMPILE_CMDS_INLINE flag) that
+ * when compiling new code, no commands will be compiled inline
+ * (i.e., into an inline sequence of instructions). We do this
+ * because commands that were compiled inline will never result in
* a command trace being called.
*/
@@ -2051,15 +2094,15 @@ Tcl_CreateObjTrace( interp, level, flags, proc, clientData, delProc )
}
iPtr->tracesForbiddingInline++;
}
-
+
tracePtr = (Trace *) ckalloc(sizeof(Trace));
- tracePtr->level = level;
- tracePtr->proc = proc;
- tracePtr->clientData = clientData;
- tracePtr->delProc = delProc;
- tracePtr->nextPtr = iPtr->tracePtr;
- tracePtr->flags = flags;
- iPtr->tracePtr = tracePtr;
+ tracePtr->level = level;
+ tracePtr->proc = proc;
+ tracePtr->clientData = clientData;
+ tracePtr->delProc = delProc;
+ tracePtr->nextPtr = iPtr->tracePtr;
+ tracePtr->flags = flags;
+ iPtr->tracePtr = tracePtr;
return (Tcl_Trace) tracePtr;
}
@@ -2069,16 +2112,16 @@ Tcl_CreateObjTrace( interp, level, flags, proc, clientData, delProc )
*
* Tcl_CreateTrace --
*
- * Arrange for a procedure to be called to trace command execution.
+ * Arrange for a function to be called to trace command execution.
*
* Results:
- * The return value is a token for the trace, which may be passed
- * to Tcl_DeleteTrace to eliminate the trace.
+ * The return value is a token for the trace, which may be passed to
+ * Tcl_DeleteTrace to eliminate the trace.
*
* Side effects:
- * From now on, proc will be called just before a command procedure
- * is called to execute a Tcl command. Calls to proc will have the
- * following form:
+ * From now on, proc will be called just before a command procedure is
+ * called to execute a Tcl command. Calls to proc will have the following
+ * form:
*
* void
* proc(clientData, interp, level, command, cmdProc, cmdClientData,
@@ -2094,15 +2137,14 @@ Tcl_CreateObjTrace( interp, level, flags, proc, clientData, delProc )
* {
* }
*
- * The clientData and interp arguments to proc will be the same
- * as the corresponding arguments to this procedure. Level gives
- * the nesting level of command interpretation for this interpreter
- * (0 corresponds to top level). Command gives the ASCII text of
- * the raw command, cmdProc and cmdClientData give the procedure that
- * will be called to process the command and the ClientData value it
- * will receive, and argc and argv give the arguments to the
- * command, after any argument parsing and substitution. Proc
- * does not return a value.
+ * The clientData and interp arguments to proc will be the same as the
+ * corresponding arguments to this function. Level gives the nesting
+ * level of command interpretation for this interpreter (0 corresponds to
+ * top level). Command gives the ASCII text of the raw command, cmdProc
+ * and cmdClientData give the function that will be called to process the
+ * command and the ClientData value it will receive, and argc and argv
+ * give the arguments to the command, after any argument parsing and
+ * substitution. Proc does not return a value.
*
*----------------------------------------------------------------------
*/
@@ -2112,16 +2154,16 @@ Tcl_CreateTrace(interp, level, proc, clientData)
Tcl_Interp *interp; /* Interpreter in which to create trace. */
int level; /* Only call proc for commands at nesting
* level<=argument level (1=>top level). */
- Tcl_CmdTraceProc *proc; /* Procedure to call before executing each
+ Tcl_CmdTraceProc *proc; /* Function to call before executing each
* command. */
ClientData clientData; /* Arbitrary value word to pass to proc. */
{
StringTraceData* data;
- data = (StringTraceData*) ckalloc( sizeof( *data ));
+ data = (StringTraceData *) ckalloc(sizeof(*data));
data->clientData = clientData;
data->proc = proc;
- return Tcl_CreateObjTrace( interp, level, 0, StringTraceProc,
- (ClientData) data, StringTraceDeleteProc );
+ return Tcl_CreateObjTrace(interp, level, 0, StringTraceProc,
+ (ClientData) data, StringTraceDeleteProc);
}
/*
@@ -2129,20 +2171,19 @@ Tcl_CreateTrace(interp, level, proc, clientData)
*
* StringTraceProc --
*
- * Invoke a string-based trace procedure from an object-based
- * callback.
+ * Invoke a string-based trace function from an object-based callback.
*
* Results:
* None.
*
* Side effects:
- * Whatever the string-based trace procedure does.
+ * Whatever the string-based trace function does.
*
*----------------------------------------------------------------------
*/
static int
-StringTraceProc( clientData, interp, level, command, commandInfo, objc, objv )
+StringTraceProc(clientData, interp, level, command, commandInfo, objc, objv)
ClientData clientData;
Tcl_Interp* interp;
int level;
@@ -2153,33 +2194,30 @@ StringTraceProc( clientData, interp, level, command, commandInfo, objc, objv )
{
StringTraceData* data = (StringTraceData*) clientData;
Command* cmdPtr = (Command*) commandInfo;
-
CONST char** argv; /* Args to pass to string trace proc */
-
int i;
/*
- * This is a bit messy because we have to emulate the old trace
- * interface, which uses strings for everything.
+ * This is a bit messy because we have to emulate the old trace interface,
+ * which uses strings for everything.
*/
-
- argv = (CONST char **) ckalloc((unsigned) ( (objc + 1)
- * sizeof(CONST char *) ));
+
+ argv = (CONST char **)
+ ckalloc((unsigned) ((objc + 1) * sizeof(CONST char *)));
for (i = 0; i < objc; i++) {
argv[i] = Tcl_GetString(objv[i]);
}
argv[objc] = 0;
/*
- * Invoke the command procedure. Note that we cast away const-ness
- * on two parameters for compatibility with legacy code; the code
- * MUST NOT modify either command or argv.
+ * Invoke the command function. Note that we cast away const-ness on two
+ * parameters for compatibility with legacy code; the code MUST NOT modify
+ * either command or argv.
*/
-
- ( data->proc )( data->clientData, interp, level,
- (char*) command, cmdPtr->proc, cmdPtr->clientData,
- objc, argv );
- ckfree( (char*) argv );
+
+ (data->proc)(data->clientData, interp, level, (char *) command,
+ cmdPtr->proc, cmdPtr->clientData, objc, argv);
+ ckfree((char *) argv);
return TCL_OK;
}
@@ -2201,10 +2239,10 @@ StringTraceProc( clientData, interp, level, command, commandInfo, objc, objv )
*/
static void
-StringTraceDeleteProc( clientData )
+StringTraceDeleteProc(clientData)
ClientData clientData;
{
- ckfree( (char*) clientData );
+ ckfree((char *) clientData);
}
/*
@@ -2218,8 +2256,8 @@ StringTraceDeleteProc( clientData )
* None.
*
* Side effects:
- * From now on there will be no more calls to the procedure given
- * in trace.
+ * From now on there will be no more calls to the function given in
+ * trace.
*
*----------------------------------------------------------------------
*/
@@ -2236,8 +2274,8 @@ Tcl_DeleteTrace(interp, trace)
ActiveInterpTrace *activePtr;
/*
- * Locate the trace entry in the interpreter's trace list,
- * and remove it from the list.
+ * Locate the trace entry in the interpreter's trace list, and remove it
+ * from the list.
*/
prevPtr = NULL;
@@ -2251,9 +2289,9 @@ Tcl_DeleteTrace(interp, trace)
(*tracePtr2) = (*tracePtr2)->nextPtr;
/*
- * The code below makes it possible to delete traces while traces
- * are active: it makes sure that the deleted trace won't be
- * processed by TclCheckInterpTraces.
+ * The code below makes it possible to delete traces while traces are
+ * active: it makes sure that the deleted trace won't be processed by
+ * TclCheckInterpTraces.
*/
for (activePtr = iPtr->activeInterpTracePtr; activePtr != NULL;
@@ -2269,9 +2307,9 @@ Tcl_DeleteTrace(interp, trace)
/*
* If the trace forbids bytecode compilation, change the interpreter's
- * state. If bytecode compilation is now permitted, flag the fact and
- * advance the compilation epoch so that procs will be recompiled to
- * take advantage of it.
+ * state. If bytecode compilation is now permitted, flag the fact and
+ * advance the compilation epoch so that procs will be recompiled to take
+ * advantage of it.
*/
if (!(tracePtr->flags & TCL_ALLOW_INLINE_COMPILATION)) {
@@ -2290,7 +2328,9 @@ Tcl_DeleteTrace(interp, trace)
(tracePtr->delProc)(tracePtr->clientData);
}
- /* Delete the trace object */
+ /*
+ * Delete the trace object.
+ */
Tcl_EventuallyFree((char*)tracePtr, TCL_DYNAMIC);
}
@@ -2300,9 +2340,9 @@ Tcl_DeleteTrace(interp, trace)
*
* TclTraceVarExists --
*
- * This is called from info exists. We need to trigger read
- * and/or array traces because they may end up creating a
- * variable that doesn't currently exist.
+ * This is called from info exists. We need to trigger read and/or array
+ * traces because they may end up creating a variable that doesn't
+ * currently exist.
*
* Results:
* A pointer to the Var structure, or NULL.
@@ -2322,17 +2362,16 @@ TclVarTraceExists(interp, varName)
Var *arrayPtr;
/*
- * The choice of "create" flag values is delicate here, and
- * matches the semantics of GetVar. Things are still not perfect,
- * however, because if you do "info exists x" you get a varPtr
- * and therefore trigger traces. However, if you do
- * "info exists x(i)", then you only get a varPtr if x is already
- * known to be an array. Otherwise you get NULL, and no trace
- * is triggered. This matches Tcl 7.6 semantics.
+ * The choice of "create" flag values is delicate here, and matches the
+ * semantics of GetVar. Things are still not perfect, however, because if
+ * you do "info exists x" you get a varPtr and therefore trigger traces.
+ * However, if you do "info exists x(i)", then you only get a varPtr if x
+ * is already known to be an array. Otherwise you get NULL, and no trace
+ * is triggered. This matches Tcl 7.6 semantics.
*/
- varPtr = TclLookupVar(interp, varName, (char *) NULL,
- 0, "access", /*createPart1*/ 0, /*createPart2*/ 1, &arrayPtr);
+ varPtr = TclLookupVar(interp, varName, (char *) NULL, 0, "access",
+ /*createPart1*/ 0, /*createPart2*/ 1, &arrayPtr);
if (varPtr == NULL) {
return NULL;
@@ -2345,8 +2384,8 @@ TclVarTraceExists(interp, varName)
}
/*
- * If the variable doesn't exist anymore and no-one's using
- * it, then free up the relevant structures and hash table entries.
+ * If the variable doesn't exist anymore and no-one's using it, then free
+ * up the relevant structures and hash table entries.
*/
if (TclIsVarUndefined(varPtr)) {
@@ -2362,21 +2401,20 @@ TclVarTraceExists(interp, varName)
*
* TclCallVarTraces --
*
- * This procedure is invoked to find and invoke relevant
- * trace procedures associated with a particular operation on
- * a variable. This procedure invokes traces both on the
- * variable and on its containing array (where relevant).
+ * This function is invoked to find and invoke relevant trace functions
+ * associated with a particular operation on a variable. This function
+ * invokes traces both on the variable and on its containing array (where
+ * relevant).
*
* Results:
- * Returns TCL_OK to indicate normal operation. Returns TCL_ERROR
- * if invocation of a trace procedure indicated an error. When
- * TCL_ERROR is returned and leaveErrMsg is true, then the
- * errorInfo field of iPtr has information about the error
- * placed in it.
+ * Returns TCL_OK to indicate normal operation. Returns TCL_ERROR if
+ * invocation of a trace function indicated an error. When TCL_ERROR is
+ * returned and leaveErrMsg is true, then the errorInfo field of iPtr has
+ * information about the error placed in it.
*
* Side effects:
- * Almost anything can happen, depending on trace; this procedure
- * itself doesn't have any side effects.
+ * Almost anything can happen, depending on trace; this function itself
+ * doesn't have any side effects.
*
*----------------------------------------------------------------------
*/
@@ -2384,21 +2422,20 @@ TclVarTraceExists(interp, varName)
int
TclCallVarTraces(iPtr, arrayPtr, varPtr, part1, part2, flags, leaveErrMsg)
Interp *iPtr; /* Interpreter containing variable. */
- 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. */
+ 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. */
CONST char *part1;
CONST char *part2; /* Variable's two-part name. */
- int flags; /* Flags passed to trace procedures:
- * indicates what's happening to variable,
- * plus other stuff like TCL_GLOBAL_ONLY,
+ int flags; /* Flags passed to trace functions: indicates
+ * what's happening to variable, plus other
+ * stuff like TCL_GLOBAL_ONLY,
* TCL_NAMESPACE_ONLY, and
* TCL_INTERP_DESTROYED. */
- int leaveErrMsg; /* If true, and one of the traces indicates an
- * error, then leave an error message and stack
- * trace information in *iPTr. */
+ int leaveErrMsg; /* If true, and one of the traces indicates an
+ * error, then leave an error message and
+ * stack trace information in *iPTr. */
{
register VarTrace *tracePtr;
ActiveVarTrace active;
@@ -2411,8 +2448,8 @@ TclCallVarTraces(iPtr, arrayPtr, varPtr, part1, part2, flags, leaveErrMsg)
Tcl_InterpState state = NULL;
/*
- * If there are already similar trace procedures active for the
- * variable, don't call them again.
+ * If there are already similar trace functions active for the variable,
+ * don't call them again.
*/
if (TclIsVarTraceActive(varPtr)) {
@@ -2425,12 +2462,11 @@ TclCallVarTraces(iPtr, arrayPtr, varPtr, part1, part2, flags, leaveErrMsg)
}
/*
- * If the variable name hasn't been parsed into array name and
- * element, do it here. If there really is an array element,
- * make a copy of the original name so that NULLs can be
- * inserted into it to separate the names (can't modify the name
- * string in place, because the string might get used by the
- * callbacks we invoke).
+ * If the variable name hasn't been parsed into array name and element, do
+ * it here. If there really is an array element, make a copy of the
+ * original name so that NULLs can be inserted into it to separate the
+ * names (can't modify the name string in place, because the string might
+ * get used by the callbacks we invoke).
*/
copiedName = 0;
@@ -2445,6 +2481,7 @@ TclCallVarTraces(iPtr, arrayPtr, varPtr, part1, part2, flags, leaveErrMsg)
if (*p == ')') {
int offset = (openParen - part1);
char *newPart1;
+
Tcl_DStringInit(&nameCopy);
Tcl_DStringAppend(&nameCopy, part1, (p-part1));
newPart1 = Tcl_DStringValue(&nameCopy);
@@ -2469,7 +2506,7 @@ TclCallVarTraces(iPtr, arrayPtr, varPtr, part1, part2, flags, leaveErrMsg)
if (arrayPtr != NULL && !TclIsVarTraceActive(arrayPtr)) {
active.varPtr = arrayPtr;
for (tracePtr = arrayPtr->tracePtr; tracePtr != NULL;
- tracePtr = active.nextTracePtr) {
+ tracePtr = active.nextTracePtr) {
active.nextTracePtr = tracePtr->nextPtr;
if (!(tracePtr->flags & flags)) {
continue;
@@ -2482,10 +2519,13 @@ TclCallVarTraces(iPtr, arrayPtr, varPtr, part1, part2, flags, leaveErrMsg)
(Tcl_Interp *) iPtr, part1, part2, flags);
if (result != NULL) {
if (flags & TCL_TRACE_UNSETS) {
- /* Ignore errors in unset traces */
+ /*
+ * Ignore errors in unset traces.
+ */
+
DisposeTraceResult(tracePtr->flags, result);
} else {
- disposeFlags = tracePtr->flags;
+ disposeFlags = tracePtr->flags;
code = TCL_ERROR;
}
}
@@ -2505,7 +2545,7 @@ TclCallVarTraces(iPtr, arrayPtr, varPtr, part1, part2, flags, leaveErrMsg)
}
active.varPtr = varPtr;
for (tracePtr = varPtr->tracePtr; tracePtr != NULL;
- tracePtr = active.nextTracePtr) {
+ tracePtr = active.nextTracePtr) {
active.nextTracePtr = tracePtr->nextPtr;
if (!(tracePtr->flags & flags)) {
continue;
@@ -2518,7 +2558,10 @@ TclCallVarTraces(iPtr, arrayPtr, varPtr, part1, part2, flags, leaveErrMsg)
(Tcl_Interp *) iPtr, part1, part2, flags);
if (result != NULL) {
if (flags & TCL_TRACE_UNSETS) {
- /* Ignore errors in unset traces */
+ /*
+ * Ignore errors in unset traces.
+ */
+
DisposeTraceResult(tracePtr->flags, result);
} else {
disposeFlags = tracePtr->flags;
@@ -2532,11 +2575,11 @@ TclCallVarTraces(iPtr, arrayPtr, varPtr, part1, part2, flags, leaveErrMsg)
}
/*
- * Restore the variable's flags, remove the record of our active
- * traces, and then return.
+ * Restore the variable's flags, remove the record of our active traces,
+ * and then return.
*/
- done:
+ done:
if (code == TCL_ERROR) {
if (leaveErrMsg) {
CONST char *type = "";
@@ -2555,18 +2598,18 @@ TclCallVarTraces(iPtr, arrayPtr, varPtr, part1, part2, flags, leaveErrMsg)
}
Tcl_AppendToObj(errorInfo, "\n (", -1);
switch (flags&(TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_ARRAY)) {
- case TCL_TRACE_READS:
- type = "read";
- Tcl_AppendToObj(errorInfo, type, -1);
- break;
- case TCL_TRACE_WRITES:
- type = "set";
- Tcl_AppendToObj(errorInfo, "write", -1);
- break;
- case TCL_TRACE_ARRAY:
- type = "trace array";
- Tcl_AppendToObj(errorInfo, "array", -1);
- break;
+ case TCL_TRACE_READS:
+ type = "read";
+ Tcl_AppendToObj(errorInfo, type, -1);
+ break;
+ case TCL_TRACE_WRITES:
+ type = "set";
+ Tcl_AppendToObj(errorInfo, "write", -1);
+ break;
+ case TCL_TRACE_ARRAY:
+ type = "trace array";
+ Tcl_AppendToObj(errorInfo, "array", -1);
+ break;
}
if (disposeFlags & TCL_TRACE_RESULT_OBJECT) {
TclVarErrMsg((Tcl_Interp *) iPtr, part1, part2, type,
@@ -2618,9 +2661,9 @@ TclCallVarTraces(iPtr, arrayPtr, varPtr, part1, part2, flags, leaveErrMsg)
*
* DisposeTraceResult--
*
- * This procedure is called to dispose of the result returned from
- * a trace procedure. The disposal method appropriate to the type
- * of result is determined by flags.
+ * This function is called to dispose of the result returned from a trace
+ * function. The disposal method appropriate to the type of result is
+ * determined by flags.
*
* Results:
* None.
@@ -2634,9 +2677,9 @@ TclCallVarTraces(iPtr, arrayPtr, varPtr, part1, part2, flags, leaveErrMsg)
static void
DisposeTraceResult(flags, result)
int flags; /* Indicates type of result to determine
- * proper disposal method */
- char *result; /* The result returned from a trace
- * procedure to be disposed */
+ * proper disposal method. */
+ char *result; /* The result returned from a trace function
+ * to be disposed. */
{
if (flags & TCL_TRACE_RESULT_DYNAMIC) {
ckfree(result);
@@ -2656,9 +2699,8 @@ DisposeTraceResult(flags, result)
* None.
*
* Side effects:
- * If there exists a trace for the variable given by varName
- * with the given flags, proc, and clientData, then that trace
- * is removed.
+ * If there exists a trace for the variable given by varName with the
+ * given flags, proc, and clientData, then that trace is removed.
*
*----------------------------------------------------------------------
*/
@@ -2666,14 +2708,13 @@ DisposeTraceResult(flags, result)
void
Tcl_UntraceVar(interp, varName, flags, proc, clientData)
Tcl_Interp *interp; /* Interpreter containing variable. */
- 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, TCL_TRACE_WRITES,
- * TCL_TRACE_UNSETS, TCL_GLOBAL_ONLY
- * and TCL_NAMESPACE_ONLY. */
- Tcl_VarTraceProc *proc; /* Procedure assocated with trace. */
+ 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,
+ * TCL_TRACE_WRITES, TCL_TRACE_UNSETS,
+ * TCL_GLOBAL_ONLY and TCL_NAMESPACE_ONLY. */
+ Tcl_VarTraceProc *proc; /* Function assocated with trace. */
ClientData clientData; /* Arbitrary argument to pass to proc. */
{
Tcl_UntraceVar2(interp, varName, (char *) NULL, flags, proc, clientData);
@@ -2690,9 +2731,8 @@ Tcl_UntraceVar(interp, varName, flags, proc, clientData)
* None.
*
* Side effects:
- * If there exists a trace for the variable given by part1
- * and part2 with the given flags, proc, and clientData, then
- * that trace is removed.
+ * If there exists a trace for the variable given by part1 and part2 with
+ * the given flags, proc, and clientData, then that trace is removed.
*
*----------------------------------------------------------------------
*/
@@ -2701,15 +2741,14 @@ void
Tcl_UntraceVar2(interp, part1, part2, flags, proc, clientData)
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 *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 trace, including any of
- * TCL_TRACE_READS, TCL_TRACE_WRITES,
- * TCL_TRACE_UNSETS, TCL_GLOBAL_ONLY,
- * and TCL_NAMESPACE_ONLY. */
- Tcl_VarTraceProc *proc; /* Procedure assocated with trace. */
+ int flags; /* OR-ed collection of bits describing current
+ * trace, including any of TCL_TRACE_READS,
+ * TCL_TRACE_WRITES, TCL_TRACE_UNSETS,
+ * TCL_GLOBAL_ONLY, and TCL_NAMESPACE_ONLY. */
+ Tcl_VarTraceProc *proc; /* Function assocated with trace. */
ClientData clientData; /* Arbitrary argument to pass to proc. */
{
register VarTrace *tracePtr;
@@ -2718,11 +2757,12 @@ Tcl_UntraceVar2(interp, part1, part2, flags, proc, clientData)
Interp *iPtr = (Interp *) interp;
ActiveVarTrace *activePtr;
int flagMask;
-
+
/*
* Set up a mask to mask out the parts of the flags that we are not
* interested in now.
*/
+
flagMask = TCL_GLOBAL_ONLY | TCL_NAMESPACE_ONLY;
varPtr = TclLookupVar(interp, part1, part2, flags & flagMask,
/*msg*/ (char *) NULL,
@@ -2735,14 +2775,15 @@ Tcl_UntraceVar2(interp, part1, part2, flags, proc, clientData)
* Set up a mask to mask out the parts of the flags that we are not
* interested in now.
*/
+
flagMask = TCL_TRACE_READS | TCL_TRACE_WRITES | TCL_TRACE_UNSETS |
- TCL_TRACE_ARRAY | TCL_TRACE_RESULT_DYNAMIC | TCL_TRACE_RESULT_OBJECT;
+ TCL_TRACE_ARRAY | TCL_TRACE_RESULT_DYNAMIC | TCL_TRACE_RESULT_OBJECT;
#ifndef TCL_REMOVE_OBSOLETE_TRACES
flagMask |= TCL_TRACE_OLD_STYLE;
#endif
flags &= flagMask;
- for (tracePtr = varPtr->tracePtr, prevPtr = NULL; ;
- prevPtr = tracePtr, tracePtr = tracePtr->nextPtr) {
+ for (tracePtr = varPtr->tracePtr, prevPtr = NULL; ;
+ prevPtr = tracePtr, tracePtr = tracePtr->nextPtr) {
if (tracePtr == NULL) {
return;
}
@@ -2753,13 +2794,13 @@ Tcl_UntraceVar2(interp, part1, part2, flags, proc, clientData)
}
/*
- * The code below makes it possible to delete traces while traces
- * are active: it makes sure that the deleted trace won't be
- * processed by TclCallVarTraces.
+ * The code below makes it possible to delete traces while traces are
+ * active: it makes sure that the deleted trace won't be processed by
+ * TclCallVarTraces.
*/
for (activePtr = iPtr->activeVarTracePtr; activePtr != NULL;
- activePtr = activePtr->nextPtr) {
+ activePtr = activePtr->nextPtr) {
if (activePtr->nextTracePtr == tracePtr) {
activePtr->nextTracePtr = tracePtr->nextPtr;
}
@@ -2772,8 +2813,8 @@ Tcl_UntraceVar2(interp, part1, part2, flags, proc, clientData)
Tcl_EventuallyFree((ClientData) tracePtr, TCL_DYNAMIC);
/*
- * If this is the last trace on the variable, and the variable is
- * unset and unused, then free up the variable.
+ * If this is the last trace on the variable, and the variable is unset
+ * and unused, then free up the variable.
*/
if (TclIsVarUndefined(varPtr)) {
@@ -2786,20 +2827,17 @@ Tcl_UntraceVar2(interp, part1, part2, flags, proc, clientData)
*
* Tcl_VarTraceInfo --
*
- * Return the clientData value associated with a trace on a
- * variable. This procedure can also be used to step through
- * all of the traces on a particular variable that have the
- * same trace procedure.
+ * Return the clientData value associated with a trace on a variable.
+ * This function can also be used to step through all of the traces on a
+ * particular variable that have the same trace function.
*
* Results:
- * The return value is the clientData value associated with
- * a trace on the given variable. Information will only be
- * returned for a trace with proc as trace procedure. If
- * the clientData argument is NULL then the first such trace is
- * returned; otherwise, the next relevant one after the one
- * given by clientData will be returned. If the variable
- * doesn't exist, or if there are no (more) traces for it,
- * then NULL is returned.
+ * The return value is the clientData value associated with a trace on
+ * the given variable. Information will only be returned for a trace with
+ * proc as trace function. If the clientData argument is NULL then the
+ * first such trace is returned; otherwise, the next relevant one after
+ * the one given by clientData will be returned. If the variable doesn't
+ * exist, or if there are no (more) traces for it, then NULL is returned.
*
* Side effects:
* None.
@@ -2810,16 +2848,15 @@ Tcl_UntraceVar2(interp, part1, part2, flags, proc, clientData)
ClientData
Tcl_VarTraceInfo(interp, varName, flags, proc, prevClientData)
Tcl_Interp *interp; /* Interpreter containing variable. */
- CONST char *varName; /* Name of variable; may end with "(index)"
- * to signify an array reference. */
+ 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). */
- Tcl_VarTraceProc *proc; /* Procedure assocated with trace. */
- ClientData prevClientData; /* If non-NULL, gives last value returned
- * by this procedure, so this call will
- * return the next trace after that one.
- * If NULL, this call will return the
- * first 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. */
{
return Tcl_VarTraceInfo2(interp, varName, (char *) NULL,
flags, proc, prevClientData);
@@ -2830,8 +2867,8 @@ Tcl_VarTraceInfo(interp, varName, flags, proc, prevClientData)
*
* Tcl_VarTraceInfo2 --
*
- * Same as Tcl_VarTraceInfo, except takes name in two pieces
- * instead of one.
+ * Same as Tcl_VarTraceInfo, except takes name in two pieces instead of
+ * one.
*
* Results:
* Same as Tcl_VarTraceInfo.
@@ -2846,17 +2883,16 @@ ClientData
Tcl_VarTraceInfo2(interp, part1, part2, flags, proc, prevClientData)
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 *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,
* TCL_NAMESPACE_ONLY. */
- Tcl_VarTraceProc *proc; /* Procedure assocated with trace. */
- ClientData prevClientData; /* If non-NULL, gives last value returned
- * by this procedure, so this call will
- * return the next trace after that one.
- * If NULL, this call will return the
- * first 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. */
{
register VarTrace *tracePtr;
Var *varPtr, *arrayPtr;
@@ -2883,7 +2919,7 @@ Tcl_VarTraceInfo2(interp, part1, part2, flags, proc, prevClientData)
}
}
}
- for ( ; tracePtr != NULL; tracePtr = tracePtr->nextPtr) {
+ for (; tracePtr!=NULL ; tracePtr=tracePtr->nextPtr) {
if (tracePtr->traceProc == proc) {
return tracePtr->clientData;
}
@@ -2896,37 +2932,36 @@ Tcl_VarTraceInfo2(interp, part1, part2, flags, proc, prevClientData)
*
* Tcl_TraceVar --
*
- * Arrange for reads and/or writes to a variable to cause a
- * procedure to be invoked, which can monitor the operations
- * and/or change their actions.
+ * Arrange for reads and/or writes to a variable to cause a function to
+ * be invoked, which can monitor the operations and/or change their
+ * actions.
*
* Results:
* A standard Tcl return value.
*
* Side effects:
- * A trace is set up on the variable given by varName, such that
- * future references to the variable will be intermediated by
- * proc. See the manual entry for complete details on the calling
- * sequence for proc.
+ * A trace is set up on the variable given by varName, such that future
+ * references to the variable will be intermediated by proc. See the
+ * manual entry for complete details on the calling sequence for proc.
*
*----------------------------------------------------------------------
*/
int
Tcl_TraceVar(interp, varName, flags, proc, clientData)
- Tcl_Interp *interp; /* Interpreter in which variable is
- * to be traced. */
- 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,
+ Tcl_Interp *interp; /* Interpreter in which variable is to be
+ * traced. */
+ 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,
* TCL_TRACE_UNSETS, TCL_GLOBAL_ONLY, and
* TCL_NAMESPACE_ONLY. */
- Tcl_VarTraceProc *proc; /* Procedure to call when specified ops are
+ Tcl_VarTraceProc *proc; /* Function to call when specified ops are
* invoked upon varName. */
ClientData clientData; /* Arbitrary argument to pass to proc. */
{
- return Tcl_TraceVar2(interp, varName, (char *) NULL,
+ return Tcl_TraceVar2(interp, varName, (char *) NULL,
flags, proc, clientData);
}
@@ -2935,48 +2970,49 @@ Tcl_TraceVar(interp, varName, flags, proc, clientData)
*
* Tcl_TraceVar2 --
*
- * Arrange for reads and/or writes to a variable to cause a
- * procedure to be invoked, which can monitor the operations
- * and/or change their actions.
+ * Arrange for reads and/or writes to a variable to cause a function to
+ * be invoked, which can monitor the operations and/or change their
+ * actions.
*
* Results:
* A standard Tcl return value.
*
* Side effects:
- * A trace is set up on the variable given by part1 and part2, such
- * that future references to the variable will be intermediated by
- * proc. See the manual entry for complete details on the calling
- * sequence for proc.
+ * A trace is set up on the variable given by part1 and part2, such that
+ * future references to the variable will be intermediated by proc. See
+ * the manual entry for complete details on the calling sequence for
+ * proc.
*
*----------------------------------------------------------------------
*/
int
Tcl_TraceVar2(interp, part1, part2, flags, proc, clientData)
- Tcl_Interp *interp; /* Interpreter in which variable is
- * to be traced. */
+ 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 *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 TCL_TRACE_READS, TCL_TRACE_WRITES,
- * TCL_TRACE_UNSETS, TCL_GLOBAL_ONLY,
- * and TCL_NAMESPACE_ONLY. */
- Tcl_VarTraceProc *proc; /* Procedure to call when specified ops are
+ int flags; /* OR-ed collection of bits, including any of
+ * TCL_TRACE_READS, TCL_TRACE_WRITES,
+ * TCL_TRACE_UNSETS, TCL_GLOBAL_ONLY, and
+ * TCL_NAMESPACE_ONLY. */
+ Tcl_VarTraceProc *proc; /* Function to call when specified ops are
* invoked upon varName. */
ClientData clientData; /* Arbitrary argument to pass to proc. */
{
Var *varPtr, *arrayPtr;
register VarTrace *tracePtr;
int flagMask;
-
- /*
+
+ /*
* We strip 'flags' down to just the parts which are relevant to
- * TclLookupVar, to avoid conflicts between trace flags and
- * internal namespace flags such as 'TCL_FIND_ONLY_NS'. This can
- * now occur since we have trace flags with values 0x1000 and higher.
+ * TclLookupVar, to avoid conflicts between trace flags and internal
+ * namespace flags such as 'TCL_FIND_ONLY_NS'. This can now occur since we
+ * have trace flags with values 0x1000 and higher.
*/
+
flagMask = TCL_GLOBAL_ONLY | TCL_NAMESPACE_ONLY;
varPtr = TclLookupVar(interp, part1, part2,
(flags & flagMask) | TCL_LEAVE_ERR_MSG,
@@ -2986,10 +3022,10 @@ Tcl_TraceVar2(interp, part1, part2, flags, proc, clientData)
}
/*
- * Check for a nonsense flag combination. Note that this is a
- * Tcl_Panic() because there should be no code path that ever sets
- * both flags.
+ * Check for a nonsense flag combination. Note that this is a Tcl_Panic()
+ * because there should be no code path that ever sets both flags.
*/
+
if ((flags&TCL_TRACE_RESULT_DYNAMIC) && (flags&TCL_TRACE_RESULT_OBJECT)) {
Tcl_Panic("bad result flag combination");
}
@@ -2998,16 +3034,25 @@ Tcl_TraceVar2(interp, part1, part2, flags, proc, clientData)
* Set up trace information.
*/
- flagMask = TCL_TRACE_READS | TCL_TRACE_WRITES | TCL_TRACE_UNSETS |
- TCL_TRACE_ARRAY | TCL_TRACE_RESULT_DYNAMIC | TCL_TRACE_RESULT_OBJECT;
+ flagMask = TCL_TRACE_READS | TCL_TRACE_WRITES | TCL_TRACE_UNSETS |
+ TCL_TRACE_ARRAY | TCL_TRACE_RESULT_DYNAMIC | TCL_TRACE_RESULT_OBJECT;
#ifndef TCL_REMOVE_OBSOLETE_TRACES
flagMask |= TCL_TRACE_OLD_STYLE;
#endif
tracePtr = (VarTrace *) ckalloc(sizeof(VarTrace));
- tracePtr->traceProc = proc;
- tracePtr->clientData = clientData;
- tracePtr->flags = flags & flagMask;
- tracePtr->nextPtr = varPtr->tracePtr;
- varPtr->tracePtr = tracePtr;
+ tracePtr->traceProc = proc;
+ tracePtr->clientData = clientData;
+ tracePtr->flags = flags & flagMask;
+ tracePtr->nextPtr = varPtr->tracePtr;
+
+ varPtr->tracePtr = tracePtr;
return TCL_OK;
}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclVar.c b/generic/tclVar.c
index e2d3bf9..5e196a7 100644
--- a/generic/tclVar.c
+++ b/generic/tclVar.c
@@ -15,7 +15,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.108 2005/07/05 14:19:10 dkf Exp $
+ * RCS: @(#) $Id: tclVar.c,v 1.109 2005/07/23 00:04:32 dkf Exp $
*/
#include "tclInt.h"
@@ -99,7 +99,7 @@ static Tcl_ObjType localVarNameType = {
/*
* Caching of namespace variables disabled: no simple way was found to avoid
- * interfering with the resolver's idea of variable existence. A cached
+ * interfering with the resolver's idea of variable existence. A cached
* varName may keep a variable's name in the namespace's hash table, which is
* the resolver's criterion for existence (see test namespace-17.10).
*/
@@ -222,11 +222,11 @@ TclLookupVar(interp, part1, part2, flags, msg, createPart1, createPart2,
/*
* Parse part1 into array name and index.
* Always check if part1 is an array element name and allow it only if
- * part2 is not given. (if one does not care about creating array
- * elements that can't be used from tcl, and prefer slightly better
- * performance, one can put the following in an if (part2 == NULL) { ... }
- * block and remove the part2's test and error reporting or move that code
- * in array set)
+ * part2 is not given. (If one does not care about creating array elements
+ * that can't be used from tcl, and prefer slightly better performance,
+ * one can put the following in an if (part2 == NULL) { ... } block and
+ * remove the part2's test and error reporting or move that code in array
+ * set.)
*/
elName = part2;
@@ -456,7 +456,7 @@ TclObjLookupVar(interp, part1Ptr, part2, flags, msg, createPart1, createPart2,
#endif
}
- doParse:
+ doParse:
if (!parsed && (*(part1 + len1 - 1) == ')')) {
/*
* part1Ptr is possibly an unparsed array element.
@@ -602,9 +602,9 @@ TclObjLookupVar(interp, part1Ptr, part2, flags, msg, createPart1, createPart2,
* This flag bit should not interfere with TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY,
* or TCL_LEAVE_ERR_MSG; it signals that the variable lookup is performed for
* upvar (or similar) purposes, with slightly different rules:
- * - Bug #696893 - variable is either proc-local or in the current
- * namespace; never follow the second (global) resolution path
- * - Bug #631741 - do not use special namespace or interp resolvers
+ * - Bug #696893 - variable is either proc-local or in the current
+ * namespace; never follow the second (global) resolution path
+ * - Bug #631741 - do not use special namespace or interp resolvers
*
* It should also not collide with the (deprecated) TCL_PARSE_PART1 flag
* (Bug #835020)
@@ -3249,10 +3249,11 @@ TclArraySet(interp, arrayNameObj, arrayElemObj)
* loop and return an error.
*/
- for (i = 0; i < elemLen; i += 2) {
+ for (i=0 ; i<elemLen ; i+=2) {
char *part2 = TclGetString(elemPtrs[i]);
Var *elemVarPtr = TclLookupArrayElement(interp, varName,
part2, TCL_LEAVE_ERR_MSG, "set", 1, 1, varPtr);
+
if ((elemVarPtr == NULL) ||
(TclPtrSetVar(interp, elemVarPtr, varPtr, varName, part2,
elemPtrs[i+1], TCL_LEAVE_ERR_MSG) == NULL)) {
@@ -3409,8 +3410,8 @@ ObjMakeUpvar(interp, framePtr, otherP1Ptr, otherP2, otherFlags, myName,
* LOOKUP_FOR_UPVAR to indicate the special resolution rules for upvar
* purposes:
* - Bug #696893 - variable is either proc-local or in the current
- * namespace; never follow the second (global) resolution path
- * - Bug #631741 - do not use special namespace or interp resolvers
+ * namespace; never follow the second (global) resolution path.
+ * - Bug #631741 - do not use special namespace or interp resolvers.
*/
varPtr = TclLookupSimpleVar(interp, myName, (myFlags|LOOKUP_FOR_UPVAR),
@@ -4169,7 +4170,7 @@ TclDeleteVars(iPtr, tablePtr)
}
for (hPtr = Tcl_FirstHashEntry(tablePtr, &search); hPtr != NULL;
- hPtr = Tcl_NextHashEntry(&search)) {
+ hPtr = Tcl_NextHashEntry(&search)) {
varPtr = (Var *) Tcl_GetHashValue(hPtr);
/*
@@ -4339,7 +4340,7 @@ TclDeleteCompiledLocalVars(iPtr, framePtr)
Tcl_EventuallyFree((ClientData) tracePtr, TCL_DYNAMIC);
}
for (activePtr = iPtr->activeVarTracePtr; activePtr != NULL;
- activePtr = activePtr->nextPtr) {
+ activePtr = activePtr->nextPtr) {
if (activePtr->varPtr == varPtr) {
activePtr->nextTracePtr = NULL;
}
@@ -4422,11 +4423,12 @@ DeleteArray(iPtr, arrayName, varPtr, flags)
/* leaveErrMsg */ 0);
while (elPtr->tracePtr != NULL) {
VarTrace *tracePtr = elPtr->tracePtr;
+
elPtr->tracePtr = tracePtr->nextPtr;
- Tcl_EventuallyFree((ClientData) tracePtr,TCL_DYNAMIC);
+ Tcl_EventuallyFree((ClientData) tracePtr, TCL_DYNAMIC);
}
for (activePtr = iPtr->activeVarTracePtr; activePtr != NULL;
- activePtr = activePtr->nextPtr) {
+ activePtr = activePtr->nextPtr) {
if (activePtr->varPtr == elPtr) {
activePtr->nextTracePtr = NULL;
}
@@ -4702,3 +4704,11 @@ UpdateParsedVarName(objPtr)
*p++ = ')';
*p = '\0';
}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */