summaryrefslogtreecommitdiffstats
path: root/generic/tclVar.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclVar.c')
-rw-r--r--generic/tclVar.c126
1 files changed, 75 insertions, 51 deletions
diff --git a/generic/tclVar.c b/generic/tclVar.c
index 02c049b..ba33a1c 100644
--- a/generic/tclVar.c
+++ b/generic/tclVar.c
@@ -16,7 +16,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclVar.c,v 1.155 2007/11/11 19:32:17 msofer Exp $
+ * RCS: @(#) $Id: tclVar.c,v 1.156 2007/11/15 09:40:00 dkf Exp $
*/
#include "tclInt.h"
@@ -148,8 +148,9 @@ static void AppendLocals(Tcl_Interp *interp, Tcl_Obj *listPtr,
static void DeleteSearches(Interp *iPtr, Var *arrayVarPtr);
static void DeleteArray(Interp *iPtr, Tcl_Obj *arrayNamePtr,
Var *varPtr, int flags);
-static Tcl_Var ObjFindNamespaceVar(Tcl_Interp *interp, Tcl_Obj *namePtr,
- Tcl_Namespace *contextNsPtr, int flags);
+static Tcl_Var ObjFindNamespaceVar(Tcl_Interp *interp,
+ Tcl_Obj *namePtr, Tcl_Namespace *contextNsPtr,
+ int flags);
static int ObjMakeUpvar(Tcl_Interp *interp,
CallFrame *framePtr, Tcl_Obj *otherP1Ptr,
const char *otherP2, const int otherFlags,
@@ -245,11 +246,11 @@ Tcl_ObjType tclArraySearchType = {
"array search",
NULL, NULL, NULL, SetArraySearchObj
};
-
+
Var *
TclVarHashCreateVar(
TclVarHashTable *tablePtr,
- const char *key,
+ const char *key,
int *newPtr)
{
Tcl_Obj *keyPtr;
@@ -400,7 +401,7 @@ TclLookupVar(
/*
*----------------------------------------------------------------------
*
- * TclObjLookupVar --
+ * TclObjLookupVar, TclObjLookupVarEx --
*
* This function is used by virtually all of the variable code to locate
* a variable given its name(s). The parsing into array/element
@@ -483,14 +484,27 @@ TclObjLookupVar(
Var *
TclObjLookupVarEx(
- Tcl_Interp *interp,
- Tcl_Obj *part1Ptr,
- Tcl_Obj *part2Ptr,
- int flags,
- const char *msg,
- const int createPart1,
- const int createPart2,
- Var **arrayPtrPtr)
+ Tcl_Interp *interp, /* Interpreter to use for lookup. */
+ Tcl_Obj *part1Ptr, /* If part2Ptr isn't NULL, this is the name of
+ * an array. Otherwise, this is a full
+ * variable name that could include a
+ * parenthesized array element. */
+ Tcl_Obj *part2Ptr, /* Name of element within array, or NULL. */
+ int flags, /* Only TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY,
+ * and TCL_LEAVE_ERR_MSG bits matter. */
+ const char *msg, /* Verb to use in error messages, e.g. "read"
+ * or "set". Only needed if TCL_LEAVE_ERR_MSG
+ * is set in flags. */
+ const int createPart1, /* If 1, create hash table entry for part 1 of
+ * name, if it doesn't already exist. If 0,
+ * return error if it doesn't exist. */
+ const int createPart2, /* If 1, create hash table entry for part 2 of
+ * name, if it doesn't already exist. If 0,
+ * return error if it doesn't exist. */
+ Var **arrayPtrPtr) /* If the name refers to an element of an
+ * array, *arrayPtrPtr gets filled in with
+ * address of array variable. Otherwise this
+ * is set to NULL. */
{
Interp *iPtr = (Interp *) interp;
register Var *varPtr; /* Points to the variable's in-frame Var
@@ -522,8 +536,7 @@ TclObjLookupVarEx(
if (typePtr == &localVarNameType) {
int localIndex;
- localVarNameTypeHandling:
-
+ localVarNameTypeHandling:
localIndex = (int) part1Ptr->internalRep.ptrAndLongRep.value;
if (HasLocalVars(varFramePtr)
&& !(flags & (TCL_GLOBAL_ONLY | TCL_NAMESPACE_ONLY))
@@ -532,7 +545,8 @@ TclObjLookupVarEx(
* Use the cached index if the names coincide.
*/
- Tcl_Obj *namePtr = (Tcl_Obj *) part1Ptr->internalRep.ptrAndLongRep.ptr;
+ Tcl_Obj *namePtr = (Tcl_Obj *)
+ part1Ptr->internalRep.ptrAndLongRep.ptr;
Tcl_Obj *checkNamePtr = localName(iPtr->varFramePtr, localIndex);
if ((!namePtr && (checkNamePtr == part1Ptr)) ||
@@ -711,8 +725,10 @@ TclObjLookupVarEx(
part1Ptr->typePtr = &localVarNameType;
if (part1Ptr != localName(iPtr->varFramePtr, index)) {
- part1Ptr->internalRep.ptrAndLongRep.ptr = localName(iPtr->varFramePtr, index);
- Tcl_IncrRefCount((Tcl_Obj *)part1Ptr->internalRep.ptrAndLongRep.ptr);
+ part1Ptr->internalRep.ptrAndLongRep.ptr =
+ localName(iPtr->varFramePtr, index);
+ Tcl_IncrRefCount((Tcl_Obj *)
+ part1Ptr->internalRep.ptrAndLongRep.ptr);
} else {
part1Ptr->internalRep.ptrAndLongRep.ptr = NULL;
}
@@ -919,11 +935,10 @@ TclLookupSimpleVar(
|| !HasLocalVars(varFramePtr)
|| (strstr(varName, "::") != NULL)) {
const char *tail;
- int lookGlobal;
-
- lookGlobal = (flags & TCL_GLOBAL_ONLY)
+ int lookGlobal = (flags & TCL_GLOBAL_ONLY)
|| (cxtNsPtr == iPtr->globalNsPtr)
|| ((*varName == ':') && (*(varName+1) == ':'));
+
if (lookGlobal) {
*indexPtr = -1;
flags = (flags | TCL_GLOBAL_ONLY) & ~TCL_NAMESPACE_ONLY;
@@ -942,7 +957,8 @@ TclLookupSimpleVar(
*/
varPtr = (Var *) ObjFindNamespaceVar(interp, varNamePtr,
- (Tcl_Namespace *) cxtNsPtr, (flags | AVOID_RESOLVERS) & ~TCL_LEAVE_ERR_MSG);
+ (Tcl_Namespace *) cxtNsPtr,
+ (flags | AVOID_RESOLVERS) & ~TCL_LEAVE_ERR_MSG);
if (varPtr == NULL) {
Tcl_Obj *tailPtr;
@@ -952,11 +968,11 @@ TclLookupSimpleVar(
if (varNsPtr == NULL) {
*errMsgPtr = badNamespace;
return NULL;
- }
- if (tail == NULL) {
+ } else if (tail == NULL) {
*errMsgPtr = missingName;
return NULL;
- } else if (tail != varName) {
+ }
+ if (tail != varName) {
tailPtr = Tcl_NewStringObj(tail, -1);
} else {
tailPtr = varNamePtr;
@@ -984,9 +1000,11 @@ TclLookupSimpleVar(
Tcl_Obj **objPtrPtr = &varFramePtr->localCachePtr->varName0;
for (i=0 ; i<localCt ; i++, objPtrPtr++) {
- Tcl_Obj *objPtr = *objPtrPtr;
+ register Tcl_Obj *objPtr = *objPtrPtr;
+
if (objPtr) {
char *localName = TclGetString(objPtr);
+
if ((varName[0] == localName[0])
&& (strcmp(varName, localName) == 0)) {
*indexPtr = i;
@@ -1366,7 +1384,9 @@ TclPtrGetVar(
* in the array part1. */
const int flags, /* OR-ed combination of TCL_GLOBAL_ONLY, and
* TCL_LEAVE_ERR_MSG bits. */
- int index)
+ int index) /* Index into the local variable table of the
+ * variable, or -1. Only used when part1Ptr is
+ * NULL. */
{
Interp *iPtr = (Interp *) interp;
const char *msg;
@@ -2011,7 +2031,9 @@ TclPtrIncrObjVar(
* any of TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY,
* TCL_APPEND_VALUE, TCL_LIST_ELEMENT,
* TCL_LEAVE_ERR_MSG. */
- int index)
+ int index) /* Index into the local variable table of the
+ * variable, or -1. Only used when part1Ptr is
+ * NULL. */
{
register Tcl_Obj *varValuePtr, *newValuePtr = NULL;
int duplicated, code;
@@ -2322,7 +2344,8 @@ UnsetVarStruct(
dummyVar.flags &= ~VAR_TRACE_ACTIVE;
TclObjCallVarTraces(iPtr, arrayPtr, (Var *) &dummyVar,
part1Ptr, part2Ptr,
- (flags & (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY))| TCL_TRACE_UNSETS,
+ (flags & (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY))
+ | TCL_TRACE_UNSETS,
/* leaveErrMsg */ 0, -1);
if (tPtr) {
Tcl_DeleteHashEntry(tPtr);
@@ -4205,11 +4228,11 @@ ParseSearchId(
* optimize this address arithmetic!
*/
- id = (int)(((char*)handleObj->internalRep.twoPtrValue.ptr1) -
- ((char*)NULL));
+ id = (int)(((char *) handleObj->internalRep.twoPtrValue.ptr1) -
+ ((char *) NULL));
string = TclGetString(handleObj);
- offset = (((char*)handleObj->internalRep.twoPtrValue.ptr2) -
- ((char*)NULL));
+ offset = (((char *) handleObj->internalRep.twoPtrValue.ptr2) -
+ ((char *) NULL));
/*
* This test cannot be placed inside the Tcl_Obj machinery, since it is
@@ -4219,9 +4242,7 @@ ParseSearchId(
if (strcmp(string+offset, varName) != 0) {
Tcl_AppendResult(interp, "search identifier \"", string,
"\" isn't for variable \"", varName, "\"", NULL);
- Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ARRAYSEARCH", string,
- NULL);
- return NULL;
+ goto badLookup;
}
/*
@@ -4235,7 +4256,7 @@ ParseSearchId(
if (varPtr->flags & VAR_SEARCH_ACTIVE) {
Tcl_HashEntry *hPtr =
- Tcl_FindHashEntry(&iPtr->varSearches,(char *) varPtr);
+ Tcl_FindHashEntry(&iPtr->varSearches, (char *) varPtr);
for (searchPtr = (ArraySearch *) Tcl_GetHashValue(hPtr);
searchPtr != NULL; searchPtr = searchPtr->nextPtr) {
@@ -4245,6 +4266,7 @@ ParseSearchId(
}
}
Tcl_AppendResult(interp, "couldn't find search \"", string, "\"", NULL);
+ badLookup:
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ARRAYSEARCH", string, NULL);
return NULL;
}
@@ -4610,11 +4632,13 @@ TclObjVarErrMsg(
const char *operation, /* String describing operation that failed,
* e.g. "read", "set", or "unset". */
const char *reason, /* String describing why operation failed. */
- int index)
+ int index) /* Index into the local variable table of the
+ * variable, or -1. Only used when part1Ptr is
+ * NULL. */
{
Tcl_ResetResult(interp);
if (!part1Ptr) {
- part1Ptr = localName(((Interp*)interp)->varFramePtr, index);
+ part1Ptr = localName(((Interp *)interp)->varFramePtr, index);
}
Tcl_AppendResult(interp, "can't ", operation, " \"",
TclGetString(part1Ptr), NULL);
@@ -4685,8 +4709,9 @@ DupLocalVarName(
}
dupPtr->internalRep.ptrAndLongRep.ptr = namePtr;
Tcl_IncrRefCount(namePtr);
-
- dupPtr->internalRep.ptrAndLongRep.value = srcPtr->internalRep.ptrAndLongRep.value;
+
+ dupPtr->internalRep.ptrAndLongRep.value =
+ srcPtr->internalRep.ptrAndLongRep.value;
dupPtr->typePtr = &localVarNameType;
}
@@ -4894,7 +4919,7 @@ ObjFindNamespaceVar(
Tcl_Var var;
Tcl_Obj *simpleNamePtr;
char *name = TclGetString(namePtr);
-
+
/*
* If this namespace has a variable resolver, then give it first crack at
* the variable resolution. It may return a Tcl_Var value, it may signal
@@ -4955,7 +4980,7 @@ ObjFindNamespaceVar(
} else {
simpleNamePtr = namePtr;
}
-
+
for (search = 0; (search < 2) && (varPtr == NULL); search++) {
if ((nsPtr[search] != NULL) && (simpleName != NULL)) {
varPtr = VarHashFindVar(&nsPtr[search]->varTable, simpleNamePtr);
@@ -4964,13 +4989,12 @@ ObjFindNamespaceVar(
if (simpleName != name) {
Tcl_DecrRefCount(simpleNamePtr);
}
- if (varPtr != NULL) {
- return (Tcl_Var) varPtr;
- } else if (flags & TCL_LEAVE_ERR_MSG) {
+ if ((varPtr == NULL) && (flags & TCL_LEAVE_ERR_MSG)) {
Tcl_ResetResult(interp);
Tcl_AppendResult(interp, "unknown variable \"", name, "\"", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARIABLE", name, NULL);
}
- return (Tcl_Var) NULL;
+ return (Tcl_Var) varPtr;
}
/*
@@ -5489,8 +5513,8 @@ CompareVarKeys(
}
/*
- * Don't use Tcl_GetStringFromObj as it would prevent l1 and l2 being
- * in a register.
+ * Don't use Tcl_GetStringFromObj as it would prevent l1 and l2 being in a
+ * register.
*/
p1 = TclGetString(objPtr1);
@@ -5540,7 +5564,7 @@ HashVarKey(
* character's bits hang around in the low-order bits of the hash value
* for ever, plus they spread fairly rapidly up to the high-order bits
* to fill out the hash value. This seems works well both for decimal
- * and *non-decimal strings.
+ * and non-decimal strings.
*/
for (i=0 ; i<length ; i++) {