Attachment "varflags2.diff" to
ticket [1055216fff]
added by
msofer
2004-10-29 04:05:33.
Index: generic/tclCmdIL.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclCmdIL.c,v
retrieving revision 1.67
diff -u -r1.67 tclCmdIL.c
--- generic/tclCmdIL.c 25 Oct 2004 01:06:49 -0000 1.67
+++ generic/tclCmdIL.c 28 Oct 2004 15:00:26 -0000
@@ -534,6 +534,7 @@
Proc *procPtr;
CompiledLocal *localPtr;
Tcl_Obj *listObjPtr;
+ int argNum = 0;
if (objc != 3) {
Tcl_WrongNumArgs(interp, 2, objv, "procname");
@@ -553,12 +554,11 @@
*/
listObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
- for (localPtr = procPtr->firstLocalPtr; localPtr != NULL;
+ for (localPtr = procPtr->firstLocalPtr;
+ (argNum++ < procPtr->numArgs) && (localPtr != NULL);
localPtr = localPtr->nextPtr) {
- if (TclIsVarArgument(localPtr)) {
- Tcl_ListObjAppendElement(interp, listObjPtr,
- Tcl_NewStringObj(localPtr->name, -1));
- }
+ Tcl_ListObjAppendElement(interp, listObjPtr,
+ Tcl_NewStringObj(localPtr->name, -1));
}
Tcl_SetObjResult(interp, listObjPtr);
return TCL_OK;
@@ -909,6 +909,7 @@
Proc *procPtr;
CompiledLocal *localPtr;
Tcl_Obj *valueObjPtr;
+ int argNum = 0;
if (objc != 5) {
Tcl_WrongNumArgs(interp, 2, objv, "procname arg varname");
@@ -927,7 +928,7 @@
for (localPtr = procPtr->firstLocalPtr; localPtr != NULL;
localPtr = localPtr->nextPtr) {
- if (TclIsVarArgument(localPtr)
+ if ((argNum++ < procPtr->numArgs)
&& (strcmp(argName, localPtr->name) == 0)) {
if (localPtr->defValuePtr != NULL) {
valueObjPtr = Tcl_ObjSetVar2(interp, objv[4], NULL,
Index: generic/tclCompCmds.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclCompCmds.c,v
retrieving revision 1.59
diff -u -r1.59 tclCompCmds.c
--- generic/tclCompCmds.c 18 Oct 2004 21:15:37 -0000 1.59
+++ generic/tclCompCmds.c 28 Oct 2004 15:00:26 -0000
@@ -255,7 +255,7 @@
}
localIndex = TclFindCompiledLocal(nameTokenPtr[1].start,
nameTokenPtr[1].size, /*create*/ 1,
- /*flags*/ VAR_SCALAR, envPtr->procPtr);
+ /*flags*/ 0, envPtr->procPtr);
} else {
return TCL_OUT_LINE_COMPILE;
}
@@ -756,13 +756,13 @@
firstValueTemp = -1;
for (loopIndex = 0; loopIndex < numLists; loopIndex++) {
tempVar = TclFindCompiledLocal(NULL, /*nameChars*/ 0,
- /*create*/ 1, /*flags*/ VAR_SCALAR, procPtr);
+ /*create*/ 1, /*flags*/ 0, procPtr);
if (loopIndex == 0) {
firstValueTemp = tempVar;
}
}
loopCtTemp = TclFindCompiledLocal(NULL, /*nameChars*/ 0,
- /*create*/ 1, /*flags*/ VAR_SCALAR, procPtr);
+ /*create*/ 1, /*flags*/ 0, procPtr);
/*
* Create and initialize the ForeachInfo and ForeachVarList data
@@ -785,7 +785,7 @@
CONST char *varName = varvList[loopIndex][j];
int nameChars = strlen(varName);
varListPtr->varIndexes[j] = TclFindCompiledLocal(varName,
- nameChars, /*create*/ 1, /*flags*/ VAR_SCALAR, procPtr);
+ nameChars, /*create*/ 1, /*flags*/ 0, procPtr);
}
infoPtr->varLists[loopIndex] = varListPtr;
}
@@ -3492,7 +3492,7 @@
if ((envPtr->procPtr != NULL) && !hasNsQualifiers) {
localIndex = TclFindCompiledLocal(name, nameChars,
/*create*/ (flags & TCL_CREATE_VAR),
- /*flags*/ ((elName==NULL)? VAR_SCALAR : VAR_ARRAY),
+ /*flags*/ ((elName==NULL)? 0 : VAR_ARRAY),
envPtr->procPtr);
if ((flags & TCL_NO_LARGE_INDEX) && (localIndex > 255)) {
/* we'll push the name */
Index: generic/tclCompile.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclCompile.c,v
retrieving revision 1.78
diff -u -r1.78 tclCompile.c
--- generic/tclCompile.c 8 Oct 2004 15:39:52 -0000 1.78
+++ generic/tclCompile.c 28 Oct 2004 15:00:27 -0000
@@ -1777,8 +1777,8 @@
int create; /* If 1, allocate a local frame entry for
* the variable if it is new. */
int flags; /* Flag bits for the compiled local if
- * created. Only VAR_SCALAR, VAR_ARRAY, and
- * VAR_LINK make sense. */
+ * created. Only VAR_ARRAY, and VAR_LINK make
+ * sense, a scalar is created if flags is 0. */
register Proc *procPtr; /* Points to structure describing procedure
* containing the variable reference. */
{
@@ -1821,12 +1821,12 @@
procPtr->lastLocalPtr->nextPtr = localPtr;
procPtr->lastLocalPtr = localPtr;
}
+ localPtr->flags = flags;
localPtr->nextPtr = NULL;
localPtr->nameLength = nameBytes;
localPtr->frameIndex = localVar;
- localPtr->flags = flags | VAR_UNDEFINED;
if (name == NULL) {
- localPtr->flags |= VAR_TEMPORARY;
+ TclSetVarTemporary(localPtr);
}
localPtr->defValuePtr = NULL;
localPtr->resolveInfo = NULL;
@@ -1872,7 +1872,9 @@
Var *resolvedVarPtr;
ResolverScheme *resPtr;
int result;
-
+ int argNum = 0, numArgs = framePtr->procPtr->numArgs;
+ int resolversNeeded = (nsPtr->compiledVarResProc || iPtr->resolverPtr);
+
/*
* Initialize the array of local variables stored in the call frame.
* Some variables may have special resolution rules. In that case,
@@ -1882,75 +1884,77 @@
for (localPtr = framePtr->procPtr->firstLocalPtr;
localPtr != NULL;
- localPtr = localPtr->nextPtr) {
-
- /*
- * Check to see if this local is affected by namespace or
- * interp resolvers. The resolver to use is cached for the
- * next invocation of the procedure.
- */
-
- if (!(localPtr->flags & (VAR_ARGUMENT|VAR_TEMPORARY|VAR_RESOLVED))
- && (nsPtr->compiledVarResProc || iPtr->resolverPtr)) {
- resPtr = iPtr->resolverPtr;
-
- if (nsPtr->compiledVarResProc) {
- result = (*nsPtr->compiledVarResProc)(nsPtr->interp,
- localPtr->name, localPtr->nameLength,
- (Tcl_Namespace *) nsPtr, &vinfo);
- } else {
- result = TCL_CONTINUE;
- }
+ varPtr++, localPtr = localPtr->nextPtr) {
- while ((result == TCL_CONTINUE) && resPtr) {
- if (resPtr->compiledVarResProc) {
- result = (*resPtr->compiledVarResProc)(nsPtr->interp,
+ if (resolversNeeded) {
+ /*
+ * Check to see if this local is affected by namespace or
+ * interp resolvers. The resolver to use is cached for the
+ * next invocation of the procedure.
+ *
+ * Performance note: should this be an independent loop?
+ */
+
+ if ((argNum++ >= numArgs)
+ && !(localPtr->flags & (VAR_TEMPORARY|VAR_RESOLVED))) {
+ resPtr = iPtr->resolverPtr;
+
+ if (nsPtr->compiledVarResProc) {
+ result = (*nsPtr->compiledVarResProc)(nsPtr->interp,
localPtr->name, localPtr->nameLength,
(Tcl_Namespace *) nsPtr, &vinfo);
+ } else {
+ result = TCL_CONTINUE;
+ }
+
+ while ((result == TCL_CONTINUE) && resPtr) {
+ if (resPtr->compiledVarResProc) {
+ result = (*resPtr->compiledVarResProc)(nsPtr->interp,
+ localPtr->name, localPtr->nameLength,
+ (Tcl_Namespace *) nsPtr, &vinfo);
+ }
+ resPtr = resPtr->nextPtr;
}
- resPtr = resPtr->nextPtr;
+ if (result == TCL_OK) {
+ localPtr->resolveInfo = vinfo;
+ TclSetVarResolved(localPtr);
+ }
+ }
+
+ /*
+ * Now invoke the resolvers to determine the exact variables that
+ * should be used.
+ */
+
+ resVarInfo = localPtr->resolveInfo;
+ resolvedVarPtr = NULL;
+
+ if (resVarInfo && resVarInfo->fetchProc) {
+ resolvedVarPtr = (Var*) (*resVarInfo->fetchProc)(interp,
+ resVarInfo);
}
- if (result == TCL_OK) {
- localPtr->resolveInfo = vinfo;
- localPtr->flags |= VAR_RESOLVED;
+
+ if (resolvedVarPtr) {
+ TclSetVarLink(varPtr);
+ varPtr->value.linkPtr = resolvedVarPtr;
+ resolvedVarPtr->refCount++;
}
}
/*
- * Now invoke the resolvers to determine the exact variables that
- * should be used.
+ * Performance note: would it be better to memset all the
+ * varPtr fields to 0 outside the loop, and then iterate setting
+ * the names and resolvers?
*/
-
- resVarInfo = localPtr->resolveInfo;
- resolvedVarPtr = NULL;
-
- if (resVarInfo && resVarInfo->fetchProc) {
- resolvedVarPtr = (Var*) (*resVarInfo->fetchProc)(interp,
- resVarInfo);
- }
-
- if (resolvedVarPtr) {
- varPtr->name = localPtr->name; /* will be just '\0' if temp var */
- varPtr->nsPtr = NULL;
- varPtr->hPtr = NULL;
- varPtr->refCount = 0;
- varPtr->tracePtr = NULL;
- varPtr->searchPtr = NULL;
- varPtr->flags = 0;
- TclSetVarLink(varPtr);
- varPtr->value.linkPtr = resolvedVarPtr;
- resolvedVarPtr->refCount++;
- } else {
- varPtr->value.objPtr = NULL;
- varPtr->name = localPtr->name; /* will be just '\0' if temp var */
- varPtr->nsPtr = NULL;
- varPtr->hPtr = NULL;
- varPtr->refCount = 0;
- varPtr->tracePtr = NULL;
- varPtr->searchPtr = NULL;
- varPtr->flags = localPtr->flags;
- }
- varPtr++;
+
+ varPtr->value.objPtr = NULL;
+ varPtr->name = localPtr->name; /* will be just '\0' if temp var */
+ varPtr->nsPtr = NULL;
+ varPtr->hPtr = NULL;
+ varPtr->refCount = 0;
+ varPtr->tracePtr = NULL;
+ varPtr->searchPtr = NULL;
+ varPtr->flags = 0;
}
}
@@ -3029,12 +3033,12 @@
CompiledLocal *localPtr = procPtr->firstLocalPtr;
for (i = 0; i < numCompiledLocals; i++) {
fprintf(stdout, " slot %d%s%s%s%s%s%s", i,
- ((localPtr->flags & VAR_SCALAR)? ", scalar" : ""),
- ((localPtr->flags & VAR_ARRAY)? ", array" : ""),
- ((localPtr->flags & VAR_LINK)? ", link" : ""),
- ((localPtr->flags & VAR_ARGUMENT)? ", arg" : ""),
- ((localPtr->flags & VAR_TEMPORARY)? ", temp" : ""),
- ((localPtr->flags & VAR_RESOLVED)? ", resolved" : ""));
+ (TclIsVarScalar(localPtr)? ", scalar" : ""),
+ (TclIsVarArray(localPtr)? ", array" : ""),
+ (TclIsVarLink(localPtr)? ", link" : ""),
+ ((i < procPtr->numArgs)? ", arg" : ""),
+ (TclIsVarTemporary(localPtr)? ", temp" : ""),
+ (TclIsVarResolved(localPtr)? ", resolved" : ""));
if (TclIsVarTemporary(localPtr)) {
fprintf(stdout, "\n");
} else {
Index: generic/tclExecute.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclExecute.c,v
retrieving revision 1.162
diff -u -r1.162 tclExecute.c
--- generic/tclExecute.c 25 Oct 2004 20:24:12 -0000 1.162
+++ generic/tclExecute.c 28 Oct 2004 15:00:27 -0000
@@ -2107,8 +2107,7 @@
if (valuePtr != NULL) {
TclDecrRefCount(valuePtr);
} else {
- TclSetVarScalar(varPtr);
- TclClearVarUndefined(varPtr);
+ varPtr->flags |= VAR_DIRECT_READABLE;
}
varPtr->value.objPtr = objResultPtr;
Tcl_IncrRefCount(objResultPtr);
@@ -4494,7 +4493,6 @@
Tcl_SetLongObj(oldValuePtr, -1);
}
TclSetVarScalar(iterVarPtr);
- TclClearVarUndefined(iterVarPtr);
TRACE(("%u => loop iter count temp %d\n",
opnd, iterTmpIndex));
}
@@ -4604,13 +4602,18 @@
varPtr = varPtr->value.linkPtr;
}
if (TclIsVarDirectWritable(varPtr)) {
+ /*
+ * Note that the bytecode compiler insures that
+ * varPtr isNOT an array element, so that we do
+ * not need to check for array traces.
+ */
+
value2Ptr = varPtr->value.objPtr;
if (valuePtr != value2Ptr) {
if (value2Ptr != NULL) {
TclDecrRefCount(value2Ptr);
} else {
- TclSetVarScalar(varPtr);
- TclClearVarUndefined(varPtr);
+ varPtr->flags |= VAR_DIRECT_READABLE;
}
varPtr->value.objPtr = valuePtr;
Tcl_IncrRefCount(valuePtr);
Index: generic/tclInt.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclInt.h,v
retrieving revision 1.189
diff -u -r1.189 tclInt.h
--- generic/tclInt.h 27 Oct 2004 17:13:58 -0000 1.189
+++ generic/tclInt.h 28 Oct 2004 15:00:28 -0000
@@ -379,6 +379,8 @@
*/
typedef struct Var {
+ int flags; /* Miscellaneous bits of information about
+ * variable. See below for definitions. */
union {
Tcl_Obj *objPtr; /* The variable's object value. Used for
* scalar variables and array elements. */
@@ -423,18 +425,15 @@
* variable. */
ArraySearch *searchPtr; /* First in list of all searches active
* for this variable, or NULL if none. */
- int flags; /* Miscellaneous bits of information about
- * variable. See below for definitions. */
} Var;
/*
- * Flag bits for variables. The first three (VAR_SCALAR, VAR_ARRAY, and
- * VAR_LINK) are mutually exclusive and give the "type" of the variable.
- * VAR_UNDEFINED is independent of the variable's type.
- *
- * VAR_SCALAR - 1 means this is a scalar variable and not
- * an array or link. The "objPtr" field points
- * to the variable's value, a Tcl object.
+ * Flag bits for variables. The first two (VAR_ARRAY and VAR_LINK) are
+ * mutually exclusive and give the "type" of the variable; a scalar is
+ * neither an array nor a link.
+ *
+ * VAR_SCALAR - UNUSED since tcl8.5. A scalar variable is one
+ * where neither VAR_ARRAY or VAR_LINK are set.
* VAR_ARRAY - 1 means this is an array variable rather
* than a scalar variable or link. The
* "tablePtr" field points to the array's
@@ -446,12 +445,8 @@
* this come about through "upvar" and "global"
* commands, or through references to variables
* in enclosing namespaces.
- * VAR_UNDEFINED - 1 means that the variable is in the process
- * of being deleted. An undefined variable
- * logically does not exist and survives only
- * while it has a trace, or if it is a global
- * variable currently being used by some
- * procedure.
+ * VAR_UNDEFINED - UNUSED since tcl8.5. An undefined variable is
+ * one that has a NULL value field.
* VAR_IN_HASHTABLE - 1 means this variable is in a hashtable and
* the Var structure is malloced. 0 if it is
* a local variable that was assigned a slot
@@ -485,6 +480,24 @@
* name.
* VAR_RESOLVED - 1 if name resolution has been done for this
* variable.
+ *
+ * The following additional flags are used to speed up variable access by
+ * the bytecode engine. The information contained is already present in the
+ * other flag values and/or the fields of the Var structure. There is special
+ * code to maintain these flag values in synch with the rest.
+ *
+ * VAR_DIRECT_READABLE 1 means that TEBC can read this variable
+ * directly:
+ * - VAR_SCALAR is set
+ * - VAR_UNDEFINED is not set
+ * - tracePtr is NULL.
+ * VAR_DIRECT_WRITABLE 1 means that TEBC can write this variable
+ * directly:
+ * - one of {VAR_SCALAR,VAR_UNDEFINED} is set
+ * - tracePtr is NULL
+ * - VAR_IN_HASHTABLE is not set, or else hPtr
+ * is not NULL.
+ * THIS IS NOT YET IMPLEMENTED.
*/
#define VAR_SCALAR 0x1
@@ -500,6 +513,9 @@
#define VAR_TEMPORARY 0x200
#define VAR_RESOLVED 0x400
+#define VAR_DIRECT_READABLE 0x800
+#define VAR_DIRECT_WRITABLE 0x1000
+
/*
* Macros to ensure that various flag bits are set properly for variables.
* The ANSI C "prototypes" for these macros are:
@@ -513,22 +529,24 @@
*/
#define TclSetVarScalar(varPtr) \
- (varPtr)->flags = ((varPtr)->flags & ~(VAR_ARRAY|VAR_LINK)) | VAR_SCALAR
+ (varPtr)->flags = ((varPtr)->flags & ~(VAR_ARRAY|VAR_LINK))
#define TclSetVarArray(varPtr) \
- (varPtr)->flags = ((varPtr)->flags & ~(VAR_SCALAR|VAR_LINK)) | VAR_ARRAY
+ (varPtr)->flags = ((varPtr)->flags | VAR_ARRAY) \
+ & ~(VAR_LINK|VAR_DIRECT_READABLE|VAR_DIRECT_WRITABLE)
#define TclSetVarLink(varPtr) \
- (varPtr)->flags = ((varPtr)->flags & ~(VAR_SCALAR|VAR_ARRAY)) | VAR_LINK
+ (varPtr)->flags = ((varPtr)->flags | VAR_LINK) \
+ & ~(VAR_ARRAY|VAR_DIRECT_READABLE|VAR_DIRECT_WRITABLE)
#define TclSetVarArrayElement(varPtr) \
(varPtr)->flags = ((varPtr)->flags & ~VAR_ARRAY) | VAR_ARRAY_ELEMENT
#define TclSetVarUndefined(varPtr) \
- (varPtr)->flags |= VAR_UNDEFINED
+ (varPtr)->flags &= ~(VAR_DIRECT_READABLE|VAR_ARRAY|VAR_LINK); \
+ (varPtr)->value.objPtr = NULL
-#define TclClearVarUndefined(varPtr) \
- (varPtr)->flags &= ~VAR_UNDEFINED
+#define TclClearVarUndefined(varPtr)
#define TclSetVarTraceActive(varPtr) \
(varPtr)->flags |= VAR_TRACE_ACTIVE
@@ -542,6 +560,12 @@
#define TclClearVarNamespaceVar(varPtr) \
(varPtr)->flags &= ~VAR_NAMESPACE_VAR
+#define TclSetVarTemporary(varPtr) \
+ (varPtr)->flags |= VAR_TEMPORARY
+
+#define TclSetVarResolved(varPtr) \
+ (varPtr)->flags |= VAR_RESOLVED
+
/*
* Macros to read various flag bits of variables.
* The ANSI C "prototypes" for these macros are:
@@ -552,12 +576,11 @@
* EXTERN int TclIsVarUndefined _ANSI_ARGS_((Var *varPtr));
* EXTERN int TclIsVarArrayElement _ANSI_ARGS_((Var *varPtr));
* EXTERN int TclIsVarTemporary _ANSI_ARGS_((Var *varPtr));
- * EXTERN int TclIsVarArgument _ANSI_ARGS_((Var *varPtr));
* EXTERN int TclIsVarResolved _ANSI_ARGS_((Var *varPtr));
*/
#define TclIsVarScalar(varPtr) \
- ((varPtr)->flags & VAR_SCALAR)
+ (!((varPtr)->flags & (VAR_ARRAY|VAR_LINK)))
#define TclIsVarLink(varPtr) \
((varPtr)->flags & VAR_LINK)
@@ -566,7 +589,7 @@
((varPtr)->flags & VAR_ARRAY)
#define TclIsVarUndefined(varPtr) \
- ((varPtr)->flags & VAR_UNDEFINED)
+ (varPtr->value.objPtr == NULL)
#define TclIsVarArrayElement(varPtr) \
((varPtr)->flags & VAR_ARRAY_ELEMENT)
@@ -577,15 +600,15 @@
#define TclIsVarTemporary(varPtr) \
((varPtr)->flags & VAR_TEMPORARY)
-#define TclIsVarArgument(varPtr) \
- ((varPtr)->flags & VAR_ARGUMENT)
-
#define TclIsVarResolved(varPtr) \
((varPtr)->flags & VAR_RESOLVED)
#define TclIsVarTraceActive(varPtr) \
((varPtr)->flags & VAR_TRACE_ACTIVE)
+#define TclIsVarTraced(varPtr) \
+ ((varPtr)->tracePtr != NULL)
+
#define TclIsVarUntraced(varPtr) \
((varPtr)->tracePtr == NULL)
@@ -593,6 +616,27 @@
* Macros for direct variable access by TEBC
*/
+#define TclSetVarDirectAccess(varPtr) \
+ if (TclIsVarUnTraced(varPtr)) { \
+ if (TclIsVarScalar(varPtr) \
+ && !TclIsVarUndefined(varPtr)) { \
+ (varPtr)->flags |= VAR_DIRECT_READABLE; \
+ } else { \
+ (varPtr)->flags &= ~VAR_DIRECT_READABLE; \
+ } \
+ if ((TclIsVarScalar(varPtr) \
+ || TclIsVarUndefined(varPtr)) \
+ && !(((varPtr)->flags & VAR_IN_HASHTABLE) \
+ && ((varPtr)->hPtr == NULL))) { \
+ (varPtr)->flags |= VAR_DIRECT_WRITABLE; \
+ } else { \
+ (varPtr)->flags &= ~VAR_DIRECT_WRITABLE; \
+ } \
+ } else { \
+ (varPtr)->flags &= ~(VAR_DIRECT_READABLE|VAR_DIRECT_WRITABLE); \
+ }
+
+#if 0
#define TclIsVarDirectReadable(varPtr) \
(TclIsVarScalar(varPtr) \
&& !TclIsVarUndefined(varPtr) \
@@ -604,6 +648,13 @@
&& TclIsVarUntraced(varPtr) \
&& (TclIsVarScalar(varPtr) \
|| TclIsVarUndefined(varPtr)))
+#else
+#define TclIsVarDirectReadable(varPtr) \
+ ((varPtr)->flags & VAR_DIRECT_READABLE)
+
+#define TclIsVarDirectWritable(varPtr) \
+ ((varPtr)->flags & VAR_DIRECT_WRITABLE)
+#endif
/*
*----------------------------------------------------------------
Index: generic/tclProc.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclProc.c,v
retrieving revision 1.63
diff -u -r1.63 tclProc.c
--- generic/tclProc.c 22 Oct 2004 13:48:58 -0000 1.63
+++ generic/tclProc.c 28 Oct 2004 15:00:28 -0000
@@ -410,13 +410,16 @@
* For the flags, we and out VAR_UNDEFINED to support bridging
* precompiled <= 8.3 code in 8.4 where this is now used as an
* optimization indicator. Yes, this is a hack. -- hobbs
+ *
+ * FIXME: VAR_UNDEFINED, VAR_SCALAR and VAR_ARGUMENT now not used
+ * in the core; what about older precompiled code? Tests in
+ * tesuite pass.
*/
if ((localPtr->nameLength != nameLength)
|| (strcmp(localPtr->name, fieldValues[0]))
|| (localPtr->frameIndex != i)
- || ((localPtr->flags & ~VAR_UNDEFINED)
- != (VAR_SCALAR | VAR_ARGUMENT))
+ /* || (localPtr->flags != VAR_ARGUMENT) */
|| ((localPtr->defValuePtr == NULL)
&& (fieldCount == 2))
|| ((localPtr->defValuePtr != NULL)
@@ -469,7 +472,7 @@
localPtr->nextPtr = NULL;
localPtr->nameLength = nameLength;
localPtr->frameIndex = i;
- localPtr->flags = VAR_SCALAR | VAR_ARGUMENT;
+ localPtr->flags = 0;
localPtr->resolveInfo = NULL;
if (fieldCount == 2) {
@@ -1000,11 +1003,6 @@
localPtr = procPtr->firstLocalPtr;
argCt = objc;
for (i = 1, argCt -= 1; i <= numArgs; i++, argCt--) {
- if (!TclIsVarArgument(localPtr)) {
- Tcl_Panic("TclObjInterpProc: local variable %s is not argument but should be",
- localPtr->name);
- return TCL_ERROR;
- }
if (TclIsVarTemporary(localPtr)) {
Tcl_Panic("TclObjInterpProc: local variable %d is temporary but should be an argument", i);
return TCL_ERROR;
@@ -1021,19 +1019,16 @@
Tcl_Obj *listPtr = Tcl_NewListObj(argCt, &(objv[i]));
varPtr->value.objPtr = listPtr;
Tcl_IncrRefCount(listPtr); /* local var is a reference */
- TclClearVarUndefined(varPtr);
argCt = 0;
break; /* done processing args */
} else if (argCt > 0) {
Tcl_Obj *objPtr = objv[i];
varPtr->value.objPtr = objPtr;
- TclClearVarUndefined(varPtr);
Tcl_IncrRefCount(objPtr); /* since the local variable now has
* another reference to object. */
} else if (localPtr->defValuePtr != NULL) {
Tcl_Obj *objPtr = localPtr->defValuePtr;
varPtr->value.objPtr = objPtr;
- TclClearVarUndefined(varPtr);
Tcl_IncrRefCount(objPtr); /* since the local variable now has
* another reference to object. */
} else {
Index: generic/tclTrace.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclTrace.c,v
retrieving revision 1.18
diff -u -r1.18 tclTrace.c
--- generic/tclTrace.c 25 Oct 2004 01:06:51 -0000 1.18
+++ generic/tclTrace.c 28 Oct 2004 15:00:28 -0000
@@ -2765,6 +2765,13 @@
if (TclIsVarUndefined(varPtr)) {
TclCleanupVar(varPtr, (Var *) NULL);
+ } else {
+ if (TclIsVarDirectReadable(varPtr)) {
+ varPtr->flags |= VAR_DIRECT_READABLE;
+ }
+ if (TclIsVarDirectWritable(varPtr)) {
+ varPtr->flags |= VAR_DIRECT_WRITABLE;
+ }
}
}
@@ -2996,5 +3003,6 @@
tracePtr->flags = flags & flagMask;
tracePtr->nextPtr = varPtr->tracePtr;
varPtr->tracePtr = tracePtr;
+ varPtr->flags &= ~(VAR_DIRECT_READABLE|VAR_DIRECT_WRITABLE);
return TCL_OK;
}
Index: generic/tclVar.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclVar.c,v
retrieving revision 1.97
diff -u -r1.97 tclVar.c
--- generic/tclVar.c 26 Oct 2004 16:19:58 -0000 1.97
+++ generic/tclVar.c 28 Oct 2004 15:00:31 -0000
@@ -164,19 +164,19 @@
* variable structure for the array that contains the variable (or NULL
* if the variable is a scalar). If the variable can't be found and
* either createPart1 or createPart2 are 1, a new as-yet-undefined
- * (VAR_UNDEFINED) variable structure is created, entered into a hash
- * table, and returned.
+ * variable structure is created, entered into a hash table and
+ * returned.
*
* If the variable isn't found and creation wasn't specified, or some
* other error occurs, NULL is returned and an error message is left in
* the interp's result if TCL_LEAVE_ERR_MSG is set in flags.
*
- * Note: it's possible for the variable returned to be VAR_UNDEFINED
+ * Note: it's possible for the variable returned to be undefined
* even if createPart1 or createPart2 are 1 (these only cause the hash
* table entry or array to be created). For example, the variable might
* be a global that has been unset but is still referenced by a
* procedure, or a variable that has been unset but it only being kept
- * in existence (if VAR_UNDEFINED) by a trace.
+ * in existence by a trace.
*
* Side effects:
* New hashtable entries may be created if createPart1 or createPart2
@@ -313,19 +313,19 @@
* variable structure for the array that contains the variable (or NULL
* if the variable is a scalar). If the variable can't be found and
* either createPart1 or createPart2 are 1, a new as-yet-undefined
- * (VAR_UNDEFINED) variable structure is created, entered into a hash
- * table, and returned.
+ * variable structure is created, entered into a hash table, and
+ * returned.
*
* If the variable isn't found and creation wasn't specified, or some
* other error occurs, NULL is returned and an error message is left in
* the interp's result if TCL_LEAVE_ERR_MSG is set in flags.
*
- * Note: it's possible for the variable returned to be VAR_UNDEFINED
+ * Note: it's possible for the variable returned to be undefined
* even if createPart1 or createPart2 are 1 (these only cause the hash
* table entry or array to be created). For example, the variable might
* be a global that has been unset but is still referenced by a
* procedure, or a variable that has been unset but it only being kept
- * in existence (if VAR_UNDEFINED) by a trace.
+ * in existence by a trace.
*
* Side effects:
* New hashtable entries may be created if createPart1 or createPart2
@@ -625,8 +625,8 @@
* Results:
* The return value is a pointer to the variable structure indicated by
* varName, or NULL if the variable couldn't be found. If the variable
- * can't be found and create is 1, a new as-yet-undefined (VAR_UNDEFINED)
- * variable structure is created, entered into a hash table, and returned.
+ * can't be found and create is 1, a new as-yet-undefined variable
+ * structure is created, entered into a hash table, and returned.
*
* If the current CallFrame corresponds to a proc and the variable found is
* one of the compiledLocals, its index is placed in *indexPtr. Otherwise,
@@ -642,12 +642,11 @@
* other error occurs, NULL is returned and the corresponding error
* message is left in *errMsgPtr.
*
- * Note: it's possible for the variable returned to be VAR_UNDEFINED
+ * Note: it's possible for the variable returned to be undefined
* even if create is 1 (this only causes the hash table entry to be
* created). For example, the variable might be a global that has been
* unset but is still referenced by a procedure, or a variable that has
- * been unset but it only being kept in existence (if VAR_UNDEFINED) by
- * a trace.
+ * been unset but it only being kept in existence by a trace.
*
* Side effects:
* A new hashtable entry may be created if create is 1.
@@ -797,6 +796,7 @@
Tcl_SetHashValue(hPtr, varPtr);
varPtr->hPtr = hPtr;
varPtr->nsPtr = varNsPtr;
+ varPtr->flags |= VAR_DIRECT_WRITABLE;
if (lookGlobal) {
/*
* The variable was created starting from the global
@@ -846,6 +846,7 @@
Tcl_SetHashValue(hPtr, varPtr);
varPtr->hPtr = hPtr;
varPtr->nsPtr = NULL; /* a local variable */
+ varPtr->flags |= VAR_DIRECT_WRITABLE;
} else {
varPtr = (Var *) Tcl_GetHashValue(hPtr);
}
@@ -886,12 +887,12 @@
* created. Otherwise, NULL is returned and an error message is left in
* the interp's result if TCL_LEAVE_ERR_MSG is set in flags.
*
- * Note: it's possible for the variable returned to be VAR_UNDEFINED
+ * Note: it's possible for the variable returned to be undefined
* even if createPart1 or createPart2 are 1 (these only cause the hash
* table entry or array to be created). For example, the variable might
* be a global that has been unset but is still referenced by a
* procedure, or a variable that has been unset but it only being kept
- * in existence (if VAR_UNDEFINED) by a trace.
+ * in existence by a trace.
*
* Side effects:
* The variable at arrayPtr may be converted to be an array if
@@ -948,7 +949,6 @@
}
TclSetVarArray(arrayPtr);
- TclClearVarUndefined(arrayPtr);
arrayPtr->value.tablePtr =
(Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
Tcl_InitHashTable(arrayPtr->value.tablePtr, TCL_STRING_KEYS);
@@ -969,7 +969,7 @@
Tcl_SetHashValue(hPtr, varPtr);
varPtr->hPtr = hPtr;
varPtr->nsPtr = arrayPtr->nsPtr;
- TclSetVarArrayElement(varPtr);
+ varPtr->flags |= (VAR_ARRAY_ELEMENT|VAR_DIRECT_WRITABLE);
}
} else {
hPtr = Tcl_FindHashEntry(arrayPtr->value.tablePtr, elName);
@@ -1210,6 +1210,15 @@
CONST char *msg;
/*
+ * Shortcut for directly readable variables - untraced scalars.
+ */
+
+ if (TclIsVarDirectReadable(varPtr)
+ && (!arrayPtr || TclIsVarUntraced(arrayPtr))) {
+ return varPtr->value.objPtr;
+ }
+
+ /*
* Invoke any traces that have been set for the variable.
*/
@@ -1567,46 +1576,50 @@
Tcl_Obj *resultPtr = NULL;
int result;
- /*
- * If the variable is in a hashtable and its hPtr field is NULL, then we
- * may have an upvar to an array element where the array was deleted
- * or an upvar to a namespace variable whose namespace was deleted.
- * Generate an error (allowing the variable to be reset would screw up
- * our storage allocation and is meaningless anyway).
- */
+ if (!TclIsVarDirectWritable(varPtr)
+ || (arrayPtr && TclIsVarTraced(arrayPtr))) {
- if ((varPtr->flags & VAR_IN_HASHTABLE) && (varPtr->hPtr == NULL)) {
- if (flags & TCL_LEAVE_ERR_MSG) {
- if (TclIsVarArrayElement(varPtr)) {
- TclVarErrMsg(interp, part1, part2, "set", danglingElement);
- } else {
- TclVarErrMsg(interp, part1, part2, "set", danglingVar);
+ /*
+ * If the variable is in a hashtable and its hPtr field is NULL, then we
+ * may have an upvar to an array element where the array was deleted
+ * or an upvar to a namespace variable whose namespace was deleted.
+ * Generate an error (allowing the variable to be reset would screw up
+ * our storage allocation and is meaningless anyway).
+ */
+
+ if ((varPtr->flags & VAR_IN_HASHTABLE) && (varPtr->hPtr == NULL)) {
+ if (flags & TCL_LEAVE_ERR_MSG) {
+ if (TclIsVarArrayElement(varPtr)) {
+ TclVarErrMsg(interp, part1, part2, "set", danglingElement);
+ } else {
+ TclVarErrMsg(interp, part1, part2, "set", danglingVar);
+ }
}
+ return NULL;
}
- return NULL;
- }
-
- /*
- * It's an error to try to set an array variable itself.
- */
-
- if (TclIsVarArray(varPtr) && !TclIsVarUndefined(varPtr)) {
- if (flags & TCL_LEAVE_ERR_MSG) {
- TclVarErrMsg(interp, part1, part2, "set", isArray);
+
+ /*
+ * It's an error to try to set an array variable itself.
+ */
+
+ if (TclIsVarArray(varPtr) && !TclIsVarUndefined(varPtr)) {
+ if (flags & TCL_LEAVE_ERR_MSG) {
+ TclVarErrMsg(interp, part1, part2, "set", isArray);
+ }
+ return NULL;
}
- return NULL;
- }
-
- /*
- * Invoke any read traces that have been set for the variable if it
- * is requested; this is only done in the core when lappending.
- */
- if ((flags & TCL_TRACE_READS) && ((varPtr->tracePtr != NULL)
- || ((arrayPtr != NULL) && (arrayPtr->tracePtr != NULL)))) {
- if (TCL_ERROR == TclCallVarTraces(iPtr, arrayPtr, varPtr, part1, part2,
- TCL_TRACE_READS, (flags & TCL_LEAVE_ERR_MSG))) {
- return NULL;
+ /*
+ * Invoke any read traces that have been set for the variable if it
+ * is requested; this is only done in the core when lappending.
+ */
+
+ if ((flags & TCL_TRACE_READS) && (!TclIsVarUntraced(varPtr)
+ || ((arrayPtr != NULL) && !TclIsVarUntraced(arrayPtr)))) {
+ if (TCL_ERROR == TclCallVarTraces(iPtr, arrayPtr, varPtr, part1, part2,
+ TCL_TRACE_READS, (flags & TCL_LEAVE_ERR_MSG))) {
+ return NULL;
+ }
}
}
@@ -1618,17 +1631,14 @@
* "copy on write".
*/
- if (flags & TCL_LIST_ELEMENT && !(flags & TCL_APPEND_VALUE)) {
- TclSetVarUndefined(varPtr);
- }
oldValuePtr = varPtr->value.objPtr;
if (flags & (TCL_APPEND_VALUE|TCL_LIST_ELEMENT)) {
- if (TclIsVarUndefined(varPtr) && (oldValuePtr != NULL)) {
- Tcl_DecrRefCount(oldValuePtr); /* discard old value */
- varPtr->value.objPtr = NULL;
- oldValuePtr = NULL;
- }
if (flags & TCL_LIST_ELEMENT) { /* append list element */
+ if (!(flags & TCL_APPEND_VALUE) && oldValuePtr) {
+ Tcl_DecrRefCount(oldValuePtr); /* discard old value */
+ varPtr->value.objPtr = NULL;
+ oldValuePtr = NULL;
+ }
if (oldValuePtr == NULL) {
TclNewObj(oldValuePtr);
varPtr->value.objPtr = oldValuePtr;
@@ -1675,17 +1685,13 @@
}
}
TclSetVarScalar(varPtr);
- TclClearVarUndefined(varPtr);
- if (arrayPtr != NULL) {
- TclClearVarUndefined(arrayPtr);
- }
/*
* Invoke any write traces for the variable.
*/
if ((varPtr->tracePtr != NULL)
- || ((arrayPtr != NULL) && (arrayPtr->tracePtr != NULL))) {
+ || (arrayPtr && TclIsVarTraced(arrayPtr))) {
if (TCL_ERROR == TclCallVarTraces(iPtr, arrayPtr, varPtr, part1, part2,
(flags & (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY))
| TCL_TRACE_WRITES, (flags & TCL_LEAVE_ERR_MSG))) {
@@ -1700,14 +1706,17 @@
*/
if (TclIsVarScalar(varPtr) && !TclIsVarUndefined(varPtr)) {
+ if (TclIsVarUntraced(varPtr)) {
+ varPtr->flags |= (VAR_DIRECT_READABLE|VAR_DIRECT_WRITABLE);
+ }
return varPtr->value.objPtr;
}
-
+
/*
* A trace changed the value in some gross way. Return an empty string
* object.
*/
-
+
resultPtr = iPtr->emptyObjPtr;
/*
@@ -2187,8 +2196,6 @@
dummyVar = *varPtr;
TclSetVarUndefined(varPtr);
- TclSetVarScalar(varPtr);
- varPtr->value.objPtr = NULL; /* dummyVar points to any value object */
varPtr->tracePtr = NULL;
varPtr->searchPtr = NULL;
@@ -2296,6 +2303,8 @@
part1Ptr->typePtr = NULL;
}
#endif
+
+ varPtr->flags &= ~VAR_DIRECT_READABLE;
/*
* Finally, if the variable is truly not in use then free up its Var
@@ -3296,7 +3305,6 @@
}
}
TclSetVarArray(varPtr);
- TclClearVarUndefined(varPtr);
varPtr->value.tablePtr =
(Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
Tcl_InitHashTable(varPtr->value.tablePtr, TCL_STRING_KEYS);
@@ -3464,7 +3472,6 @@
}
}
TclSetVarLink(varPtr);
- TclClearVarUndefined(varPtr);
varPtr->value.linkPtr = otherPtr;
otherPtr->refCount++;
return TCL_OK;
@@ -3942,7 +3949,7 @@
varPtr->refCount = 0;
varPtr->tracePtr = NULL;
varPtr->searchPtr = NULL;
- varPtr->flags = (VAR_SCALAR | VAR_UNDEFINED | VAR_IN_HASHTABLE);
+ varPtr->flags = VAR_IN_HASHTABLE;
return varPtr;
}
@@ -4234,17 +4241,15 @@
if (TclIsVarArray(varPtr)) {
DeleteArray(iPtr, Tcl_GetHashKey(tablePtr, hPtr), varPtr,
flags);
- varPtr->value.tablePtr = NULL;
}
if (TclIsVarScalar(varPtr) && (varPtr->value.objPtr != NULL)) {
objPtr = varPtr->value.objPtr;
TclDecrRefCount(objPtr);
- varPtr->value.objPtr = NULL;
}
varPtr->hPtr = NULL;
+ varPtr->flags &= ~VAR_DIRECT_WRITABLE;
varPtr->tracePtr = NULL;
TclSetVarUndefined(varPtr);
- TclSetVarScalar(varPtr);
/*
* If the variable was a namespace variable, decrement its
@@ -4366,12 +4371,11 @@
}
if (TclIsVarScalar(varPtr) && (varPtr->value.objPtr != NULL)) {
TclDecrRefCount(varPtr->value.objPtr);
- varPtr->value.objPtr = NULL;
}
varPtr->hPtr = NULL;
+ varPtr->flags &= ~VAR_DIRECT_WRITABLE;
varPtr->tracePtr = NULL;
TclSetVarUndefined(varPtr);
- TclSetVarScalar(varPtr);
varPtr++;
}
}
@@ -4426,6 +4430,7 @@
elPtr->value.objPtr = NULL;
}
elPtr->hPtr = NULL;
+ elPtr->flags &= ~VAR_DIRECT_WRITABLE;
if (elPtr->tracePtr != NULL) {
elPtr->flags &= ~VAR_TRACE_ACTIVE;
TclCallVarTraces(iPtr, (Var *) NULL, elPtr, arrayName,
@@ -4444,7 +4449,6 @@
}
}
TclSetVarUndefined(elPtr);
- TclSetVarScalar(elPtr);
/*
* Even though array elements are not supposed to be namespace
