summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--ChangeLog9
-rw-r--r--generic/tclCmdIL.c10
-rw-r--r--generic/tclExecute.c36
-rw-r--r--generic/tclInt.h34
-rw-r--r--generic/tclTrace.c10
5 files changed, 64 insertions, 35 deletions
diff --git a/ChangeLog b/ChangeLog
index 96ebbbd..bad7ce1 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,12 @@
+2004-10-24 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclCmdIL.c:
+ * generic/tclExecute.c:
+ * generic/tclInt.h:
+ * generic/tclTrace.c: defined new macros to get/set the flags of
+ variables. The only files that still access the flag values
+ directly are tclCompCmds.c, tclCompile.c, tclProc.c and tclVar.c
+
2004-10-24 Don Porter <dgp@users.sourceforge.net>
* generic/tclBasic.c (Tcl_LogCommandInfo,Tcl_AddObjErrorInfo):
diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c
index 2204d1f..5c48f09 100644
--- a/generic/tclCmdIL.c
+++ b/generic/tclCmdIL.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: tclCmdIL.c,v 1.66 2004/10/14 17:20:11 dkf Exp $
+ * RCS: @(#) $Id: tclCmdIL.c,v 1.67 2004/10/25 01:06:49 msofer Exp $
*/
#include "tclInt.h"
@@ -1977,7 +1977,7 @@ InfoVarsCmd(dummy, interp, objc, objv)
if (entryPtr != NULL) {
varPtr = (Var *) Tcl_GetHashValue(entryPtr);
if (!TclIsVarUndefined(varPtr)
- || (varPtr->flags & VAR_NAMESPACE_VAR)) {
+ || TclIsVarNamespaceVar(varPtr)) {
if (specificNsInPattern) {
elemObjPtr = Tcl_NewObj();
Tcl_GetVariableFullName(interp, (Tcl_Var) varPtr,
@@ -1992,7 +1992,7 @@ InfoVarsCmd(dummy, interp, objc, objv)
simplePattern);
varPtr = (Var *) Tcl_GetHashValue(entryPtr);
if (!TclIsVarUndefined(varPtr)
- || (varPtr->flags & VAR_NAMESPACE_VAR)) {
+ || TclIsVarNamespaceVar(varPtr)) {
Tcl_ListObjAppendElement(interp, listPtr,
Tcl_NewStringObj(simplePattern, -1));
}
@@ -2006,7 +2006,7 @@ InfoVarsCmd(dummy, interp, objc, objv)
while (entryPtr != NULL) {
varPtr = (Var *) Tcl_GetHashValue(entryPtr);
if (!TclIsVarUndefined(varPtr)
- || (varPtr->flags & VAR_NAMESPACE_VAR)) {
+ || TclIsVarNamespaceVar(varPtr)) {
varName = Tcl_GetHashKey(&nsPtr->varTable, entryPtr);
if ((simplePattern == NULL)
|| Tcl_StringMatch(varName, simplePattern)) {
@@ -2037,7 +2037,7 @@ InfoVarsCmd(dummy, interp, objc, objv)
while (entryPtr != NULL) {
varPtr = (Var *) Tcl_GetHashValue(entryPtr);
if (!TclIsVarUndefined(varPtr)
- || (varPtr->flags & VAR_NAMESPACE_VAR)) {
+ || TclIsVarNamespaceVar(varPtr)) {
varName = Tcl_GetHashKey(&globalNsPtr->varTable,
entryPtr);
if ((simplePattern == NULL)
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index d76e054..da280c5 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -11,7 +11,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclExecute.c,v 1.160 2004/10/22 14:01:00 dkf Exp $
+ * RCS: @(#) $Id: tclExecute.c,v 1.161 2004/10/25 01:06:49 msofer Exp $
*/
#ifdef STDC_HEADERS
@@ -1775,8 +1775,7 @@ TclExecuteByteCode(interp, codePtr)
varPtr = varPtr->value.linkPtr;
}
TRACE(("%u => ", opnd));
- if (TclIsVarScalar(varPtr) && !TclIsVarUndefined(varPtr)
- && (varPtr->tracePtr == NULL)) {
+ if (TclIsVarDirectReadable(varPtr)) {
/*
* No errors, no traces: just get the value.
*/
@@ -1798,8 +1797,7 @@ TclExecuteByteCode(interp, codePtr)
varPtr = varPtr->value.linkPtr;
}
TRACE(("%u => ", opnd));
- if (TclIsVarScalar(varPtr) && !TclIsVarUndefined(varPtr)
- && (varPtr->tracePtr == NULL)) {
+ if (TclIsVarDirectReadable(varPtr)) {
/*
* No errors, no traces: just get the value.
*/
@@ -1838,10 +1836,9 @@ TclExecuteByteCode(interp, codePtr)
result = TCL_ERROR;
goto checkForCatch;
}
- if (TclIsVarScalar(varPtr) && !TclIsVarUndefined(varPtr)
- && (varPtr->tracePtr == NULL)
+ if (TclIsVarDirectReadable(varPtr)
&& ((arrayPtr == NULL)
- || (arrayPtr->tracePtr == NULL))) {
+ || TclIsVarUntraced(arrayPtr))) {
/*
* No errors, no traces: just get the value.
*/
@@ -1876,10 +1873,9 @@ TclExecuteByteCode(interp, codePtr)
result = TCL_ERROR;
goto checkForCatch;
}
- if (TclIsVarScalar(varPtr) && !TclIsVarUndefined(varPtr)
- && (varPtr->tracePtr == NULL)
+ if (TclIsVarDirectReadable(varPtr)
&& ((arrayPtr == NULL)
- || (arrayPtr->tracePtr == NULL))) {
+ || TclIsVarUntraced(arrayPtr))) {
/*
* No errors, no traces: just get the value.
*/
@@ -2100,13 +2096,9 @@ TclExecuteByteCode(interp, codePtr)
doCallPtrSetVar:
if ((storeFlags == TCL_LEAVE_ERR_MSG)
- && !((varPtr->flags & VAR_IN_HASHTABLE)
- && (varPtr->hPtr == NULL))
- && (varPtr->tracePtr == NULL)
- && (TclIsVarScalar(varPtr)
- || TclIsVarUndefined(varPtr))
+ && TclIsVarDirectWritable(varPtr)
&& ((arrayPtr == NULL)
- || (arrayPtr->tracePtr == NULL))) {
+ || TclIsVarUntraced(arrayPtr))) {
/*
* No traces, no errors, plain 'set': we can safely inline.
* The value *will* be set to what's requested, so that
@@ -2295,11 +2287,9 @@ TclExecuteByteCode(interp, codePtr)
doIncrVar:
objPtr = varPtr->value.objPtr;
- if (TclIsVarScalar(varPtr)
- && !TclIsVarUndefined(varPtr)
- && (varPtr->tracePtr == NULL)
+ if (TclIsVarDirectReadable(varPtr)
&& ((arrayPtr == NULL)
- || (arrayPtr->tracePtr == NULL))) {
+ || TclIsVarUntraced(arrayPtr))) {
if (objPtr->typePtr == &tclIntType && !isWide) {
/*
* No errors, no traces, the variable already has an
@@ -4642,9 +4632,7 @@ TclExecuteByteCode(interp, codePtr)
while (TclIsVarLink(varPtr)) {
varPtr = varPtr->value.linkPtr;
}
- if (!((varPtr->flags & VAR_IN_HASHTABLE) && (varPtr->hPtr == NULL))
- && (varPtr->tracePtr == NULL)
- && (TclIsVarScalar(varPtr) || TclIsVarUndefined(varPtr))) {
+ if (TclIsVarDirectWritable(varPtr)) {
value2Ptr = varPtr->value.objPtr;
if (valuePtr != value2Ptr) {
if (value2Ptr != NULL) {
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 252d06b..6485187 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -12,7 +12,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclInt.h,v 1.186 2004/10/21 17:07:31 dgp Exp $
+ * RCS: @(#) $Id: tclInt.h,v 1.187 2004/10/25 01:06:51 msofer Exp $
*/
#ifndef _TCLINT
@@ -530,6 +530,13 @@ typedef struct Var {
#define TclClearVarUndefined(varPtr) \
(varPtr)->flags &= ~VAR_UNDEFINED
+#define TclSetVarTraceActive(varPtr) \
+ (varPtr)->flags |= VAR_TRACE_ACTIVE
+
+#define TclClearVarTraceActive(varPtr) \
+ (varPtr)->flags &= ~VAR_TRACE_ACTIVE
+
+
/*
* Macros to read various flag bits of variables.
* The ANSI C "prototypes" for these macros are:
@@ -559,6 +566,9 @@ typedef struct Var {
#define TclIsVarArrayElement(varPtr) \
((varPtr)->flags & VAR_ARRAY_ELEMENT)
+#define TclIsVarNamespaceVar(varPtr) \
+ ((varPtr)->flags & VAR_NAMESPACE_VAR)
+
#define TclIsVarTemporary(varPtr) \
((varPtr)->flags & VAR_TEMPORARY)
@@ -568,6 +578,28 @@ typedef struct Var {
#define TclIsVarResolved(varPtr) \
((varPtr)->flags & VAR_RESOLVED)
+#define TclIsVarTraceActive(varPtr) \
+ ((varPtr)->flags & VAR_TRACE_ACTIVE)
+
+#define TclIsVarUntraced(varPtr) \
+ ((varPtr)->tracePtr == NULL)
+
+/*
+ * Macros for direct variable access by TEBC
+ */
+
+#define TclIsVarDirectReadable(varPtr) \
+ (TclIsVarScalar(varPtr) \
+ && !TclIsVarUndefined(varPtr) \
+ && TclIsVarUntraced(varPtr))
+
+#define TclIsVarDirectWritable(varPtr) \
+ ( !(((varPtr)->flags & VAR_IN_HASHTABLE) \
+ && ((varPtr)->hPtr == NULL)) \
+ && TclIsVarUntraced(varPtr) \
+ && (TclIsVarScalar(varPtr) \
+ || TclIsVarUndefined(varPtr)))
+
/*
*----------------------------------------------------------------
* Data structures related to procedures. These are used primarily
diff --git a/generic/tclTrace.c b/generic/tclTrace.c
index 3d5e835..1088f2e 100644
--- a/generic/tclTrace.c
+++ b/generic/tclTrace.c
@@ -11,7 +11,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclTrace.c,v 1.17 2004/10/19 21:54:07 dgp Exp $
+ * RCS: @(#) $Id: tclTrace.c,v 1.18 2004/10/25 01:06:51 msofer Exp $
*/
#include "tclInt.h"
@@ -2429,10 +2429,10 @@ TclCallVarTraces(iPtr, arrayPtr, varPtr, part1, part2, flags, leaveErrMsg)
* variable, don't call them again.
*/
- if (varPtr->flags & VAR_TRACE_ACTIVE) {
+ if (TclIsVarTraceActive(varPtr)) {
return code;
}
- varPtr->flags |= VAR_TRACE_ACTIVE;
+ TclSetVarTraceActive(varPtr);
varPtr->refCount++;
if (arrayPtr != NULL) {
arrayPtr->refCount++;
@@ -2480,7 +2480,7 @@ TclCallVarTraces(iPtr, arrayPtr, varPtr, part1, part2, flags, leaveErrMsg)
active.nextPtr = iPtr->activeVarTracePtr;
iPtr->activeVarTracePtr = &active;
Tcl_Preserve((ClientData) iPtr);
- if (arrayPtr != NULL && !(arrayPtr->flags & VAR_TRACE_ACTIVE)) {
+ if (arrayPtr != NULL && !TclIsVarTraceActive(arrayPtr)) {
active.varPtr = arrayPtr;
for (tracePtr = arrayPtr->tracePtr; tracePtr != NULL;
tracePtr = active.nextTracePtr) {
@@ -2593,7 +2593,7 @@ TclCallVarTraces(iPtr, arrayPtr, varPtr, part1, part2, flags, leaveErrMsg)
if (copiedName) {
Tcl_DStringFree(&nameCopy);
}
- varPtr->flags &= ~VAR_TRACE_ACTIVE;
+ TclClearVarTraceActive(varPtr);
varPtr->refCount--;
iPtr->activeVarTracePtr = active.nextPtr;
Tcl_Release((ClientData) iPtr);
generated by cgit v0.12 at 2024-08-21 17:45:06 (GMT)