/* 

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

 *