Tcl_Obj *key, int *newPtr);
static inline Var *	VarHashFirstVar(TclVarHashTable *tablePtr,
			    Tcl_HashSearch *searchPtr);
static inline Var *	VarHashNextVar(Tcl_HashSearch *searchPtr);
static inline void	CleanupVar(Var *varPtr, Var *arrayPtr);

#define VarHashGetValue(hPtr) \
    ((Var *) ((char *)hPtr - offsetof(VarInHash, entry)))
    ((Var *) ((char *) (hPtr) - offsetof(VarInHash, entry)))

/*
 * NOTE: VarHashCreateVar increments the recount of its key argument.
 * All callers that will call Tcl_DecrRefCount on that argument must
 * call Tcl_IncrRefCount on it before passing it in.  This requirement
 * can bubble up to callers of callers .... etc.
 */

/*
 * A test to see if we are in a call frame that has local variables. This is
 * true if we are inside a procedure body.
 */

#define HasLocalVars(framePtr) ((framePtr)->isProcCallFrame & FRAME_IS_PROC)

/*
 * Marker that a variable is not known to be in a local variable table.
 */
#define NOT_IN_LVT	(-1)

/*
 * The following structure describes an enumerative search in progress on an
 * array variable; this are invoked with options to the "array" command.
 */

typedef struct ArraySearch {
    Tcl_Obj *name;		/* Name of this search */

 * TIP #508: [array default]
 *
 * The following structure extends the regular TclVarHashTable used by array
 * variables to store their optional default value.
 */

typedef struct ArrayVarHashTable {
    TclVarHashTable table;
    Tcl_Obj *defaultObj;
    TclVarHashTable table;	/* The base hash table. */
    Tcl_Obj *defaultObj;	/* The default value, if one is present. If
				 * set, has TWO reference counts to ensure no
				 * accidental mutation. */
} ArrayVarHashTable;

/*
 * Forward references to functions defined later in this file:
 */

static void		AppendLocals(Tcl_Interp *interp, Tcl_Obj *listPtr,
			    Tcl_Obj *patternPtr, int includeLinks,
			    Tcl_Obj *patternPtr, int flags);
			    int justConstants);
static void		ArrayPopulateSearch(Tcl_Interp *interp,
			    Tcl_Obj *arrayNameObj, Var *varPtr,
			    ArraySearch *searchPtr);
static void		ArrayDoneSearch(Interp *iPtr, Var *varPtr,
			    ArraySearch *searchPtr);
static Tcl_NRPostProc   ArrayForLoopCallback;
static Tcl_NRPostProc	ArrayForLoopCallback;
static Tcl_ObjCmdProc	ArrayForNRCmd;
static void		DeleteSearches(Interp *iPtr, Var *arrayVarPtr);
static void		DeleteArray(Interp *iPtr, Tcl_Obj *arrayNamePtr,
			    Var *varPtr, int flags, int index);
static int		LocateArray(Tcl_Interp *interp, Tcl_Obj *name,
			    Var **varPtrPtr, int *isArrayPtr);
static int		NotArrayError(Tcl_Interp *interp, Tcl_Obj *name);

static Tcl_DupInternalRepProc	DupLocalVarName;
static Tcl_FreeInternalRepProc	FreeLocalVarName;

static Tcl_FreeInternalRepProc	FreeParsedVarName;
static Tcl_DupInternalRepProc	DupParsedVarName;

/*
 * Values fed out of TclLookupSimpleVar by the indexPtr argument when not set
 * to a local variable table index (all valid LVT indices are >= 0). 
 */
enum LookupSimpleVarBadIndices {
    GLOBAL_REFERENCE = -1,	/* Variable was in the global namespace. */
    NAMESPACE_REFERENCE = -2,	/* Variable was in a non-global NS. */
    UNKNOWN_REFERENCE = -3	/* Variable was of unknown provenance; do not
				 * cache! Typically means that a resolver is
				 * doing something complicated. */
};

/* Flags to AppendLocals(), used to select what to describe. */
enum AppendLocalsFlags {
    INCLUDE_LINKS = 1 << 0,	/* Whether upvars should be included. */
    CONSTANTS_ONLY = 1 << 1	/* Whether just constants should be included. */
};

enum MiscFlagCombinations {
    SCOPES = TCL_GLOBAL_ONLY | TCL_NAMESPACE_ONLY,
    SET_MODIFIERS = TCL_APPEND_VALUE | TCL_LIST_ELEMENT
};

/*
 * Types of Tcl_Objs used to cache variable lookups.
 *
 * localVarName - INTERNALREP DEFINITION:
 *   twoPtrValue.ptr1:   pointer to name obj in varFramePtr->localCache
 *			  or NULL if it is this same obj
 *   twoPtrValue.ptr2: index into locals table
 *   twoPtrValue.ptr1:	pointer to name obj in varFramePtr->localCache
 *			or NULL if it is this same obj
 *   twoPtrValue.ptr2:	index into locals table
 *
 * parsedVarName - INTERNALREP DEFINITION:
 *   twoPtrValue.ptr1:	pointer to the array name Tcl_Obj, or NULL if it is a
 *			scalar variable
 *   twoPtrValue.ptr2:	pointer to the element name string (owned by this
 *			Tcl_Obj), or NULL if it is a scalar variable
 */

static const Tcl_ObjType localVarNameType = {
    "localVarName",
    FreeLocalVarName, DupLocalVarName, NULL, NULL,
    TCL_OBJTYPE_V0
};

static inline void
#define LocalSetInternalRep(objPtr, index, namePtr)			\
LocalSetInternalRep(
    do {								\
	Tcl_ObjInternalRep ir;						\
	Tcl_Obj *ptr = (namePtr);					\
	if (ptr) {Tcl_IncrRefCount(ptr);}				\
	ir.twoPtrValue.ptr1 = ptr;					\
	ir.twoPtrValue.ptr2 = INT2PTR(index);				\
	Tcl_StoreInternalRep((objPtr), &localVarNameType, &ir);		\
    Tcl_Obj *objPtr,		/* Object to set the rep of. */
    Tcl_Size index,		/* LVT index. >= 0 */
    Tcl_Obj *namePtr)		/* Pointer into name table if not objPtr. */
{
    Tcl_ObjInternalRep ir;

    if (namePtr) {
	Tcl_IncrRefCount(namePtr);
    }
    ir.twoPtrValue.ptr1 = namePtr;
    ir.twoPtrValue.ptr2 = INT2PTR(index);
    Tcl_StoreInternalRep(objPtr, &localVarNameType, &ir);
    } while (0)

#define LocalGetInternalRep(objPtr, index, name)			\
}

#define LocalGetInternalRep(objPtr, index, name) \
    do {								\
	const Tcl_ObjInternalRep *irPtr;				\
	irPtr = TclFetchInternalRep((objPtr), &localVarNameType);	\
	(name) = irPtr ? (Tcl_Obj *)irPtr->twoPtrValue.ptr1 : NULL;	\
	(index) = irPtr ? PTR2INT(irPtr->twoPtrValue.ptr2) : TCL_INDEX_NONE; \
	const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(		\
		(objPtr), &localVarNameType);				\
	(name) = irPtr ? (Tcl_Obj *) irPtr->twoPtrValue.ptr1 : NULL;	\
	(index) = irPtr ? PTR2INT(irPtr->twoPtrValue.ptr2) : NOT_IN_LVT;\
    } while (0)

static const Tcl_ObjType parsedVarNameType = {
    "parsedVarName",
    FreeParsedVarName, DupParsedVarName, NULL, NULL,
    TCL_OBJTYPE_V0
};

static inline void
#define ParsedSetInternalRep(objPtr, arrayPtr, elem)			\
ParsedSetInternalRep(
    do {								\
	Tcl_ObjInternalRep ir;						\
	Tcl_Obj *ptr1 = (arrayPtr);					\
    Tcl_Obj *objPtr,		/* Object to set the rep of. */
    Tcl_Obj *arrayPtr,		/* The array name Tcl_Obj, or NULL if it is a
				 * scalar variable. */
    Tcl_Obj *elem)		/* pointer to the element name string (will be
				 * owned by objPtr), or NULL if it is a scalar
				 * variable. */
{
    Tcl_ObjInternalRep ir;

    if (arrayPtr) {
	Tcl_Obj *ptr2 = (elem);						\
	if (ptr1) {Tcl_IncrRefCount(ptr1);}				\
	if (ptr2) {Tcl_IncrRefCount(ptr2);}				\
	ir.twoPtrValue.ptr1 = ptr1;					\
	ir.twoPtrValue.ptr2 = ptr2;					\
	Tcl_StoreInternalRep((objPtr), &parsedVarNameType, &ir);	\
	Tcl_IncrRefCount(arrayPtr);
    }
    if (elem) {
	Tcl_IncrRefCount(elem);
    }
    ir.twoPtrValue.ptr1 = arrayPtr;
    ir.twoPtrValue.ptr2 = elem;
    Tcl_StoreInternalRep(objPtr, &parsedVarNameType, &ir);
    } while (0)

#define ParsedGetInternalRep(objPtr, parsed, array, elem)		\
}

#define ParsedGetInternalRep(objPtr, parsed, array, elem) \
    do {								\
	const Tcl_ObjInternalRep *irPtr;				\
	irPtr = TclFetchInternalRep((objPtr), &parsedVarNameType);	\
	const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(		\
		(objPtr), &parsedVarNameType);				\
	(parsed) = (irPtr != NULL);					\
	(array) = irPtr ? (Tcl_Obj *)irPtr->twoPtrValue.ptr1 : NULL;	\
	(elem) = irPtr ? (Tcl_Obj *)irPtr->twoPtrValue.ptr2 : NULL;	\
	(array) = irPtr ? (Tcl_Obj *) irPtr->twoPtrValue.ptr1 : NULL;	\
	(elem) = irPtr ? (Tcl_Obj *) irPtr->twoPtrValue.ptr2 : NULL;	\
    } while (0)

/*
 * Simple rules for when a pattern is simple enough to not need a table scan,
 * or when a scanned entry matches the pattern.
 */

#define TrivialPattern(pattern) \
    ((pattern) && TclMatchIsTrivial(pattern))
#define PatternMatch(pattern, nameObj) \
    (!(pattern) || Tcl_StringMatch(TclGetString(nameObj), (pattern)))

Var *
TclVarHashCreateVar(
    TclVarHashTable *tablePtr,
    const char *key,
    int *newPtr)
{
    Tcl_Obj *keyPtr;
    Var *varPtr;
    Tcl_Obj *keyPtr = Tcl_NewStringObj(key, TCL_AUTO_LENGTH);
    Var *varPtr = VarHashCreateVar(tablePtr, keyPtr, newPtr);

    keyPtr = Tcl_NewStringObj(key, -1);
    Tcl_IncrRefCount(keyPtr);
    Tcl_BounceRefCount(keyPtr);
    varPtr = VarHashCreateVar(tablePtr, keyPtr, newPtr);
    Tcl_DecrRefCount(keyPtr);

    return varPtr;
}

