/* 

  * tclVar.c --

  *

  *	This file contains routines that implement Tcl variables

  *	(both scalars and arrays).

  *

  *	The implementation of arrays is modelled after an initial

  *	implementation by Mark Diekhans and Karl Lehenbauer.

  *

  * Copyright (c) 1987-1994 The Regents of the University of California.

  * Copyright (c) 1994-1997 Sun Microsystems, Inc.

  * Copyright (c) 1998-1999 by Scriptics Corporation.

  * Copyright (c) 2001 by Kevin B. Kenny.  All rights reserved.

  * Portions Copyright (c) 2007-2008 Nokia Corporation and/or its subsidiaries. All rights reserved.  

  *

  * See the file "license.terms" for information on usage and redistribution

  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.

  *

  * RCS: @(#) $Id: tclVar.c,v 1.69.2.14 2007/05/10 18:23:58 dgp Exp $

  */

 #include "tclInt.h"

 #include "tclPort.h"

 /*

  * The strings below are used to indicate what went wrong when a

  * variable access is denied.

  */

 static CONST char *noSuchVar =		"no such variable";

 static CONST char *isArray =		"variable is array";

 static CONST char *needArray =		"variable isn't array";

 static CONST char *noSuchElement =	"no such element in array";

 static CONST char *danglingElement =

 				"upvar refers to element in deleted array";

 static CONST char *danglingVar =	

 				"upvar refers to variable in deleted namespace";

 static CONST char *badNamespace =	"parent namespace doesn't exist";

 static CONST char *missingName =	"missing variable name";

 static CONST char *isArrayElement =	"name refers to an element in an array";

 /*

  * Forward references to procedures defined later in this file:

  */

 static int		CallVarTraces _ANSI_ARGS_((Interp *iPtr, Var *arrayPtr,

 			    Var *varPtr, CONST char *part1, CONST char *part2,

 			    int flags, CONST int leaveErrMsg));

 static void		CleanupVar _ANSI_ARGS_((Var *varPtr,

 			    Var *arrayPtr));

 static void		DeleteSearches _ANSI_ARGS_((Var *arrayVarPtr));

 static void		DeleteArray _ANSI_ARGS_((Interp *iPtr,

 			    CONST char *arrayName, Var *varPtr, int flags));

 static void		DisposeTraceResult _ANSI_ARGS_((int flags,

 			    char *result));

 static int              ObjMakeUpvar _ANSI_ARGS_((Tcl_Interp *interp, 

                             CallFrame *framePtr, Tcl_Obj *otherP1Ptr, 

                             CONST char *otherP2, CONST int otherFlags,

 		            CONST char *myName, int myFlags, int index));

 static Var *		NewVar _ANSI_ARGS_((void));

 static ArraySearch *	ParseSearchId _ANSI_ARGS_((Tcl_Interp *interp,

 			    CONST Var *varPtr, CONST char *varName,

 			    Tcl_Obj *handleObj));

 static void		VarErrMsg _ANSI_ARGS_((Tcl_Interp *interp,

 			    CONST char *part1, CONST char *part2,

 			    CONST char *operation, CONST char *reason));

 static int		SetArraySearchObj _ANSI_ARGS_((Tcl_Interp *interp,

 			    Tcl_Obj *objPtr));

 static void		UnsetVarStruct _ANSI_ARGS_((Var *varPtr, Var *arrayPtr,

 			    Interp *iPtr, CONST char *part1, CONST char *part2,

 			    int flags));

 /*

  * Functions defined in this file that may be exported in the future

  * for use by the bytecode compiler and engine or to the public interface.

  */

 Var *		TclLookupSimpleVar _ANSI_ARGS_((Tcl_Interp *interp,

 		    CONST char *varName, int flags, CONST int create,

 		    CONST char **errMsgPtr, int *indexPtr));

 int		TclObjUnsetVar2 _ANSI_ARGS_((Tcl_Interp *interp,

 		    Tcl_Obj *part1Ptr, CONST char *part2, int flags));

 static Tcl_FreeInternalRepProc FreeLocalVarName;

 static Tcl_DupInternalRepProc DupLocalVarName;

 static Tcl_UpdateStringProc UpdateLocalVarName;

 static Tcl_FreeInternalRepProc FreeNsVarName;

 static Tcl_DupInternalRepProc DupNsVarName;

 static Tcl_FreeInternalRepProc FreeParsedVarName;

 static Tcl_DupInternalRepProc DupParsedVarName;

 static Tcl_UpdateStringProc UpdateParsedVarName;

 /*

  * Types of Tcl_Objs used to cache variable lookups.

  *

  * 

  * localVarName - INTERNALREP DEFINITION:

  *   twoPtrValue.ptr1 = pointer to the corresponding Proc 

  *   twoPtrValue.ptr2 = index into locals table

  *

  * nsVarName - INTERNALREP DEFINITION:

  *   twoPtrValue.ptr1: pointer to the namespace containing the 

  *                     reference

  *   twoPtrValue.ptr2: pointer to the corresponding Var 

  *

  * 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 Tcl_ObjType tclLocalVarNameType = {

     "localVarName",

     FreeLocalVarName, DupLocalVarName, UpdateLocalVarName, NULL

 };

 static Tcl_ObjType tclNsVarNameType = {

     "namespaceVarName",

     FreeNsVarName, DupNsVarName, NULL, NULL

 };

 static Tcl_ObjType tclParsedVarNameType = {

     "parsedVarName",

     FreeParsedVarName, DupParsedVarName, UpdateParsedVarName, NULL

 };

 /*

  * Type of Tcl_Objs used to speed up array searches.

  *

  * INTERNALREP DEFINITION:

  *   twoPtrValue.ptr1 = searchIdNumber as offset from (char*)NULL

  *   twoPtrValue.ptr2 = variableNameStartInString as offset from (char*)NULL

  *

  * Note that the value stored in ptr2 is the offset into the string of

  * the start of the variable name and not the address of the variable

  * name itself, as this can be safely copied.

  */

 Tcl_ObjType tclArraySearchType = {

     "array search",

     NULL, NULL, NULL, SetArraySearchObj

 };

 /*

  *----------------------------------------------------------------------

  *

  * TclLookupVar --

  *

  *	This procedure is used to locate a variable given its name(s). It

  *      has been mostly superseded by TclObjLookupVar, it is now only used 

  *      by the string-based interfaces. It is kept in tcl8.4 mainly because 

  *      it is in the internal stubs table, so that some extension may be 

  *      calling it. 

  *

  * Results:

  *	The return value is a pointer to the variable structure indicated by

  *	part1 and part2, or NULL if the variable couldn't be found. If the

  *	variable is found, *arrayPtrPtr is filled in with the address of the

  *	variable structure for the array that contains the variable (or NULL

  *	if the variable is a scalar). If the variable can't be found and

  *	either createPart1 or createPart2 are 1, a new as-yet-undefined

  *	(VAR_UNDEFINED) variable structure is created, entered into a hash

  *	table, and returned.

  *

  *	If the variable isn't found and creation wasn't specified, or some

  *	other error occurs, NULL is returned and an error message is left in

  *	the interp's result if TCL_LEAVE_ERR_MSG is set in flags. 

  *

  *	Note: it's possible for the variable returned to be VAR_UNDEFINED

  *	even if createPart1 or createPart2 are 1 (these only cause the hash

  *	table entry or array to be created). For example, the variable might

  *	be a global that has been unset but is still referenced by a

  *	procedure, or a variable that has been unset but it only being kept

  *	in existence (if VAR_UNDEFINED) by a trace.

  *

  * Side effects:

  *	New hashtable entries may be created if createPart1 or createPart2

  *	are 1.

  *

  *----------------------------------------------------------------------

  */

 Var *

 TclLookupVar(interp, part1, part2, flags, msg, createPart1, createPart2,

         arrayPtrPtr)

     Tcl_Interp *interp;		/* Interpreter to use for lookup. */

     CONST char *part1;	        /* If part2 isn't NULL, this is the name of

 				 * an array. Otherwise, this

 				 * is a full variable name that could

 				 * include a parenthesized array element. */

     CONST char *part2;		/* Name of element within array, or NULL. */

     int flags;			/* Only TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY,

 				 * and TCL_LEAVE_ERR_MSG bits matter. */

     CONST char *msg;			/* Verb to use in error messages, e.g.

 				 * "read" or "set". Only needed if

 				 * TCL_LEAVE_ERR_MSG is set in flags. */

     int createPart1;		/* If 1, create hash table entry for part 1

 				 * of name, if it doesn't already exist. If

 				 * 0, return error if it doesn't exist. */

     int createPart2;		/* If 1, create hash table entry for part 2

 				 * of name, if it doesn't already exist. If

 				 * 0, return error if it doesn't exist. */

     Var **arrayPtrPtr;		/* If the name refers to an element of an

 				 * array, *arrayPtrPtr gets filled in with

 				 * address of array variable. Otherwise

 				 * this is set to NULL. */

 {

     Var *varPtr;

     CONST char *elName;		/* Name of array element or NULL; may be

 				 * same as part2, or may be openParen+1. */

     int openParen, closeParen;

                                 /* If this procedure parses a name into

 				 * array and index, these are the offsets to 

 				 * the parens around the index.  Otherwise 

 				 * they are -1. */

     register CONST char *p;

     CONST char *errMsg = NULL;

     int index;

 #define VAR_NAME_BUF_SIZE 26

     char buffer[VAR_NAME_BUF_SIZE];

     char *newVarName = buffer;

     varPtr = NULL;

     *arrayPtrPtr = NULL;

     openParen = closeParen = -1;

     /*

      * Parse part1 into array name and index.

      * Always check if part1 is an array element name and allow it only if

      * part2 is not given.   

      * (if one does not care about creating array elements that can't be used

      *  from tcl, and prefer slightly better performance, one can put

      *  the following in an   if (part2 == NULL) { ... } block and remove

      *  the part2's test and error reporting  or move that code in array set)

      */

     elName = part2;

     for (p = part1; *p ; p++) {

 	if (*p == '(') {

 	    openParen = p - part1;

 	    do {

 		p++;

 	    } while (*p != '\0');

 	    p--;

 	    if (*p == ')') {

 		if (part2 != NULL) {

 		    if (flags & TCL_LEAVE_ERR_MSG) {

 			VarErrMsg(interp, part1, part2, msg, needArray);

 		    }

 		    return NULL;

 		}

 		closeParen = p - part1;

 	    } else {

 		openParen = -1;

 	    }

 	    break;

 	}

     }

     if (openParen != -1) {

 	if (closeParen >= VAR_NAME_BUF_SIZE) {

 	    newVarName = ckalloc((unsigned int) (closeParen+1));

 	}

 	memcpy(newVarName, part1, (unsigned int) closeParen);

 	newVarName[openParen] = '\0';

 	newVarName[closeParen] = '\0';

 	part1 = newVarName;

 	elName = newVarName + openParen + 1;

     }

     varPtr = TclLookupSimpleVar(interp, part1, flags, 

             createPart1, &errMsg, &index);

     if (varPtr == NULL) {

 	if ((errMsg != NULL) && (flags & TCL_LEAVE_ERR_MSG)) {

 	    VarErrMsg(interp, part1, elName, msg, errMsg);

 	}

     } else {

 	while (TclIsVarLink(varPtr)) {

 	    varPtr = varPtr->value.linkPtr;

 	}

 	if (elName != NULL) {

 	    *arrayPtrPtr = varPtr;

 	    varPtr = TclLookupArrayElement(interp, part1, elName, flags, 

 		    msg, createPart1, createPart2, varPtr);

 	}

     }

     if (newVarName != buffer) {

 	ckfree(newVarName);

     }

     return varPtr;

 #undef VAR_NAME_BUF_SIZE

 }

 /*

  *----------------------------------------------------------------------

  *

  * TclObjLookupVar --

  *

  *	This procedure is used by virtually all of the variable code to

  *	locate a variable given its name(s). The parsing into array/element

  *      components and (if possible) the lookup results are cached in 

  *      part1Ptr, which is converted to one of the varNameTypes.

  *

  * Results:

  *	The return value is a pointer to the variable structure indicated by

  *	part1Ptr and part2, or NULL if the variable couldn't be found. If 

  *      the variable is found, *arrayPtrPtr is filled with the address of the

  *	variable structure for the array that contains the variable (or NULL

  *	if the variable is a scalar). If the variable can't be found and

  *	either createPart1 or createPart2 are 1, a new as-yet-undefined

  *	(VAR_UNDEFINED) variable structure is created, entered into a hash

  *	table, and returned.

  *

  *	If the variable isn't found and creation wasn't specified, or some

  *	other error occurs, NULL is returned and an error message is left in

  *	the interp's result if TCL_LEAVE_ERR_MSG is set in flags. 

  *

  *	Note: it's possible for the variable returned to be VAR_UNDEFINED

  *	even if createPart1 or createPart2 are 1 (these only cause the hash

  *	table entry or array to be created). For example, the variable might

  *	be a global that has been unset but is still referenced by a

  *	procedure, or a variable that has been unset but it only being kept

  *	in existence (if VAR_UNDEFINED) by a trace.

  *

  * Side effects:

  *	New hashtable entries may be created if createPart1 or createPart2

  *	are 1.

  *      The object part1Ptr is converted to one of tclLocalVarNameType, 

  *      tclNsVarNameType or tclParsedVarNameType and caches as much of the

  *      lookup as it can.

  *

  *----------------------------------------------------------------------

  */

 Var *

 TclObjLookupVar(interp, part1Ptr, part2, flags, msg, createPart1, createPart2,

         arrayPtrPtr)

     Tcl_Interp *interp;		/* Interpreter to use for lookup. */

     register Tcl_Obj *part1Ptr;	/* If part2 isn't NULL, this is the name 

 				 * of an array. Otherwise, this is a full 

 				 * variable name that could include a parenthesized 

 				 * array element. */

     CONST char *part2;		/* Name of element within array, or NULL. */

     int flags;		        /* Only TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY,

 				 * and TCL_LEAVE_ERR_MSG bits matter. */

     CONST char *msg;		/* Verb to use in error messages, e.g.

 				 * "read" or "set". Only needed if

 				 * TCL_LEAVE_ERR_MSG is set in flags. */

     CONST int createPart1;	/* If 1, create hash table entry for part 1

 				 * of name, if it doesn't already exist. If

 				 * 0, return error if it doesn't exist. */

     CONST int createPart2;	/* If 1, create hash table entry for part 2

 				 * of name, if it doesn't already exist. If

 				 * 0, return error if it doesn't exist. */

     Var **arrayPtrPtr;		/* If the name refers to an element of an

 				 * array, *arrayPtrPtr gets filled in with

 				 * address of array variable. Otherwise

 				 * this is set to NULL. */

 {

     Interp *iPtr = (Interp *) interp;

     register Var *varPtr;	/* Points to the variable's in-frame Var

 				 * structure. */

     char *part1;

     int index, len1, len2;

     int parsed = 0;

     Tcl_Obj *objPtr;

     Tcl_ObjType *typePtr = part1Ptr->typePtr;

     CONST char *errMsg = NULL;

     CallFrame *varFramePtr = iPtr->varFramePtr;

     Namespace *nsPtr;

     /*

      * If part1Ptr is a tclParsedVarNameType, separate it into the 

      * pre-parsed parts.

      */

     *arrayPtrPtr = NULL;

     if (typePtr == &tclParsedVarNameType) {

 	if (part1Ptr->internalRep.twoPtrValue.ptr1 != NULL) {

 	    if (part2 != NULL) {

 		/*

 		 * ERROR: part1Ptr is already an array element, cannot 

 		 * specify a part2.

 		 */

 		if (flags & TCL_LEAVE_ERR_MSG) {

 		    part1 = TclGetString(part1Ptr);

 		    VarErrMsg(interp, part1, part2, msg, needArray);

 		}

 		return NULL;

 	    }

 	    part2 = (char *) part1Ptr->internalRep.twoPtrValue.ptr2;

 	    part1Ptr = (Tcl_Obj *) part1Ptr->internalRep.twoPtrValue.ptr1;

 	    typePtr = part1Ptr->typePtr;

 	}

 	parsed = 1;

     }

     part1 = Tcl_GetStringFromObj(part1Ptr, &len1);    

     nsPtr = ((varFramePtr == NULL)? iPtr->globalNsPtr : varFramePtr->nsPtr);

     if (nsPtr->varResProc != NULL || iPtr->resolverPtr != NULL) {

 	goto doParse;

     }

     if (typePtr == &tclLocalVarNameType) {

 	Proc *procPtr = (Proc *) part1Ptr->internalRep.twoPtrValue.ptr1;

 	int localIndex = (int) part1Ptr->internalRep.twoPtrValue.ptr2;

 	int useLocal;

 	useLocal = ((varFramePtr != NULL) && varFramePtr->isProcCallFrame

 	        && !(flags & (TCL_GLOBAL_ONLY | TCL_NAMESPACE_ONLY)));

 	if (useLocal && (procPtr == varFramePtr->procPtr)) {

 	    /*

 	     * part1Ptr points to an indexed local variable of the

 	     * correct procedure: use the cached value.

 	     */

 	    varPtr = &(varFramePtr->compiledLocals[localIndex]);

 	    goto donePart1;

 	}

 	goto doneParsing;

     } else if (typePtr == &tclNsVarNameType) {

 	Namespace *cachedNsPtr;

 	int useGlobal, useReference;

 	varPtr = (Var *) part1Ptr->internalRep.twoPtrValue.ptr2;

 	cachedNsPtr = (Namespace *) part1Ptr->internalRep.twoPtrValue.ptr1;

 	useGlobal = (cachedNsPtr == iPtr->globalNsPtr) 

 	    && ((flags & TCL_GLOBAL_ONLY) 

 		|| ((*part1 == ':') && (*(part1+1) == ':'))

 		|| (varFramePtr == NULL) 

 		|| (!varFramePtr->isProcCallFrame 

 		    && (nsPtr == iPtr->globalNsPtr)));

 	useReference = useGlobal || ((cachedNsPtr == nsPtr) 

 	        && ((flags & TCL_NAMESPACE_ONLY) 

 		    || (varFramePtr && !varFramePtr->isProcCallFrame 

 			&& !(flags & TCL_GLOBAL_ONLY)

 			/* careful: an undefined ns variable could

 			 * be hiding a valid global reference. */

 			&& !(varPtr->flags & VAR_UNDEFINED))));

 	if (useReference && (varPtr->hPtr != NULL)) {

 	    /*

 	     * A straight global or namespace reference, use it. It isn't 

 	     * so simple to deal with 'implicit' namespace references, i.e., 

 	     * those where the reference could be to either a namespace 

 	     * or a global variable. Those we lookup again.

 	     *

 	     * If (varPtr->hPtr == NULL), this might be a reference to a

 	     * variable in a deleted namespace, kept alive by e.g. part1Ptr.

 	     * We could conceivably be so unlucky that a new namespace was

 	     * created at the same address as the deleted one, so to be 

 	     * safe we test for a valid hPtr.

 	     */

 	    goto donePart1;

 	}

 	goto doneParsing;

     }

     doParse:

     if (!parsed && (*(part1 + len1 - 1) == ')')) {

 	/*

 	 * part1Ptr is possibly an unparsed array element.

 	 */

 	register int i;

 	char *newPart2;

 	len2 = -1;

 	for (i = 0; i < len1; i++) {

 	    if (*(part1 + i) == '(') {

 		if (part2 != NULL) {

 		    if (flags & TCL_LEAVE_ERR_MSG) {

 			VarErrMsg(interp, part1, part2, msg, needArray);

 		    }

 		}			

 		/*

 		 * part1Ptr points to an array element; first copy 

 		 * the element name to a new string part2.

 		 */

 		part2 = part1 + i + 1;

 		len2 = len1 - i - 2;

 		len1 = i;

 		newPart2 = ckalloc((unsigned int) (len2+1));

 		memcpy(newPart2, part2, (unsigned int) len2);

 		*(newPart2+len2) = '\0';

 		part2 = newPart2;

 		/*

 		 * Free the internal rep of the original part1Ptr, now

 		 * renamed objPtr, and set it to tclParsedVarNameType.

 		 */

 		objPtr = part1Ptr;

 		if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) {

 		    typePtr->freeIntRepProc(objPtr);

 		}

 		objPtr->typePtr = &tclParsedVarNameType;

 		/*

 		 * Define a new string object to hold the new part1Ptr, i.e., 

 		 * the array name. Set the internal rep of objPtr, reset

 		 * typePtr and part1 to contain the references to the

 		 * array name.

 		 */

 		part1Ptr = Tcl_NewStringObj(part1, len1);

 		Tcl_IncrRefCount(part1Ptr);

 		objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) part1Ptr;

 		objPtr->internalRep.twoPtrValue.ptr2 = (VOID *) part2;		

 		typePtr = part1Ptr->typePtr;

 		part1 = TclGetString(part1Ptr);

 		break;

 	    }

 	}

     }

     doneParsing:

     /*

      * part1Ptr is not an array element; look it up, and convert 

      * it to one of the cached types if possible.

      */

     if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) {

 	typePtr->freeIntRepProc(part1Ptr);

 	part1Ptr->typePtr = NULL;

     }

     varPtr = TclLookupSimpleVar(interp, part1, flags, 

             createPart1, &errMsg, &index);

     if (varPtr == NULL) {

 	if ((errMsg != NULL) && (flags & TCL_LEAVE_ERR_MSG)) {

 	    VarErrMsg(interp, part1, part2, msg, errMsg);

 	}

 	return NULL;

     }

     /*

      * Cache the newly found variable if possible.

      */

     if (index >= 0) {

         /*

 	 * An indexed local variable.

 	 */

 	Proc *procPtr = ((Interp *) interp)->varFramePtr->procPtr;

 	part1Ptr->typePtr = &tclLocalVarNameType;

 	procPtr->refCount++;

 	part1Ptr->internalRep.twoPtrValue.ptr1 = (VOID *) procPtr;

 	part1Ptr->internalRep.twoPtrValue.ptr2 = (VOID *) index;

 #if 0

     /*

      * TEMPORARYLY DISABLED tclNsVarNameType

      *

      * This optimisation will hopefully be turned back on soon.

      *      Miguel Sofer, 2004-05-22

      */

     } else if (index > -3) {

 	/*

 	 * A cacheable namespace or global variable.

 	 */

 	Namespace *nsPtr;

 	nsPtr = ((index == -1)? iPtr->globalNsPtr : varFramePtr->nsPtr);

 	varPtr->refCount++;

 	part1Ptr->typePtr = &tclNsVarNameType;

 	part1Ptr->internalRep.twoPtrValue.ptr1 = (VOID *) nsPtr;

 	part1Ptr->internalRep.twoPtrValue.ptr2 = (VOID *) varPtr;

 #endif

     } else {

 	/*

 	 * At least mark part1Ptr as already parsed.

 	 */

 	part1Ptr->typePtr = &tclParsedVarNameType;

 	part1Ptr->internalRep.twoPtrValue.ptr1 = NULL;

 	part1Ptr->internalRep.twoPtrValue.ptr2 = NULL;

     }

     donePart1:

 #if 0

     if (varPtr == NULL) {

 	if (flags & TCL_LEAVE_ERR_MSG) {

 	    part1 = TclGetString(part1Ptr);

 	    VarErrMsg(interp, part1, part2, msg, 

 		    "Cached variable reference is NULL.");

 	}

 	return NULL;

     }

 #endif

     while (TclIsVarLink(varPtr)) {

 	varPtr = varPtr->value.linkPtr;

     }

     if (part2 != NULL) {

 	/*

 	 * Array element sought: look it up.

 	 */

 	part1 = TclGetString(part1Ptr);

 	*arrayPtrPtr = varPtr;

 	varPtr = TclLookupArrayElement(interp, part1, part2, 

                 flags, msg, createPart1, createPart2, varPtr);

     }

     return varPtr;

 }

 /*

  * This flag bit should not interfere with TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY,

  * or TCL_LEAVE_ERR_MSG; it signals that the variable lookup is performed for 

  * upvar (or similar) purposes, with slightly different rules:

  *   - Bug #696893 - variable is either proc-local or in the current

  *     namespace; never follow the second (global) resolution path 

  *   - Bug #631741 - do not use special namespace or interp resolvers

  */

 #define LOOKUP_FOR_UPVAR 0x40000

 /*

  *----------------------------------------------------------------------

  *

  * TclLookupSimpleVar --

  *

  *	This procedure is used by to locate a simple variable (i.e., not

  *      an array element) given its name.

  *

  * Results:

  *	The return value is a pointer to the variable structure indicated by

  *	varName, or NULL if the variable couldn't be found. If the variable 

  *      can't be found and create is 1, a new as-yet-undefined (VAR_UNDEFINED) 

  *      variable structure is created, entered into a hash table, and returned.

  *

  *      If the current CallFrame corresponds to a proc and the variable found is

  *      one of the compiledLocals, its index is placed in *indexPtr. Otherwise,

  *      *indexPtr will be set to (according to the needs of TclObjLookupVar):

  *               -1 a global reference

  *               -2 a reference to a namespace variable

  *               -3 a non-cachable reference, i.e., one of:

  *                    . non-indexed local var

  *                    . a reference of unknown origin;

  *                    . resolution by a namespace or interp resolver

  *

  *	If the variable isn't found and creation wasn't specified, or some

  *	other error occurs, NULL is returned and the corresponding error

  *	message is left in *errMsgPtr. 

  *

  *	Note: it's possible for the variable returned to be VAR_UNDEFINED

  *	even if create is 1 (this only causes the hash table entry to be

  *	created).  For example, the variable might be a global that has been

  *	unset but is still referenced by a procedure, or a variable that has

  *	been unset but it only being kept in existence (if VAR_UNDEFINED) by

  *	a trace.

  *

  * Side effects:

  *	A new hashtable entry may be created if create is 1.

  *

  *----------------------------------------------------------------------

  */

 Var *

 TclLookupSimpleVar(interp, varName, flags, create, errMsgPtr, indexPtr)

     Tcl_Interp *interp;		/* Interpreter to use for lookup. */

     CONST char *varName;        /* This is a simple variable name that could

 				 * representa scalar or an array. */

     int flags;		        /* Only TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY,

 				 * LOOKUP_FOR_UPVAR and TCL_LEAVE_ERR_MSG bits 

 				 * matter. */

     CONST int create;		/* If 1, create hash table entry for varname,

 				 * if it doesn't already exist. If 0, return 

 				 * error if it doesn't exist. */

     CONST char **errMsgPtr;

     int *indexPtr;

 {    

     Interp *iPtr = (Interp *) interp;

     CallFrame *varFramePtr = iPtr->varFramePtr;

 				/* Points to the procedure call frame whose

 				 * variables are currently in use. Same as

 				 * the current procedure's frame, if any,

 				 * unless an "uplevel" is executing. */

     Tcl_HashTable *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;

     Tcl_HashEntry *hPtr;

     int new, i, result;

     varPtr = NULL;

     varNsPtr = NULL;		/* set non-NULL if a nonlocal variable */

     *indexPtr = -3;

     if ((flags & TCL_GLOBAL_ONLY) || iPtr->varFramePtr == NULL) {

         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 & LOOKUP_FOR_UPVAR)) {

         resPtr = iPtr->resolverPtr;

         if (cxtNsPtr->varResProc) {

             result = (*cxtNsPtr->varResProc)(interp, varName,

 		    (Tcl_Namespace *) cxtNsPtr, flags, &var);

         } else {

             result = TCL_CONTINUE;

         }

         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) {

             varPtr = (Var *) var;

 	    return varPtr;

         } else if (result != TCL_CONTINUE) {

 	    return NULL;

         }

     }

     /*

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

 	    || (varFramePtr == NULL)

 	    || !varFramePtr->isProcCallFrame

 	    || (strstr(varName, "::") != NULL)) {

 	CONST char *tail;

 	int lookGlobal;

 	lookGlobal = (flags & TCL_GLOBAL_ONLY) 

 	    || (cxtNsPtr == iPtr->globalNsPtr)

 	    || ((*varName == ':') && (*(varName+1) == ':'));

 	if (lookGlobal) {

 	    *indexPtr = -1;

 	    flags = (flags | TCL_GLOBAL_ONLY) & ~(TCL_NAMESPACE_ONLY|LOOKUP_FOR_UPVAR);

 	} else {

 	    if (flags & LOOKUP_FOR_UPVAR) {

 		flags = (flags | TCL_NAMESPACE_ONLY) & ~LOOKUP_FOR_UPVAR;

 	    }

 	    if (flags & TCL_NAMESPACE_ONLY) {

 		*indexPtr = -2;

 	    }

 	} 

 	/*

 	 * Don't pass TCL_LEAVE_ERR_MSG, we may yet create the variable,

 	 * or otherwise generate our own error!

 	 */

 	var = Tcl_FindNamespaceVar(interp, varName, (Tcl_Namespace *) cxtNsPtr,

 		flags & ~TCL_LEAVE_ERR_MSG);

 	if (var != (Tcl_Var) NULL) {

             varPtr = (Var *) var;

         }

 	if (varPtr == NULL) {

 	    if (create) {   /* var wasn't found so create it  */

 		TclGetNamespaceForQualName(interp, varName, cxtNsPtr,

 			flags, &varNsPtr, &dummy1Ptr, &dummy2Ptr, &tail);

 		if (varNsPtr == NULL) {

 		    *errMsgPtr = badNamespace;

 		    return NULL;

 		}

 		if (tail == NULL) {

 		    *errMsgPtr = missingName;

 		    return NULL;

 		}

 		hPtr = Tcl_CreateHashEntry(&varNsPtr->varTable, tail, &new);

 		varPtr = NewVar();

 		Tcl_SetHashValue(hPtr, varPtr);

 		varPtr->hPtr = hPtr;

 		varPtr->nsPtr = varNsPtr;

 		if ((lookGlobal)  || (varNsPtr == NULL)) {

 		    /*

 		     * The variable was created starting from the global

 		     * namespace: a global reference is returned even if 

 		     * it wasn't explicitly requested.

 		     */

 		    *indexPtr = -1;

 		} else {

 		    *indexPtr = -2;

 		}

 	    } else {		/* var wasn't found and not to create it */

 		*errMsgPtr = noSuchVar;

 		return NULL;

 	    }

 	}

     } else {			/* local var: look in frame varFramePtr */

 	Proc *procPtr = varFramePtr->procPtr;

 	int localCt = procPtr->numCompiledLocals;

 	CompiledLocal *localPtr = procPtr->firstLocalPtr;

 	Var *localVarPtr = varFramePtr->compiledLocals;

 	int varNameLen = strlen(varName);

 	for (i = 0;  i < localCt;  i++) {

 	    if (!TclIsVarTemporary(localPtr)) {

 		register char *localName = localVarPtr->name;

 		if ((varName[0] == localName[0])

 		        && (varNameLen == localPtr->nameLength)

 		        && (strcmp(varName, localName) == 0)) {

 		    *indexPtr = i;

 		    return localVarPtr;

 		}

 	    }

 	    localVarPtr++;

 	    localPtr = localPtr->nextPtr;

 	}

 	tablePtr = varFramePtr->varTablePtr;

 	if (create) {

 	    if (tablePtr == NULL) {

 		tablePtr = (Tcl_HashTable *)

 		    ckalloc(sizeof(Tcl_HashTable));

 		Tcl_InitHashTable(tablePtr, TCL_STRING_KEYS);

 		varFramePtr->varTablePtr = tablePtr;

 	    }

 	    hPtr = Tcl_CreateHashEntry(tablePtr, varName, &new);

 	    if (new) {

 		varPtr = NewVar();

 		Tcl_SetHashValue(hPtr, varPtr);

 		varPtr->hPtr = hPtr;

 		varPtr->nsPtr = NULL; /* a local variable */

 	    } else {

 		varPtr = (Var *) Tcl_GetHashValue(hPtr);

 	    }

 	} else {

 	    hPtr = NULL;

 	    if (tablePtr != NULL) {

 		hPtr = Tcl_FindHashEntry(tablePtr, varName);

 	    }

 	    if (hPtr == NULL) {

 		*errMsgPtr = noSuchVar;

 		return NULL;

 	    }

 	    varPtr = (Var *) Tcl_GetHashValue(hPtr);

 	}

     }

     return varPtr;

 }

 /*

  *----------------------------------------------------------------------

  *

  * TclLookupArrayElement --

  *

  *	This procedure is used to locate a variable which is in an array's 

  *      hashtable given a pointer to the array's Var structure and the 

  *      element's name.

  *

  * Results:

  *	The return value is a pointer to the variable structure , or NULL if 

  *      the variable couldn't be found. 

  *

  *      If arrayPtr points to a variable that isn't an array and createPart1 

  *      is 1, the corresponding variable will be converted to an array. 

  *      Otherwise, NULL is returned and an error message is left in

  *	the interp's result if TCL_LEAVE_ERR_MSG is set in flags.

  *

  *      If the variable is not found and createPart2 is 1, the variable is

  *      created. Otherwise, NULL is returned and an error message is left in

  *	the interp's result if TCL_LEAVE_ERR_MSG is set in flags.

  *

  *	Note: it's possible for the variable returned to be VAR_UNDEFINED

  *	even if createPart1 or createPart2 are 1 (these only cause the hash

  *	table entry or array to be created). For example, the variable might

  *	be a global that has been unset but is still referenced by a

  *	procedure, or a variable that has been unset but it only being kept

  *	in existence (if VAR_UNDEFINED) by a trace.

  *

  * Side effects:

  *      The variable at arrayPtr may be converted to be an array if 

  *      createPart1 is 1. A new hashtable entry may be created if createPart2 

  *      is 1.

  *

  *----------------------------------------------------------------------

  */

 Var *

 TclLookupArrayElement(interp, arrayName, elName, flags, msg, createArray, createElem, arrayPtr)

     Tcl_Interp *interp;		/* Interpreter to use for lookup. */

     CONST char *arrayName;	        /* This is the name of the array. */

     CONST char *elName;		/* Name of element within array. */

     CONST int flags;		/* Only TCL_LEAVE_ERR_MSG bit matters. */

     CONST char *msg;			/* Verb to use in error messages, e.g.

 				 * "read" or "set". Only needed if

 				 * TCL_LEAVE_ERR_MSG is set in flags. */

     CONST int createArray;	/* If 1, transform arrayName to be an array

 				 * if it isn't one yet and the transformation 

 				 * is possible. If 0, return error if it 

 				 * isn't already an array. */

     CONST int createElem;	/* If 1, create hash table entry for the 

 				 * element, if it doesn't already exist. If

 				 * 0, return error if it doesn't exist. */

     Var *arrayPtr;	        /* Pointer to the array's Var structure. */

 {

     Tcl_HashEntry *hPtr;

     int new;

     Var *varPtr;

     /*

      * We're dealing with an array element. Make sure the variable is an

      * array and look up the element (create the element if desired).

      */

     if (TclIsVarUndefined(arrayPtr) && !TclIsVarArrayElement(arrayPtr)) {

 	if (!createArray) {

 	    if (flags & TCL_LEAVE_ERR_MSG) {

 		VarErrMsg(interp, arrayName, elName, msg, noSuchVar);

 	    }

 	    return NULL;

 	}

 	/*

 	 * Make sure we are not resurrecting a namespace variable from a

 	 * deleted namespace!

 	 */

 	if ((arrayPtr->flags & VAR_IN_HASHTABLE) && (arrayPtr->hPtr == NULL)) {

 	    if (flags & TCL_LEAVE_ERR_MSG) {

 		VarErrMsg(interp, arrayName, elName, msg, danglingVar);

 	    }

 	    return NULL;

 	}

 	TclSetVarArray(arrayPtr);

 	TclClearVarUndefined(arrayPtr);

 	arrayPtr->value.tablePtr =

 	    (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));

 	Tcl_InitHashTable(arrayPtr->value.tablePtr, TCL_STRING_KEYS);

     } else if (!TclIsVarArray(arrayPtr)) {

 	if (flags & TCL_LEAVE_ERR_MSG) {

 	    VarErrMsg(interp, arrayName, elName, msg, needArray);

 	}

 	return NULL;

     }

     if (createElem) {

 	hPtr = Tcl_CreateHashEntry(arrayPtr->value.tablePtr, elName, &new);

 	if (new) {

 	    if (arrayPtr->searchPtr != NULL) {

 		DeleteSearches(arrayPtr);

 	    }

 	    varPtr = NewVar();

 	    Tcl_SetHashValue(hPtr, varPtr);

 	    varPtr->hPtr = hPtr;

 	    varPtr->nsPtr = arrayPtr->nsPtr;

 	    TclSetVarArrayElement(varPtr);

 	}

     } else {

 	hPtr = Tcl_FindHashEntry(arrayPtr->value.tablePtr, elName);

 	if (hPtr == NULL) {

 	    if (flags & TCL_LEAVE_ERR_MSG) {

 		VarErrMsg(interp, arrayName, elName, msg, noSuchElement);

 	    }

 	    return NULL;

 	}

     }

     return (Var *) Tcl_GetHashValue(hPtr);

 }

 /*

  *----------------------------------------------------------------------

  *

  * Tcl_GetVar --

  *

  *	Return the value of a Tcl variable as a string.

  *

  * Results:

  *	The return value points to the current value of varName as a string.

  *	If the variable is not defined or can't be read because of a clash

  *	in array usage then a NULL pointer is returned and an error message

  *	is left in the interp's result if the TCL_LEAVE_ERR_MSG flag is set.

  *	Note: the return value is only valid up until the next change to the

  *	variable; if you depend on the value lasting longer than that, then

  *	make yourself a private copy.

  *

  * Side effects:

  *	None.

  *

  *----------------------------------------------------------------------

  */

 EXPORT_C CONST char *

 Tcl_GetVar(interp, varName, flags)

     Tcl_Interp *interp;		/* Command interpreter in which varName is

 				 * to be looked up. */

     CONST char *varName;	/* Name of a variable in interp. */

     int flags;			/* OR-ed combination of TCL_GLOBAL_ONLY,

 				 * TCL_NAMESPACE_ONLY or TCL_LEAVE_ERR_MSG

 				 * bits. */

 {

     return Tcl_GetVar2(interp, varName, (char *) NULL, flags);

 }

 /*

  *----------------------------------------------------------------------

  *

  * Tcl_GetVar2 --

  *

  *	Return the value of a Tcl variable as a string, given a two-part

  *	name consisting of array name and element within array.

  *

  * Results:

  *	The return value points to the current value of the variable given

  *	by part1 and part2 as a string. If the specified variable doesn't

  *	exist, or if there is a clash in array usage, then NULL is returned

  *	and a message will be left in the interp's result if the

  *	TCL_LEAVE_ERR_MSG flag is set. Note: the return value is only valid

  *	up until the next change to the variable; if you depend on the value

  *	lasting longer than that, then make yourself a private copy.

  *

  * Side effects:

  *	None.

  *

  *----------------------------------------------------------------------

  */

 EXPORT_C CONST char *

 Tcl_GetVar2(interp, part1, part2, flags)

     Tcl_Interp *interp;		/* Command interpreter in which variable is

 				 * to be looked up. */

     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,

 				 * TCL_NAMESPACE_ONLY and TCL_LEAVE_ERR_MSG

                                  * bits. */

 {

     Tcl_Obj *objPtr;

     objPtr = Tcl_GetVar2Ex(interp, part1, part2, flags);

     if (objPtr == NULL) {

 	return NULL;

     }

     return TclGetString(objPtr);

 }

 /*

  *----------------------------------------------------------------------

  *

  * Tcl_GetVar2Ex --

  *

  *	Return the value of a Tcl variable as a Tcl object, given a

  *	two-part name consisting of array name and element within array.

  *

  * Results:

  *	The return value points to the current object value of the variable

  *	given by part1Ptr and part2Ptr. If the specified variable doesn't

  *	exist, or if there is a clash in array usage, then NULL is returned

  *	and a message will be left in the interpreter's result if the

  *	TCL_LEAVE_ERR_MSG flag is set.

  *

  * Side effects:

  *	The ref count for the returned object is _not_ incremented to

  *	reflect the returned reference; if you want to keep a reference to

  *	the object you must increment its ref count yourself.

  *

  *----------------------------------------------------------------------

  */

 EXPORT_C Tcl_Obj *

 Tcl_GetVar2Ex(interp, part1, part2, flags)

     Tcl_Interp *interp;		/* Command interpreter in which variable is

 				 * to be looked up. */

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

 {

     Var *varPtr, *arrayPtr;

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

     flags &= (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY|TCL_LEAVE_ERR_MSG);

     varPtr = TclLookupVar(interp, part1, part2, flags, "read",

             /*createPart1*/ 0, /*createPart2*/ 1, &arrayPtr);

     if (varPtr == NULL) {

 	return NULL;

     }

     return TclPtrGetVar(interp, varPtr, arrayPtr, part1, part2, flags);

 }

 /*

  *----------------------------------------------------------------------

  *

  * Tcl_ObjGetVar2 --

  *

  *	Return the value of a Tcl variable as a Tcl object, given a

  *	two-part name consisting of array name and element within array.

  *

  * Results:

  *	The return value points to the current object value of the variable

  *	given by part1Ptr and part2Ptr. If the specified variable doesn't

  *	exist, or if there is a clash in array usage, then NULL is returned

  *	and a message will be left in the interpreter's result if the

  *	TCL_LEAVE_ERR_MSG flag is set.

  *

  * Side effects:

  *	The ref count for the returned object is _not_ incremented to

  *	reflect the returned reference; if you want to keep a reference to

  *	the object you must increment its ref count yourself.

  *

  *----------------------------------------------------------------------

  */

 EXPORT_C Tcl_Obj *

 Tcl_ObjGetVar2(interp, part1Ptr, part2Ptr, flags)

     Tcl_Interp *interp;		/* Command interpreter in which variable is

 				 * to be looked up. */

     register Tcl_Obj *part1Ptr;	/* Points to an object holding the name of

 				 * an array (if part2 is non-NULL) or the

 				 * name of a variable. */

     register Tcl_Obj *part2Ptr;	/* If non-null, points to an object holding

 				 * the name of an element in the array

 				 * part1Ptr. */

     int flags;			/* OR-ed combination of TCL_GLOBAL_ONLY and

 				 * TCL_LEAVE_ERR_MSG bits. */

 {

     Var *varPtr, *arrayPtr;

     char *part1, *part2;

     part1 = Tcl_GetString(part1Ptr);

     part2 = ((part2Ptr == NULL) ? NULL : Tcl_GetString(part2Ptr));

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

     flags &= (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY|TCL_LEAVE_ERR_MSG);

     varPtr = TclObjLookupVar(interp, part1Ptr, part2, flags, "read",

             /*createPart1*/ 0, /*createPart2*/ 1, &arrayPtr);

     if (varPtr == NULL) {

 	return NULL;

     }

     return TclPtrGetVar(interp, varPtr, arrayPtr, part1, part2, flags);

 }

 /*

  *----------------------------------------------------------------------

  *

  * TclPtrGetVar --

  *

  *	Return the value of a Tcl variable as a Tcl object, given the

  *      pointers to the variable's (and possibly containing array's) 

  *      VAR structure.

  *

  * Results:

  *	The return value points to the current object value of the variable

  *	given by varPtr. If the specified variable doesn't exist, or if there 

  *      is a clash in array usage, then NULL is returned and a message will be 

  *      left in the interpreter's result if the TCL_LEAVE_ERR_MSG flag is set.

  *

  * Side effects:

  *	The ref count for the returned object is _not_ incremented to

  *	reflect the returned reference; if you want to keep a reference to

  *	the object you must increment its ref count yourself.

  *

  *----------------------------------------------------------------------

  */

 Tcl_Obj *

 TclPtrGetVar(interp, varPtr, arrayPtr, part1, part2, flags)

     Tcl_Interp *interp;		/* Command interpreter in which variable is

 				 * to be looked up. */

     register Var *varPtr;       /* The variable to be read.*/

     Var *arrayPtr;              /* NULL for scalar variables, pointer to

 				 * the containing array otherwise. */

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

     CONST int flags;		/* OR-ed combination of TCL_GLOBAL_ONLY,

 				 * and TCL_LEAVE_ERR_MSG bits. */

 {

     Interp *iPtr = (Interp *) interp;

     CONST char *msg;

     /*

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

      */

     if ((varPtr->tracePtr != NULL)

 	    || ((arrayPtr != NULL) && (arrayPtr->tracePtr != NULL))) {

 	if (TCL_ERROR == CallVarTraces(iPtr, arrayPtr, varPtr, part1, part2,

 		(flags & (TCL_NAMESPACE_ONLY|TCL_GLOBAL_ONLY))

 		| TCL_TRACE_READS, (flags & TCL_LEAVE_ERR_MSG))) {

 	    goto errorReturn;

 	}

     }

     /*

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

      */

     if (TclIsVarScalar(varPtr) && !TclIsVarUndefined(varPtr)) {

 	return varPtr->value.objPtr;

     }

     if (flags & TCL_LEAVE_ERR_MSG) {

 	if (TclIsVarUndefined(varPtr) && (arrayPtr != NULL)

 	        && !TclIsVarUndefined(arrayPtr)) {

 	    msg = noSuchElement;

 	} else if (TclIsVarArray(varPtr)) {

 	    msg = isArray;

 	} else {

 	    msg = noSuchVar;

 	}

 	VarErrMsg(interp, part1, part2, "read", msg);

     }

     /*

      * An error. If the variable doesn't exist anymore and no-one's using

      * it, then free up the relevant structures and hash table entries.

      */

     errorReturn:

     if (TclIsVarUndefined(varPtr)) {

 	CleanupVar(varPtr, arrayPtr);

     }

     return NULL;

 }

 /*

  *----------------------------------------------------------------------

  *

  * Tcl_SetObjCmd --

  *

  *	This procedure is invoked to process the "set" Tcl command.

  *	See the user documentation for details on what it does.

  *

  * Results:

  *	A standard Tcl result value.

  *

  * Side effects:

  *	A variable's value may be changed.

  *

  *----------------------------------------------------------------------

  */

 	/* ARGSUSED */

 int

 Tcl_SetObjCmd(dummy, interp, objc, objv)

     ClientData dummy;			/* Not used. */

     register 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) {

 	    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) {

 	    return TCL_ERROR;

 	}

 	Tcl_SetObjResult(interp, varValueObj);

 	return TCL_OK;

     } else {

 	Tcl_WrongNumArgs(interp, 1, objv, "varName ?newValue?");

 	return TCL_ERROR;

     }

 }

 /*

  *----------------------------------------------------------------------

  *

  * Tcl_SetVar --

  *

  *	Change the value of a variable.

  *

  * Results:

  *	Returns a pointer to the malloc'ed string which is the character

  *	representation of the variable's new value. The caller must not

  *	modify this string. If the write operation was disallowed then NULL

  *	is returned; if the TCL_LEAVE_ERR_MSG flag is set, then an

  *	explanatory message will be left in the interp's result. Note that the

  *	returned string may not be the same as newValue; this is because

  *	variable traces may modify the variable's value.

  *

  * Side effects:

  *	If varName is defined as a local or global variable in interp,

  *	its value is changed to newValue. If varName isn't currently

  *	defined, then a new global variable by that name is created.

  *

  *----------------------------------------------------------------------

  */

 EXPORT_C CONST char *

 Tcl_SetVar(interp, varName, newValue, flags)

     Tcl_Interp *interp;		/* Command interpreter in which varName is

 				 * to be looked up. */

     CONST char *varName;	/* Name of a variable in interp. */

     CONST char *newValue;	/* New value for varName. */

     int flags;			/* Various flags that tell how to set value:

 				 * any of TCL_GLOBAL_ONLY,

 				 * TCL_NAMESPACE_ONLY, TCL_APPEND_VALUE,

 				 * TCL_LIST_ELEMENT, TCL_LEAVE_ERR_MSG. */

 {

     return Tcl_SetVar2(interp, varName, (char *) NULL, newValue, flags);

 }

 /*

  *----------------------------------------------------------------------

  *

  * Tcl_SetVar2 --

  *

  *      Given a two-part variable name, which may refer either to a

  *      scalar variable or an element of an array, change the value

  *      of the variable.  If the named scalar or array or element

  *      doesn't exist then create one.

  *

  * Results:

  *	Returns a pointer to the malloc'ed string which is the character

  *	representation of the variable's new value. The caller must not

  *	modify this string. If the write operation was disallowed because an

  *	array was expected but not found (or vice versa), then NULL is

  *	returned; if the TCL_LEAVE_ERR_MSG flag is set, then an explanatory

  *	message will be left in the interp's result. Note that the returned

  *	string may not be the same as newValue; this is because 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 one is created.

  *

  *----------------------------------------------------------------------

  */

 EXPORT_C CONST char *

 Tcl_SetVar2(interp, part1, part2, newValue, flags)

     Tcl_Interp *interp;         /* Command interpreter in which variable is

                                  * to be looked up. */

     CONST char *part1;          /* If part2 is NULL, this is name of scalar

                                  * variable. Otherwise it is the name of

                                  * an array. */

     CONST char *part2;		/* Name of an element within an array, or

 				 * NULL. */

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

 {

     register Tcl_Obj *valuePtr;

     Tcl_Obj *varValuePtr;

     /*

      * Create an object holding the variable's new value and use

      * Tcl_SetVar2Ex to actually set the variable.

      */

     valuePtr = Tcl_NewStringObj(newValue, -1);

     Tcl_IncrRefCount(valuePtr);

     varValuePtr = Tcl_SetVar2Ex(interp, part1, part2, valuePtr, flags);

     Tcl_DecrRefCount(valuePtr); /* done with the object */

     if (varValuePtr == NULL) {

 	return NULL;

     }

     return TclGetString(varValuePtr);

 }

 /*

  *----------------------------------------------------------------------

  *

  * Tcl_SetVar2Ex --

  *

  *	Given a two-part variable name, which may refer either to a scalar

  *	variable or an element of an array, change the value of the variable

  *	to a new Tcl object value. If the named scalar or array or element

  *	doesn't exist then create one.

  *

  * Results:

  *	Returns a pointer to the Tcl_Obj holding the new value of the

  *	variable. If the write operation was disallowed because an array was

  *	expected but not found (or vice versa), then NULL is returned; if

  *	the TCL_LEAVE_ERR_MSG flag is set, then an explanatory message will

  *	be left in the interpreter's result. Note that the returned object

  *	may not be the same one referenced by newValuePtr; this is because

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

  *

  *	The reference count is decremented for any old value of the variable

  *	and incremented for its new value. If the new value for the variable

  *	is not the same one referenced by newValuePtr (perhaps as a result

  *	of a variable trace), then newValuePtr's ref count is left unchanged

  *	by Tcl_SetVar2Ex. newValuePtr's ref count is also left unchanged if

  *	we are appending it as a string value: that is, if "flags" includes

  *	TCL_APPEND_VALUE but not TCL_LIST_ELEMENT.

  *

  *	The reference count for the returned object is _not_ incremented: if

  *	you want to keep a reference to the object you must increment its

  *	ref count yourself.

  *

  *----------------------------------------------------------------------

  */

 EXPORT_C Tcl_Obj *

 Tcl_SetVar2Ex(interp, part1, part2, newValuePtr, flags)

     Tcl_Interp *interp;		/* Command interpreter in which variable is

 				 * to be found. */

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

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

 {

     Var *varPtr, *arrayPtr;

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

     flags &= (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY|TCL_LEAVE_ERR_MSG

 	    |TCL_APPEND_VALUE|TCL_LIST_ELEMENT);

     varPtr = TclLookupVar(interp, part1, part2, flags, "set",

 	    /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr);

     if (varPtr == NULL) {

 	return NULL;

     }

     return TclPtrSetVar(interp, varPtr, arrayPtr, part1, part2, 

             newValuePtr, flags);

 }

 /*

  *----------------------------------------------------------------------

  *

  * Tcl_ObjSetVar2 --

  *

  *	This function is the same as Tcl_SetVar2Ex above, except the

  *	variable names are passed in Tcl object instead of strings.

  *

  * Results:

  *	Returns a pointer to the Tcl_Obj holding the new value of the

  *	variable. If the write operation was disallowed because an array was

  *	expected but not found (or vice versa), then NULL is returned; if

  *	the TCL_LEAVE_ERR_MSG flag is set, then an explanatory message will

  *	be left in the interpreter's result. Note that the returned object

  *	may not be the same one referenced by newValuePtr; this is because

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

  *

  *----------------------------------------------------------------------

  */

 EXPORT_C Tcl_Obj *

 Tcl_ObjSetVar2(interp, part1Ptr, part2Ptr, newValuePtr, flags)

     Tcl_Interp *interp;		/* Command interpreter in which variable is

 				 * to be found. */

     register Tcl_Obj *part1Ptr;	/* Points to an object holding the name of

 				 * an array (if part2 is non-NULL) or the

 				 * name of a variable. */

     register Tcl_Obj *part2Ptr;	/* If non-null, points to an object holding

 				 * the name of an element in the array

 				 * part1Ptr. */

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

 {

     Var *varPtr, *arrayPtr;

     char *part1, *part2;

     part1 = TclGetString(part1Ptr);

     part2 = ((part2Ptr == NULL) ? NULL : Tcl_GetString(part2Ptr));    

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

     flags &= (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY|TCL_LEAVE_ERR_MSG

 	    |TCL_APPEND_VALUE|TCL_LIST_ELEMENT);

     varPtr = TclObjLookupVar(interp, part1Ptr, part2, flags, "set",

 	    /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr);

     if (varPtr == NULL) {

 	return NULL;

     }

     return TclPtrSetVar(interp, varPtr, arrayPtr, part1, part2, 

             newValuePtr, flags);

 }

 /*

  *----------------------------------------------------------------------

  *

  * TclPtrSetVar --

  *

  *	This function is the same as Tcl_SetVar2Ex above, except that

  *      it requires pointers to the variable's Var structs in addition

  *	to the variable names.

  *

  * Results:

  *	Returns a pointer to the Tcl_Obj holding the new value of the

  *	variable. If the write operation was disallowed because an array was

  *	expected but not found (or vice versa), then NULL is returned; if

  *	the TCL_LEAVE_ERR_MSG flag is set, then an explanatory message will

  *	be left in the interpreter's result. Note that the returned object

  *	may not be the same one referenced by newValuePtr; this is because

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

  *

  *----------------------------------------------------------------------

  */

 Tcl_Obj *

 TclPtrSetVar(interp, varPtr, arrayPtr, part1, part2, newValuePtr, flags)

     Tcl_Interp *interp;		/* Command interpreter in which variable is

 				 * to be looked up. */

     register Var *varPtr;

     Var *arrayPtr;

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

     Tcl_Obj *newValuePtr;	/* New value for variable. */

     CONST int flags;		/* OR-ed combination of TCL_GLOBAL_ONLY,

 				 * and TCL_LEAVE_ERR_MSG bits. */

 {

     Interp *iPtr = (Interp *) interp;

     Tcl_Obj *oldValuePtr;

     Tcl_Obj *resultPtr = NULL;

     int result;

     /*

      * If the variable is in a hashtable and its hPtr field is NULL, then we

      * may have an upvar to an array element where the array was deleted

      * or an upvar to a namespace variable whose namespace was deleted.

      * Generate an error (allowing the variable to be reset would screw up

      * our storage allocation and is meaningless anyway).

      */

     if ((varPtr->flags & VAR_IN_HASHTABLE) && (varPtr->hPtr == NULL)) {

 	if (flags & TCL_LEAVE_ERR_MSG) {

 	    if (TclIsVarArrayElement(varPtr)) {

 		VarErrMsg(interp, part1, part2, "set", danglingElement);

 	    } else {

 		VarErrMsg(interp, part1, part2, "set", danglingVar);

 	    }

 	}

 	return NULL;

     }

     /*

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

      */

     if (TclIsVarArray(varPtr) && !TclIsVarUndefined(varPtr)) {

 	if (flags & TCL_LEAVE_ERR_MSG) {

 	    VarErrMsg(interp, part1, part2, "set", isArray);

 	}

 	return NULL;

     }

     /*

      * Invoke any read traces that have been set for the variable if it

      * is requested; this is only done in the core by the INST_LAPPEND_*

      * instructions.

      */

     if ((flags & TCL_TRACE_READS) && ((varPtr->tracePtr != NULL) 

 	    || ((arrayPtr != NULL) && (arrayPtr->tracePtr != NULL)))) {

 	if (TCL_ERROR == CallVarTraces(iPtr, arrayPtr, varPtr, part1, part2,

 		TCL_TRACE_READS, (flags & TCL_LEAVE_ERR_MSG))) {

 	    return NULL;

 	}

     }

     /*

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

      */

     if (flags & TCL_LIST_ELEMENT && !(flags & TCL_APPEND_VALUE)) {

 	TclSetVarUndefined(varPtr);

     }

     oldValuePtr = varPtr->value.objPtr;

     if (flags & (TCL_APPEND_VALUE|TCL_LIST_ELEMENT)) {

 	if (TclIsVarUndefined(varPtr) && (oldValuePtr != NULL)) {

 	    Tcl_DecrRefCount(oldValuePtr);     /* discard old value */

 	    varPtr->value.objPtr = NULL;

 	    oldValuePtr = NULL;

 	}

 	if (flags & TCL_LIST_ELEMENT) {	       /* append list element */

 	    if (oldValuePtr == NULL) {

 		TclNewObj(oldValuePtr);

 		varPtr->value.objPtr = oldValuePtr;

 		Tcl_IncrRefCount(oldValuePtr); /* since var is referenced */

 	    } else if (Tcl_IsShared(oldValuePtr)) {

 		varPtr->value.objPtr = Tcl_DuplicateObj(oldValuePtr);

 		Tcl_DecrRefCount(oldValuePtr);

 		oldValuePtr = varPtr->value.objPtr;

 		Tcl_IncrRefCount(oldValuePtr); /* since var is referenced */

 	    }

 	    result = Tcl_ListObjAppendElement(interp, oldValuePtr,

 		    newValuePtr);

 	    if (result != TCL_OK) {

 		return NULL;

 	    }

 	} else {		               /* append string */

 	    /*

 	     * We append newValuePtr's bytes but don't change its ref count.

 	     */

 	    if (oldValuePtr == NULL) {

 		varPtr->value.objPtr = newValuePtr;

 		Tcl_IncrRefCount(newValuePtr);

 	    } else {

 		if (Tcl_IsShared(oldValuePtr)) {   /* append to copy */

 		    varPtr->value.objPtr = Tcl_DuplicateObj(oldValuePtr);

 		    TclDecrRefCount(oldValuePtr);

 		    oldValuePtr = varPtr->value.objPtr;

 		    Tcl_IncrRefCount(oldValuePtr); /* since var is ref */

 		}

 		Tcl_AppendObjToObj(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) {

 	    TclDecrRefCount(oldValuePtr);   /* discard old value */

 	}

     }

     TclSetVarScalar(varPtr);

     TclClearVarUndefined(varPtr);

     if (arrayPtr != NULL) {

 	TclClearVarUndefined(arrayPtr);

     }

     /*

      * Invoke any write traces for the variable.

      */

     if ((varPtr->tracePtr != NULL)

 	    || ((arrayPtr != NULL) && (arrayPtr->tracePtr != NULL))) {

 	if (TCL_ERROR == CallVarTraces(iPtr, arrayPtr, varPtr, part1, part2,

 	        (flags & (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY))

 		| TCL_TRACE_WRITES, (flags & TCL_LEAVE_ERR_MSG))) {

 	    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

      * array). 

      */

     if (TclIsVarScalar(varPtr) && !TclIsVarUndefined(varPtr)) {

 	return varPtr->value.objPtr;

     }

     /*

      * A trace changed the value in some gross way. Return an empty string

      * object.

      */

     resultPtr = iPtr->emptyObjPtr;

     /*

      * 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 (TclIsVarUndefined(varPtr)) {

 	CleanupVar(varPtr, arrayPtr);

     }

     return resultPtr;

 }

 /*

  *----------------------------------------------------------------------

  *

  * TclIncrVar2 --

  *

  *	Given a two-part variable name, which may refer either to a scalar

  *	variable or an element of an array, increment the Tcl object value

  *	of the variable by a specified amount.

  *

  * Results:

  *	Returns a pointer to the Tcl_Obj holding the new value of the

  *	variable. If the specified variable doesn't exist, or there is a

  *	clash in array usage, or an error occurs while executing variable

  *	traces, then NULL is returned and a message will be left in

  *	the interpreter's result.

  *

  * Side effects:

  *	The value of the given variable is incremented by the specified

  *	amount. If either the array or the entry didn't exist then a new

  *	variable is created. The ref count for the returned object is _not_

  *	incremented to reflect the returned reference; if you want to keep a

  *	reference to the object you must increment its ref count yourself.

  *

  *----------------------------------------------------------------------

  */

 Tcl_Obj *

 TclIncrVar2(interp, part1Ptr, part2Ptr, incrAmount, flags)

     Tcl_Interp *interp;		/* Command interpreter in which variable is

 				 * to be found. */

     Tcl_Obj *part1Ptr;		/* Points to an object holding the name of

 				 * an array (if part2 is non-NULL) or the

 				 * name of a variable. */

     Tcl_Obj *part2Ptr;		/* If non-null, points to an object holding

 				 * the name of an element in the array

 				 * part1Ptr. */

     long incrAmount;		/* Amount to be added to variable. */

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

 {

     Var *varPtr, *arrayPtr;

     char *part1, *part2;

     part1 = TclGetString(part1Ptr);

     part2 = ((part2Ptr == NULL)? NULL : TclGetString(part2Ptr));

     varPtr = TclObjLookupVar(interp, part1Ptr, part2, flags, "read",

 	    0, 1, &arrayPtr);

     if (varPtr == NULL) {

 	Tcl_AddObjErrorInfo(interp,

 		"\n    (reading value of variable to increment)", -1);

 	return NULL;

     }

     return TclPtrIncrVar(interp, varPtr, arrayPtr, part1, part2,

 	    incrAmount, flags);

 }

 /*

  *----------------------------------------------------------------------

  *

  * TclPtrIncrVar --

  *

  *	Given the pointers to a variable and possible containing array, 

  *      increment the Tcl object value of the variable by a specified 

  *      amount.

  *

  * Results:

  *	Returns a pointer to the Tcl_Obj holding the new value of the

  *	variable. If the specified variable doesn't exist, or there is a

  *	clash in array usage, or an error occurs while executing variable

  *	traces, then NULL is returned and a message will be left in

  *	the interpreter's result.

  *

  * Side effects:

  *	The value of the given variable is incremented by the specified

  *	amount. If either the array or the entry didn't exist then a new

  *	variable is created. The ref count for the returned object is _not_

  *	incremented to reflect the returned reference; if you want to keep a

  *	reference to the object you must increment its ref count yourself.

  *

  *----------------------------------------------------------------------

  */

 Tcl_Obj *

 TclPtrIncrVar(interp, varPtr, arrayPtr, part1, part2, incrAmount, flags)

     Tcl_Interp *interp;		/* Command interpreter in which variable is

 				 * to be found. */

     Var *varPtr;

     Var *arrayPtr;

     CONST char *part1;		/* Points to an object holding the name of

 				 * an array (if part2 is non-NULL) or the

 				 * name of a variable. */

     CONST char *part2;		/* If non-null, points to an object holding

 				 * the name of an element in the array

 				 * part1Ptr. */

     CONST long incrAmount;	/* Amount to be added to variable. */

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

 {

     register Tcl_Obj *varValuePtr;

     int createdNewObj;		/* Set 1 if var's value object is shared

 				 * so we must increment a copy (i.e. copy

 				 * on write). */

     long i;

     varValuePtr = TclPtrGetVar(interp, varPtr, arrayPtr, part1, part2, flags);

     if (varValuePtr == NULL) {

 	Tcl_AddObjErrorInfo(interp,

 		"\n    (reading value of variable to increment)", -1);

 	return NULL;

     }

     /*

      * Increment the variable's value. If the object is unshared we can

      * modify it directly, otherwise we must create a new copy to modify:

      * this is "copy on write". Then free the variable's old string

      * representation, if any, since it will no longer be valid.

      */

     createdNewObj = 0;

     if (Tcl_IsShared(varValuePtr)) {

 	varValuePtr = Tcl_DuplicateObj(varValuePtr);

 	createdNewObj = 1;

     }

     if (varValuePtr->typePtr == &tclWideIntType) {

 	Tcl_WideInt wide;

 	TclGetWide(wide,varValuePtr);

 	Tcl_SetWideIntObj(varValuePtr, wide + Tcl_LongAsWide(incrAmount));

     } else if (varValuePtr->typePtr == &tclIntType) {

 	i = varValuePtr->internalRep.longValue;

 	Tcl_SetIntObj(varValuePtr, i + incrAmount);

     } else {

 	/*

 	 * Not an integer or wide internal-rep...

 	 */

 	Tcl_WideInt wide;

 	if (Tcl_GetWideIntFromObj(interp, varValuePtr, &wide) != TCL_OK) {

 	    if (createdNewObj) {

 		Tcl_DecrRefCount(varValuePtr); /* free unneeded copy */

 	    }

 	    return NULL;

 	}

 	if (wide <= Tcl_LongAsWide(LONG_MAX)

 		&& wide >= Tcl_LongAsWide(LONG_MIN)) {

 	    Tcl_SetLongObj(varValuePtr, Tcl_WideAsLong(wide) + incrAmount);

 	} else {

 	    Tcl_SetWideIntObj(varValuePtr, wide + Tcl_LongAsWide(incrAmount));

 	}

     }

     /*

      * Store the variable's new value and run any write traces.

      */

     return TclPtrSetVar(interp, varPtr, arrayPtr, part1, part2,

 	    varValuePtr, flags);

 }

 /*

  *----------------------------------------------------------------------

  *

  * Tcl_UnsetVar --

  *

  *	Delete a variable, so that it may not be accessed anymore.

  *

  * Results:

  *	Returns TCL_OK if the variable was successfully deleted, TCL_ERROR

  *	if the variable can't be unset.  In the event of an error,

  *	if the TCL_LEAVE_ERR_MSG flag is set then an error message

  *	is left in the interp's result.

  *

  * Side effects:

  *	If varName is defined as a local or global variable in interp,

  *	it is deleted.

  *

  *----------------------------------------------------------------------

  */

 EXPORT_C int

 Tcl_UnsetVar(interp, varName, flags)

     Tcl_Interp *interp;		/* Command interpreter in which varName is

 				 * to be looked up. */

     CONST char *varName;	/* Name of a variable in interp.  May be

 				 * either a scalar name or an array name

 				 * or an element in an array. */

     int flags;			/* OR-ed combination of any of

 				 * TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY or

 				 * TCL_LEAVE_ERR_MSG. */

 {

     return Tcl_UnsetVar2(interp, varName, (char *) NULL, flags);

 }

 /*

  *----------------------------------------------------------------------

  *

  * Tcl_UnsetVar2 --

  *

  *	Delete a variable, given a 2-part name.

  *

  * Results:

  *	Returns TCL_OK if the variable was successfully deleted, TCL_ERROR

  *	if the variable can't be unset.  In the event of an error,

  *	if the TCL_LEAVE_ERR_MSG flag is set then an error message

  *	is left in the interp's result.

  *

  * Side effects:

  *	If part1 and part2 indicate a local or global variable in interp,

  *	it is deleted.  If part1 is an array name and part2 is NULL, then

  *	the whole array is deleted.

  *

  *----------------------------------------------------------------------

  */

 EXPORT_C int

 Tcl_UnsetVar2(interp, part1, part2, flags)

     Tcl_Interp *interp;		/* Command interpreter in which varName is

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

 {

     int result;

     Tcl_Obj *part1Ptr;

     part1Ptr = Tcl_NewStringObj(part1, -1);

     Tcl_IncrRefCount(part1Ptr);

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

     flags &= (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY|TCL_LEAVE_ERR_MSG);

     result = TclObjUnsetVar2(interp, part1Ptr, part2, flags);

     TclDecrRefCount(part1Ptr);

     return result;

 }

 /*

  *----------------------------------------------------------------------

  *

  * TclObjUnsetVar2 --

  *

  *	Delete a variable, given a 2-object name.

  *

  * Results:

  *	Returns TCL_OK if the variable was successfully deleted, TCL_ERROR

  *	if the variable can't be unset.  In the event of an error,

  *	if the TCL_LEAVE_ERR_MSG flag is set then an error message

  *	is left in the interp's result.

  *

  * Side effects:

  *	If part1ptr and part2Ptr indicate a local or global variable in interp,

  *	it is deleted.  If part1Ptr is an array name and part2Ptr is NULL, then

  *	the whole array is deleted.

  *

  *----------------------------------------------------------------------

  */

 int

 TclObjUnsetVar2(interp, part1Ptr, part2, flags)

     Tcl_Interp *interp;		/* Command interpreter in which varName is

 				 * to be looked up. */

     Tcl_Obj *part1Ptr;		/* 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. */

 {

     Var *varPtr;

     Interp *iPtr = (Interp *) interp;

     Var *arrayPtr;

     int result;

     char *part1;

     part1 = TclGetString(part1Ptr);

     varPtr = TclObjLookupVar(interp, part1Ptr, part2, flags, "unset",

 	    /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr);

     if (varPtr == NULL) {

 	return TCL_ERROR;

     }

     result = (TclIsVarUndefined(varPtr)? TCL_ERROR : TCL_OK);

     /*

      * Keep the variable alive until we're done with it. We used to

      * increase/decrease the refCount for each operation, making it

      * hard to find [Bug 735335] - caused by unsetting the variable

      * whose value was the variable's name.

      */

     varPtr->refCount++;

     UnsetVarStruct(varPtr, arrayPtr, iPtr, part1, part2, flags);

     /*

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

      */

     if (result != TCL_OK) {

 	if (flags & TCL_LEAVE_ERR_MSG) {

 	    VarErrMsg(interp, part1, part2, "unset", 

 		    ((arrayPtr == NULL) ? noSuchVar : noSuchElement));

 	}

     }

     /*

      * Try to avoid keeping the Var struct allocated due to a tclNsVarNameType 

      * keeping a reference. This removes some additional exteriorisations of

      * [Bug 736729], but may be a good thing independently of the bug.

      */

     if (part1Ptr->typePtr == &tclNsVarNameType) {

 	part1Ptr->typePtr->freeIntRepProc(part1Ptr);

 	part1Ptr->typePtr = 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.

      */

     varPtr->refCount--;

     CleanupVar(varPtr, arrayPtr);

     return result;

 }

 /*

  *----------------------------------------------------------------------

  *

  * UnsetVarStruct --

  *

  *	Unset and delete a variable. This does the internal work for

  *	TclObjUnsetVar2 and TclDeleteNamespaceVars, which call here for each

  *	variable to be unset and deleted.

  *

  * Results:

  *	None.

  *

  * Side effects:

  *	If the arguments indicate a local or global variable in iPtr, it is

  *      unset and deleted.   

  *

  *----------------------------------------------------------------------

  */

 static void

 UnsetVarStruct(varPtr, arrayPtr, iPtr, part1, part2, flags)

     Var *varPtr;

     Var *arrayPtr;

     Interp *iPtr;

     CONST char *part1;

     CONST char *part2;

     int flags;

 {

     Var dummyVar;

     Var *dummyVarPtr;

     ActiveVarTrace *activePtr;

     if ((arrayPtr != NULL) && (arrayPtr->searchPtr != NULL)) {

 	DeleteSearches(arrayPtr);

     }

     /*

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

      */

     if (TclIsVarLink(varPtr)) {

 	Var *linkPtr = varPtr->value.linkPtr;

 	linkPtr->refCount--;

 	if ((linkPtr->refCount == 0) && TclIsVarUndefined(linkPtr)

 		&& (linkPtr->tracePtr == NULL)

 		&& (linkPtr->flags & VAR_IN_HASHTABLE)) {

 	    if (linkPtr->hPtr != NULL) {

 		Tcl_DeleteHashEntry(linkPtr->hPtr);

 	    }

 	    ckfree((char *) linkPtr);

 	}

     }

     /*

      * The code below is tricky, because of the possibility that

      * a trace procedure might try to access a variable being

      * deleted. To handle this situation gracefully, do things

      * in three steps:

      * 1. Copy the contents of the variable to a dummy variable

      *    structure, and mark the original Var structure as undefined.

      * 2. Invoke traces and clean up the variable, using the dummy copy.

      * 3. If at the end of this the original variable is still

      *    undefined and has no outstanding references, then delete

      *	  it (but it could have gotten recreated by a trace).

      */

     dummyVar = *varPtr;

     TclSetVarUndefined(varPtr);

     TclSetVarScalar(varPtr);

     varPtr->value.objPtr = NULL; /* dummyVar points to any value object */

     varPtr->tracePtr = NULL;

     varPtr->searchPtr = NULL;

     /*

      * Call trace procedures for the variable being deleted. Then delete

      * its traces. Be sure to abort any other traces for the variable

      * that are still pending. Special tricks:

      * 1. We need to increment varPtr's refCount around this: CallVarTraces

      *    will use dummyVar so it won't increment varPtr's refCount itself.

      * 2. Turn off the VAR_TRACE_ACTIVE flag in dummyVar: we want to

      *    call unset traces even if other traces are pending.

      */

     if ((dummyVar.tracePtr != NULL)

 	    || ((arrayPtr != NULL) && (arrayPtr->tracePtr != NULL))) {

 	dummyVar.flags &= ~VAR_TRACE_ACTIVE;

 	CallVarTraces(iPtr, arrayPtr, &dummyVar, part1, part2,

 		(flags & (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY))

 		| TCL_TRACE_UNSETS, /* leaveErrMsg */ 0);

 	while (dummyVar.tracePtr != NULL) {

 	    VarTrace *tracePtr = dummyVar.tracePtr;

 	    dummyVar.tracePtr = tracePtr->nextPtr;

 	    Tcl_EventuallyFree((ClientData) tracePtr, TCL_DYNAMIC);

 	}

 	for (activePtr = iPtr->activeVarTracePtr;  activePtr != NULL;

 	     activePtr = activePtr->nextPtr) {

 	    if (activePtr->varPtr == varPtr) {

 		activePtr->nextTracePtr = NULL;

 	    }

 	}

     }

     /*

      * If the variable is an array, delete all of its elements. This must be

      * done after calling the traces on the array, above (that's the way

      * traces are defined). If it is a scalar, "discard" its object

      * (decrement the ref count of its object, if any).

      */

     dummyVarPtr = &dummyVar;

     if (TclIsVarArray(dummyVarPtr) && !TclIsVarUndefined(dummyVarPtr)) {

 	DeleteArray(iPtr, part1, dummyVarPtr, (flags

 		& (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY)) | TCL_TRACE_UNSETS);

     }

     if (TclIsVarScalar(dummyVarPtr)

 	    && (dummyVarPtr->value.objPtr != NULL)) {

 	Tcl_Obj *objPtr = dummyVarPtr->value.objPtr;

 	TclDecrRefCount(objPtr);

 	dummyVarPtr->value.objPtr = NULL;

     }

     /*

      * If the variable was a namespace variable, decrement its reference count.

      */

     if (varPtr->flags & VAR_NAMESPACE_VAR) {

 	varPtr->flags &= ~VAR_NAMESPACE_VAR;

 	varPtr->refCount--;

     }

 }

 /*

  *----------------------------------------------------------------------

  *

  * Tcl_TraceVar --

  *

  *	Arrange for reads and/or writes to a variable to cause a

  *	procedure to be invoked, which can monitor the operations

  *	and/or change their actions.

  *

  * Results:

  *	A standard Tcl return value.

  *

  * Side effects:

  *	A trace is set up on the variable given by varName, such that

  *	future references to the variable will be intermediated by

  *	proc.  See the manual entry for complete details on the calling

  *	sequence for proc.

  *

  *----------------------------------------------------------------------

  */

 EXPORT_C int

 Tcl_TraceVar(interp, varName, flags, proc, clientData)

     Tcl_Interp *interp;		/* Interpreter in which variable is

 				 * to be traced. */

     CONST char *varName;	/* Name of variable;  may end with "(index)"

 				 * to signify an array reference. */

     int flags;			/* OR-ed collection of bits, including any

 				 * of TCL_TRACE_READS, TCL_TRACE_WRITES,

 				 * TCL_TRACE_UNSETS, TCL_GLOBAL_ONLY, and

 				 * TCL_NAMESPACE_ONLY. */

     Tcl_VarTraceProc *proc;	/* Procedure to call when specified ops are

 				 * invoked upon varName. */

     ClientData clientData;	/* Arbitrary argument to pass to proc. */

 {

     return Tcl_TraceVar2(interp, varName, (char *) NULL, 

 	    flags, proc, clientData);

 }

 /*

  *----------------------------------------------------------------------

  *

  * Tcl_TraceVar2 --

  *

  *	Arrange for reads and/or writes to a variable to cause a

  *	procedure to be invoked, which can monitor the operations

  *	and/or change their actions.

  *

  * Results:

  *	A standard Tcl return value.

  *

  * Side effects:

  *	A trace is set up on the variable given by part1 and part2, such

  *	that future references to the variable will be intermediated by

  *	proc.  See the manual entry for complete details on the calling

  *	sequence for proc.

  *

  *----------------------------------------------------------------------

  */

 EXPORT_C int

 Tcl_TraceVar2(interp, part1, part2, flags, proc, clientData)

     Tcl_Interp *interp;		/* Interpreter in which variable is

 				 * to be traced. */

     CONST char *part1;		/* Name of scalar variable or array. */

     CONST char *part2;		/* Name of element within array;  NULL means

 				 * trace applies to scalar variable or array

 				 * as-a-whole. */

     int flags;			/* OR-ed collection of bits, including any

 				 * of TCL_TRACE_READS, TCL_TRACE_WRITES,

 				 * TCL_TRACE_UNSETS, TCL_GLOBAL_ONLY,

 				 * and TCL_NAMESPACE_ONLY. */

     Tcl_VarTraceProc *proc;	/* Procedure to call when specified ops are

 				 * invoked upon varName. */

     ClientData clientData;	/* Arbitrary argument to pass to proc. */

 {

     Var *varPtr, *arrayPtr;

     register VarTrace *tracePtr;

     int flagMask;

     /* 

      * We strip 'flags' down to just the parts which are relevant to

      * TclLookupVar, to avoid conflicts between trace flags and

      * internal namespace flags such as 'FIND_ONLY_NS'.  This can

      * now occur since we have trace flags with values 0x1000 and higher.

      */

     flagMask = TCL_GLOBAL_ONLY | TCL_NAMESPACE_ONLY;

     varPtr = TclLookupVar(interp, part1, part2,

 	    (flags & flagMask) | TCL_LEAVE_ERR_MSG,

 	    "trace", /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr);

     if (varPtr == NULL) {

 	return TCL_ERROR;

     }

     /*

      * Check for a nonsense flag combination.  Note that this is a

      * panic() because there should be no code path that ever sets

      * both flags.

      */

     if ((flags&TCL_TRACE_RESULT_DYNAMIC) && (flags&TCL_TRACE_RESULT_OBJECT)) {

 	panic("bad result flag combination");

     }

     /*

      * Set up trace information.

      */

     flagMask = TCL_TRACE_READS | TCL_TRACE_WRITES | TCL_TRACE_UNSETS | 

 	TCL_TRACE_ARRAY | TCL_TRACE_RESULT_DYNAMIC | TCL_TRACE_RESULT_OBJECT;

 #ifndef TCL_REMOVE_OBSOLETE_TRACES

     flagMask |= TCL_TRACE_OLD_STYLE;

 #endif

     tracePtr = (VarTrace *) ckalloc(sizeof(VarTrace));

     tracePtr->traceProc		= proc;

     tracePtr->clientData	= clientData;

     tracePtr->flags		= flags & flagMask;

     tracePtr->nextPtr		= varPtr->tracePtr;

     varPtr->tracePtr		= tracePtr;

     return TCL_OK;

 }

 /*

  *----------------------------------------------------------------------

  *

  * Tcl_UntraceVar --

  *

  *	Remove a previously-created trace for a variable.

  *

  * Results:

  *	None.

  *

  * Side effects:

  *	If there exists a trace for the variable given by varName

  *	with the given flags, proc, and clientData, then that trace

  *	is removed.

  *

  *----------------------------------------------------------------------

  */

 EXPORT_C void

 Tcl_UntraceVar(interp, varName, flags, proc, clientData)

     Tcl_Interp *interp;		/* Interpreter containing variable. */

     CONST char *varName;	/* Name of variable; may end with "(index)"

 				 * to signify an array reference. */

     int flags;			/* OR-ed collection of bits describing

 				 * current trace, including any of

 				 * TCL_TRACE_READS, TCL_TRACE_WRITES,

 				 * TCL_TRACE_UNSETS, TCL_GLOBAL_ONLY

 				 * and TCL_NAMESPACE_ONLY. */

     Tcl_VarTraceProc *proc;	/* Procedure assocated with trace. */

     ClientData clientData;	/* Arbitrary argument to pass to proc. */

 {

     Tcl_UntraceVar2(interp, varName, (char *) NULL, flags, proc, clientData);

 }

 /*

  *----------------------------------------------------------------------

  *

  * Tcl_UntraceVar2 --

  *

  *	Remove a previously-created trace for a variable.

  *

  * Results:

  *	None.

  *

  * Side effects:

  *	If there exists a trace for the variable given by part1

  *	and part2 with the given flags, proc, and clientData, then

  *	that trace is removed.

  *

  *----------------------------------------------------------------------

  */

 EXPORT_C void

 Tcl_UntraceVar2(interp, part1, part2, flags, proc, clientData)

     Tcl_Interp *interp;		/* Interpreter containing variable. */

     CONST char *part1;		/* Name of variable or array. */

     CONST char *part2;		/* Name of element within array;  NULL means

 				 * trace applies to scalar variable or array

 				 * as-a-whole. */

     int flags;			/* OR-ed collection of bits describing

 				 * current trace, including any of

 				 * TCL_TRACE_READS, TCL_TRACE_WRITES,

 				 * TCL_TRACE_UNSETS, TCL_GLOBAL_ONLY,

 				 * and TCL_NAMESPACE_ONLY. */

     Tcl_VarTraceProc *proc;	/* Procedure assocated with trace. */

     ClientData clientData;	/* Arbitrary argument to pass to proc. */

 {

     register VarTrace *tracePtr;

     VarTrace *prevPtr;

     Var *varPtr, *arrayPtr;

     Interp *iPtr = (Interp *) interp;

     ActiveVarTrace *activePtr;

     int flagMask;

     /*

      * Set up a mask to mask out the parts of the flags that we are not

      * interested in now.

      */

     flagMask = TCL_GLOBAL_ONLY | TCL_NAMESPACE_ONLY;

     varPtr = TclLookupVar(interp, part1, part2, flags & flagMask,

 	    /*msg*/ (char *) NULL,

 	    /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr);

     if (varPtr == NULL) {

 	return;

     }

     /*

      * Set up a mask to mask out the parts of the flags that we are not

      * interested in now.

      */

     flagMask = TCL_TRACE_READS | TCL_TRACE_WRITES | TCL_TRACE_UNSETS |

 	TCL_TRACE_ARRAY | TCL_TRACE_RESULT_DYNAMIC | TCL_TRACE_RESULT_OBJECT; 

 #ifndef TCL_REMOVE_OBSOLETE_TRACES

     flagMask |= TCL_TRACE_OLD_STYLE;

 #endif

     flags &= flagMask;

     for (tracePtr = varPtr->tracePtr, prevPtr = NULL;  ;

 	 prevPtr = tracePtr, tracePtr = tracePtr->nextPtr) {

 	if (tracePtr == NULL) {

 	    return;

 	}

 	if ((tracePtr->traceProc == proc) && (tracePtr->flags == flags)

 		&& (tracePtr->clientData == clientData)) {

 	    break;

 	}

     }

     /*

      * The code below makes it possible to delete traces while traces

      * are active: it makes sure that the deleted trace won't be

      * processed by CallVarTraces.

      */

     for (activePtr = iPtr->activeVarTracePtr;  activePtr != NULL;

 	 activePtr = activePtr->nextPtr) {

 	if (activePtr->nextTracePtr == tracePtr) {

 	    activePtr->nextTracePtr = tracePtr->nextPtr;

 	}

     }

     if (prevPtr == NULL) {

 	varPtr->tracePtr = tracePtr->nextPtr;

     } else {

 	prevPtr->nextPtr = tracePtr->nextPtr;

     }

     Tcl_EventuallyFree((ClientData) tracePtr, TCL_DYNAMIC);

     /*

      * If this is the last trace on the variable, and the variable is

      * unset and unused, then free up the variable.

      */

     if (TclIsVarUndefined(varPtr)) {

 	CleanupVar(varPtr, (Var *) NULL);

     }

 }

 /*

  *----------------------------------------------------------------------

  *

  * Tcl_VarTraceInfo --

  *

  *	Return the clientData value associated with a trace on a

  *	variable.  This procedure can also be used to step through

  *	all of the traces on a particular variable that have the

  *	same trace procedure.

  *

  * Results:

  *	The return value is the clientData value associated with

  *	a trace on the given variable.  Information will only be

  *	returned for a trace with proc as trace procedure.  If

  *	the clientData argument is NULL then the first such trace is

  *	returned;  otherwise, the next relevant one after the one

  *	given by clientData will be returned.  If the variable

  *	doesn't exist, or if there are no (more) traces for it,

  *	then NULL is returned.

  *

  * Side effects:

  *	None.

  *

  *----------------------------------------------------------------------

  */

 EXPORT_C ClientData

 Tcl_VarTraceInfo(interp, varName, flags, proc, prevClientData)

     Tcl_Interp *interp;		/* Interpreter containing variable. */

     CONST char *varName;	/* Name of variable;  may end with "(index)"

 				 * to signify an array reference. */

     int flags;			/* OR-ed combo or TCL_GLOBAL_ONLY,

 				 * TCL_NAMESPACE_ONLY (can be 0). */

     Tcl_VarTraceProc *proc;	/* Procedure assocated with trace. */

     ClientData prevClientData;	/* If non-NULL, gives last value returned

 				 * by this procedure, so this call will

 				 * return the next trace after that one.

 				 * If NULL, this call will return the

 				 * first trace. */

 {

     return Tcl_VarTraceInfo2(interp, varName, (char *) NULL,

 	    flags, proc, prevClientData);

 }

 /*

  *----------------------------------------------------------------------

  *

  * Tcl_VarTraceInfo2 --

  *

  *	Same as Tcl_VarTraceInfo, except takes name in two pieces

  *	instead of one.

  *

  * Results:

  *	Same as Tcl_VarTraceInfo.

  *

  * Side effects:

  *	None.

  *

  *----------------------------------------------------------------------

  */

 EXPORT_C ClientData

 Tcl_VarTraceInfo2(interp, part1, part2, flags, proc, prevClientData)

     Tcl_Interp *interp;		/* Interpreter containing variable. */

     CONST char *part1;		/* Name of variable or array. */

     CONST char *part2;		/* Name of element within array;  NULL means

 				 * trace applies to scalar variable or array

 				 * as-a-whole. */

     int flags;			/* OR-ed combination of TCL_GLOBAL_ONLY,

 				 * TCL_NAMESPACE_ONLY. */

     Tcl_VarTraceProc *proc;	/* Procedure assocated with trace. */

     ClientData prevClientData;	/* If non-NULL, gives last value returned

 				 * by this procedure, so this call will

 				 * return the next trace after that one.

 				 * If NULL, this call will return the

 				 * first trace. */

 {

     register VarTrace *tracePtr;

     Var *varPtr, *arrayPtr;

     varPtr = TclLookupVar(interp, part1, part2,

 	    flags & (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY),

 	    /*msg*/ (char *) NULL,

 	    /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr);

     if (varPtr == NULL) {

 	return NULL;

     }

     /*

      * Find the relevant trace, if any, and return its clientData.

      */

     tracePtr = varPtr->tracePtr;

     if (prevClientData != NULL) {

 	for ( ;  tracePtr != NULL;  tracePtr = tracePtr->nextPtr) {

 	    if ((tracePtr->clientData == prevClientData)

 		    && (tracePtr->traceProc == proc)) {

 		tracePtr = tracePtr->nextPtr;

 		break;

 	    }

 	}

     }

     for ( ;  tracePtr != NULL;  tracePtr = tracePtr->nextPtr) {

 	if (tracePtr->traceProc == proc) {

 	    return tracePtr->clientData;

 	}

     }

     return NULL;

 }

 /*

  *----------------------------------------------------------------------

  *

  * Tcl_UnsetObjCmd --

  *

  *	This object-based procedure is invoked to process the "unset" Tcl

  *	command. See the user documentation for details on what it does.

  *

  * Results:

  *	A standard Tcl object result value.

  *

  * Side effects:

  *	See the user documentation.

  *

  *----------------------------------------------------------------------

  */

 	/* ARGSUSED */

 int

 Tcl_UnsetObjCmd(dummy, interp, objc, objv)

     ClientData dummy;		/* Not used. */

     Tcl_Interp *interp;		/* Current interpreter. */

     int objc;			/* Number of arguments. */

     Tcl_Obj *CONST objv[];	/* Argument objects. */

 {

     register int i, flags = TCL_LEAVE_ERR_MSG;

     register char *name;

     if (objc < 1) {

 	Tcl_WrongNumArgs(interp, 1, objv,

 		"?-nocomplain? ?--? ?varName varName ...?");

 	return TCL_ERROR;

     } else if (objc == 1) {

 	/*

 	 * Do nothing if no arguments supplied, so as to match

 	 * command documentation.

 	 */

 	return TCL_OK;

     }

     /*

      * Simple, restrictive argument parsing.  The only options are --

      * and -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) {

 	    i++;

  	    if (i == objc) {

 		return TCL_OK;

 	    }

  	    flags = 0;

  	    name = TclGetString(objv[i]);

  	}

  	if (strcmp("--", name) == 0) {

  	    i++;

  	}

     }

     for (; i < objc;  i++) {

 	if ((TclObjUnsetVar2(interp, objv[i], NULL, flags) != TCL_OK)

 		&& (flags == TCL_LEAVE_ERR_MSG)) {

 	    return TCL_ERROR;

 	}

     }

     return TCL_OK;

 }

 /*

  *----------------------------------------------------------------------

  *

  * Tcl_AppendObjCmd --

  *

  *	This object-based procedure is invoked to process the "append" 

  *	Tcl command. See the user documentation for details on what it does.

  *

  * Results:

  *	A standard Tcl object result value.

  *

  * Side effects:

  *	A variable's value may be changed.

  *

  *----------------------------------------------------------------------

  */

 	/* ARGSUSED */

 int

 Tcl_AppendObjCmd(dummy, interp, objc, objv)