static int
LocateArray(
    Tcl_Interp *interp,
    Tcl_Obj *name,
    Var **varPtrPtr,
    int *isArrayPtr)
{
    Var *arrayPtr, *varPtr = TclObjLookupVarEx(interp, name, NULL, /*flags*/ 0,
	    /*msg*/ 0, /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr);

    if (TclCheckArrayTraces(interp, varPtr, arrayPtr, name, -1) == TCL_ERROR) {
    if (TclCheckArrayTraces(interp, varPtr, arrayPtr, name,
	    NOT_IN_LVT) == TCL_ERROR) {
	return TCL_ERROR;
    }
    if (varPtrPtr) {
	*varPtrPtr = varPtr;
    }
    if (isArrayPtr) {
	*isArrayPtr = (varPtr != NULL)
	*isArrayPtr = varPtr && !TclIsVarUndefined(varPtr)
		&& !TclIsVarUndefined(varPtr)
		&& TclIsVarArray(varPtr);
    }
    return TCL_OK;
}

static int
NotArrayError(
    Tcl_Interp *interp,
    Tcl_Obj *name)
{
    const char *nameStr = TclGetString(name);

    Tcl_SetObjResult(interp,
	    Tcl_ObjPrintf("\"%s\" isn't an array", nameStr));
    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ARRAY", nameStr, (char *)NULL);
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * AsObj --
 *
 * 	Convenience function that converts a string to a zero-ref Tcl_Obj, but
 *	accepts a NULL and leaves that as a NULL (useful for part2 arguments).
 *
 *----------------------------------------------------------------------
 */
static inline Tcl_Obj *
AsObj(
    const char *str)		/* NUL-terminated string or NULL. */
{
    return str ? Tcl_NewStringObj(str, TCL_AUTO_LENGTH) : NULL;
}

/*
 *----------------------------------------------------------------------
 *
 * AsStr --
 *
 * 	Convenience function that converts a Tcl_Obj to a string, but accepts
 *	a NULL and leaves that as a NULL.
 *
 *----------------------------------------------------------------------
 */
static inline const char *
AsStr(
    Tcl_Obj *objPtr)		/* Object or NULL. */
{
    return objPtr ? TclGetString(objPtr) : NULL;
}

/*
 *----------------------------------------------------------------------
 *
 * TclCleanupVar --
 *
 *	This function is called when it looks like it may be OK to free up a

static inline void
CleanupVar(
    Var *varPtr,		/* Pointer to variable that may be a candidate
				 * for being expunged. */
    Var *arrayPtr)		/* Array that contains the variable, or NULL
				 * if this variable isn't an array element. */
{
#define READY_TO_CLEAN(varPtr) \
	(VarHashRefCount(varPtr) == (Tcl_Size) !TclIsVarDeadHash(varPtr))
    if (TclIsVarUndefined(varPtr) && TclIsVarInHash(varPtr)
	    && !TclIsVarTraced(varPtr)
	    && !TclIsVarTraced(varPtr) && READY_TO_CLEAN(varPtr)) {
	    && (VarHashRefCount(varPtr) == (Tcl_Size)
		    !TclIsVarDeadHash(varPtr))) {
	if (VarHashRefCount(varPtr) == 0) {
	    Tcl_Free(varPtr);
	} else {
	    VarHashDeleteEntry(varPtr);
	}
    }
    if (arrayPtr != NULL && TclIsVarUndefined(arrayPtr) &&
	    TclIsVarInHash(arrayPtr) && !TclIsVarTraced(arrayPtr) &&
    if (arrayPtr && TclIsVarUndefined(arrayPtr) && TclIsVarInHash(arrayPtr)
	    && !TclIsVarTraced(arrayPtr) && READY_TO_CLEAN(arrayPtr)) {
	    (VarHashRefCount(arrayPtr) == (Tcl_Size)
		    !TclIsVarDeadHash(arrayPtr))) {
	if (VarHashRefCount(arrayPtr) == 0) {
	    Tcl_Free(arrayPtr);
	} else {
	    VarHashDeleteEntry(arrayPtr);
	}
    }
}

				 * 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. */
{
    Var *varPtr;
    Tcl_Obj *part1Ptr = Tcl_NewStringObj(part1, -1);
    Tcl_Obj *part1Ptr = Tcl_NewStringObj(part1, TCL_AUTO_LENGTH);

    if (createPart1) {
	Tcl_IncrRefCount(part1Ptr);
    }

    varPtr = TclObjLookupVar(interp, part1Ptr, part2, flags, msg,
    Var *varPtr = TclObjLookupVar(interp, part1Ptr, part2, flags, msg,
	    createPart1, createPart2, arrayPtrPtr);

    TclDecrRefCount(part1Ptr);
    Tcl_BounceRefCount(part1Ptr);
    return varPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * TclObjLookupVar, TclObjLookupVarEx --

				 * 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. */
{
    Tcl_Obj *part2Ptr = NULL;
    Tcl_Obj *part2Ptr = AsObj(part2);
    Var *resPtr;

    if (part2) {
	part2Ptr = Tcl_NewStringObj(part2, -1);
	if (createPart2) {
	    Tcl_IncrRefCount(part2Ptr);
	}
    }

    resPtr = TclObjLookupVarEx(interp, part1Ptr, part2Ptr,
    Var *resPtr = TclObjLookupVarEx(interp, part1Ptr, part2Ptr,
	    flags, msg, createPart1, createPart2, arrayPtrPtr);

    if (part2Ptr) {
	Tcl_DecrRefCount(part2Ptr);
    Tcl_BounceRefCount(part2Ptr);
    }

    return resPtr;
}

/*
 *	When createPart1 is 1, callers must IncrRefCount part1Ptr if they
 *	plan to DecrRefCount it.
 *	When createPart2 is 1, callers must IncrRefCount part2Ptr if they

    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;
    CallFrame *varFramePtr = iPtr->varFramePtr;
    Var *varPtr;	/* Points to the variable's in-frame Var
    Var *varPtr;		/* Points to the variable's in-frame Var
				 * structure. */
    const char *errMsg = NULL;
    int index, parsed = 0;

    Tcl_Size localIndex;
    Tcl_Obj *namePtr, *arrayPtr, *elem;

    *arrayPtrPtr = NULL;

  restart:
    LocalGetInternalRep(part1Ptr, localIndex, namePtr);
    if (localIndex >= 0) {
	if (HasLocalVars(varFramePtr)
		&& !(flags & (TCL_GLOBAL_ONLY | TCL_NAMESPACE_ONLY))
		&& !(flags & SCOPES)
		&& (localIndex < varFramePtr->numCompiledLocals)) {
	    /*
	     * Use the cached index if the names coincide.
	     */

	    Tcl_Obj *checkNamePtr = localName(varFramePtr, localIndex);

	    if ((!namePtr && (checkNamePtr == part1Ptr)) ||
		    (namePtr && (checkNamePtr == namePtr))) {
		varPtr = (Var *) &(varFramePtr->compiledLocals[localIndex]);
		varPtr = &varFramePtr->compiledLocals[localIndex];
		goto donePart1;
	    }
	}
	goto doneParsing;
    }

    /*
     * If part1Ptr is a parsedVarNameType, retrieve the preparsed parts.
     */

    ParsedGetInternalRep(part1Ptr, parsed, arrayPtr, elem);
    if (parsed && arrayPtr) {
	    if (part2Ptr != NULL) {
		/*
		 * ERROR: part1Ptr is already an array element, cannot specify
		 * a part2.
		 */
	if (part2Ptr) {
	    /*
	     * ERROR: part1Ptr is already an array element, cannot specify
	     * a part2.
	     */

		if (flags & TCL_LEAVE_ERR_MSG) {
		    TclObjVarErrMsg(interp, part1Ptr, part2Ptr, msg,
			    NOSUCHVAR, -1);
		    Tcl_SetErrorCode(interp, "TCL", "VALUE", "VARNAME", (char *)NULL);
		}
		return NULL;
	    }
	    part2Ptr = elem;
	    part1Ptr = arrayPtr;
	    goto restart;
	    if (flags & TCL_LEAVE_ERR_MSG) {
		TclObjVarErrMsg(interp, part1Ptr, part2Ptr, msg,
			NOSUCHVAR, NOT_IN_LVT);
		Tcl_SetErrorCode(interp, "TCL", "VALUE", "VARNAME", (char *)NULL);
	    }
	    return NULL;
	}
	part2Ptr = elem;
	part1Ptr = arrayPtr;
	goto restart;
    }

    if (!parsed) {
	/*
	 * part1Ptr is possibly an unparsed array element.
	 */

	Tcl_Size len;
	const char *part1 = TclGetStringFromObj(part1Ptr, &len);

	if ((len > 1) && (part1[len - 1] == ')')) {
	    const char *part2 = strchr(part1, '(');

	    if (part2) {
		if (part2Ptr != NULL) {
		if (part2Ptr) {
		    if (flags & TCL_LEAVE_ERR_MSG) {
			TclObjVarErrMsg(interp, part1Ptr, part2Ptr, msg,
				NEEDARRAY, -1);
				NEEDARRAY, NOT_IN_LVT);
			Tcl_SetErrorCode(interp, "TCL", "VALUE", "VARNAME",
				(char *)NULL);
		    }
		    return NULL;
		}

		arrayPtr = Tcl_NewStringObj(part1, (part2 - part1));

    /*
     * part1Ptr is not an array element; look it up, and convert it to one of
     * the cached types if possible.
     */

    varPtr = TclLookupSimpleVar(interp, part1Ptr, flags, createPart1,
	    &errMsg, &index);
    if (varPtr == NULL) {
	if ((errMsg != NULL) && (flags & TCL_LEAVE_ERR_MSG)) {
	    TclObjVarErrMsg(interp, part1Ptr, part2Ptr, msg, errMsg, -1);
    if (!varPtr) {
	if (errMsg && (flags & TCL_LEAVE_ERR_MSG)) {
	    TclObjVarErrMsg(interp, part1Ptr, part2Ptr, msg, errMsg,
		    NOT_IN_LVT);
	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARNAME",
		    TclGetString(part1Ptr), (char *)NULL);
	}
	return NULL;
    }

    /*

    }

  donePart1:
    while (TclIsVarLink(varPtr)) {
	varPtr = varPtr->value.linkPtr;
    }

    if (part2Ptr != NULL) {
    if (part2Ptr) {
	/*
	 * Array element sought: look it up.
	 */

	*arrayPtrPtr = varPtr;
	varPtr = TclLookupArrayElement(interp, part1Ptr, part2Ptr, flags, msg,
		createPart1, createPart2, varPtr, -1);
		createPart1, createPart2, varPtr, NOT_IN_LVT);
    }
    return varPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * ApplyResolvers --
 *
 *	How to actually apply variable resolvers when looking up a variable.
 *
 *	It is up to the caller to check for the TCL_AVOID_RESOLVERS flag
 *	before calling this.
 *
 * Results:
 *	TCL_OK if a variable has been resolved.
 * 	TCL_ERROR if a definite failure has been determined (i.e., the
 *	resolution process is indicating that the variable definitely
 *	doesn't exist).
 *	TCL_CONTINUE if no resolver has decided to resolve the variable.
 *
 * Side effects:
 *	The interpreter's result is set on error. The resolvers may alter
 *	their internal state.
 *
 *----------------------------------------------------------------------
 */
static inline int
ApplyResolvers(
    Tcl_Interp *interp,
    Namespace *cxtNsPtr,	/* Context namespace. */
    const char *varName,	/* Variable name. */
    int flags,
    Tcl_Var *varPtrPtr)		/* OUT: Set to found var, or NULL on error. */
{
    Interp *iPtr = (Interp *) interp;
    int result = TCL_CONTINUE;

    if (cxtNsPtr->varResProc || iPtr->resolverPtr) {
	ResolverScheme *resPtr = iPtr->resolverPtr;

	/*
	 * Apply the namespace's resolver, if there is one.
	 */

	if (cxtNsPtr->varResProc) {
	    result = cxtNsPtr->varResProc(interp, varName,
		    (Tcl_Namespace *) cxtNsPtr, flags, varPtrPtr);
	}

	/*
	 * Apply the list of global resolvers, at least until one of them
	 * elects to do something (and only if the namespace resolver didn't
	 * already do so).
	 */

	for (; result == TCL_CONTINUE && resPtr; resPtr = resPtr->nextPtr) {
	    if (resPtr->varResProc) {
		result = resPtr->varResProc(interp, varName,
			(Tcl_Namespace *) cxtNsPtr, flags, varPtrPtr);
	    }
	}

	/*
	 * Ensure that we have a defined state on error.
	 */

	if (result == TCL_ERROR) {
	    *varPtrPtr = NULL;
	}
    }
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * TclLookupSimpleVar --
 *
 *	This function is used by to locate a simple variable (i.e., not an

				 * an "uplevel" is executing. */
    TclVarHashTable *tablePtr;	/* Points to the hashtable, if any, in which
				 * to look up the variable. */
    Tcl_Var var;		/* Used to search for global names. */
    Var *varPtr;		/* Points to the Var structure returned for
				 * the variable. */
    Namespace *varNsPtr, *cxtNsPtr, *dummy1Ptr, *dummy2Ptr;
    ResolverScheme *resPtr;
    int isNew, result;
    Tcl_Size i, varLen;
    const char *varName = TclGetStringFromObj(varNamePtr, &varLen);

    varPtr = NULL;
    varNsPtr = NULL;		/* Set non-NULL if a nonlocal variable. */
    *indexPtr = -3;
    *indexPtr = UNKNOWN_REFERENCE;

    if (flags & TCL_GLOBAL_ONLY) {
	cxtNsPtr = iPtr->globalNsPtr;
    } else {
	cxtNsPtr = iPtr->varFramePtr->nsPtr;
    }

    /*
     * 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
     * to continue onward, or it may signal an error.
     */

    if ((cxtNsPtr->varResProc != NULL || iPtr->resolverPtr != NULL)
	    && !(flags & TCL_AVOID_RESOLVERS)) {
    if (!(flags & TCL_AVOID_RESOLVERS)) {
	resPtr = iPtr->resolverPtr;
	if (cxtNsPtr->varResProc) {
	    result = cxtNsPtr->varResProc(interp, varName,
		    (Tcl_Namespace *) cxtNsPtr, flags, &var);
	} else {
	    result = TCL_CONTINUE;
	}

	result = ApplyResolvers(interp, cxtNsPtr, varName, flags, &var);
	while (result == TCL_CONTINUE && resPtr) {
	    if (resPtr->varResProc) {
		result = resPtr->varResProc(interp, varName,
			(Tcl_Namespace *) cxtNsPtr, flags, &var);
	    }
	    resPtr = resPtr->nextPtr;
	}

	if (result == TCL_OK) {
	    return (Var *) var;
	} else if (result != TCL_CONTINUE) {
	    return NULL;
	if (result != TCL_CONTINUE) {
	    return (Var *) var;
	}
    }

    /*
     * Look up varName. Look it up as either a namespace variable or as a
     * local variable in a procedure call frame (varFramePtr). Interpret
     * varName as a namespace variable if:
     *    1) so requested by a TCL_GLOBAL_ONLY or TCL_NAMESPACE_ONLY flag,
     *    2) there is no active frame (we're at the global :: scope),
     *    3) the active frame was pushed to define the namespace context for a
     *	     "namespace eval" or "namespace inscope" command,
     *    4) the name has namespace qualifiers ("::"s).
     * Otherwise, if varName is a local variable, search first in the frame's
     * array of compiler-allocated local variables, then in its hashtable for
     * runtime-created local variables.
     *
     * If create and the variable isn't found, create the variable and, if
     * necessary, create varFramePtr's local var hashtable.
     */

    if (((flags & (TCL_GLOBAL_ONLY | TCL_NAMESPACE_ONLY)) != 0)
    if (((flags & SCOPES) != 0)
	    || !HasLocalVars(varFramePtr)
	    || (strstr(varName, "::") != NULL)) {
	const char *tail;
	int lookGlobal = (flags & TCL_GLOBAL_ONLY)
		|| (cxtNsPtr == iPtr->globalNsPtr)
		|| ((varName[0] == ':') && (varName[1] == ':'));

	if (lookGlobal) {
	    *indexPtr = -1;
	    *indexPtr = GLOBAL_REFERENCE;
	    flags = (flags | TCL_GLOBAL_ONLY) & ~TCL_NAMESPACE_ONLY;
	} else {
	    flags = (flags | TCL_NAMESPACE_ONLY);
	    *indexPtr = -2;
	    flags |= TCL_NAMESPACE_ONLY;
	    *indexPtr = NAMESPACE_REFERENCE;
	}

	/*
	 * Don't pass TCL_LEAVE_ERR_MSG, we may yet create the variable, or
	 * otherwise generate our own error!
	 */

	varPtr = (Var *) ObjFindNamespaceVar(interp, varNamePtr,
		(Tcl_Namespace *) cxtNsPtr,
		(flags | TCL_AVOID_RESOLVERS) & ~TCL_LEAVE_ERR_MSG);
	if (varPtr == NULL) {
	if (!varPtr) {
	    Tcl_Obj *tailPtr;

	    if (!create) {	/* Var wasn't found and not to create it. */
		*errMsgPtr = NOSUCHVAR;
		return NULL;
	    }

	    /*
	     * Var wasn't found so create it.
	     */

	    TclGetNamespaceForQualName(interp, varName, cxtNsPtr, flags,
		    &varNsPtr, &dummy1Ptr, &dummy2Ptr, &tail);
	    if (varNsPtr == NULL) {
	    if (!varNsPtr) {
		*errMsgPtr = BADNAMESPACE;
		return NULL;
	    } else if (tail == NULL) {
	    } else if (!tail) {
		*errMsgPtr = MISSINGNAME;
		return NULL;
	    }
	    if (tail != varName) {
		tailPtr = Tcl_NewStringObj(tail, -1);
		tailPtr = Tcl_NewStringObj(tail, TCL_AUTO_LENGTH);
	    } else {
		tailPtr = varNamePtr;
	    }
	    varPtr = VarHashCreateVar(&varNsPtr->varTable, tailPtr, &isNew);
	    if (lookGlobal) {
		/*
		 * The variable was created starting from the global
		 * namespace: a global reference is returned even if it wasn't
		 * explicitly requested.
		 */

		*indexPtr = -1;
		*indexPtr = GLOBAL_REFERENCE;
	    } else {
		*indexPtr = -2;
		*indexPtr = NAMESPACE_REFERENCE;
	    }
	}
    } else {			/* Local var: look in frame varFramePtr. */
	Tcl_Size localCt = varFramePtr->numCompiledLocals;

	if (localCt > 0) {
	    Tcl_Obj **objPtrPtr = &varFramePtr->localCachePtr->varName0;
	    const char *localNameStr;
	    Tcl_Size localLen;

	    for (i=0 ; i<localCt ; i++, objPtrPtr++) {
		Tcl_Obj *objPtr = *objPtrPtr;

		if (objPtr) {
		    localNameStr = TclGetStringFromObj(objPtr, &localLen);

		    if ((varLen == localLen) && (varName[0] == localNameStr[0])
		    if ((varLen == localLen)
			    && (varName[0] == localNameStr[0])
			    && !memcmp(varName, localNameStr, varLen)) {
			*indexPtr = i;
			return (Var *) &varFramePtr->compiledLocals[i];
			return &varFramePtr->compiledLocals[i];
		    }
		}
	    }
	}
	tablePtr = varFramePtr->varTablePtr;
	if (create) {
	    if (tablePtr == NULL) {
		tablePtr = (TclVarHashTable *)Tcl_Alloc(sizeof(TclVarHashTable));
	    if (!tablePtr) {
		tablePtr = (TclVarHashTable *)
			Tcl_Alloc(sizeof(TclVarHashTable));
		TclInitVarHashTable(tablePtr, NULL);
		tablePtr->arrayPtr = varPtr;
		varFramePtr->varTablePtr = tablePtr;
	    }
	    varPtr = VarHashCreateVar(tablePtr, varNamePtr, &isNew);
	} else {
	    varPtr = NULL;
	    if (tablePtr != NULL) {
	    if (tablePtr) {
		varPtr = VarHashFindVar(tablePtr, varNamePtr);
	    }
	    if (varPtr == NULL) {
	    if (!varPtr) {
		*errMsgPtr = NOSUCHVAR;
	    }
	}
    }
    return varPtr;
}


    if (TclIsVarUndefined(arrayPtr) && !TclIsVarArrayElement(arrayPtr)) {
	if (!createArray) {
	    if (flags & TCL_LEAVE_ERR_MSG) {
		TclObjVarErrMsg(interp, arrayNamePtr, elNamePtr, msg,
			NOSUCHVAR, index);
		Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARNAME",
			arrayNamePtr?TclGetString(arrayNamePtr):NULL, (char *)NULL);
			AsStr(arrayNamePtr), (char *)NULL);
	    }
	    return NULL;
	}

	/*
	 * Make sure we are not resurrecting a namespace variable from a
	 * deleted namespace!
	 */

	if (TclIsVarDeadHash(arrayPtr)) {
	    if (flags & TCL_LEAVE_ERR_MSG) {
		TclObjVarErrMsg(interp, arrayNamePtr, elNamePtr, msg,
			DANGLINGVAR, index);
		Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARNAME",
			arrayNamePtr?TclGetString(arrayNamePtr):NULL, (char *)NULL);
			AsStr(arrayNamePtr), (char *)NULL);
	    }
	    return NULL;
	}

	TclInitArrayVar(arrayPtr);
    } else if (!TclIsVarArray(arrayPtr)) {
	if (flags & TCL_LEAVE_ERR_MSG) {
	    TclObjVarErrMsg(interp, arrayNamePtr, elNamePtr, msg, NEEDARRAY,
		    index);
	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARNAME",
		    arrayNamePtr?TclGetString(arrayNamePtr):NULL, (char *)NULL);
		    AsStr(arrayNamePtr), (char *)NULL);
	}
	return NULL;
    }

    if (createElem) {
	varPtr = VarHashCreateVar(arrayPtr->value.tablePtr, elNamePtr,
		&isNew);
	if (isNew) {
	    if (arrayPtr->flags & VAR_SEARCH_ACTIVE) {
		DeleteSearches((Interp *) interp, arrayPtr);
	    }
	    TclSetVarArrayElement(varPtr);
	}
    } else {
	varPtr = VarHashFindVar(arrayPtr->value.tablePtr, elNamePtr);
	if (varPtr == NULL) {
	    if (flags & TCL_LEAVE_ERR_MSG) {
		TclObjVarErrMsg(interp, arrayNamePtr, elNamePtr, msg,
			NOSUCHELEMENT, index);
		Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ELEMENT",
			TclGetString(elNamePtr), (char *)NULL);
	if (!varPtr && (flags & TCL_LEAVE_ERR_MSG)) {
	    TclObjVarErrMsg(interp, arrayNamePtr, elNamePtr, msg,
		    NOSUCHELEMENT, index);
	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ELEMENT",
		    TclGetString(elNamePtr), (char *)NULL);
	    }
	}
    }
    return varPtr;
}

/*
 *----------------------------------------------------------------------

				 * the name of a variable. */
    const char *part2,		/* If non-NULL, gives the name of an element
				 * in the array part1. */
    int flags)			/* OR-ed combination of TCL_GLOBAL_ONLY,
				 * TCL_NAMESPACE_ONLY and TCL_LEAVE_ERR_MSG *
				 * bits. */
{
    Tcl_Obj *resultPtr;
    Tcl_Obj *part2Ptr = NULL, *part1Ptr = Tcl_NewStringObj(part1, -1);

    Tcl_Obj *part1Ptr = Tcl_NewStringObj(part1, TCL_AUTO_LENGTH);
    Tcl_Obj *part2Ptr = AsObj(part2);
    if (part2) {
	part2Ptr = Tcl_NewStringObj(part2, -1);
	Tcl_IncrRefCount(part2Ptr);
    }

    resultPtr = Tcl_ObjGetVar2(interp, part1Ptr, part2Ptr, flags);
    Tcl_Obj *resultPtr = Tcl_ObjGetVar2(interp, part1Ptr, part2Ptr, flags);

    Tcl_DecrRefCount(part1Ptr);
    Tcl_BounceRefCount(part1Ptr);
    if (part2Ptr) {
	Tcl_DecrRefCount(part2Ptr);
    Tcl_BounceRefCount(part2Ptr);
    }
    if (resultPtr == NULL) {
	return NULL;
    return AsStr(resultPtr);
    }
    return TclGetString(resultPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetVar2Ex --
 *

    const char *part1,		/* Name of an array (if part2 is non-NULL) or
				 * the name of a variable. */
    const char *part2,		/* If non-NULL, gives the name of an element
				 * in the array part1. */
    int flags)			/* OR-ed combination of TCL_GLOBAL_ONLY, and
				 * TCL_LEAVE_ERR_MSG bits. */
{
    Tcl_Obj *resPtr, *part2Ptr = NULL, *part1Ptr = Tcl_NewStringObj(part1, -1);

    Tcl_Obj *part1Ptr = Tcl_NewStringObj(part1, TCL_AUTO_LENGTH);
    Tcl_Obj *part2Ptr = AsObj(part2);
    if (part2) {
	part2Ptr = Tcl_NewStringObj(part2, -1);
	Tcl_IncrRefCount(part2Ptr);
    }

    resPtr = Tcl_ObjGetVar2(interp, part1Ptr, part2Ptr, flags);
    Tcl_Obj *resPtr = Tcl_ObjGetVar2(interp, part1Ptr, part2Ptr, flags);

    Tcl_DecrRefCount(part1Ptr);
    Tcl_BounceRefCount(part1Ptr);
    if (part2Ptr) {
	Tcl_DecrRefCount(part2Ptr);
    Tcl_BounceRefCount(part2Ptr);
    }

    return resPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ObjGetVar2 --

{
    Var *varPtr, *arrayPtr;

    /*
     * Filter to pass through only the flags this interface supports.
     */

    flags &= (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY|TCL_LEAVE_ERR_MSG);
    flags &= SCOPES | TCL_LEAVE_ERR_MSG;
    varPtr = TclObjLookupVarEx(interp, part1Ptr, part2Ptr, flags, "read",
	    /*createPart1*/ 0, /*createPart2*/ 1, &arrayPtr);
    if (varPtr == NULL) {
    if (!varPtr) {
	return NULL;
    }

    return TclPtrGetVarIdx(interp, varPtr, arrayPtr, part1Ptr, part2Ptr,
	    flags, -1);
	    flags, NOT_IN_LVT);
}

/*
 *----------------------------------------------------------------------
 *
 * TclPtrGetVar --
 *

    Tcl_Obj *part1Ptr,		/* Name of an array (if part2 is non-NULL) or
				 * the name of a variable. */
    Tcl_Obj *part2Ptr,		/* If non-NULL, gives the name of an element
				 * in the array part1. */
    int flags)			/* OR-ed combination of TCL_GLOBAL_ONLY, and
				 * TCL_LEAVE_ERR_MSG bits. */
{
    if (varPtr == NULL) {
    if (!varPtr) {
	Tcl_Panic("varPtr must not be NULL");
    }
    if (part1Ptr == NULL) {
    if (!part1Ptr) {
	Tcl_Panic("part1Ptr must not be NULL");
    }
    return TclPtrGetVarIdx(interp, (Var *) varPtr, (Var *) arrayPtr,
	    part1Ptr, part2Ptr, flags, -1);
	    part1Ptr, part2Ptr, flags, NOT_IN_LVT);
}

/*
 *----------------------------------------------------------------------
 *
 * TclPtrGetVarIdx --
 *

    Tcl_Obj *part1Ptr,		/* Name of an array (if part2 is non-NULL) or
				 * the name of a variable. */
    Tcl_Obj *part2Ptr,		/* If non-NULL, gives the name of an element
				 * in the array part1. */
    int flags,			/* OR-ed combination of TCL_GLOBAL_ONLY, and
				 * TCL_LEAVE_ERR_MSG bits. */
    int index)			/* Index into the local variable table of the
				 * variable, or -1. Only used when part1Ptr is
				 * NULL. */
				 * variable, or NOT_IN_LVT (-1). Only used when
				 * part1Ptr is NULL. */
{
    Interp *iPtr = (Interp *) interp;
    const char *msg;
    Var *initialArrayPtr = arrayPtr;

    TclVarFindHiddenArray(varPtr, arrayPtr);

    /*
     * Invoke any read traces that have been set for the variable.
     */

    if ((varPtr->flags & VAR_TRACED_READ)
	    || (arrayPtr && (arrayPtr->flags & VAR_TRACED_READ))) {
	if (TCL_ERROR == TclObjCallVarTraces(iPtr, arrayPtr, varPtr,
	if (TclObjCallVarTraces(iPtr, arrayPtr, varPtr, part1Ptr, part2Ptr,
		part1Ptr, part2Ptr,
		(flags & (TCL_NAMESPACE_ONLY|TCL_GLOBAL_ONLY))
		| TCL_TRACE_READS, (flags & TCL_LEAVE_ERR_MSG), index)) {
		(flags & SCOPES) | TCL_TRACE_READS,
		(flags & TCL_LEAVE_ERR_MSG), index) != TCL_OK) {
	    goto errorReturn;
	}
    }

    /*
     * Return the element if it's an existing scalar variable.
     */

    if (TclIsVarScalar(varPtr) && !TclIsVarUndefined(varPtr)) {
	return varPtr->value.objPtr;
    }

    /*
     * Return the array default value if any.
     */

    if (arrayPtr && TclIsVarArray(arrayPtr) && TclGetArrayDefault(arrayPtr)) {
	return TclGetArrayDefault(arrayPtr);
    if (arrayPtr && TclIsVarArray(arrayPtr)) {
	Tcl_Obj *defaultObj = TclGetArrayDefault(arrayPtr);
	if (defaultObj) {
	    return defaultObj;
	}
    }
    if (TclIsVarArrayElement(varPtr) && !arrayPtr) {
	/*
	 * UGLY! Peek inside the implementation of things. This lets us get
	 * the default of an array even when we've been [upvar]ed to just an
	 * element of the array.
	 */

    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Obj *varValueObj;

    if (objc == 2) {
	varValueObj = Tcl_ObjGetVar2(interp, objv[1], NULL,TCL_LEAVE_ERR_MSG);
	if (varValueObj == NULL) {
	varValueObj = Tcl_ObjGetVar2(interp, objv[1], NULL, TCL_LEAVE_ERR_MSG);
	if (!varValueObj) {
	    return TCL_ERROR;
	}
	Tcl_SetObjResult(interp, varValueObj);
	return TCL_OK;
    } else if (objc == 3) {
	varValueObj = Tcl_ObjSetVar2(interp, objv[1], NULL, objv[2],
		TCL_LEAVE_ERR_MSG);
	if (varValueObj == NULL) {
	if (!varValueObj) {
	    return TCL_ERROR;
	}
	Tcl_SetObjResult(interp, varValueObj);
	return TCL_OK;
    } else {
	Tcl_WrongNumArgs(interp, 1, objv, "varName ?newValue?");
	return TCL_ERROR;

    const char *newValue,	/* New value for variable. */
    int flags)			/* Various flags that tell how to set value:
				 * any of TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY,
				 * TCL_APPEND_VALUE, TCL_LIST_ELEMENT, or
				 * TCL_LEAVE_ERR_MSG. */
{
    Tcl_Obj *varValuePtr = Tcl_SetVar2Ex(interp, part1, part2,
	    Tcl_NewStringObj(newValue, -1), flags);
	    Tcl_NewStringObj(newValue, TCL_AUTO_LENGTH), flags);

    if (varValuePtr == NULL) {
	return NULL;
    return AsStr(varValuePtr);
    }
    return TclGetString(varValuePtr);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_SetVar2Ex --
 *

				 * in the array part1. */
    Tcl_Obj *newValuePtr,	/* New value for variable. */
    int flags)			/* Various flags that tell how to set value:
				 * any of TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY,
				 * TCL_APPEND_VALUE, TCL_LIST_ELEMENT or
				 * TCL_LEAVE_ERR_MSG. */
{
    Tcl_Obj *resPtr, *part2Ptr = NULL, *part1Ptr = Tcl_NewStringObj(part1, -1);

    Tcl_Obj *part1Ptr = Tcl_NewStringObj(part1, TCL_AUTO_LENGTH);
    Tcl_Obj *part2Ptr = AsObj(part2);
    Tcl_IncrRefCount(part1Ptr);
    if (part2) {
	part2Ptr = Tcl_NewStringObj(part2, -1);
	Tcl_IncrRefCount(part2Ptr);
    }

    resPtr = Tcl_ObjSetVar2(interp, part1Ptr, part2Ptr, newValuePtr, flags);
    Tcl_Obj *resPtr = Tcl_ObjSetVar2(interp, part1Ptr, part2Ptr, newValuePtr,
	    flags);

    Tcl_DecrRefCount(part1Ptr);
    Tcl_BounceRefCount(part1Ptr);
    if (part2Ptr) {
	Tcl_DecrRefCount(part2Ptr);
    Tcl_BounceRefCount(part2Ptr);
    }

    return resPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ObjSetVar2 --

 *	variable traces may modify the variable's value.
 *
 * Side effects:
 *	The value of the given variable is set. If either the array or the
 *	entry didn't exist then a new variable is created.
 *	Callers must Incr part1Ptr if they plan to Decr it.
 *	Callers must Incr part2Ptr if they plan to Decr it.
 *
 *	If the variable could not be created and the value has a zero reference
 *	count, the value is freed.
 *
 *----------------------------------------------------------------------
 */

Tcl_Obj *
Tcl_ObjSetVar2(
    Tcl_Interp *interp,		/* Command interpreter in which variable is to

{
    Var *varPtr, *arrayPtr;

    /*
     * Filter to pass through only the flags this interface supports.
     */

    flags &= (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY|TCL_LEAVE_ERR_MSG
    flags &= SCOPES | TCL_LEAVE_ERR_MSG | SET_MODIFIERS;
	    |TCL_APPEND_VALUE|TCL_LIST_ELEMENT);
    varPtr = TclObjLookupVarEx(interp, part1Ptr, part2Ptr, flags, "set",
	    /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr);
    if (varPtr == NULL) {
    if (!varPtr) {
	if (newValuePtr->refCount == 0) {
	    Tcl_DecrRefCount(newValuePtr);
	Tcl_BounceRefCount(newValuePtr);
	}
	return NULL;
    }

    return TclPtrSetVarIdx(interp, varPtr, arrayPtr, part1Ptr, part2Ptr,
	    newValuePtr, flags, -1);
	    newValuePtr, flags, NOT_IN_LVT);
}

/*
 *----------------------------------------------------------------------
 *
 * TclPtrSetVar --
 *

				 * the name of a variable. */
    Tcl_Obj *part2Ptr,		/* If non-NULL, gives the name of an element
				 * in the array part1. */
    Tcl_Obj *newValuePtr,	/* New value for variable. */
    int flags)			/* OR-ed combination of TCL_GLOBAL_ONLY, and
				 * TCL_LEAVE_ERR_MSG bits. */
{
    if (varPtr == NULL) {
    if (!varPtr) {
	Tcl_Panic("varPtr must not be NULL");
    }
    if (part1Ptr == NULL) {
    if (!part1Ptr) {
	Tcl_Panic("part1Ptr must not be NULL");
    }
    if (newValuePtr == NULL) {
    if (!newValuePtr) {
	Tcl_Panic("newValuePtr must not be NULL");
    }
    return TclPtrSetVarIdx(interp, (Var *) varPtr, (Var *) arrayPtr,
	    part1Ptr, part2Ptr, newValuePtr, flags, -1);
	    part1Ptr, part2Ptr, newValuePtr, flags, NOT_IN_LVT);
}

/*
 *----------------------------------------------------------------------
 *
 * ListAppendInVar, StringAppendInVar --
 *

ListAppendInVar(
    Tcl_Interp *interp,
    Var *varPtr,
    Var *arrayPtr,
    Tcl_Obj *oldValuePtr,
    Tcl_Obj *newValuePtr)
{
    if (oldValuePtr == NULL) {
    if (!oldValuePtr) {
	/*
	 * No previous value. Check for defaults if there's an array we can
	 * ask this of.
	 */

	if (arrayPtr) {
	    Tcl_Obj *defValuePtr = TclGetArrayDefault(arrayPtr);

	    if (defValuePtr) {
		oldValuePtr = Tcl_DuplicateObj(defValuePtr);
	    }
	}

	if (oldValuePtr == NULL) {
	if (!oldValuePtr) {
	    /*
	     * No default. [lappend] semantics say this is like being an empty
	     * string.
	     */

	    TclNewObj(oldValuePtr);
	}

{
    /*
     * If there was no previous value, either we use the array's default (if
     * this is an array with a default at all) or we treat this as a simple
     * set.
     */

    if (oldValuePtr == NULL) {
    if (!oldValuePtr) {
	if (arrayPtr) {
	    Tcl_Obj *defValuePtr = TclGetArrayDefault(arrayPtr);

	    if (defValuePtr) {
		/*
		 * This is *almost* the same as the shared path below, except
		 * that the original value reference in defValuePtr is not

	TclDecrRefCount(oldValuePtr);
	oldValuePtr = varPtr->value.objPtr;
	Tcl_IncrRefCount(oldValuePtr);	/* Since var is ref */
    }

    Tcl_AppendObjToObj(oldValuePtr, newValuePtr);
    if (newValuePtr->refCount == 0) {
	Tcl_DecrRefCount(newValuePtr);
    Tcl_BounceRefCount(newValuePtr);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TclPtrSetVarIdx --
 *

    int index)			/* Index of local var where part1 is to be
				 * found. */
{
    Interp *iPtr = (Interp *) interp;
    Tcl_Obj *oldValuePtr;
    Tcl_Obj *resultPtr = NULL;
    int result;
    int cleanupOnEarlyError = (newValuePtr->refCount == 0);

    /*
     * 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).

    }

    /*
     * It's an error to try to set a constant.
     */
    if (TclIsVarConstant(varPtr)) {
	if (flags & TCL_LEAVE_ERR_MSG) {
	    TclObjVarErrMsg(interp, part1Ptr, part2Ptr, "set", ISCONST,index);
	    Tcl_SetErrorCode(interp, "TCL", "WRITE", "CONST", (void *)NULL);
	    TclObjVarErrMsg(interp, part1Ptr, part2Ptr, "set", ISCONST, index);
	    Tcl_SetErrorCode(interp, "TCL", "WRITE", "CONST", (char *)NULL);
	}
	goto earlyError;
    }

    /*
     * It's an error to try to set an array variable itself.
     */

    if (TclIsVarArray(varPtr)) {
	if (flags & TCL_LEAVE_ERR_MSG) {
	    TclObjVarErrMsg(interp, part1Ptr, part2Ptr, "set", ISARRAY,index);
	    TclObjVarErrMsg(interp, part1Ptr, part2Ptr, "set", ISARRAY, index);
	    Tcl_SetErrorCode(interp, "TCL", "WRITE", "ARRAY", (char *)NULL);
	}
	goto earlyError;
    }

    TclVarFindHiddenArray(varPtr, arrayPtr);

    /*
     * Invoke any read traces that have been set for the variable if it is
     * requested. This was done for INST_LAPPEND_* but that was inconsistent
     * with the non-bc instruction, and would cause failures trying to
     * lappend to any non-existing ::env var, which is inconsistent with
     * documented behavior. [Bug #3057639].
     */

    if ((flags & TCL_TRACE_READS) && ((varPtr->flags & VAR_TRACED_READ)
	    || (arrayPtr && (arrayPtr->flags & VAR_TRACED_READ)))) {
	if (TCL_ERROR == TclObjCallVarTraces(iPtr, arrayPtr, varPtr,
	if (TclObjCallVarTraces(iPtr, arrayPtr, varPtr, part1Ptr, part2Ptr,
		part1Ptr, part2Ptr,
		TCL_TRACE_READS, (flags & TCL_LEAVE_ERR_MSG), index)) {
		TCL_TRACE_READS, (flags & TCL_LEAVE_ERR_MSG),
		index) != TCL_OK) {
	    goto earlyError;
	}
    }

    /*
     * Set the variable's new value. If appending, append the new value to the
     * variable, either as a list element or as a string. Also, if appending,
     * then if the variable's old value is unshared we can modify it directly,
     * otherwise we must create a new copy to modify: this is "copy on write".
     */

    oldValuePtr = varPtr->value.objPtr;
    if (flags & TCL_LIST_ELEMENT && !(flags & TCL_APPEND_VALUE)) {
    if ((flags & TCL_LIST_ELEMENT) && !(flags & TCL_APPEND_VALUE)) {
	varPtr->value.objPtr = NULL;
    }
    if (flags & (TCL_APPEND_VALUE|TCL_LIST_ELEMENT)) {
    if (flags & SET_MODIFIERS) {
	if (flags & TCL_LIST_ELEMENT) {		/* Append list element. */
	    result = ListAppendInVar(interp, varPtr, arrayPtr, oldValuePtr,
		    newValuePtr);
	    if (result != TCL_OK) {
		goto earlyError;
	    }
	} else {				/* Append string. */
	    StringAppendInVar(varPtr, arrayPtr, oldValuePtr, newValuePtr);
	}
    } else if (newValuePtr != oldValuePtr) {
	/*
	 * In this case we are replacing the value, so we don't need to do
	 * more than swap the objects.
	 */

	varPtr->value.objPtr = newValuePtr;
	Tcl_IncrRefCount(newValuePtr);		/* Var is another ref. */
	if (oldValuePtr != NULL) {
	if (oldValuePtr) {
	    TclDecrRefCount(oldValuePtr);	/* Discard old value. */
	}
    }

    /*
     * Invoke any write traces for the variable.
     */

    if ((varPtr->flags & VAR_TRACED_WRITE)
	    || (arrayPtr && (arrayPtr->flags & VAR_TRACED_WRITE))) {
	if (TCL_ERROR == TclObjCallVarTraces(iPtr, arrayPtr, varPtr, part1Ptr,
		part2Ptr, (flags & (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY))
		| TCL_TRACE_WRITES, (flags & TCL_LEAVE_ERR_MSG), index)) {
	if (TclObjCallVarTraces(iPtr, arrayPtr, varPtr, part1Ptr, part2Ptr,
		(flags & SCOPES) | TCL_TRACE_WRITES,
		(flags & TCL_LEAVE_ERR_MSG), index) != TCL_OK) {
	    goto cleanup;
	}
    }

    /*
     * Return the variable's value unless the variable was changed in some
     * gross way by a trace (e.g. it was unset and then recreated as an

    /*
     * If the variable doesn't exist anymore and no-one's using it, then free
     * up the relevant structures and hash table entries.
     */

  cleanup:
    if (resultPtr == NULL) {
    if (!resultPtr) {
	Tcl_SetErrorCode(interp, "TCL", "WRITE", "VARNAME", (char *)NULL);
    }
    if (TclIsVarUndefined(varPtr)) {
	TclCleanupVar(varPtr, arrayPtr);
    }
    return resultPtr;

  earlyError:
    if (cleanupOnEarlyError) {
	Tcl_DecrRefCount(newValuePtr);
    Tcl_BounceRefCount(newValuePtr);
    }
    goto cleanup;
}

/*
 *----------------------------------------------------------------------
 *
 * TclIncrObjVar2 --

				 * TCL_APPEND_VALUE, TCL_LIST_ELEMENT,
				 * TCL_LEAVE_ERR_MSG. */
{
    Var *varPtr, *arrayPtr;

    varPtr = TclObjLookupVarEx(interp, part1Ptr, part2Ptr, flags, "read",
	    1, 1, &arrayPtr);
    if (varPtr == NULL) {
    if (!varPtr) {
	Tcl_AddErrorInfo(interp,
		"\n    (reading value of variable to increment)");
	return NULL;
    }
    return TclPtrIncrObjVarIdx(interp, varPtr, arrayPtr, part1Ptr, part2Ptr,
	    incrPtr, flags, -1);
	    incrPtr, flags, NOT_IN_LVT);
}

/*
 *----------------------------------------------------------------------
 *
 * TclPtrIncrObjVar --
 *

    Tcl_Obj *incrPtr,		/* Increment value. */
/* TODO: Which of these flag values really make sense? */
    int flags)			/* Various flags that tell how to incr value:
				 * any of TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY,
				 * TCL_APPEND_VALUE, TCL_LIST_ELEMENT,
				 * TCL_LEAVE_ERR_MSG. */
{
    if (varPtr == NULL) {
    if (!varPtr) {
	Tcl_Panic("varPtr must not be NULL");
    }
    if (part1Ptr == NULL) {
    if (!part1Ptr) {
	Tcl_Panic("part1Ptr must not be NULL");
    }
    return TclPtrIncrObjVarIdx(interp, (Var *) varPtr, (Var *) arrayPtr,
	    part1Ptr, part2Ptr, incrPtr, flags, -1);
	    part1Ptr, part2Ptr, incrPtr, flags, NOT_IN_LVT);
}

/*
 *----------------------------------------------------------------------
 *
 * TclPtrIncrObjVarIdx --
 *

    Tcl_Obj *incrPtr,		/* Increment value. */
/* TODO: Which of these flag values really make sense? */
    int flags,			/* Various flags that tell how to incr value:
				 * any of TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY,
				 * TCL_APPEND_VALUE, TCL_LIST_ELEMENT,
				 * TCL_LEAVE_ERR_MSG. */
    int index)			/* Index into the local variable table of the
				 * variable, or -1. Only used when part1Ptr is
				 * NULL. */
				 * variable, or NOT_IN_LVT (-1). Only used when
				 * part1Ptr is NULL. */
{
    Tcl_Obj *varValuePtr;

    /*
     * It's an error to try to increment a constant.
     */
    if (TclIsVarConstant(varPtr)) {
	if (flags & TCL_LEAVE_ERR_MSG) {
	    TclObjVarErrMsg(interp, part1Ptr, part2Ptr, "incr", ISCONST,index);
	    Tcl_SetErrorCode(interp, "TCL", "WRITE", "CONST", (void *)NULL);
	    TclObjVarErrMsg(interp, part1Ptr, part2Ptr, "incr", ISCONST, index);
	    Tcl_SetErrorCode(interp, "TCL", "WRITE", "CONST", (char *)NULL);
	}
	return NULL;
    }

    if (TclIsVarInHash(varPtr)) {
	VarHashRefCount(varPtr)++;
    }
    varValuePtr = TclPtrGetVarIdx(interp, varPtr, arrayPtr, part1Ptr,
	    part2Ptr, flags, index);
    if (TclIsVarInHash(varPtr)) {
	VarHashRefCount(varPtr)--;
    }
    if (varValuePtr == NULL) {
    if (!varValuePtr) {
	TclNewIntObj(varValuePtr, 0);
    }
    if (Tcl_IsShared(varValuePtr)) {
	/* Copy on write */
	varValuePtr = Tcl_DuplicateObj(varValuePtr);

	if (TCL_OK == TclIncrObj(interp, varValuePtr, incrPtr)) {
	if (TclIncrObj(interp, varValuePtr, incrPtr) != TCL_OK) {
	    return TclPtrSetVarIdx(interp, varPtr, arrayPtr, part1Ptr,
		    part2Ptr, varValuePtr, flags, index);
	} else {
	    Tcl_DecrRefCount(varValuePtr);
	    return NULL;
	}
    } else {
	/* Unshared - can Incr in place */
	if (TCL_OK == TclIncrObj(interp, varValuePtr, incrPtr)) {
	    /*
	     * This seems dumb to write the incremeted value into the var
	     * after we just adjusted the value in place, but the spec for
	if (TclIncrObj(interp, varValuePtr, incrPtr) != TCL_OK) {
	    return NULL;
	}
    }

    /*
     * This seems dumb to write the incremeted value into the var after we just
     * adjusted the value in place, but the spec for [incr] requires that write
	     * [incr] requires that write traces fire, and making this call
	     * is the way to make that happen.
	     */
     * traces fire, and making this call is the way to make that happen.
     * 
     * This also handles the case where we are creating the variable, and is
     * unified with the second half of the shared value handling.
     */

	    return TclPtrSetVarIdx(interp, varPtr, arrayPtr, part1Ptr,
		    part2Ptr, varValuePtr, flags, index);
    return TclPtrSetVarIdx(interp, varPtr, arrayPtr, part1Ptr,
	    part2Ptr, varValuePtr, flags, index);
	} else {
	    return NULL;
	}
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_UnsetVar2 --
 *

				 * be looked up. */
    const char *part1,		/* Name of variable or array. */
    const char *part2,		/* Name of element within array or NULL. */
    int flags)			/* OR-ed combination of any of
				 * TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY,
				 * TCL_LEAVE_ERR_MSG. */
{
    Tcl_Obj *part1Ptr = Tcl_NewStringObj(part1, TCL_AUTO_LENGTH);
    Tcl_Obj *part2Ptr = AsObj(part2);
    int result;
    Tcl_Obj *part2Ptr = NULL, *part1Ptr = Tcl_NewStringObj(part1, -1);

    if (part2) {
	part2Ptr = Tcl_NewStringObj(part2, -1);
    }

    /*
     * Filter to pass through only the flags this interface supports.
     */

    flags &= (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY|TCL_LEAVE_ERR_MSG);
    flags &= SCOPES | TCL_LEAVE_ERR_MSG;
    result = TclObjUnsetVar2(interp, part1Ptr, part2Ptr, flags);

    Tcl_DecrRefCount(part1Ptr);
    Tcl_BounceRefCount(part1Ptr);
    if (part2Ptr) {
	Tcl_DecrRefCount(part2Ptr);
    Tcl_BounceRefCount(part2Ptr);
    }
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * TclObjUnsetVar2 --

				 * TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY,
				 * TCL_LEAVE_ERR_MSG. */
{
    Var *varPtr, *arrayPtr;

    varPtr = TclObjLookupVarEx(interp, part1Ptr, part2Ptr, flags, "unset",
	    /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr);
    if (varPtr == NULL) {
    if (!varPtr) {
	return TCL_ERROR;
    }

    return TclPtrUnsetVarIdx(interp, varPtr, arrayPtr, part1Ptr, part2Ptr,
	    flags, -1);
	    flags, NOT_IN_LVT);
}

/*
 *----------------------------------------------------------------------
 *
 * TclPtrUnsetVar --
 *

				 * the name of a variable. */
    Tcl_Obj *part2Ptr,		/* If non-NULL, gives the name of an element
				 * in the array part1. */
    int flags)			/* OR-ed combination of any of
				 * TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY,
				 * TCL_LEAVE_ERR_MSG. */
{
    if (varPtr == NULL) {
    if (!varPtr) {
	Tcl_Panic("varPtr must not be NULL");
    }
    if (part1Ptr == NULL) {
    if (!part1Ptr) {
	Tcl_Panic("part1Ptr must not be NULL");
    }
    return TclPtrUnsetVarIdx(interp, (Var *) varPtr, (Var *) arrayPtr,
	    part1Ptr, part2Ptr, flags, -1);
	    part1Ptr, part2Ptr, flags, NOT_IN_LVT);
}

/*
 *----------------------------------------------------------------------
 *
 * TclPtrUnsetVarIdx --
 *

				 * the name of a variable. */
    Tcl_Obj *part2Ptr,		/* If non-NULL, gives the name of an element
				 * in the array part1. */
    int flags,			/* OR-ed combination of any of
				 * TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY,
				 * TCL_LEAVE_ERR_MSG. */
    int index)			/* Index into the local variable table of the
				 * variable, or -1. Only used when part1Ptr is
				 * NULL. */
				 * variable, or NOT_IN_LVT (-1). Only used when
				 * part1Ptr is NULL. */
{
    Interp *iPtr = (Interp *) interp;
    int result = (TclIsVarUndefined(varPtr)? TCL_ERROR : TCL_OK);
    int result = (TclIsVarUndefined(varPtr) ? TCL_ERROR : TCL_OK);
    Var *initialArrayPtr = arrayPtr;

    /*
     * It's an error to try to unset a constant.
     */
    if (TclIsVarConstant(varPtr)) {
	if (flags & TCL_LEAVE_ERR_MSG) {
	    TclObjVarErrMsg(interp, part1Ptr, part2Ptr, "unset", ISCONST,index);
	    Tcl_SetErrorCode(interp, "TCL", "UNSET", "CONST", (void *)NULL);
	    TclObjVarErrMsg(interp, part1Ptr, part2Ptr, "unset", ISCONST, index);
	    Tcl_SetErrorCode(interp, "TCL", "UNSET", "CONST", (char *)NULL);
	}
	return TCL_ERROR;
    }

    /*
     * Keep the variable alive until we're done with it. We used to
     * increase/decrease the refCount for each operation, making it hard to

    UnsetVarStruct(varPtr, arrayPtr, iPtr, part1Ptr, part2Ptr, flags, index);

    /*
     * It's an error to unset an undefined variable.
     */

    if (result != TCL_OK) {
	if (flags & TCL_LEAVE_ERR_MSG) {
	    TclObjVarErrMsg(interp, part1Ptr, part2Ptr, "unset",
	      ((initialArrayPtr == NULL) ? NOSUCHVAR : NOSUCHELEMENT), index);
	    Tcl_SetErrorCode(interp, "TCL", "UNSET", "VARNAME", (char *)NULL);
    if ((result != TCL_OK) && (flags & TCL_LEAVE_ERR_MSG)) {
	TclObjVarErrMsg(interp, part1Ptr, part2Ptr, "unset",
		!initialArrayPtr ? NOSUCHVAR : NOSUCHELEMENT, index);
	Tcl_SetErrorCode(interp, "TCL", "UNSET", "VARNAME", (char *)NULL);
	}
    }

    /*
     * Finally, if the variable is truly not in use then free up its Var
     * structure and remove it from its hash table, if any. The ref count of
     * its value object, if any, was decremented above.
     */

	     * Transfer any existing traces on var, IF there are unset traces.
	     * Otherwise just delete them.
	     */

	    int isNew;

	    tPtr = Tcl_FindHashEntry(&iPtr->varTraces, varPtr);
	    tracePtr = (VarTrace *)Tcl_GetHashValue(tPtr);
	    tracePtr = (VarTrace *) Tcl_GetHashValue(tPtr);
	    varPtr->flags &= ~VAR_ALL_TRACES;
	    Tcl_DeleteHashEntry(tPtr);
	    if (dummyVar.flags & VAR_TRACED_UNSET) {
		tPtr = Tcl_CreateHashEntry(&iPtr->varTraces,
			&dummyVar, &isNew);
		Tcl_SetHashValue(tPtr, tracePtr);
	    }
	}

	if ((dummyVar.flags & VAR_TRACED_UNSET)
		|| (arrayPtr && (arrayPtr->flags & VAR_TRACED_UNSET))) {

	    /*
	     * Pass the array element name to TclObjCallVarTraces(), because
	     * it cannot be determined from dummyVar. Alternatively, indicate
	     * via flags whether the variable involved in the code that caused
	     * the trace to be triggered was an array element, for the correct
	     * formatting of error messages.
	     */

	    if (part2Ptr) {
		flags |= VAR_ARRAY_ELEMENT;
	    } else if (TclIsVarArrayElement(varPtr)) {
		part2Ptr = VarHashGetKey(varPtr);
	    }

	    dummyVar.flags &= ~VAR_TRACE_ACTIVE;
	    TclObjCallVarTraces(iPtr, arrayPtr, &dummyVar, part1Ptr, part2Ptr,
	      (flags & (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY|VAR_ARRAY_ELEMENT))
			    | TCL_TRACE_UNSETS,
		    /* leaveErrMsg */ 0, index);
		    (flags & (SCOPES | VAR_ARRAY_ELEMENT)) | TCL_TRACE_UNSETS,
		    /*leaveErrMsg*/ 0, index);

	    /*
	     * The traces that we just called may have triggered a change in
	     * the set of traces. If so, reload the traces to manipulate.
	     */

	    tracePtr = NULL;
	    if (TclIsVarTraced(&dummyVar)) {
		tPtr = Tcl_FindHashEntry(&iPtr->varTraces, &dummyVar);
		if (tPtr) {
		    tracePtr = (VarTrace *)Tcl_GetHashValue(tPtr);
		    tracePtr = (VarTrace *) Tcl_GetHashValue(tPtr);
		    Tcl_DeleteHashEntry(tPtr);
		}
	    }
	}

	if (tracePtr) {
	    ActiveVarTrace *activePtr;

		    activePtr->nextTracePtr = NULL;
		}
	    }
	    dummyVar.flags &= ~VAR_ALL_TRACES;
	}
    }

    if (TclIsVarScalar(&dummyVar) && (dummyVar.value.objPtr != NULL)) {
    if (TclIsVarScalar(&dummyVar) && !TclIsVarUndefined(&dummyVar)) {
	/*
	 * Decrement the ref count of the var's value.
	 */

	Tcl_Obj *objPtr = dummyVar.value.objPtr;

	TclDecrRefCount(objPtr);
    } else if (TclIsVarArray(&dummyVar)) {
	/*
	 * If the variable is an array, delete all of its elements. This must
	 * be done after calling and deleting the traces on the array, above
	 * (that's the way traces are defined). If the array name is not
	 * present and is required for a trace on some element, it will be
	 * computed at DeleteArray.
	 */

	DeleteArray(iPtr, part1Ptr, (Var *) &dummyVar, (flags
		& (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY)) | TCL_TRACE_UNSETS,
	DeleteArray(iPtr, part1Ptr, &dummyVar,
		(flags & SCOPES) | TCL_TRACE_UNSETS, index);
		index);
    } else if (TclIsVarLink(&dummyVar)) {
	/*
	 * For global/upvar variables referenced in procedures, decrement the
	 * reference count on the variable referred to, and free the
	 * referenced variable if it's no longer needed.
	 */

     * -nocomplain (which must come first and be given exactly to be an
     * option).
     */

    i = 1;
    name = TclGetString(objv[i]);
    if (name[0] == '-') {
	if (strcmp("-nocomplain", name) == 0) {
	if (!strcmp("-nocomplain", name)) {
	    i++;
	    if (i == objc) {
		return TCL_OK;
	    }
	    flags = 0;
	    name = TclGetString(objv[i]);
	}
	if (strcmp("--", name) == 0) {
	if (!strcmp("--", name)) {
	    i++;
	}
    }

    for (; i < objc; i++) {
	if ((TclObjUnsetVar2(interp, objv[i], NULL, flags) != TCL_OK)
		&& (flags == TCL_LEAVE_ERR_MSG)) {

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "varName ?value ...?");
	return TCL_ERROR;
    }

    if (objc == 2) {
	varValuePtr = Tcl_ObjGetVar2(interp, objv[1], NULL,TCL_LEAVE_ERR_MSG);
	if (varValuePtr == NULL) {
	varValuePtr = Tcl_ObjGetVar2(interp, objv[1], NULL, TCL_LEAVE_ERR_MSG);
	if (!varValuePtr) {
	    return TCL_ERROR;
	}
    } else {
	varPtr = TclObjLookupVarEx(interp, objv[1], NULL, TCL_LEAVE_ERR_MSG,
		"set", /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr);
	if (varPtr == NULL) {
	if (!varPtr) {
	    return TCL_ERROR;
	}
	for (i=2 ; i<objc ; i++) {
	    /*
	     * Note that we do not need to increase the refCount of the Var
	     * pointers: should a trace delete the variable, the return value
	     * of TclPtrSetVarIdx will be NULL or emptyObjPtr, and we will not
	     * access the variable again.
	     */

	    varValuePtr = TclPtrSetVarIdx(interp, varPtr, arrayPtr, objv[1],
		    NULL, objv[i], TCL_APPEND_VALUE|TCL_LEAVE_ERR_MSG, -1);
	    if ((varValuePtr == NULL) ||
		    NULL, objv[i], TCL_APPEND_VALUE | TCL_LEAVE_ERR_MSG,
		    NOT_IN_LVT);
	    if (!varValuePtr ||
		    (varValuePtr == ((Interp *) interp)->emptyObjPtr)) {
		return TCL_ERROR;
	    }
	}
    }
    Tcl_SetObjResult(interp, varValuePtr);
    return TCL_OK;

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "varName ?value ...?");
	return TCL_ERROR;
    }
    if (objc == 2) {
	newValuePtr = Tcl_ObjGetVar2(interp, objv[1], NULL, 0);
	if (newValuePtr == NULL) {
	if (!newValuePtr) {
	    /*
	     * The variable doesn't exist yet. Just create it with an empty
	     * initial value.
	     */

	    TclNewObj(varValuePtr);
	    newValuePtr = Tcl_ObjSetVar2(interp, objv[1], NULL, varValuePtr,
		    TCL_LEAVE_ERR_MSG);
	    if (newValuePtr == NULL) {
	    if (!newValuePtr) {
		return TCL_ERROR;
	    }
	} else {
	    result = TclListObjLength(interp, newValuePtr, &numElems);
	    if (result != TCL_OK) {
		return result;
	    }

	 * Protect the variable pointers around the TclPtrGetVarIdx call
	 * to insure that they remain valid even if the variable was undefined
	 * and unused.
	 */

	varPtr = TclObjLookupVarEx(interp, objv[1], NULL, TCL_LEAVE_ERR_MSG,
		"set", /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr);
	if (varPtr == NULL) {
	if (!varPtr) {
	    return TCL_ERROR;
	}
	if (TclIsVarInHash(varPtr)) {
	    VarHashRefCount(varPtr)++;
	}
	if (arrayPtr && TclIsVarInHash(arrayPtr)) {
	    VarHashRefCount(arrayPtr)++;
	}
	varValuePtr = TclPtrGetVarIdx(interp, varPtr, arrayPtr, objv[1], NULL,
		TCL_LEAVE_ERR_MSG, -1);
		TCL_LEAVE_ERR_MSG, NOT_IN_LVT);
	if (TclIsVarInHash(varPtr)) {
	    VarHashRefCount(varPtr)--;
	}
	if (arrayPtr && TclIsVarInHash(arrayPtr)) {
	    VarHashRefCount(arrayPtr)--;
	}

	if (varValuePtr == NULL) {
	if (!varValuePtr) {
	    /*
	     * We couldn't read the old value: either the var doesn't yet
	     * exist or it's an array element. If it's new, we will try to
	     * create it with Tcl_ObjSetVar2 below.
	     */

	    TclNewObj(varValuePtr);
	    createdNewObj = 1;
	} else if (Tcl_IsShared(varValuePtr)) {
	    varValuePtr = Tcl_DuplicateObj(varValuePtr);
	    createdNewObj = 1;
	}

	result = TclListObjLength(interp, varValuePtr, &numElems);
	if (result == TCL_OK) {
	    result = Tcl_ListObjReplace(interp, varValuePtr, numElems, 0,
		    (objc-2), (objv+2));
		    (objc - 2), (objv + 2));
	}
	if (result != TCL_OK) {
	    if (createdNewObj) {
		TclDecrRefCount(varValuePtr); /* Free unneeded obj. */
	    }
	    return result;
	}

	/*
	 * Now store the list object back into the variable. If there is an
	 * error setting the new value, decrement its ref count if it was new
	 * and we didn't create the variable.
	 */

	newValuePtr = TclPtrSetVarIdx(interp, varPtr, arrayPtr, objv[1], NULL,
		varValuePtr, TCL_LEAVE_ERR_MSG, -1);
	if (newValuePtr == NULL) {
		varValuePtr, TCL_LEAVE_ERR_MSG, NOT_IN_LVT);
	if (!newValuePtr) {
	    return TCL_ERROR;
	}
    }

    /*
     * Set the interpreter's object result to refer to the variable's value
     * object.

	return donerc;
    }

    gotValue = 0;
    while (1) {
	Tcl_HashEntry *hPtr = searchPtr->nextEntry;

	if (hPtr != NULL) {
	if (hPtr) {
	    searchPtr->nextEntry = NULL;
	} else {
	    hPtr = Tcl_NextHashEntry(&searchPtr->search);
	    if (hPtr == NULL) {
	    if (!hPtr) {
		gotValue = 0;
		break;
	    }
	}
	varPtr = VarHashGetValue(hPtr);
	if (!TclIsVarUndefined(varPtr)) {
	    gotValue = 1;

    if (TclListObjLength(interp, objv[1], &numVars) != TCL_OK) {
	return TCL_ERROR;
    }

    if (numVars != 2) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"must have two variable names", -1));
		"must have two variable names", TCL_AUTO_LENGTH));
	Tcl_SetErrorCode(interp, "TCL", "SYNTAX", "array", "for", (char *)NULL);
	return TCL_ERROR;
    }

    arrayNameObj = objv[2];

    if (TCL_ERROR == LocateArray(interp, arrayNameObj, &varPtr, &isArray)) {
    if (LocateArray(interp, arrayNameObj, &varPtr, &isArray) != TCL_OK) {
	return TCL_ERROR;
    }

    if (!isArray) {
	return NotArrayError(interp, arrayNameObj);
    }

    /*
     * Make a new array search, put it on the stack.
     */

    searchPtr = (ArraySearch *)Tcl_Alloc(sizeof(ArraySearch));
    searchPtr = (ArraySearch *) Tcl_Alloc(sizeof(ArraySearch));
    ArrayPopulateSearch(interp, arrayNameObj, varPtr, searchPtr);

    /*
     * Make sure that these objects (which we need throughout the body of the
     * loop) don't vanish.
     */

static int
ArrayForLoopCallback(
    void *data[],
    Tcl_Interp *interp,
    int result)
{
    Interp *iPtr = (Interp *) interp;
    ArraySearch *searchPtr = (ArraySearch *)data[0];
    Tcl_Obj *varListObj = (Tcl_Obj *)data[1];
    Tcl_Obj *arrayNameObj = (Tcl_Obj *)data[2];
    Tcl_Obj *scriptObj = (Tcl_Obj *)data[3];
    ArraySearch *searchPtr = (ArraySearch *) data[0];
    Tcl_Obj *varListObj = (Tcl_Obj *) data[1];
    Tcl_Obj *arrayNameObj = (Tcl_Obj *) data[2];
    Tcl_Obj *scriptObj = (Tcl_Obj *) data[3];
    Tcl_Obj **varv;
    Tcl_Obj *keyObj, *valueObj;
    Var *varPtr;
    Var *varPtr, *arrayPtr;
    Var *arrayPtr;
    int done;
    Tcl_Size varc;

    /*
     * Process the result from the previous execution of the script body.
     */

     * Get the next mapping from the array.
     */

    keyObj = NULL;
    valueObj = NULL;
    varPtr = TclObjLookupVarEx(interp, arrayNameObj, NULL, /*flags*/ 0,
	    /*msg*/ 0, /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr);
    if (varPtr == NULL) {
    if (!varPtr) {
	done = TCL_ERROR;
    } else {
	done = ArrayObjNext(interp, arrayNameObj, varPtr, searchPtr, &keyObj,
		&valueObj);
    }

    result = TCL_OK;
    if (done != TCL_CONTINUE) {
	Tcl_ResetResult(interp);
	if (done == TCL_ERROR) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "array changed during iteration", -1));
		    "array changed during iteration", TCL_AUTO_LENGTH));
	    Tcl_SetErrorCode(interp, "TCL", "READ", "array", "for", (char *)NULL);
	    varPtr->flags |= TCL_LEAVE_ERR_MSG;
	    result = done;
	}
	goto arrayfordone;
    }

    result = TclListObjGetElements(NULL, varListObj, &varc, &varv);
    if (result != TCL_OK) {
	goto arrayfordone;
    }
    if (Tcl_ObjSetVar2(interp, varv[0], NULL, keyObj,
    if (!Tcl_ObjSetVar2(interp, varv[0], NULL, keyObj, TCL_LEAVE_ERR_MSG)) {
	    TCL_LEAVE_ERR_MSG) == NULL) {
	result = TCL_ERROR;
	goto arrayfordone;
    }
    if (valueObj != NULL) {
	if (Tcl_ObjSetVar2(interp, varv[1], NULL, valueObj,
    if (valueObj) {
	if (!Tcl_ObjSetVar2(interp, varv[1], NULL, valueObj, TCL_LEAVE_ERR_MSG)) {
		TCL_LEAVE_ERR_MSG) == NULL) {
	    result = TCL_ERROR;
	    goto arrayfordone;
	}
    }

    /*
     * Run the script.

    hPtr = Tcl_CreateHashEntry(&iPtr->varSearches, varPtr, &isNew);
    if (isNew) {
	searchPtr->id = 1;
	varPtr->flags |= VAR_SEARCH_ACTIVE;
	searchPtr->nextPtr = NULL;
    } else {
	searchPtr->id = ((ArraySearch *) Tcl_GetHashValue(hPtr))->id + 1;
	searchPtr->nextPtr = (ArraySearch *)Tcl_GetHashValue(hPtr);
	searchPtr->nextPtr = (ArraySearch *) Tcl_GetHashValue(hPtr);
    }
    searchPtr->varPtr = varPtr;
    searchPtr->nextEntry = VarHashFirstEntry(varPtr->value.tablePtr,
	    &searchPtr->search);
    Tcl_SetHashValue(hPtr, searchPtr);
    searchPtr->name = Tcl_ObjPrintf("s-%d-%s", searchPtr->id,
	    TclGetString(arrayNameObj));

    ArraySearch *searchPtr;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "arrayName");
	return TCL_ERROR;
    }

    if (TCL_ERROR == LocateArray(interp, objv[1], &varPtr, &isArray)) {
    if (LocateArray(interp, objv[1], &varPtr, &isArray) != TCL_OK) {
	return TCL_ERROR;
    }

    if (!isArray) {
	return NotArrayError(interp, objv[1]);
    }

    /*
     * Make a new array search with a free name.
     */

    searchPtr = (ArraySearch *)Tcl_Alloc(sizeof(ArraySearch));
    searchPtr = (ArraySearch *) Tcl_Alloc(sizeof(ArraySearch));
    ArrayPopulateSearch(interp, objv[1], varPtr, searchPtr);
    Tcl_SetObjResult(interp, searchPtr->name);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------

    /*
     * Unhook the search from the list of searches associated with the
     * variable.
     */

    hPtr = Tcl_FindHashEntry(&iPtr->varSearches, varPtr);
    if (hPtr == NULL) {
    if (!hPtr) {
	return;
    }
    if (searchPtr == Tcl_GetHashValue(hPtr)) {
	if (searchPtr->nextPtr) {
	    Tcl_SetHashValue(hPtr, searchPtr->nextPtr);
	} else {
	    varPtr->flags &= ~VAR_SEARCH_ACTIVE;
	    Tcl_DeleteHashEntry(hPtr);
	}
    } else {
	for (prevPtr = (ArraySearch *)Tcl_GetHashValue(hPtr); ; prevPtr=prevPtr->nextPtr) {
	for (prevPtr = (ArraySearch *) Tcl_GetHashValue(hPtr); ;
		prevPtr=prevPtr->nextPtr) {
	    if (prevPtr->nextPtr == searchPtr) {
		prevPtr->nextPtr = searchPtr->nextPtr;
		break;
	    }
	}
    }
}

    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "arrayName searchId");
	return TCL_ERROR;
    }
    varNameObj = objv[1];
    searchObj = objv[2];

    if (TCL_ERROR == LocateArray(interp, varNameObj, &varPtr, &isArray)) {
    if (LocateArray(interp, varNameObj, &varPtr, &isArray) != TCL_OK) {
	return TCL_ERROR;
    }

    if (!isArray) {
	return NotArrayError(interp, varNameObj);
    }

    /*
     * Get the search.
     */

    searchPtr = ParseSearchId(interp, varPtr, varNameObj, searchObj);
    if (searchPtr == NULL) {
    if (!searchPtr) {
	return TCL_ERROR;
    }

    /*
     * Scan forward to find if there are any further elements in the array
     * that are defined.
     */

    while (1) {
	if (searchPtr->nextEntry != NULL) {
	if (searchPtr->nextEntry) {
	    varPtr = VarHashGetValue(searchPtr->nextEntry);
	    if (!TclIsVarUndefined(varPtr)) {
		gotValue = 1;
		break;
	    }
	}
	searchPtr->nextEntry = Tcl_NextHashEntry(&searchPtr->search);
	if (searchPtr->nextEntry == NULL) {
	if (!searchPtr->nextEntry) {
	    gotValue = 0;
	    break;
	}
    }
    Tcl_SetObjResult(interp, iPtr->execEnvPtr->constants[gotValue]);
    return TCL_OK;
}

    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "arrayName searchId");
	return TCL_ERROR;
    }
    varNameObj = objv[1];
    searchObj = objv[2];

    if (TCL_ERROR == LocateArray(interp, varNameObj, &varPtr, &isArray)) {
    if (LocateArray(interp, varNameObj, &varPtr, &isArray) != TCL_OK) {
	return TCL_ERROR;
    }

    if (!isArray) {
	return NotArrayError(interp, varNameObj);
    }

    /*
     * Get the search.
     */

    searchPtr = ParseSearchId(interp, varPtr, varNameObj, searchObj);
    if (searchPtr == NULL) {
    if (!searchPtr) {
	return TCL_ERROR;
    }

    /*
     * Get the next element from the search, or the empty string on
     * exhaustion. Note that the [array anymore] command may well have already
     * pulled a value from the hash enumeration, so we have to check the cache
     * there first.
     */

    while (1) {
	Tcl_HashEntry *hPtr = searchPtr->nextEntry;

	if (hPtr == NULL) {
	if (!hPtr) {
	    hPtr = Tcl_NextHashEntry(&searchPtr->search);
	    if (hPtr == NULL) {
	    if (!hPtr) {
		return TCL_OK;
	    }
	} else {
	    searchPtr->nextEntry = NULL;
	}
	varPtr = VarHashGetValue(hPtr);
	if (!TclIsVarUndefined(varPtr)) {

    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "arrayName searchId");
	return TCL_ERROR;
    }
    varNameObj = objv[1];
    searchObj = objv[2];

    if (TCL_ERROR == LocateArray(interp, varNameObj, &varPtr, &isArray)) {
    if (LocateArray(interp, varNameObj, &varPtr, &isArray) != TCL_OK) {
	return TCL_ERROR;
    }

    if (!isArray) {
	return NotArrayError(interp, varNameObj);
    }

    /*
     * Get the search.
     */

    searchPtr = ParseSearchId(interp, varPtr, varNameObj, searchObj);
    if (searchPtr == NULL) {
    if (!searchPtr) {
	return TCL_ERROR;
    }

    ArrayDoneSearch(iPtr, varPtr, searchPtr);
    Tcl_DecrRefCount(searchPtr->name);
    Tcl_Free(searchPtr);
    return TCL_OK;

static int
ArrayExistsCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Interp *iPtr = (Interp *)interp;
    Interp *iPtr = (Interp *) interp;
    int isArray;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "arrayName");
	return TCL_ERROR;
    }

    if (TCL_ERROR == LocateArray(interp, objv[1], NULL, &isArray)) {
    if (LocateArray(interp, objv[1], NULL, &isArray) != TCL_OK) {
	return TCL_ERROR;
    }

    Tcl_SetObjResult(interp, iPtr->execEnvPtr->constants[isArray]);
    return TCL_OK;
}


	patternObj = objv[2];
	break;
    default:
	Tcl_WrongNumArgs(interp, 1, objv, "arrayName ?pattern?");
	return TCL_ERROR;
    }

    if (TCL_ERROR == LocateArray(interp, varNameObj, &varPtr, &isArray)) {
    if (LocateArray(interp, varNameObj, &varPtr, &isArray) != TCL_OK) {
	return TCL_ERROR;
    }

    /* If not an array, it's an empty result. */
    if (!isArray) {
	return TCL_OK;
    }

    pattern = (patternObj ? TclGetString(patternObj) : NULL);
    pattern = AsStr(patternObj);

    /*
     * Store the array names in a new object.
     */

    TclNewObj(nameLstObj);
    Tcl_IncrRefCount(nameLstObj);
    if ((patternObj != NULL) && TclMatchIsTrivial(pattern)) {
    if (TrivialPattern(pattern)) {
	varPtr2 = VarHashFindVar(varPtr->value.tablePtr, patternObj);
	if (varPtr2 == NULL) {
	if (!varPtr2) {
	    goto searchDone;
	}
	if (TclIsVarUndefined(varPtr2)) {
	    goto searchDone;
	}
	result = Tcl_ListObjAppendElement(interp, nameLstObj,
	(void) Tcl_ListObjAppendElement(NULL, nameLstObj,
		VarHashGetKey(varPtr2));
	if (result != TCL_OK) {
	    TclDecrRefCount(nameLstObj);
	    return result;
	}
	goto searchDone;
    }

    for (varPtr2 = VarHashFirstVar(varPtr->value.tablePtr, &search);
	    varPtr2; varPtr2 = VarHashNextVar(&search)) {
	if (TclIsVarUndefined(varPtr2)) {
	    continue;
	}
	nameObj = VarHashGetKey(varPtr2);
	if (patternObj && !Tcl_StringMatch(TclGetString(nameObj), pattern)) {
	if (!PatternMatch(pattern, nameObj)) {
	    continue;		/* Element name doesn't match pattern. */
	}

	result = Tcl_ListObjAppendElement(interp, nameLstObj, nameObj);
	(void) Tcl_ListObjAppendElement(NULL, nameLstObj, nameObj);
	if (result != TCL_OK) {
	    TclDecrRefCount(nameLstObj);
	    return result;
	}
    }

    /*
     * Make sure the Var structure of the array is not removed by a trace
     * while we're working.
     */

  searchDone:
    if (TclIsVarInHash(varPtr)) {
	VarHashRefCount(varPtr)++;
    }

    /*
     * Get the array values corresponding to each element name.
     */

    TclNewObj(tmpResObj);
    result = TclListObjGetElements(interp, nameLstObj, &count, &nameObjPtr);
    (void) TclListObjGetElements(NULL, nameLstObj, &count, &nameObjPtr);
    if (result != TCL_OK) {
	goto errorInArrayGet;
    }

    for (i=0 ; i<count ; i++) {
	nameObj = *nameObjPtr++;
	valueObj = Tcl_ObjGetVar2(interp, varNameObj, nameObj,
		TCL_LEAVE_ERR_MSG);
	if (valueObj == NULL) {
	if (!valueObj) {
	    /*
	     * Some trace played a trick on us; we need to diagnose to adapt
	     * our behaviour: was the array element unset, or did the
	     * modification modify the complete array?
	     */

	    if (TclIsVarArray(varPtr)) {

	    goto errorInArrayGet;
	}
    }
    if (TclIsVarInHash(varPtr)) {
	VarHashRefCount(varPtr)--;
    }
    Tcl_SetObjResult(interp, tmpResObj);
    TclDecrRefCount(nameLstObj);
    Tcl_BounceRefCount(nameLstObj);
    return TCL_OK;

  errorInArrayGet:
    if (TclIsVarInHash(varPtr)) {
	VarHashRefCount(varPtr)--;
    }
    TclDecrRefCount(nameLstObj);
    TclDecrRefCount(tmpResObj);	/* Free unneeded temp result. */
    Tcl_BounceRefCount(nameLstObj);
    Tcl_BounceRefCount(tmpResObj);	/* Free unneeded temp result. */
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * ArrayNamesCmd --

    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    static const char *const options[] = {
	"-exact", "-glob", "-regexp", NULL
    };
    enum arrayNamesOptionsEnum {OPT_EXACT, OPT_GLOB, OPT_REGEXP} mode = OPT_GLOB;
    enum arrayNamesOptionsEnum {
	OPT_EXACT, OPT_GLOB, OPT_REGEXP
    } mode = OPT_GLOB;
    Var *varPtr, *varPtr2;
    Tcl_Obj *nameObj, *resultObj, *patternObj;
    Tcl_HashSearch search;
    const char *pattern = NULL;
    const char *pattern;
    int isArray;

    if ((objc < 2) || (objc > 4)) {
	Tcl_WrongNumArgs(interp, 1, objv, "arrayName ?mode? ?pattern?");
	return TCL_ERROR;
    }
    patternObj = (objc > 2 ? objv[objc-1] : NULL);
    patternObj = (objc > 2 ? objv[objc - 1] : NULL);

    if (TCL_ERROR == LocateArray(interp, objv[1], &varPtr, &isArray)) {
    if (LocateArray(interp, objv[1], &varPtr, &isArray) != TCL_OK) {
	return TCL_ERROR;
    }

    /*
     * Finish parsing the arguments.
     */

    }

    /*
     * Check for the trivial cases where we can use a direct lookup.
     */

    TclNewObj(resultObj);
    if (patternObj) {
    pattern = AsStr(patternObj);
	pattern = TclGetString(patternObj);
    }
    if ((mode==OPT_GLOB && patternObj && TclMatchIsTrivial(pattern))
    if ((mode == OPT_GLOB && TrivialPattern(pattern)) || (mode == OPT_EXACT)) {
	    || (mode==OPT_EXACT)) {
	varPtr2 = VarHashFindVar(varPtr->value.tablePtr, patternObj);
	if ((varPtr2 != NULL) && !TclIsVarUndefined(varPtr2)) {
	if (varPtr2 && !TclIsVarUndefined(varPtr2)) {
	    /*
	     * This can't fail; lappending to an empty object always works.
	     */

	    Tcl_ListObjAppendElement(NULL, resultObj, VarHashGetKey(varPtr2));
	}
	Tcl_SetObjResult(interp, resultObj);

TclFindArrayPtrElements(
    Var *arrayPtr,
    Tcl_HashTable *tablePtr)
{
    Var *varPtr;
    Tcl_HashSearch search;

    if ((arrayPtr == NULL) || !TclIsVarArray(arrayPtr)
	    || TclIsVarUndefined(arrayPtr)) {
    if (!arrayPtr || !TclIsVarArray(arrayPtr) || TclIsVarUndefined(arrayPtr)) {
	return;
    }

    for (varPtr=VarHashFirstVar(arrayPtr->value.tablePtr, &search);
	    varPtr!=NULL ; varPtr=VarHashNextVar(&search)) {
	Tcl_HashEntry *hPtr;
	Tcl_Obj *nameObj;

    int result;

    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "arrayName list");
	return TCL_ERROR;
    }

    if (TCL_ERROR == LocateArray(interp, objv[1], NULL, NULL)) {
    if (LocateArray(interp, objv[1], NULL, NULL) != TCL_OK) {
	return TCL_ERROR;
    }

    arrayNameObj = objv[1];
    varPtr = TclObjLookupVarEx(interp, arrayNameObj, NULL,
	    /*flags*/ TCL_LEAVE_ERR_MSG, /*msg*/ "set", /*createPart1*/ 1,
	    /*createPart2*/ 1, &arrayPtr);
    if (varPtr == NULL) {
    if (!varPtr) {
	return TCL_ERROR;
    }
    if (arrayPtr) {
	CleanupVar(varPtr, arrayPtr);
	TclObjVarErrMsg(interp, arrayNameObj, NULL, "set", NEEDARRAY, -1);
	TclObjVarErrMsg(interp, arrayNameObj, NULL, "set", NEEDARRAY,
		NOT_IN_LVT);
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARNAME",
		TclGetString(arrayNameObj), (char *)NULL);
	return TCL_ERROR;
    }

    /*
     * Install the contents of the dictionary or list into the array.
     */

    arrayElemObj = objv[2];
    if (TclHasInternalRep(arrayElemObj, &tclDictType) && arrayElemObj->bytes == NULL) {
    if (TclHasInternalRep(arrayElemObj, &tclDictType) && !arrayElemObj->bytes) {
	Tcl_Obj *keyPtr, *valuePtr;
	Tcl_DictSearch search;
	int done;
	Tcl_Size size;

	if (Tcl_DictObjSize(interp, arrayElemObj, &size) != TCL_OK) {
	    return TCL_ERROR;

		Tcl_DictObjNext(&search, &keyPtr, &valuePtr, &done)) {
	    /*
	     * At this point, it would be nice if the key was directly usable
	     * by the array. This isn't the case though.
	     */

	    Var *elemVarPtr = TclLookupArrayElement(interp, arrayNameObj,
		    keyPtr, TCL_LEAVE_ERR_MSG, "set", 1, 1, varPtr, -1);
		    keyPtr, TCL_LEAVE_ERR_MSG, "set", 1, 1, varPtr, NOT_IN_LVT);

	    if ((elemVarPtr == NULL) ||
		    (TclPtrSetVarIdx(interp, elemVarPtr, varPtr, arrayNameObj,
		    keyPtr, valuePtr, TCL_LEAVE_ERR_MSG, -1) == NULL)) {
	    if (!elemVarPtr ||
		    !TclPtrSetVarIdx(interp, elemVarPtr, varPtr, arrayNameObj,
			    keyPtr, valuePtr, TCL_LEAVE_ERR_MSG, NOT_IN_LVT)) {
		Tcl_DictObjDone(&search);
		return TCL_ERROR;
	    }
	}
	return TCL_OK;
    } else {
	/*

	result = TclListObjLength(interp, arrayElemObj, &elemLen);
	if (result != TCL_OK) {
	    return result;
	}
	if (elemLen & 1) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "list must have an even number of elements", -1));
		    "list must have an even number of elements",
		    TCL_AUTO_LENGTH));
	    Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "FORMAT", (char *)NULL);
	    return TCL_ERROR;
	}
	if (elemLen == 0) {
	    goto ensureArray;
	}
	result = TclListObjGetElements(interp, arrayElemObj,

	copyListObj = TclListObjCopy(NULL, arrayElemObj);
	if (!copyListObj) {
	    return TCL_ERROR;
	}
	for (i=0 ; i<elemLen ; i+=2) {
	    Var *elemVarPtr = TclLookupArrayElement(interp, arrayNameObj,
		    elemPtrs[i], TCL_LEAVE_ERR_MSG, "set", 1, 1, varPtr, -1);
		    elemPtrs[i], TCL_LEAVE_ERR_MSG, "set", 1, 1, varPtr,
		    NOT_IN_LVT);

	    if ((elemVarPtr == NULL) ||
		    (TclPtrSetVarIdx(interp, elemVarPtr, varPtr, arrayNameObj,
			    elemPtrs[i], elemPtrs[i+1], TCL_LEAVE_ERR_MSG,
			    -1) == NULL)) {
	    if (!elemVarPtr ||
		    !TclPtrSetVarIdx(interp, elemVarPtr, varPtr, arrayNameObj,
			    elemPtrs[i], elemPtrs[i + 1], TCL_LEAVE_ERR_MSG,
			    NOT_IN_LVT)) {
		result = TCL_ERROR;
		break;
	    }
	}
	Tcl_DecrRefCount(copyListObj);
	return result;
    }

    /*
     * The list is empty make sure we have an array, or create one if
     * necessary.
     */

  ensureArray:
    if (varPtr != NULL) {
    if (varPtr) {
	if (TclIsVarArray(varPtr)) {
	    /*
	     * Already an array, done.
	     */

	    return TCL_OK;
	}
	if (TclIsVarArrayElement(varPtr) || !TclIsVarUndefined(varPtr)) {
	    /*
	     * Either an array element, or a scalar: lose!
	     */

	    TclObjVarErrMsg(interp, arrayNameObj, NULL, "array set",
		    NEEDARRAY, -1);
		    NEEDARRAY, NOT_IN_LVT);
	    Tcl_SetErrorCode(interp, "TCL", "WRITE", "ARRAY", (char *)NULL);
	    return TCL_ERROR;
	}
    }
    TclInitArrayVar(varPtr);
    return TCL_OK;
}

    int isArray, size = 0;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "arrayName");
	return TCL_ERROR;
    }

    if (TCL_ERROR == LocateArray(interp, objv[1], &varPtr, &isArray)) {
    if (LocateArray(interp, objv[1], &varPtr, &isArray) != TCL_OK) {
	return TCL_ERROR;
    }

    /* We can only iterate over the array if it exists... */

    if (isArray) {
	/*

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "arrayName");
	return TCL_ERROR;
    }
    varNameObj = objv[1];

    if (TCL_ERROR == LocateArray(interp, varNameObj, &varPtr, &isArray)) {
    if (LocateArray(interp, varNameObj, &varPtr, &isArray) != TCL_OK) {
	return TCL_ERROR;
    }

    if (!isArray) {
	return NotArrayError(interp, varNameObj);
    }

    stats = Tcl_HashStats((Tcl_HashTable *) varPtr->value.tablePtr);
    if (stats == NULL) {
    if (!stats) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"error reading array statistics", -1));
		"error reading array statistics", TCL_AUTO_LENGTH));
	return TCL_ERROR;
    }
    Tcl_SetObjResult(interp, Tcl_NewStringObj(stats, -1));
    Tcl_SetObjResult(interp, Tcl_NewStringObj(stats, TCL_AUTO_LENGTH));
    Tcl_Free(stats);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *

    int objc,
    Tcl_Obj *const objv[])
{
    Var *varPtr, *varPtr2, *protectedVarPtr;
    Tcl_Obj *varNameObj, *patternObj, *nameObj;
    Tcl_HashSearch search;
    const char *pattern;
    int unsetFlags = 0;	/* Should this be TCL_LEAVE_ERR_MSG? */
    int unsetFlags = 0;		/* Should this be TCL_LEAVE_ERR_MSG? */
    int isArray;

    switch (objc) {
    case 2:
	varNameObj = objv[1];
	patternObj = NULL;
	break;
    case 3:
	varNameObj = objv[1];
	patternObj = objv[2];
	break;
    default:
	Tcl_WrongNumArgs(interp, 1, objv, "arrayName ?pattern?");
	return TCL_ERROR;
    }

    if (TCL_ERROR == LocateArray(interp, varNameObj, &varPtr, &isArray)) {
    if (LocateArray(interp, varNameObj, &varPtr, &isArray) != TCL_OK) {
	return TCL_ERROR;
    }

    if (!isArray) {
	return TCL_OK;
    }

    if (!patternObj) {
	/*
	 * When no pattern is given, just unset the whole array.
	 */

	return TclObjUnsetVar2(interp, varNameObj, NULL, 0);
    }

    /*
     * With a trivial pattern, we can just unset.
     */

    pattern = TclGetString(patternObj);
    if (TclMatchIsTrivial(pattern)) {
    if (TrivialPattern(pattern)) {
	varPtr2 = VarHashFindVar(varPtr->value.tablePtr, patternObj);
	if (!varPtr2 || TclIsVarUndefined(varPtr2)) {
	    return TCL_OK;
	}
	return TclPtrUnsetVarIdx(interp, varPtr2, varPtr, varNameObj,
		patternObj, unsetFlags, -1);
		patternObj, unsetFlags, NOT_IN_LVT);
    }

    /*
     * Non-trivial case (well, deeply tricky really). We peek inside the hash
     * iterator in order to allow us to guarantee that the following element
     * in the array will not be scrubbed until we have dealt with it. This
     * stops the overall iterator from ending up pointing into deallocated

	/*
	 * Guard the next (peeked) item in the search chain by incrementing
	 * its refcount. This guarantees that the hash table iterator won't be
	 * dangling on the next time through the loop.
	 */

	if (search.nextEntryPtr != NULL) {
	if (search.nextEntryPtr) {
	    protectedVarPtr = VarHashGetValue(search.nextEntryPtr);
	    VarHashRefCount(protectedVarPtr)++;
	} else {
	    protectedVarPtr = NULL;
	}

	/*
	 * If the variable is undefined, clean it out as it has been hit by
	 * something else (i.e., an unset trace).
	 */

	if (TclIsVarUndefined(varPtr2)) {
	    CleanupVar(varPtr2, varPtr);
	    continue;
	}

	nameObj = VarHashGetKey(varPtr2);
	if (Tcl_StringMatch(TclGetString(nameObj), pattern)
	if (PatternMatch(pattern, nameObj)
		&& TclPtrUnsetVarIdx(interp, varPtr2, varPtr, varNameObj,
			nameObj, unsetFlags, -1) != TCL_OK) {
			nameObj, unsetFlags, NOT_IN_LVT) != TCL_OK) {
	    /*
	     * If we incremented a refcount, we must decrement it here as we
	     * will not be coming back properly due to the error.
	     */

	    if (protectedVarPtr) {
		VarHashRefCount(protectedVarPtr)--;

    int otherFlags,		/* 0, TCL_GLOBAL_ONLY or TCL_NAMESPACE_ONLY:
				 * indicates scope of "other" variable. */
    Tcl_Obj *myNamePtr,		/* Name of variable which will refer to
				 * otherP1/otherP2. Must be a scalar. */
    int myFlags,		/* 0, TCL_GLOBAL_ONLY or TCL_NAMESPACE_ONLY:
				 * indicates scope of myName. */
    int index)			/* If the variable to be linked is an indexed
				 * scalar, this is its index. Otherwise, -1 */
				 * scalar, this is its index. Otherwise,
				 * NOT_IN_LVT (-1) */
{
    Interp *iPtr = (Interp *) interp;
    Var *otherPtr, *arrayPtr;
    CallFrame *varFramePtr;

    /*
     * Find "other" in "framePtr". If not looking up other in just the current
     * namespace, temporarily replace the current var frame pointer in the
     * interpreter in order to use TclObjLookupVar.
     */

    if (framePtr == NULL) {
    if (!framePtr) {
	framePtr = iPtr->rootFramePtr;
    }

    varFramePtr = iPtr->varFramePtr;
    if (!(otherFlags & TCL_NAMESPACE_ONLY)) {
	iPtr->varFramePtr = framePtr;
    }
    otherPtr = TclObjLookupVar(interp, otherP1Ptr, otherP2,
	    (otherFlags | TCL_LEAVE_ERR_MSG), "access",
	    /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr);
    if (!(otherFlags & TCL_NAMESPACE_ONLY)) {
	iPtr->varFramePtr = varFramePtr;
    }
    if (otherPtr == NULL) {
    if (!otherPtr) {
	return TCL_ERROR;
    }

    /*
     * Check that we are not trying to create a namespace var linked to a
     * local variable in a procedure. If we allowed this, the local
     * variable in the shorter-lived procedure frame could go away leaving
     * the namespace var's reference invalid.
     */

    if (index < 0) {
	if (!(arrayPtr != NULL
		     ? (TclIsVarInHash(arrayPtr) && TclGetVarNsPtr(arrayPtr))
	if (!(arrayPtr ? (TclIsVarInHash(arrayPtr) && TclGetVarNsPtr(arrayPtr))
		     : (TclIsVarInHash(otherPtr) && TclGetVarNsPtr(otherPtr)))
		&& ((myFlags & (TCL_GLOBAL_ONLY | TCL_NAMESPACE_ONLY))
			|| (varFramePtr == NULL)
		&& ((myFlags & SCOPES)
			|| !varFramePtr
			|| !HasLocalVars(varFramePtr)
			|| (strstr(TclGetString(myNamePtr), "::") != NULL))) {
	    Tcl_SetObjResult((Tcl_Interp *) iPtr, Tcl_ObjPrintf(
		    "bad variable name \"%s\": can't create namespace "
		    "variable that refers to procedure variable",
		    TclGetString(myNamePtr)));
	    Tcl_SetErrorCode(interp, "TCL", "UPVAR", "INVERTED", (char *)NULL);

				 * error messages, too. */
    Var *otherPtr,		/* Pointer to the variable being linked-to. */
    const char *myName,		/* Name of variable which will refer to
				 * otherP1/otherP2. Must be a scalar. */
    int myFlags,		/* 0, TCL_GLOBAL_ONLY or TCL_NAMESPACE_ONLY:
				 * indicates scope of myName. */
    int index)			/* If the variable to be linked is an indexed
				 * scalar, this is its index. Otherwise, -1 */
				 * scalar, this is its index. Otherwise,
				 * NOT_IN_LVT (-1) */
{
    Tcl_Obj *myNamePtr = NULL;
    Tcl_Obj *myNamePtr = AsObj(myName);
    int result;

    if (myName) {
	myNamePtr = Tcl_NewStringObj(myName, -1);
	Tcl_IncrRefCount(myNamePtr);
    }
    result = TclPtrObjMakeUpvarIdx(interp, otherPtr, myNamePtr, myFlags,
    int result = TclPtrObjMakeUpvarIdx(interp, otherPtr, myNamePtr, myFlags,
	    index);
    if (myNamePtr) {
	Tcl_DecrRefCount(myNamePtr);
    }

    Tcl_BounceRefCount(myNamePtr);
    return result;
}

int
TclPtrObjMakeUpvar(
    Tcl_Interp *interp,		/* Interpreter containing variables. Used for
				 * error messages, too. */
    Tcl_Var otherPtr,		/* Pointer to the variable being linked-to. */
    Tcl_Obj *myNamePtr,		/* Name of variable which will refer to
				 * otherP1/otherP2. Must be a scalar. */
    int myFlags)		/* 0, TCL_GLOBAL_ONLY or TCL_NAMESPACE_ONLY:
				 * indicates scope of myName. */
{
    return TclPtrObjMakeUpvarIdx(interp, (Var *) otherPtr, myNamePtr, myFlags,
	    -1);
	    NOT_IN_LVT);
}

/* Callers must Incr myNamePtr if they plan to Decr it. */

int
TclPtrObjMakeUpvarIdx(
    Tcl_Interp *interp,		/* Interpreter containing variables. Used for
				 * error messages, too. */
    Var *otherPtr,		/* Pointer to the variable being linked-to. */
    Tcl_Obj *myNamePtr,		/* Name of variable which will refer to
				 * otherP1/otherP2. Must be a scalar. */
    int myFlags,		/* 0, TCL_GLOBAL_ONLY or TCL_NAMESPACE_ONLY:
				 * indicates scope of myName. */
    int index)			/* If the variable to be linked is an indexed
				 * scalar, this is its index. Otherwise, -1 */
				 * scalar, this is its index. Otherwise,
				 * NOT_IN_LVT (-1) */
{
    Interp *iPtr = (Interp *) interp;
    CallFrame *varFramePtr = iPtr->varFramePtr;
    const char *errMsg, *p, *myName;
    Var *varPtr;

    if (index >= 0) {
	if (!HasLocalVars(varFramePtr)) {
	    Tcl_Panic("ObjMakeUpvar called with an index outside from a proc");
	}
	varPtr = (Var *) &(varFramePtr->compiledLocals[index]);
	varPtr = &varFramePtr->compiledLocals[index];
	myNamePtr = localName(iPtr->varFramePtr, index);
	myName = myNamePtr? TclGetString(myNamePtr) : NULL;
	myName = AsStr(myNamePtr);
    } else {
	/*
	 * Do not permit the new variable to look like an array reference, as
	 * it will not be reachable in that case [Bug 600812, TIP 184]. The
	 * "definition" of what "looks like an array reference" is consistent
	 * (and must remain consistent) with the code in TclObjLookupVar().
	 */

	myName = TclGetString(myNamePtr);
	p = strstr(myName, "(");
	if (p != NULL) {
	    p += strlen(p)-1;
	    p += strlen(p) - 1;
	    if (*p == ')') {
		/*
		 * myName looks like an array reference.
		 */

		Tcl_SetObjResult((Tcl_Interp *) iPtr, Tcl_ObjPrintf(
			"bad variable name \"%s\": can't create a scalar "

	 * 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.
	 */

	varPtr = TclLookupSimpleVar(interp, myNamePtr,
		myFlags|TCL_AVOID_RESOLVERS, /* create */ 1, &errMsg, &index);
	if (varPtr == NULL) {
	    TclObjVarErrMsg(interp, myNamePtr, NULL, "create", errMsg, -1);
		myFlags | TCL_AVOID_RESOLVERS, /*create*/ 1, &errMsg, &index);
	if (!varPtr) {
	    TclObjVarErrMsg(interp, myNamePtr, NULL, "create", errMsg,
		    NOT_IN_LVT);
	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARNAME",
		    TclGetString(myNamePtr), (char *)NULL);
	    return TCL_ERROR;
	}
    }

    if (varPtr == otherPtr) {
	Tcl_SetObjResult((Tcl_Interp *) iPtr, Tcl_NewStringObj(
		"can't upvar from variable to itself", -1));
		"can't upvar from variable to itself", TCL_AUTO_LENGTH));
	Tcl_SetErrorCode(interp, "TCL", "UPVAR", "SELF", (char *)NULL);
	return TCL_ERROR;
    }

    if (TclIsVarTraced(varPtr)) {
	Tcl_SetObjResult((Tcl_Interp *) iPtr, Tcl_ObjPrintf(
		"variable \"%s\" has traces: can't use for upvar", myName));

    CallFrame *framePtr;
    Tcl_Obj *part1Ptr, *localNamePtr;

    if (TclGetFrame(interp, frameName, &framePtr) == -1) {
	return TCL_ERROR;
    }

    part1Ptr = Tcl_NewStringObj(part1, -1);
    part1Ptr = Tcl_NewStringObj(part1, TCL_AUTO_LENGTH);
    Tcl_IncrRefCount(part1Ptr);
    localNamePtr = Tcl_NewStringObj(localNameStr, -1);
    localNamePtr = Tcl_NewStringObj(localNameStr, TCL_AUTO_LENGTH);
    Tcl_IncrRefCount(localNamePtr);

    result = ObjMakeUpvar(interp, framePtr, part1Ptr, part2, 0,
	    localNamePtr, flags, -1);
    Tcl_DecrRefCount(part1Ptr);
    Tcl_DecrRefCount(localNamePtr);
	    localNamePtr, flags, NOT_IN_LVT);

    Tcl_BounceRefCount(part1Ptr);
    Tcl_BounceRefCount(localNamePtr);
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetVariableFullName --

    /*
     * Add the full name of the containing namespace (if any), followed by the
     * "::" separator, then the variable name.
     */

    nsPtr = TclGetVarNsPtr(varPtr);
    if (nsPtr) {
	Tcl_AppendToObj(objPtr, nsPtr->fullName, -1);
	Tcl_AppendToObj(objPtr, nsPtr->fullName, TCL_AUTO_LENGTH);
	if (nsPtr != iPtr->globalNsPtr) {
	    Tcl_AppendToObj(objPtr, "::", 2);
	}
    }
    if (TclIsVarInHash(varPtr)) {
	if (!TclIsVarDeadHash(varPtr)) {
	    namePtr = VarHashGetKey(varPtr);

	return TCL_ERROR;
    }

    part1Ptr = objv[1];
    varPtr = TclObjLookupVarEx(interp, part1Ptr, NULL, TCL_LEAVE_ERR_MSG,
	    "const", /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr);
    if (TclIsVarArray(varPtr)) {
	TclObjVarErrMsg(interp, part1Ptr, NULL, "make constant", ISARRAY, -1);
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CONST", (void *)NULL);
	TclObjVarErrMsg(interp, part1Ptr, NULL, "make constant", ISARRAY,
		NOT_IN_LVT);
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CONST", (char *)NULL);
	return TCL_ERROR;
    }
    if (TclIsVarArrayElement(varPtr)) {
	if (TclIsVarUndefined(varPtr)) {
	    CleanupVar(varPtr, arrayPtr);
	}
	TclObjVarErrMsg(interp, part1Ptr, NULL, "make constant", ISARRAYELEMENT, -1);
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CONST", (void *)NULL);
	TclObjVarErrMsg(interp, part1Ptr, NULL, "make constant", ISARRAYELEMENT,
		NOT_IN_LVT);
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CONST", (char *)NULL);
	return TCL_ERROR;
    }

    /*
     * If already exists, either a constant (no problem) or an error.
     */
    if (!TclIsVarUndefined(varPtr)) {
	if (TclIsVarConstant(varPtr)) {
	    return TCL_OK;
	}
	TclObjVarErrMsg(interp, part1Ptr, NULL, "make constant", EXISTS, -1);
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CONST", (void *)NULL);
	TclObjVarErrMsg(interp, part1Ptr, NULL, "make constant", EXISTS,
		NOT_IN_LVT);
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CONST", (char *)NULL);
	return TCL_ERROR;
    }

    /*
     * Make the variable and flag it as a constant.
     */
    if (TclPtrSetVar(interp, (Tcl_Var) varPtr, NULL, objv[1], NULL,
	    objv[2], TCL_LEAVE_ERR_MSG) == NULL) {
    if (!TclPtrSetVar(interp, (Tcl_Var) varPtr, NULL, objv[1], NULL,
	    objv[2], TCL_LEAVE_ERR_MSG)) {
	if (TclIsVarUndefined(varPtr)) {
	    CleanupVar(varPtr, arrayPtr);
	}
	return TCL_ERROR;
    };
    }
    TclSetVarConstant(varPtr);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *

	if ((*tail == ':') && (tail > varName)) {
	    tail++;
	}

	if (tail == varName) {
	    tailPtr = objPtr;
	} else {
	    tailPtr = Tcl_NewStringObj(tail, -1);
	    tailPtr = Tcl_NewStringObj(tail, TCL_AUTO_LENGTH);
	    Tcl_IncrRefCount(tailPtr);
	}

	/*
	 * Link to the variable "varName" in the global :: namespace.
	 */

	result = ObjMakeUpvar(interp, NULL, objPtr, NULL,
		TCL_GLOBAL_ONLY, /*myName*/ tailPtr, /*myFlags*/ 0, -1);
		TCL_GLOBAL_ONLY, /*myName*/ tailPtr, /*myFlags*/ 0, NOT_IN_LVT);

	if (tail != varName) {
	    Tcl_DecrRefCount(tailPtr);
	}

	if (result != TCL_OK) {
	    return result;

	varNamePtr = objv[i];
	varName = TclGetString(varNamePtr);
	varPtr = TclObjLookupVarEx(interp, varNamePtr, NULL,
		(TCL_NAMESPACE_ONLY | TCL_LEAVE_ERR_MSG), "define",
		/*createPart1*/ 1, /*createPart2*/ 0, &arrayPtr);

	if (arrayPtr != NULL) {
	if (arrayPtr) {
	    /*
	     * Variable cannot be an element in an array. If arrayPtr is
	     * non-NULL, it is, so throw up an error and return.
	     */

	    TclObjVarErrMsg(interp, varNamePtr, NULL, "define",
		    ISARRAYELEMENT, -1);
		    ISARRAYELEMENT, NOT_IN_LVT);
	    Tcl_SetErrorCode(interp, "TCL", "UPVAR", "LOCAL_ELEMENT", (char *)NULL);
	    return TCL_ERROR;
	}

	if (varPtr == NULL) {
	if (!varPtr) {
	    return TCL_ERROR;
	}

	/*
	 * Mark the variable as a namespace variable and increment its
	 * reference count so that it will persist until its namespace is
	 * destroyed or until the variable is unset.
	 */

	TclSetVarNamespaceVar(varPtr);

	/*
	 * If a value was specified, set the variable to that value.
	 * Otherwise, if the variable is new, leave it undefined. (If the
	 * variable already exists and no value was specified, leave its value
	 * unchanged; just create the local link if we're in a Tcl procedure).
	 */

	if (i+1 < objc) {	/* A value was specified. */
	if (i + 1 < objc) {	/* A value was specified. */
	    varValuePtr = TclPtrSetVarIdx(interp, varPtr, arrayPtr,
		    varNamePtr, NULL, objv[i+1],
		    (TCL_NAMESPACE_ONLY | TCL_LEAVE_ERR_MSG), -1);
	    if (varValuePtr == NULL) {
		    varNamePtr, NULL, objv[i + 1],
		    (TCL_NAMESPACE_ONLY | TCL_LEAVE_ERR_MSG), NOT_IN_LVT);
	    if (!varValuePtr) {
		return TCL_ERROR;
	    }
	}

	/*
	 * If we are executing inside a Tcl procedure, create a local variable
	 * linked to the new namespace variable "varName".

	     * Create a local link "tail" to the variable "varName" in the
	     * current namespace.
	     */

	    if (tail == varName) {
		tailPtr = varNamePtr;
	    } else {
		tailPtr = Tcl_NewStringObj(tail, -1);
		tailPtr = Tcl_NewStringObj(tail, TCL_AUTO_LENGTH);
		Tcl_IncrRefCount(tailPtr);
	    }

	    result = ObjMakeUpvar(interp, NULL, varNamePtr, /*otherP2*/ NULL,
		    /*otherFlags*/ TCL_NAMESPACE_ONLY,
		    /*myName*/ tailPtr, /*myFlags*/ 0, -1);
		    /*myName*/ tailPtr, /*myFlags*/ 0, NOT_IN_LVT);

	    if (tail != varName) {
		Tcl_DecrRefCount(tailPtr);
		Tcl_BounceRefCount(tailPtr);
	    }

	    if (result != TCL_OK) {
		return result;
	    }
	}
    }

    /*
     * Iterate over each (other variable, local variable) pair. Divide the
     * other variable name into two parts, then call MakeUpvar to do all the
     * work of linking it to the local variable.
     */

    for (; objc>0 ; objc-=2, objv+=2) {
	result = ObjMakeUpvar(interp, framePtr, /* othervarName */ objv[0],
		NULL, 0, /* myVarName */ objv[1], /*flags*/ 0, -1);
	result = ObjMakeUpvar(interp, framePtr, /*othervarName*/ objv[0],
		NULL, 0, /*myVarName*/ objv[1], /*flags*/ 0, NOT_IN_LVT);
	if (result != TCL_OK) {
	    return TCL_ERROR;
	}
    }
    return TCL_OK;
}


    char *end;

    if (varPtr->flags & VAR_SEARCH_ACTIVE) {
	Tcl_HashEntry *hPtr =
		Tcl_FindHashEntry(&iPtr->varSearches, varPtr);

	/* First look for same (Tcl_Obj *) */
	for (searchPtr = (ArraySearch *)Tcl_GetHashValue(hPtr); searchPtr != NULL;
		searchPtr = searchPtr->nextPtr) {
	for (searchPtr = (ArraySearch *) Tcl_GetHashValue(hPtr);
		searchPtr != NULL; searchPtr = searchPtr->nextPtr) {
	    if (searchPtr->name == handleObj) {
		return searchPtr;
	    }
	}
	/* Fallback: do string compares. */
	for (searchPtr = (ArraySearch *)Tcl_GetHashValue(hPtr); searchPtr != NULL;
		searchPtr = searchPtr->nextPtr) {
	    if (strcmp(TclGetString(searchPtr->name), handle) == 0) {
	for (searchPtr = (ArraySearch *) Tcl_GetHashValue(hPtr);
		searchPtr != NULL; searchPtr = searchPtr->nextPtr) {
	    if (!strcmp(TclGetString(searchPtr->name), handle)) {
		return searchPtr;
	    }
	}
    }
    if ((handle[0] != 's') || (handle[1] != '-')
	    || (strtoul(handle + 2, &end, 10), end == (handle + 2))
	    || (*end != '-')) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"illegal search identifier \"%s\"", handle));
    } else if (strcmp(end + 1, TclGetString(varNamePtr)) != 0) {
    } else if (strcmp(end + 1, TclGetString(varNamePtr))) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"search identifier \"%s\" isn't for variable \"%s\"",
		handle, TclGetString(varNamePtr)));
    } else {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"couldn't find search \"%s\"", handle));
    }

				 * deleted. */
{
    ArraySearch *searchPtr, *nextPtr;
    Tcl_HashEntry *sPtr;

    if (arrayVarPtr->flags & VAR_SEARCH_ACTIVE) {
	sPtr = Tcl_FindHashEntry(&iPtr->varSearches, arrayVarPtr);
	for (searchPtr = (ArraySearch *)Tcl_GetHashValue(sPtr); searchPtr != NULL;
		searchPtr = nextPtr) {
	for (searchPtr = (ArraySearch *) Tcl_GetHashValue(sPtr);
		searchPtr != NULL; searchPtr = nextPtr) {
	    nextPtr = searchPtr->nextPtr;
	    Tcl_DecrRefCount(searchPtr->name);
	    Tcl_Free(searchPtr);
	}
	arrayVarPtr->flags &= ~VAR_SEARCH_ACTIVE;
	Tcl_DeleteHashEntry(sPtr);
    }

void
TclDeleteNamespaceVars(
    Namespace *nsPtr)
{
    TclVarHashTable *tablePtr = &nsPtr->varTable;
    Tcl_Interp *interp = nsPtr->interp;
    Interp *iPtr = (Interp *)interp;
    Interp *iPtr = (Interp *) interp;
    Tcl_HashSearch search;
    int flags = 0;
    Var *varPtr;

    /*
     * Determine what flags to pass to the trace callback functions.
     */

    for (varPtr = VarHashFirstVar(tablePtr, &search);  varPtr != NULL;
	    varPtr = VarHashFirstVar(tablePtr, &search)) {
	Tcl_Obj *objPtr;
	TclNewObj(objPtr);
	VarHashRefCount(varPtr)++;	/* Make sure we get to remove from
					 * hash. */
	Tcl_GetVariableFullName(interp, (Tcl_Var) varPtr, objPtr);
	UnsetVarStruct(varPtr, NULL, iPtr, /* part1 */ objPtr,
		NULL, flags, -1);
	UnsetVarStruct(varPtr, NULL, iPtr, /*part1*/ objPtr,
		NULL, flags, NOT_IN_LVT);

	/*
	 * We just unset the variable. However, an unset trace might
	 * have re-set it, or might have re-established traces on it.
	 * This namespace and its vartable are going away unconditionally,
	 * so we cannot let such things linger. That would be a leak.
	 *
	 * First we destroy all traces. ...
	 */

	if (TclIsVarTraced(varPtr)) {
	    Tcl_HashEntry *tPtr = Tcl_FindHashEntry(&iPtr->varTraces, varPtr);
	    VarTrace *tracePtr = (VarTrace *)Tcl_GetHashValue(tPtr);
	    VarTrace *tracePtr = (VarTrace *) Tcl_GetHashValue(tPtr);
	    ActiveVarTrace *activePtr;

	    while (tracePtr) {
		VarTrace *prevPtr = tracePtr;

		tracePtr = tracePtr->nextPtr;
		prevPtr->nextPtr = NULL;

	/*
	 * ...and then, if the variable still holds a value, we unset it
	 * again. This time with no traces left, we're sure it goes away.
	 */

	if (!TclIsVarUndefined(varPtr)) {
	    UnsetVarStruct(varPtr, NULL, iPtr, /* part1 */ objPtr,
		    NULL, flags, -1);
	    UnsetVarStruct(varPtr, NULL, iPtr, /*part1*/ objPtr,
		    NULL, flags, NOT_IN_LVT);
	}
	Tcl_DecrRefCount(objPtr); /* free no longer needed obj */
	Tcl_BounceRefCount(objPtr);	/* free no longer needed obj */
	VarHashRefCount(varPtr)--;
	VarHashDeleteEntry(varPtr);
    }
    VarHashDeleteTable(tablePtr);
}

/*

    } else if (tablePtr == &currNsPtr->varTable) {
	flags |= TCL_NAMESPACE_ONLY;
    }

    for (varPtr = VarHashFirstVar(tablePtr, &search); varPtr != NULL;
	    varPtr = VarHashFirstVar(tablePtr, &search)) {
	UnsetVarStruct(varPtr, NULL, iPtr, VarHashGetKey(varPtr), NULL, flags,
		-1);
		NOT_IN_LVT);
	VarHashDeleteEntry(varPtr);
    }
    VarHashDeleteTable(tablePtr);
}

/*
 *----------------------------------------------------------------------

    Var *elPtr;
    ActiveVarTrace *activePtr;
    Tcl_Obj *objPtr;
    VarTrace *tracePtr;

    for (elPtr = VarHashFirstVar(varPtr->value.tablePtr, &search);
	    elPtr != NULL; elPtr = VarHashNextVar(&search)) {
	if (TclIsVarScalar(elPtr) && (elPtr->value.objPtr != NULL)) {
	if (TclIsVarScalar(elPtr) && !TclIsVarUndefined(elPtr)) {
	    objPtr = elPtr->value.objPtr;
	    TclDecrRefCount(objPtr);
	    elPtr->value.objPtr = NULL;
	}

	/*
	 * Lie about the validity of the hashtable entry. In this way the

	     */

	    if (elPtr->flags & VAR_TRACED_UNSET) {
		Tcl_Obj *elNamePtr = VarHashGetKey(elPtr);

		elPtr->flags &= ~VAR_TRACE_ACTIVE;
		TclObjCallVarTraces(iPtr, NULL, elPtr, arrayNamePtr,
			elNamePtr, flags,/* leaveErrMsg */ 0, index);
			elNamePtr, flags, /*leaveErrMsg*/ 0, index);
	    }
	    tPtr = Tcl_FindHashEntry(&iPtr->varTraces, elPtr);
	    tracePtr = (VarTrace *)Tcl_GetHashValue(tPtr);
	    tracePtr = (VarTrace *) Tcl_GetHashValue(tPtr);
	    while (tracePtr) {
		VarTrace *prevPtr = tracePtr;

		tracePtr = tracePtr->nextPtr;
		prevPtr->nextPtr = NULL;
		Tcl_EventuallyFree(prevPtr, TCL_DYNAMIC);
	    }

    Tcl_Interp *interp,		/* Interpreter in which to record message. */
    const char *part1,
    const char *part2,		/* Variable's two-part name. */
    const char *operation,	/* String describing operation that failed,
				 * e.g. "read", "set", or "unset". */
    const char *reason)		/* String describing why operation failed. */
{
    Tcl_Obj *part2Ptr = NULL, *part1Ptr = Tcl_NewStringObj(part1, -1);

    Tcl_Obj *part1Ptr = Tcl_NewStringObj(part1, TCL_AUTO_LENGTH);
    Tcl_Obj *part2Ptr = AsObj(part2);
    if (part2) {
	part2Ptr = Tcl_NewStringObj(part2, -1);
    }


    TclObjVarErrMsg(interp, part1Ptr, part2Ptr, operation, reason, -1);
    TclObjVarErrMsg(interp, part1Ptr, part2Ptr, operation, reason, NOT_IN_LVT);

    Tcl_DecrRefCount(part1Ptr);
    Tcl_BounceRefCount(part1Ptr);
    if (part2Ptr) {
	Tcl_DecrRefCount(part2Ptr);
    Tcl_BounceRefCount(part2Ptr);
    }
}

void
TclObjVarErrMsg(
    Tcl_Interp *interp,		/* Interpreter in which to record message. */
    Tcl_Obj *part1Ptr,		/* (may be NULL, if index >= 0) */
    Tcl_Obj *part2Ptr,		/* Variable's two-part name. */
    const char *operation,	/* String describing operation that failed,
				 * e.g. "read", "set", or "unset". */
    const char *reason,		/* String describing why operation failed. */
    int index)			/* Index into the local variable table of the
				 * variable, or -1. Only used when part1Ptr is
				 * NULL. */
				 * variable, or NOT_IN_LVT (-1). Only used when
				 * part1Ptr is NULL. */
{
    if (!part1Ptr) {
	if (index == -1) {
	if (index == NOT_IN_LVT) {
	    Tcl_Panic("invalid part1Ptr and invalid index together");
	}
	part1Ptr = localName(((Interp *)interp)->varFramePtr, index);
	part1Ptr = localName(((Interp *) interp)->varFramePtr, index);
    }
    Tcl_SetObjResult(interp, Tcl_ObjPrintf("can't %s \"%s%s%s%s\": %s",
	    operation, TclGetString(part1Ptr), (part2Ptr ? "(" : ""),
	    (part2Ptr ? TclGetString(part2Ptr) : ""), (part2Ptr ? ")" : ""),
	    reason));
}

/*
 *----------------------------------------------------------------------
 *
 * Internal functions for variable name object types --
 *
 *----------------------------------------------------------------------
 */

/*
 * localVarName -
 *
 * INTERNALREP DEFINITION:
 *   twoPtrValue.ptr1:   pointer to name obj in varFramePtr->localCache
 *			  or NULL if it is this same obj
 *   twoPtrValue.ptr2: index into locals table
 *   twoPtrValue.ptr1:	pointer to name obj in varFramePtr->localCache
 *			or NULL if it is this same obj
 *   twoPtrValue.ptr2:	index into locals table
 */

static void
FreeLocalVarName(
    Tcl_Obj *objPtr)
{
    Tcl_Size index;

    LocalSetInternalRep(dupPtr, index, namePtr);
}

/*
 * parsedVarName -
 *
 * INTERNALREP DEFINITION:
 *   twoPtrValue.ptr1 = pointer to the array name Tcl_Obj (NULL if scalar)
 *   twoPtrValue.ptr2 = pointer to the element name string (owned by this
 *   twoPtrValue.ptr1:	pointer to the array name Tcl_Obj (NULL if scalar)
 *   twoPtrValue.ptr2:	pointer to the element name string (owned by this
 *			Tcl_Obj), or NULL if it is a scalar variable
 */

static void
FreeParsedVarName(
    Tcl_Obj *objPtr)
{
    Tcl_Obj *arrayPtr, *elem;
    int parsed;

    ParsedGetInternalRep(objPtr, parsed, arrayPtr, elem);

    parsed++;				/* Silence compiler. */
    if (arrayPtr != NULL) {
    parsed++;			/* Silence compiler. */
    if (arrayPtr) {
	TclDecrRefCount(arrayPtr);
	TclDecrRefCount(elem);
    }
}

static void
DupParsedVarName(
    Tcl_Obj *srcPtr,
    Tcl_Obj *dupPtr)
{
    Tcl_Obj *arrayPtr, *elem;
    int parsed;

    ParsedGetInternalRep(srcPtr, parsed, arrayPtr, elem);

    parsed++;				/* Silence compiler. */
    parsed++;			/* Silence compiler. */
    ParsedSetInternalRep(dupPtr, arrayPtr, elem);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_FindNamespaceVar -- MOVED OVER from tclNamesp.c

				 * TCL_NAMESPACE_ONLY (look up only in
				 * contextNsPtr, or the current namespace if
				 * contextNsPtr is NULL), and
				 * TCL_LEAVE_ERR_MSG. If both TCL_GLOBAL_ONLY
				 * and TCL_NAMESPACE_ONLY are given,
				 * TCL_GLOBAL_ONLY is ignored. */
{
    Tcl_Obj *namePtr = Tcl_NewStringObj(name, -1);
    Tcl_Var var;
    Tcl_Obj *namePtr = Tcl_NewStringObj(name, TCL_AUTO_LENGTH);
    Tcl_Var var = ObjFindNamespaceVar(interp, namePtr, contextNsPtr, flags);

    var = ObjFindNamespaceVar(interp, namePtr, contextNsPtr, flags);
    Tcl_DecrRefCount(namePtr);
    Tcl_BounceRefCount(namePtr);
    return var;
}

static Tcl_Var
ObjFindNamespaceVar(
    Tcl_Interp *interp,		/* The interpreter in which to find the
				 * variable. */

				 * TCL_NAMESPACE_ONLY (look up only in
				 * contextNsPtr, or the current namespace if
				 * contextNsPtr is NULL), and
				 * TCL_LEAVE_ERR_MSG. If both TCL_GLOBAL_ONLY
				 * and TCL_NAMESPACE_ONLY are given,
				 * TCL_GLOBAL_ONLY is ignored. */
{
    Interp *iPtr = (Interp *) interp;
    ResolverScheme *resPtr;
    Namespace *nsPtr[2], *cxtNsPtr;
    const char *simpleName;
    Var *varPtr;
    int search;
    int result;
    Tcl_Var var;
    Tcl_Obj *simpleNamePtr;
    const 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
     * to continue onward, or it may signal an error.
     */

    if ((flags & TCL_GLOBAL_ONLY) != 0) {
	cxtNsPtr = (Namespace *) TclGetGlobalNamespace(interp);
    } else if (contextNsPtr != NULL) {
    } else if (contextNsPtr) {
	cxtNsPtr = (Namespace *) contextNsPtr;
    } else {
	cxtNsPtr = (Namespace *) TclGetCurrentNamespace(interp);
    }

    if (!(flags & TCL_AVOID_RESOLVERS) &&
    if (!(flags & TCL_AVOID_RESOLVERS)) {
	    (cxtNsPtr->varResProc != NULL || iPtr->resolverPtr != NULL)) {
	resPtr = iPtr->resolverPtr;

	result = ApplyResolvers(interp, cxtNsPtr, name, flags, &var);
	if (cxtNsPtr->varResProc) {
	    result = cxtNsPtr->varResProc(interp, name,
		    (Tcl_Namespace *) cxtNsPtr, flags, &var);
	} else {
	    result = TCL_CONTINUE;
	}

	while (result == TCL_CONTINUE && resPtr) {
	    if (resPtr->varResProc) {
		result = resPtr->varResProc(interp, name,
			(Tcl_Namespace *) cxtNsPtr, flags, &var);
	    }
	    resPtr = resPtr->nextPtr;
	}

	if (result == TCL_OK) {
	    return var;
	} else if (result != TCL_CONTINUE) {
	    return NULL;
	if (result != TCL_CONTINUE) {
	    return var;
	}
    }

    /*
     * Find the namespace(s) that contain the variable.
     */

     * Look for the variable in the variable table of its namespace. Be sure
     * to check both possible search paths: from the specified namespace
     * context and from the global namespace.
     */

    varPtr = NULL;
    if (simpleName != name) {
	simpleNamePtr = Tcl_NewStringObj(simpleName, -1);
	simpleNamePtr = Tcl_NewStringObj(simpleName, TCL_AUTO_LENGTH);
    } else {
	simpleNamePtr = namePtr;
    }

    for (search = 0;  (search < 2) && (varPtr == NULL);  search++) {
	if ((nsPtr[search] != NULL) && (simpleName != NULL)) {
    for (search = 0;  (search < 2) && !varPtr;  search++) {
	if (nsPtr[search] && simpleName) {
	    varPtr = VarHashFindVar(&nsPtr[search]->varTable, simpleNamePtr);
	}
    }
    if (simpleName != name) {
	Tcl_DecrRefCount(simpleNamePtr);
    }
    if ((varPtr == NULL) && (flags & TCL_LEAVE_ERR_MSG)) {
    if (!varPtr && (flags & TCL_LEAVE_ERR_MSG)) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"unknown variable \"%s\"", name));
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARIABLE", name, (char *)NULL);
    }
    return (Tcl_Var) varPtr;
}


TclInfoVarsCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Interp *iPtr = (Interp *) interp;
    const char *varName, *pattern, *simplePattern;
    const char *pattern, *simplePattern;
    Tcl_HashSearch search;
    Var *varPtr;
    Namespace *nsPtr;
    Namespace *currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
    Tcl_Obj *listPtr, *elemObjPtr, *varNamePtr;
    int specificNsInPattern = 0;/* Init. to avoid compiler warning. */
    Tcl_Obj *simplePatternPtr = NULL;

	Namespace *dummy1NsPtr, *dummy2NsPtr;

	pattern = TclGetString(objv[1]);
	TclGetNamespaceForQualName(interp, pattern, NULL, /*flags*/ 0,
		&nsPtr, &dummy1NsPtr, &dummy2NsPtr, &simplePattern);

	if (nsPtr != NULL) {	/* We successfully found the pattern's ns. */
	if (nsPtr) {		/* We successfully found the pattern's ns. */
	    specificNsInPattern = (strcmp(simplePattern, pattern) != 0);
	    if (simplePattern == pattern) {
		simplePatternPtr = objv[1];
	    } else {
		simplePatternPtr = Tcl_NewStringObj(simplePattern, -1);
		simplePatternPtr = Tcl_NewStringObj(simplePattern,
			TCL_AUTO_LENGTH);
	    }
	    Tcl_IncrRefCount(simplePatternPtr);
	}
    } else {
	Tcl_WrongNumArgs(interp, 1, objv, "?pattern?");
	return TCL_ERROR;
    }

    /*
     * If the namespace specified in the pattern wasn't found, just return.
     */

    if (nsPtr == NULL) {
    if (!nsPtr) {
	return TCL_OK;
    }

    listPtr = Tcl_NewListObj(0, NULL);

    if (!HasLocalVars(iPtr->varFramePtr) || specificNsInPattern) {
	/*
	 * There is no frame pointer, the frame pointer was pushed only to
	 * activate a namespace, or we are in a procedure call frame but a
	 * specific namespace was specified. Create a list containing only the
	 * variables in the effective namespace's variable table.
	 */

	if (simplePattern && TclMatchIsTrivial(simplePattern)) {
	if (TrivialPattern(simplePattern)) {
	    /*
	     * If we can just do hash lookups, that simplifies things a lot.
	     */

	    varPtr = VarHashFindVar(&nsPtr->varTable, simplePatternPtr);
	    if (varPtr) {
		if (!TclIsVarUndefined(varPtr)
			|| TclIsVarNamespaceVar(varPtr)) {
		    if (specificNsInPattern) {
			TclNewObj(elemObjPtr);
			Tcl_GetVariableFullName(interp, (Tcl_Var) varPtr,
				elemObjPtr);
		    } else {
			elemObjPtr = VarHashGetKey(varPtr);
		    }
		    Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr);
		    Tcl_ListObjAppendElement(NULL, listPtr, elemObjPtr);
		}
	    }
	} else {
	    /*
	     * Have to scan the tables of variables.
	     */

	    varPtr = VarHashFirstVar(&nsPtr->varTable, &search);
	    while (varPtr) {
		if (!TclIsVarUndefined(varPtr)
			|| TclIsVarNamespaceVar(varPtr)) {
		    varNamePtr = VarHashGetKey(varPtr);
		    varName = TclGetString(varNamePtr);
		    if ((simplePattern == NULL)
		    if (PatternMatch(simplePattern, varNamePtr)) {
			    || Tcl_StringMatch(varName, simplePattern)) {
			if (specificNsInPattern) {
			    TclNewObj(elemObjPtr);
			    Tcl_GetVariableFullName(interp, (Tcl_Var) varPtr,
				    elemObjPtr);
			} else {
			    elemObjPtr = varNamePtr;
			}
			Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr);
			Tcl_ListObjAppendElement(NULL, listPtr, elemObjPtr);
		    }
		}
		varPtr = VarHashNextVar(&search);
	    }
	}
    } else if (iPtr->varFramePtr->procPtr != NULL) {
	AppendLocals(interp, listPtr, simplePatternPtr, 1, 0);
    } else if (iPtr->varFramePtr->procPtr) {
	AppendLocals(interp, listPtr, simplePatternPtr, INCLUDE_LINKS);
    }

    if (simplePatternPtr) {
	Tcl_DecrRefCount(simplePatternPtr);
    }
    Tcl_SetObjResult(interp, listPtr);
    return TCL_OK;

int
TclInfoGlobalsCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    const char *varName, *pattern;
    const char *pattern;
    Namespace *globalNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp);
    Tcl_HashSearch search;
    Var *varPtr;
    Tcl_Obj *listPtr, *varNamePtr, *patternPtr;

    if (objc == 1) {
	pattern = NULL;

    /*
     * Scan through the global :: namespace's variable table and create a list
     * of all global variables that match the pattern.
     */

    listPtr = Tcl_NewListObj(0, NULL);
    if (pattern != NULL && TclMatchIsTrivial(pattern)) {
    if (TrivialPattern(pattern)) {
	if (pattern == TclGetString(objv[1])) {
	    patternPtr = objv[1];
	} else {
	    patternPtr = Tcl_NewStringObj(pattern, -1);
	    patternPtr = Tcl_NewStringObj(pattern, TCL_AUTO_LENGTH);
	}
	Tcl_IncrRefCount(patternPtr);

	varPtr = VarHashFindVar(&globalNsPtr->varTable, patternPtr);
	if (varPtr) {
	    if (!TclIsVarUndefined(varPtr)) {
		Tcl_ListObjAppendElement(interp, listPtr,
	if (varPtr && !TclIsVarUndefined(varPtr)) {
	    /* Use the key, not the argument, to limit long-term allocations */
	    Tcl_ListObjAppendElement(NULL, listPtr, VarHashGetKey(varPtr));
			VarHashGetKey(varPtr));
	    }
	}
	}
	Tcl_DecrRefCount(patternPtr);
	Tcl_BounceRefCount(patternPtr);
    } else {
	for (varPtr = VarHashFirstVar(&globalNsPtr->varTable, &search);
		varPtr != NULL;
		varPtr = VarHashNextVar(&search)) {
	    if (TclIsVarUndefined(varPtr)) {
		continue;
	    }
	    varNamePtr = VarHashGetKey(varPtr);
	    varName = TclGetString(varNamePtr);
	    if (PatternMatch(pattern, varNamePtr)) {
	    if ((pattern == NULL) || Tcl_StringMatch(varName, pattern)) {
		Tcl_ListObjAppendElement(interp, listPtr, varNamePtr);
		Tcl_ListObjAppendElement(NULL, listPtr, varNamePtr);
	    }
	}
    }
    Tcl_SetObjResult(interp, listPtr);
    return TCL_OK;
}


    /*
     * Return a list containing names of first the compiled locals (i.e. the
     * ones stored in the call frame), then the variables in the local hash
     * table (if one exists).
     */

    listPtr = Tcl_NewListObj(0, NULL);
    AppendLocals(interp, listPtr, patternPtr, 0, 0);
    AppendLocals(interp, listPtr, patternPtr, 0);
    Tcl_SetObjResult(interp, listPtr);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *

TclInfoConstsCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Interp *iPtr = (Interp *) interp;
    const char *varName, *pattern, *simplePattern;
    const char *pattern, *simplePattern;
    Tcl_HashSearch search;
    Var *varPtr;
    Namespace *nsPtr;
    Namespace *globalNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp);
    Namespace *currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
    Tcl_Obj *listPtr, *elemObjPtr, *varNamePtr;
    int specificNsInPattern = 0;/* Init. to avoid compiler warning. */

	Namespace *dummy1NsPtr, *dummy2NsPtr;

	pattern = TclGetString(objv[1]);
	TclGetNamespaceForQualName(interp, pattern, NULL, /*flags*/ 0,
		&nsPtr, &dummy1NsPtr, &dummy2NsPtr, &simplePattern);

	if (nsPtr != NULL) {	/* We successfully found the pattern's ns. */
	if (nsPtr) {		/* We successfully found the pattern's ns. */
	    specificNsInPattern = (strcmp(simplePattern, pattern) != 0);
	    if (simplePattern == pattern) {
		simplePatternPtr = objv[1];
	    } else {
		simplePatternPtr = Tcl_NewStringObj(simplePattern, -1);
		simplePatternPtr = Tcl_NewStringObj(simplePattern,
			TCL_AUTO_LENGTH);
	    }
	    Tcl_IncrRefCount(simplePatternPtr);
	}
    } else {
	Tcl_WrongNumArgs(interp, 1, objv, "?pattern?");
	return TCL_ERROR;
    }

    /*
     * If the namespace specified in the pattern wasn't found, just return.
     */

    if (nsPtr == NULL) {
    if (!nsPtr) {
	return TCL_OK;
    }

    listPtr = Tcl_NewListObj(0, NULL);

    if (!HasLocalVars(iPtr->varFramePtr) || specificNsInPattern) {
	/*
	 * There is no frame pointer, the frame pointer was pushed only to
	 * activate a namespace, or we are in a procedure call frame but a
	 * specific namespace was specified. Create a list containing only the
	 * variables in the effective namespace's variable table.
	 */

	if (simplePattern && TclMatchIsTrivial(simplePattern)) {
	if (TrivialPattern(simplePattern)) {
	    /*
	     * If we can just do hash lookups, that simplifies things a lot.
	     */

	    varPtr = VarHashFindVar(&nsPtr->varTable, simplePatternPtr);
	    if (varPtr && TclIsVarConstant(varPtr)) {
		if (!TclIsVarUndefined(varPtr)
			|| TclIsVarNamespaceVar(varPtr)) {
		    if (specificNsInPattern) {
			TclNewObj(elemObjPtr);
			Tcl_GetVariableFullName(interp, (Tcl_Var) varPtr,
				elemObjPtr);
		    } else {
			elemObjPtr = VarHashGetKey(varPtr);
		    }
		    Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr);
		    Tcl_ListObjAppendElement(NULL, listPtr, elemObjPtr);
		}
	    } else if ((nsPtr != globalNsPtr) && !specificNsInPattern) {
		varPtr = VarHashFindVar(&globalNsPtr->varTable,
			simplePatternPtr);
		if (varPtr && TclIsVarConstant(varPtr)) {
		    if (!TclIsVarUndefined(varPtr)
			    || TclIsVarNamespaceVar(varPtr)) {
			Tcl_ListObjAppendElement(interp, listPtr,
			Tcl_ListObjAppendElement(NULL, listPtr,
				VarHashGetKey(varPtr));
		    }
		}
	    }
	} else {
	    /*
	     * Have to scan the tables of variables.
	     */

	    varPtr = VarHashFirstVar(&nsPtr->varTable, &search);
	    while (varPtr) {
		if (TclIsVarConstant(varPtr) && (!TclIsVarUndefined(varPtr)
			|| TclIsVarNamespaceVar(varPtr))) {
		    varNamePtr = VarHashGetKey(varPtr);
		    varName = TclGetString(varNamePtr);
		    if ((simplePattern == NULL)
		    if (PatternMatch(simplePattern, varNamePtr)) {
			    || Tcl_StringMatch(varName, simplePattern)) {
			if (specificNsInPattern) {
			    TclNewObj(elemObjPtr);
			    Tcl_GetVariableFullName(interp, (Tcl_Var) varPtr,
				    elemObjPtr);
			} else {
			    elemObjPtr = varNamePtr;
			}
			Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr);
			Tcl_ListObjAppendElement(NULL, listPtr, elemObjPtr);
		    }
		}
		varPtr = VarHashNextVar(&search);
	    }

	    /*
	     * If the effective namespace isn't the global :: namespace, and a
	     * specific namespace wasn't requested in the pattern (i.e., the
	     * pattern only specifies variable names), then add in all global
	     * :: variables that match the simple pattern. Of course, add in
	     * only those variables that aren't hidden by a variable in the
	     * effective namespace.
	     */

	    if ((nsPtr != globalNsPtr) && !specificNsInPattern) {
		varPtr = VarHashFirstVar(&globalNsPtr->varTable, &search);
		while (varPtr) {
		    if (TclIsVarConstant(varPtr) && (!TclIsVarUndefined(varPtr)
			    || TclIsVarNamespaceVar(varPtr))) {
			varNamePtr = VarHashGetKey(varPtr);
			varName = TclGetString(varNamePtr);
			if ((simplePattern == NULL)
			if (PatternMatch(simplePattern, varNamePtr) &&
				|| Tcl_StringMatch(varName, simplePattern)) {
			    if (VarHashFindVar(&nsPtr->varTable,
				!VarHashFindVar(&nsPtr->varTable, varNamePtr)) {
				    varNamePtr) == NULL) {
				Tcl_ListObjAppendElement(interp, listPtr,
			    Tcl_ListObjAppendElement(NULL, listPtr, varNamePtr);
					varNamePtr);
			    }
			}
		    }
		    varPtr = VarHashNextVar(&search);
		}
	    }
	}
    } else if (iPtr->varFramePtr->procPtr != NULL) {
	AppendLocals(interp, listPtr, simplePatternPtr, 1, 1);
    } else if (iPtr->varFramePtr->procPtr) {
	AppendLocals(interp, listPtr, simplePatternPtr,
		INCLUDE_LINKS | CONSTANTS_ONLY);
    }

    if (simplePatternPtr) {
	Tcl_DecrRefCount(simplePatternPtr);
    }
    Tcl_SetObjResult(interp, listPtr);
    return TCL_OK;

 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
static inline int
ContextObjectContainsConstant(
    Tcl_ObjectContext context,
    Tcl_Obj *varNamePtr)
{
    /*
     * Helper for AppendLocals to check if an object contains a variable
     * that is a constant. It's too complicated without factoring this

}

static void
AppendLocals(
    Tcl_Interp *interp,		/* Current interpreter. */
    Tcl_Obj *listPtr,		/* List object to append names to. */
    Tcl_Obj *patternPtr,	/* Pattern to match against. */
    int includeLinks,		/* 1 if upvars should be included, else 0. */
    int flags)			/* What types of locals. */
    int justConstants)		/* 1 if just constants should be included. */
{
    Interp *iPtr = (Interp *) interp;
    Var *varPtr;
    Tcl_Size i, localVarCt;
    int added;
    Tcl_Obj *objNamePtr;
    const char *varName;
    TclVarHashTable *localVarTablePtr;
    Tcl_HashSearch search;
    Tcl_HashTable addedTable;
    const char *pattern = patternPtr? TclGetString(patternPtr) : NULL;
    const char *pattern = AsStr(patternPtr);
    const int includeLinks = flags & INCLUDE_LINKS;
    const int justConstants = flags & CONSTANTS_ONLY;

    localVarCt = iPtr->varFramePtr->numCompiledLocals;
    varPtr = iPtr->varFramePtr->compiledLocals;
    localVarTablePtr = iPtr->varFramePtr->varTablePtr;
    if (includeLinks) {
	Tcl_InitObjHashTable(&addedTable);
    }

    if (localVarCt > 0) {
	Tcl_Obj **varNamePtr = &iPtr->varFramePtr->localCachePtr->varName0;

	for (i = 0; i < localVarCt; i++, varNamePtr++) {
	    /*
	     * Skip nameless (temporary) variables and undefined variables.
	     */

	    if (*varNamePtr && !TclIsVarUndefined(varPtr)
		    && (includeLinks || !TclIsVarLink(varPtr))) {
		varName = TclGetString(*varNamePtr);
		if (PatternMatch(pattern, *varNamePtr)) {
		if ((pattern == NULL) || Tcl_StringMatch(varName, pattern)) {
		    if (!justConstants || TclIsVarConstant(varPtr)) {
			Tcl_ListObjAppendElement(interp, listPtr, *varNamePtr);
			Tcl_ListObjAppendElement(NULL, listPtr, *varNamePtr);
		    }
		    if (includeLinks) {
			Tcl_CreateHashEntry(&addedTable, *varNamePtr, &added);
		    }
		}
	    }
	    varPtr++;
	}
    }

    /*
     * Do nothing if no local variables.
     */

    if (localVarTablePtr == NULL) {
    if (!localVarTablePtr) {
	goto objectVars;
    }

    /*
     * Check for the simple and fast case.
     */

    if ((pattern != NULL) && TclMatchIsTrivial(pattern)) {
    if (TrivialPattern(pattern)) {
	varPtr = VarHashFindVar(localVarTablePtr, patternPtr);
	if (varPtr != NULL) {
	    if (!TclIsVarUndefined(varPtr)
		    && (includeLinks || !TclIsVarLink(varPtr))) {
		if ((!justConstants || TclIsVarConstant(varPtr))) {
		    Tcl_ListObjAppendElement(interp, listPtr,
	if (varPtr && !TclIsVarUndefined(varPtr)
		&& (includeLinks || !TclIsVarLink(varPtr))) {
	    if ((!justConstants || TclIsVarConstant(varPtr))) {
		Tcl_ListObjAppendElement(NULL, listPtr, VarHashGetKey(varPtr));
			    VarHashGetKey(varPtr));
		}
		if (includeLinks) {
		    Tcl_CreateHashEntry(&addedTable, VarHashGetKey(varPtr),
	    }
	    if (includeLinks) {
		Tcl_CreateHashEntry(&addedTable, VarHashGetKey(varPtr), &added);
			    &added);
		}
	    }
	}
	goto objectVars;
    }

    /*
     * Scan over and process all local variables.
     */

    for (varPtr = VarHashFirstVar(localVarTablePtr, &search);
	    varPtr != NULL;
	    varPtr = VarHashNextVar(&search)) {
	if (!TclIsVarUndefined(varPtr)
		&& (includeLinks || !TclIsVarLink(varPtr))) {
	    objNamePtr = VarHashGetKey(varPtr);
	    varName = TclGetString(objNamePtr);
	    if (PatternMatch(pattern, objNamePtr)) {
	    if ((pattern == NULL) || Tcl_StringMatch(varName, pattern)) {
		if (!justConstants || TclIsVarConstant(varPtr)) {
		    Tcl_ListObjAppendElement(interp, listPtr, objNamePtr);
		    Tcl_ListObjAppendElement(NULL, listPtr, objNamePtr);
		}
		if (includeLinks) {
		    Tcl_CreateHashEntry(&addedTable, objNamePtr, &added);
		}
	    }
	}
    }

	    FOREACH(objNamePtr, oPtr->variables) {
		Tcl_CreateHashEntry(&addedTable, objNamePtr, &added);
		if (justConstants && !ContextObjectContainsConstant(context,
			objNamePtr)) {
		    continue;
		}
		if (added && (!pattern ||
		if (added && PatternMatch(pattern, objNamePtr)) {
			Tcl_StringMatch(TclGetString(objNamePtr), pattern))) {
		    Tcl_ListObjAppendElement(interp, listPtr, objNamePtr);
		    Tcl_ListObjAppendElement(NULL, listPtr, objNamePtr);
		}
	    }
	    FOREACH_STRUCT(privatePtr, oPtr->privateVariables) {
		Tcl_CreateHashEntry(&addedTable, privatePtr->variableObj,
			&added);
		if (justConstants && !ContextObjectContainsConstant(context,
			privatePtr->fullNameObj)) {
		    continue;
		}
		if (added && (!pattern ||
		if (added && PatternMatch(pattern, privatePtr->variableObj)) {
			Tcl_StringMatch(TclGetString(privatePtr->variableObj),
				pattern))) {
		    Tcl_ListObjAppendElement(interp, listPtr,
		    Tcl_ListObjAppendElement(NULL, listPtr,
			    privatePtr->variableObj);
		}
	    }
	} else {
	    Class *clsPtr = mPtr->declaringClassPtr;

	    FOREACH(objNamePtr, clsPtr->variables) {
		Tcl_CreateHashEntry(&addedTable, objNamePtr, &added);
		if (justConstants && !ContextObjectContainsConstant(context,
			objNamePtr)) {
		    continue;
		}
		if (added && (!pattern ||
		if (added && PatternMatch(pattern, objNamePtr)) {
			Tcl_StringMatch(TclGetString(objNamePtr), pattern))) {
		    Tcl_ListObjAppendElement(interp, listPtr, objNamePtr);
		    Tcl_ListObjAppendElement(NULL, listPtr, objNamePtr);
		}
	    }
	    FOREACH_STRUCT(privatePtr, clsPtr->privateVariables) {
		Tcl_CreateHashEntry(&addedTable, privatePtr->variableObj,
			&added);
		if (justConstants && !ContextObjectContainsConstant(context,
			privatePtr->fullNameObj)) {
		    continue;
		}
		if (added && (!pattern ||
		if (added && PatternMatch(pattern, privatePtr->variableObj)) {
			Tcl_StringMatch(TclGetString(privatePtr->variableObj),
				pattern))) {
		    Tcl_ListObjAppendElement(interp, listPtr,
		    Tcl_ListObjAppendElement(NULL, listPtr,
			    privatePtr->variableObj);
		}
	    }
	}
    }
    Tcl_DeleteHashTable(&addedTable);
}

}

static Tcl_HashEntry *
AllocVarEntry(
    TCL_UNUSED(Tcl_HashTable *),
    void *keyPtr)		/* Key to store in the hash table entry. */
{
    Tcl_Obj *objPtr = (Tcl_Obj *)keyPtr;
    Tcl_Obj *objPtr = (Tcl_Obj *) keyPtr;
    Tcl_HashEntry *hPtr;
    Var *varPtr;

    varPtr = (Var *)Tcl_Alloc(sizeof(VarInHash));
    varPtr = (Var *) Tcl_Alloc(sizeof(VarInHash));
    varPtr->flags = VAR_IN_HASHTABLE;
    varPtr->value.objPtr = NULL;
    VarHashRefCount(varPtr) = 1;

    hPtr = &(((VarInHash *) varPtr)->entry);
    hPtr = &((VarInHash *) varPtr)->entry;
    Tcl_SetHashValue(hPtr, varPtr);
    hPtr->key.objPtr = objPtr;
    Tcl_IncrRefCount(objPtr);

    return hPtr;
}

static void
FreeVarEntry(
    Tcl_HashEntry *hPtr)
{
    Var *varPtr = VarHashGetValue(hPtr);
    Tcl_Obj *objPtr = hPtr->key.objPtr;

    if (TclIsVarUndefined(varPtr) && !TclIsVarTraced(varPtr)
    if (TclIsVarUndefined(varPtr)
	    && !TclIsVarTraced(varPtr)
	    && (VarHashRefCount(varPtr) == 1)) {
	Tcl_Free(varPtr);
    } else {
	VarHashInvalidateEntry(varPtr);
	TclSetVarUndefined(varPtr);
	VarHashRefCount(varPtr)--;
    }
    Tcl_DecrRefCount(objPtr);
}

static int
CompareVarKeys(
    void *keyPtr,		/* New key to compare. */
    Tcl_HashEntry *hPtr)	/* Existing key to compare. */
{
    Tcl_Obj *objPtr1 = (Tcl_Obj *)keyPtr;
    Tcl_Obj *objPtr1 = (Tcl_Obj *) keyPtr;
    Tcl_Obj *objPtr2 = hPtr->key.objPtr;
    const char *p1, *p2;
    size_t l1, l2;

    /*
     * If the object pointers are the same then they match.
     * OPT: this comparison was moved to the caller

    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    static const char *const options[] = {
	"get", "set", "exists", "unset", NULL
    };
    enum arrayDefaultOptionsEnum { OPT_GET, OPT_SET, OPT_EXISTS, OPT_UNSET } option;
    enum arrayDefaultOptionsEnum {
	OPT_GET, OPT_SET, OPT_EXISTS, OPT_UNSET
    } option;
    Tcl_Obj *arrayNameObj, *defaultValueObj;
    Var *varPtr, *arrayPtr;
    int isArray;

    /*
     * Parse arguments.
     */

    if (objc != 3 && objc != 4) {
	Tcl_WrongNumArgs(interp, 1, objv, "option arrayName ?value?");
	return TCL_ERROR;
    }
    if (Tcl_GetIndexFromObj(interp, objv[1], options, "option",
	    0, &option) != TCL_OK) {
	return TCL_ERROR;
    }

    arrayNameObj = objv[2];

    if (TCL_ERROR == LocateArray(interp, arrayNameObj, &varPtr, &isArray)) {
    if (LocateArray(interp, arrayNameObj, &varPtr, &isArray) != TCL_OK) {
	return TCL_ERROR;
    }

    switch (option) {
    case OPT_GET:
	if (objc != 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "arrayName");
	    return TCL_ERROR;
	}
	if (!varPtr || TclIsVarUndefined(varPtr) || !isArray) {
	    return NotArrayError(interp, arrayNameObj);
	}

	defaultValueObj = TclGetArrayDefault(varPtr);
	if (!defaultValueObj) {
	    /* Array default must exist. */
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "array has no default value", -1));
	    Tcl_SetErrorCode(interp, "TCL", "READ", "ARRAY", "DEFAULT", (char *)NULL);
		    "array has no default value", TCL_AUTO_LENGTH));
	    Tcl_SetErrorCode(interp, "TCL", "READ", "ARRAY", "DEFAULT",
		    (char *)NULL);
	    return TCL_ERROR;
	}
	Tcl_SetObjResult(interp, defaultValueObj);
	return TCL_OK;

    case OPT_SET:
	if (objc != 4) {
	    Tcl_WrongNumArgs(interp, 2, objv, "arrayName value");
	    return TCL_ERROR;
	}

	/*
	 * Attempt to create array if needed.
	 */
	varPtr = TclObjLookupVarEx(interp, arrayNameObj, NULL,
		/*flags*/ TCL_LEAVE_ERR_MSG, /*msg*/ "array default set",
		/*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr);
	if (varPtr == NULL) {
	if (!varPtr) {
	    return TCL_ERROR;
	}
	if (arrayPtr) {
	    /*
	     * Not a valid array name.
	     */

	    CleanupVar(varPtr, arrayPtr);
	    TclObjVarErrMsg(interp, arrayNameObj, NULL, "array default set",
		    NEEDARRAY, -1);
		    NEEDARRAY, NOT_IN_LVT);
	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARNAME",
		    TclGetString(arrayNameObj), (char *)NULL);
	    return TCL_ERROR;
	}
	if (!TclIsVarArray(varPtr) && !TclIsVarUndefined(varPtr)) {
	    /*
	     * Not an array.
	     */

	    TclObjVarErrMsg(interp, arrayNameObj, NULL, "array default set",
		    NEEDARRAY, -1);
		    NEEDARRAY, NOT_IN_LVT);
	    Tcl_SetErrorCode(interp, "TCL", "WRITE", "ARRAY", (char *)NULL);
	    return TCL_ERROR;
	}

	if (!TclIsVarArray(varPtr)) {
	    TclInitArrayVar(varPtr);
	}

	if (varPtr && !TclIsVarUndefined(varPtr)) {
	    if (!isArray) {
		return NotArrayError(interp, arrayNameObj);
	    }
	    SetArrayDefault(varPtr, NULL);
	}
	return TCL_OK;
    }

    /* Unreached */
    return TCL_ERROR;

    default:
	/* Unreached */
	return TCL_ERROR;
    }
}

/*
 * Initialize array variable.
 */

void
TclInitArrayVar(
    Var *arrayPtr)
{
    ArrayVarHashTable *tablePtr = (ArrayVarHashTable *)Tcl_Alloc(sizeof(ArrayVarHashTable));
    ArrayVarHashTable *tablePtr = (ArrayVarHashTable *)
	    Tcl_Alloc(sizeof(ArrayVarHashTable));

    /*
     * Mark the variable as an array.
     */

    TclSetVarArray(arrayPtr);

    Tcl_Obj *defaultObj)
{
    ArrayVarHashTable *tablePtr = (ArrayVarHashTable *)
	    arrayPtr->value.tablePtr;

    /*
     * Increment/decrement refcount twice to ensure that the object is shared,
     * so that it doesn't get modified accidentally by the folling code:
     * so that it doesn't get modified accidentally by the following code:
     *
     *      array default set v 1
     *      lappend v(a) 2; # returns a new object {1 2}
     *      set v(b); # returns the original default object "1"
     */

    if (tablePtr->defaultObj) {