VarReform [Patch 1750051]

	*** POTENTIAL INCOMPATIBILITY *** (tclInt.h and tclCompile.h)

21 files changed, 2812 insertions, 2158 deletions

diff --git a/ChangeLog b/ChangeLog
index e9b09f9..cc1a8f7 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,57 @@
 2007-07-31  Miguel Sofer  <msofer@users.sf.net>
 
+	* doc/Hash.3:
+	* generic/tclHash.c:
+	* generic/tclObj.c:  
+	* generic/tclThreadStorage.c: (changes part of the patch below) 
+	Stop Tcl_CreateHashVar from resetting hPtr->clientData to NULL
+	after calling the allocEntryProc for a custom table. 
+	
+	* generic/tcl.h:
+	* generic/tclBasic.c:
+	* generic/tclCmdIL.c:
+	* generic/tclCompCmds.c:
+	* generic/tclCompile.c:
+	* generic/tclCompile.h:
+	* generic/tclExecute.c:
+	* generic/tclHash.c:
+	* generic/tclInt.decls:
+	* generic/tclInt.h:
+	* generic/tclIntDecls.h:
+	* generic/tclLiteral.c:
+	* generic/tclNamesp.c:
+	* generic/tclObj.c:
+	* generic/tclProc.c:
+	* generic/tclThreadStorage.c:
+	* generic/tclTrace.c:
+	* generic/tclVar.c:   VarReform [Patch 1750051]
+
+	*** POTENTIAL INCOMPATIBILITY *** (tclInt.h and tclCompile.h)
+	Extensions that access internals defined in tclInt.h and/or
+	tclCompile.h may lose both binary and source compatibility. The
+	relevant changes are:
+	1. 'struct Var' is completely changed, all acceses to its internals
+	(either direct or via the TclSetVar* and TclIsVar* macros) will
+	malfunction. Var flag values and semantics changed too.
+	2. 'struct Bytecode' has an additional field that has to be
+	initialised to NULL
+	3. 'struct Namespace' is larger, as the varTable is now one
+	pointer larger than a Tcl_HashTable. Direct access to its fields
+	will malfunction.
+	4. 'struct CallFrame' grew one more field (the second such growth
+	with respect to Tcl8.4).
+	5. api change for the functions TclFindCompiledLocal,
+	TclDeleteVars and many internal functions in tclVar.c
+
+	Additionally, direct access to variable hash tables via the
+	standard Tcl_Hash* interface is to be considered as deprecated. It
+	still works in the present version, but will be broken by further 
+	specialisation of these hash tables. This concerns especially the
+	table of array elements in an array, as well as the varTable field
+	in the Namespace struct.
+
+2007-07-31  Miguel Sofer  <msofer@users.sf.net>
+
 	* unix/configure.in: allow use of 'inline' in Tcl sources
 	* win/configure.in:  [Patch 1754128]
 	* win/makefile.vc:   Regen with autoconf 2.61
diff --git a/doc/Hash.3 b/doc/Hash.3
index d21ba2b..eae772e 100644
--- a/doc/Hash.3
+++ b/doc/Hash.3
@@ -5,7 +5,7 @@
 '\" See the file "license.terms" for information on usage and redistribution
 '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 '\" 
-'\" RCS: @(#) $Id: Hash.3,v 1.18 2004/10/07 16:05:14 dkf Exp $
+'\" RCS: @(#) $Id: Hash.3,v 1.19 2007/07/31 17:03:35 msofer Exp $
 '\" 
 .so man.macros
 .TH Tcl_Hash 3 "" Tcl "Tcl Library Procedures"
@@ -291,21 +291,21 @@ If the keys don't match then the function returns 0, otherwise
 it returns 1.
 .PP
 The \fIallocEntryProc\fR member contains the address of a function 
-called to allocate space for an entry and initialize the key.
+called to allocate space for an entry and initialize the key and clientData.
 .CS
 typedef Tcl_HashEntry *(Tcl_AllocHashEntryProc) (
         Tcl_HashTable *\fItablePtr\fR,
         void *\fIkeyPtr\fR);
 .CE
 If this is NULL then Tcl_Alloc is used to allocate enough space for a
-Tcl_HashEntry and the key pointer is assigned to key.oneWordValue.
+Tcl_HashEntry, the key pointer is assigned to key.oneWordValue and the
+cleintData is set to NULL.
 String keys and array keys use this function to allocate enough 
 space for the entry and the key in one block, rather than doing
 it in two blocks. This saves space for a pointer to the key from
 the entry and another memory allocation. Tcl_Obj * keys use this 
 function to allocate enough space for an entry and increment the 
 reference count on the object.
-If 
 .PP
 The \fIfreeEntryProc\fR member contains the address of a function 
 called to free space for an entry.
diff --git a/generic/tcl.h b/generic/tcl.h
index a636988..5df7989 100644
--- a/generic/tcl.h
+++ b/generic/tcl.h
@@ -13,7 +13,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tcl.h,v 1.233 2007/07/02 21:10:51 dgp Exp $
+ * RCS: @(#) $Id: tcl.h,v 1.234 2007/07/31 17:03:35 msofer Exp $
  */
 
 #ifndef _TCL
@@ -870,6 +870,7 @@ typedef struct Tcl_CallFrame {
     int dummy9;
     char *dummy10;
     char *dummy11;
+    char *dummy12;
 } Tcl_CallFrame;
 
 /*
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 3f7c983..e8aab2e 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -13,7 +13,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclBasic.c,v 1.263 2007/07/24 03:05:53 msofer Exp $
+ * RCS: @(#) $Id: tclBasic.c,v 1.264 2007/07/31 17:03:36 msofer Exp $
  */
 
 #include "tclInt.h"
@@ -440,6 +440,15 @@ Tcl_CreateInterp(void)
     iPtr->resultSpace[0] = 0;
     iPtr->threadId = Tcl_GetCurrentThread();
 
+    /*
+     * Initialise the tables for variable traces and searches *before*
+     * creating the global ns - so that the trace on errorInfo can be
+     * recorded. 
+     */
+    
+    Tcl_InitHashTable(&iPtr->varTraces, TCL_ONE_WORD_KEYS);
+    Tcl_InitHashTable(&iPtr->varSearches, TCL_ONE_WORD_KEYS);
+        
     iPtr->globalNsPtr = NULL;		/* Force creation of global ns below */
     iPtr->globalNsPtr = (Namespace *) Tcl_CreateNamespace(interp, "",
 	    (ClientData) NULL, NULL);
@@ -1334,6 +1343,10 @@ DeleteInterpProc(
 	ckfree((char *) iPtr->lineBCPtr);
 	iPtr->lineBCPtr = NULL;
     }
+
+    Tcl_DeleteHashTable(&iPtr->varTraces);
+    Tcl_DeleteHashTable(&iPtr->varSearches);    
+    
     ckfree((char *) iPtr);
 }
 
diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c
index a501105..d3decd7 100644
--- a/generic/tclCmdIL.c
+++ b/generic/tclCmdIL.c
@@ -16,7 +16,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclCmdIL.c,v 1.121 2007/07/01 14:49:43 msofer Exp $
+ * RCS: @(#) $Id: tclCmdIL.c,v 1.122 2007/07/31 17:03:36 msofer Exp $
  */
 
 #include "tclInt.h"
@@ -97,8 +97,6 @@ typedef struct SortInfo {
  * Forward declarations for procedures defined in this file:
  */
 
-static void		AppendLocals(Tcl_Interp *interp, Tcl_Obj *listPtr,
-			    CONST char *pattern, int includeLinks);
 static int		DictionaryCompare(char *left, char *right);
 static int		InfoArgsCmd(ClientData dummy, Tcl_Interp *interp,
 			    int objc, Tcl_Obj *CONST objv[]);
@@ -119,8 +117,6 @@ static int		InfoFrameCmd(ClientData dummy, Tcl_Interp *interp,
 			    int objc, Tcl_Obj *CONST objv[]);
 static int		InfoFunctionsCmd(ClientData dummy, Tcl_Interp *interp,
 			    int objc, Tcl_Obj *CONST objv[]);
-static int		InfoGlobalsCmd(ClientData dummy, Tcl_Interp *interp,
-			    int objc, Tcl_Obj *CONST objv[]);
 static int		InfoHostnameCmd(ClientData dummy, Tcl_Interp *interp,
 			    int objc, Tcl_Obj *CONST objv[]);
 static int		InfoLevelCmd(ClientData dummy, Tcl_Interp *interp,
@@ -129,8 +125,6 @@ static int		InfoLibraryCmd(ClientData dummy, Tcl_Interp *interp,
 			    int objc, Tcl_Obj *CONST objv[]);
 static int		InfoLoadedCmd(ClientData dummy, Tcl_Interp *interp,
 			    int objc, Tcl_Obj *CONST objv[]);
-static int		InfoLocalsCmd(ClientData dummy, Tcl_Interp *interp,
-			    int objc, Tcl_Obj *CONST objv[]);
 static int		InfoNameOfExecutableCmd(ClientData dummy,
 			    Tcl_Interp *interp, int objc,
 			    Tcl_Obj *CONST objv[]);
@@ -144,8 +138,6 @@ static int		InfoSharedlibCmd(ClientData dummy, Tcl_Interp *interp,
 			    int objc, Tcl_Obj *CONST objv[]);
 static int		InfoTclVersionCmd(ClientData dummy, Tcl_Interp *interp,
 			    int objc, Tcl_Obj *CONST objv[]);
-static int		InfoVarsCmd(ClientData dummy, Tcl_Interp *interp,
-			    int objc, Tcl_Obj *CONST objv[]);
 static SortElement *    MergeSort(SortElement *headPt, SortInfo *infoPtr);
 static SortElement *    MergeLists(SortElement *leftPtr, SortElement *rightPtr,
 			    SortInfo *infoPtr);
@@ -172,19 +164,19 @@ static const struct {
     {"exists",		InfoExistsCmd},
     {"frame",		InfoFrameCmd},
     {"functions",	InfoFunctionsCmd},
-    {"globals",		InfoGlobalsCmd},
+    {"globals",		TclInfoGlobalsCmd},
     {"hostname",	InfoHostnameCmd},
     {"level",		InfoLevelCmd},
     {"library",		InfoLibraryCmd},
     {"loaded",		InfoLoadedCmd},
-    {"locals",		InfoLocalsCmd},
+    {"locals",		TclInfoLocalsCmd},
     {"nameofexecutable",InfoNameOfExecutableCmd},
     {"patchlevel",	InfoPatchLevelCmd},
     {"procs",		InfoProcsCmd},
     {"script",		InfoScriptCmd},
     {"sharedlibextension", InfoSharedlibCmd},
     {"tclversion",	InfoTclVersionCmd},
-    {"vars",		InfoVarsCmd},
+    {"vars",		TclInfoVarsCmd},
     {NULL, NULL}
 };
 
@@ -1033,8 +1025,8 @@ InfoExistsCmd(
     varName = TclGetString(objv[1]);
     varPtr = TclVarTraceExists(interp, varName);
 
-    Tcl_SetObjResult(interp, Tcl_NewBooleanObj(
-	    ((varPtr != NULL) && !TclIsVarUndefined(varPtr))));
+    Tcl_SetObjResult(interp,
+	    Tcl_NewBooleanObj(varPtr && varPtr->value.objPtr));
     return TCL_OK;
 }
 
@@ -1359,94 +1351,6 @@ InfoFunctionsCmd(
 /*
  *----------------------------------------------------------------------
  *
- * InfoGlobalsCmd --
- *
- *	Called to implement the "info globals" command that returns the list
- *	of global variables matching an optional pattern. Handles the
- *	following syntax:
- *
- *	    info globals ?pattern?
- *
- * Results:
- *	Returns TCL_OK if successful and TCL_ERROR if there is an error.
- *
- * Side effects:
- *	Returns a result in the interpreter's result object. If there is an
- *	error, the result is an error message.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-InfoGlobalsCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *CONST objv[])	/* Argument objects. */
-{
-    char *varName, *pattern;
-    Namespace *globalNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp);
-    register Tcl_HashEntry *entryPtr;
-    Tcl_HashSearch search;
-    Var *varPtr;
-    Tcl_Obj *listPtr;
-
-    if (objc == 1) {
-	pattern = NULL;
-    } else if (objc == 2) {
-	pattern = TclGetString(objv[1]);
-
-	/*
-	 * Strip leading global-namespace qualifiers. [Bug 1057461]
-	 */
-
-	if (pattern[0] == ':' && pattern[1] == ':') {
-	    while (*pattern == ':') {
-		pattern++;
-	    }
-	}
-    } else {
-	Tcl_WrongNumArgs(interp, 1, objv, "?pattern?");
-	return TCL_ERROR;
-    }
-
-    /*
-     * Scan through the global :: namespace's variable table and create a list
-     * of all global variables that match the pattern.
-     */
-
-    listPtr = Tcl_NewListObj(0, NULL);
-    if (pattern != NULL && TclMatchIsTrivial(pattern)) {
-	entryPtr = Tcl_FindHashEntry(&globalNsPtr->varTable, pattern);
-	if (entryPtr != NULL) {
-	    varPtr = (Var *) Tcl_GetHashValue(entryPtr);
-	    if (!TclIsVarUndefined(varPtr)) {
-		Tcl_ListObjAppendElement(interp, listPtr,
-			Tcl_NewStringObj(pattern, -1));
-	    }
-	}
-    } else {
-	for (entryPtr = Tcl_FirstHashEntry(&globalNsPtr->varTable, &search);
-		entryPtr != NULL;
-		entryPtr = Tcl_NextHashEntry(&search)) {
-	    varPtr = (Var *) Tcl_GetHashValue(entryPtr);
-	    if (TclIsVarUndefined(varPtr)) {
-		continue;
-	    }
-	    varName = Tcl_GetHashKey(&globalNsPtr->varTable, entryPtr);
-	    if ((pattern == NULL) || Tcl_StringMatch(varName, pattern)) {
-		Tcl_ListObjAppendElement(interp, listPtr,
-			Tcl_NewStringObj(varName, -1));
-	    }
-	}
-    }
-    Tcl_SetObjResult(interp, listPtr);
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
  * InfoHostnameCmd --
  *
  *	Called to implement the "info hostname" command that returns the host
@@ -1650,162 +1554,6 @@ InfoLoadedCmd(
 /*
  *----------------------------------------------------------------------
  *
- * InfoLocalsCmd --
- *
- *	Called to implement the "info locals" command to return a list of
- *	local variables that match an optional pattern. Handles the following
- *	syntax:
- *
- *	    info locals ?pattern?
- *
- * Results:
- *	Returns TCL_OK if successful and TCL_ERROR if there is an error.
- *
- * Side effects:
- *	Returns a result in the interpreter's result object. If there is an
- *	error, the result is an error message.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-InfoLocalsCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *CONST objv[])	/* Argument objects. */
-{
-    Interp *iPtr = (Interp *) interp;
-    char *pattern;
-    Tcl_Obj *listPtr;
-
-    if (objc == 1) {
-	pattern = NULL;
-    } else if (objc == 2) {
-	pattern = TclGetString(objv[1]);
-    } else {
-	Tcl_WrongNumArgs(interp, 1, objv, "?pattern?");
-	return TCL_ERROR;
-    }
-
-    if (!(iPtr->varFramePtr->isProcCallFrame & FRAME_IS_PROC )) {
-	return TCL_OK;
-    }
-
-    /*
-     * Return a list containing names of first the compiled locals (i.e. the
-     * ones stored in the call frame), then the variables in the local hash
-     * table (if one exists).
-     */
-
-    listPtr = Tcl_NewListObj(0, NULL);
-    AppendLocals(interp, listPtr, pattern, 0);
-    Tcl_SetObjResult(interp, listPtr);
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * AppendLocals --
- *
- *	Append the local variables for the current frame to the specified list
- *	object.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-AppendLocals(
-    Tcl_Interp *interp,		/* Current interpreter. */
-    Tcl_Obj *listPtr,		/* List object to append names to. */
-    CONST char *pattern,	/* Pattern to match against. */
-    int includeLinks)		/* 1 if upvars should be included, else 0. */
-{
-    Interp *iPtr = (Interp *) interp;
-    CompiledLocal *localPtr;
-    Var *varPtr;
-    int i, localVarCt;
-    const char *varName;
-    Tcl_HashTable *localVarTablePtr;
-    register Tcl_HashEntry *entryPtr;
-    Tcl_HashSearch search;
-
-    localPtr = iPtr->varFramePtr->procPtr->firstLocalPtr;
-    localVarCt = iPtr->varFramePtr->numCompiledLocals;
-    varPtr = iPtr->varFramePtr->compiledLocals;
-    localVarTablePtr = iPtr->varFramePtr->varTablePtr;
-
-    for (i = 0; i < localVarCt; i++) {
-	/*
-	 * Skip nameless (temporary) variables and undefined variables.
-	 */
-
-	if (!TclIsVarTemporary(localPtr) && !TclIsVarUndefined(varPtr)
-		&& (includeLinks || !TclIsVarLink(varPtr))) {
-	    varName = varPtr->name;
-	    if ((pattern == NULL) || Tcl_StringMatch(varName, pattern)) {
-		Tcl_ListObjAppendElement(interp, listPtr,
-			Tcl_NewStringObj(varName, -1));
-	    }
-	}
-	varPtr++;
-	localPtr = localPtr->nextPtr;
-    }
-
-    /*
-     * Do nothing if no local variables.
-     */
-
-    if (localVarTablePtr == NULL) {
-	return;
-    }
-
-    /*
-     * Check for the simple and fast case.
-     */
-
-    if ((pattern != NULL) && TclMatchIsTrivial(pattern)) {
-	entryPtr = Tcl_FindHashEntry(localVarTablePtr, pattern);
-	if (entryPtr != NULL) {
-	    varPtr = (Var *) Tcl_GetHashValue(entryPtr);
-	    if (!TclIsVarUndefined(varPtr)
-		    && (includeLinks || !TclIsVarLink(varPtr))) {
-		Tcl_ListObjAppendElement(interp, listPtr,
-			Tcl_NewStringObj(pattern, -1));
-	    }
-	}
-	return;
-    }
-
-    /*
-     * Scan over and process all local variables.
-     */
-
-    for (entryPtr = Tcl_FirstHashEntry(localVarTablePtr, &search);
-	    entryPtr != NULL;
-	    entryPtr = Tcl_NextHashEntry(&search)) {
-	varPtr = (Var *) Tcl_GetHashValue(entryPtr);
-	if (!TclIsVarUndefined(varPtr)
-		&& (includeLinks || !TclIsVarLink(varPtr))) {
-	    varName = Tcl_GetHashKey(localVarTablePtr, entryPtr);
-	    if ((pattern == NULL) || Tcl_StringMatch(varName, pattern)) {
-		Tcl_ListObjAppendElement(interp, listPtr,
-			Tcl_NewStringObj(varName, -1));
-	    }
-	}
-    }
-}
-
-/*
- *----------------------------------------------------------------------
- *
  * InfoNameOfExecutableCmd --
  *
  *	Called to implement the "info nameofexecutable" command that returns
@@ -2206,197 +1954,6 @@ InfoTclVersionCmd(
 /*
  *----------------------------------------------------------------------
  *
- * InfoVarsCmd --
- *
- *	Called to implement the "info vars" command that returns the list of
- *	variables in the interpreter that match an optional pattern. The
- *	pattern, if any, consists of an optional sequence of namespace names
- *	separated by "::" qualifiers, which is followed by a glob-style
- *	pattern that restricts which variables are returned. Handles the
- *	following syntax:
- *
- *	    info vars ?pattern?
- *
- * Results:
- *	Returns TCL_OK if successful and TCL_ERROR if there is an error.
- *
- * Side effects:
- *	Returns a result in the interpreter's result object. If there is an
- *	error, the result is an error message.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-InfoVarsCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *CONST objv[])	/* Argument objects. */
-{
-    Interp *iPtr = (Interp *) interp;
-    char *varName, *pattern;
-    CONST char *simplePattern;
-    register Tcl_HashEntry *entryPtr;
-    Tcl_HashSearch search;
-    Var *varPtr;
-    Namespace *nsPtr;
-    Namespace *globalNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp);
-    Namespace *currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
-    Tcl_Obj *listPtr, *elemObjPtr;
-    int specificNsInPattern = 0;/* Init. to avoid compiler warning. */
-
-    /*
-     * Get the pattern and find the "effective namespace" in which to list
-     * variables. We only use this effective namespace if there's no active
-     * Tcl procedure frame.
-     */
-
-    if (objc == 1) {
-	simplePattern = NULL;
-	nsPtr = currNsPtr;
-	specificNsInPattern = 0;
-    } else if (objc == 2) {
-	/*
-	 * From the pattern, get the effective namespace and the simple
-	 * pattern (no namespace qualifiers or ::'s) at the end. If an error
-	 * was found while parsing the pattern, return it. Otherwise, if the
-	 * namespace wasn't found, just leave nsPtr NULL: we will return an
-	 * empty list since no variables there can be found.
-	 */
-
-	Namespace *dummy1NsPtr, *dummy2NsPtr;
-
-	pattern = TclGetString(objv[1]);
-	TclGetNamespaceForQualName(interp, pattern, (Namespace *) NULL,
-		/*flags*/ 0, &nsPtr, &dummy1NsPtr, &dummy2NsPtr,
-		&simplePattern);
-
-	if (nsPtr != NULL) {	/* We successfully found the pattern's ns. */
-	    specificNsInPattern = (strcmp(simplePattern, pattern) != 0);
-	}
-    } else {
-	Tcl_WrongNumArgs(interp, 1, objv, "?pattern?");
-	return TCL_ERROR;
-    }
-
-    /*
-     * If the namespace specified in the pattern wasn't found, just return.
-     */
-
-    if (nsPtr == NULL) {
-	return TCL_OK;
-    }
-
-    listPtr = Tcl_NewListObj(0, NULL);
-
-    if (!(iPtr->varFramePtr->isProcCallFrame & FRAME_IS_PROC)
-	    || specificNsInPattern) {
-	/*
-	 * There is no frame pointer, the frame pointer was pushed only to
-	 * activate a namespace, or we are in a procedure call frame but a
-	 * specific namespace was specified. Create a list containing only the
-	 * variables in the effective namespace's variable table.
-	 */
-
-	if (simplePattern != NULL && TclMatchIsTrivial(simplePattern)) {
-	    /*
-	     * If we can just do hash lookups, that simplifies things a lot.
-	     */
-
-	    entryPtr = Tcl_FindHashEntry(&nsPtr->varTable, simplePattern);
-	    if (entryPtr != NULL) {
-		varPtr = (Var *) Tcl_GetHashValue(entryPtr);
-		if (!TclIsVarUndefined(varPtr)
-			|| TclIsVarNamespaceVar(varPtr)) {
-		    if (specificNsInPattern) {
-			elemObjPtr = Tcl_NewObj();
-			Tcl_GetVariableFullName(interp, (Tcl_Var) varPtr,
-				    elemObjPtr);
-		    } else {
-			elemObjPtr = Tcl_NewStringObj(simplePattern, -1);
-		    }
-		    Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr);
-		}
-	    } else if ((nsPtr != globalNsPtr) && !specificNsInPattern) {
-		entryPtr = Tcl_FindHashEntry(&globalNsPtr->varTable,
-			simplePattern);
-		if (entryPtr != NULL) {
-		    varPtr = (Var *) Tcl_GetHashValue(entryPtr);
-		    if (!TclIsVarUndefined(varPtr)
-			    || TclIsVarNamespaceVar(varPtr)) {
-			Tcl_ListObjAppendElement(interp, listPtr,
-				Tcl_NewStringObj(simplePattern, -1));
-		    }
-		}
-	    }
-	} else {
-	    /*
-	     * Have to scan the tables of variables.
-	     */
-
-	    entryPtr = Tcl_FirstHashEntry(&nsPtr->varTable, &search);
-	    while (entryPtr != NULL) {
-		varPtr = (Var *) Tcl_GetHashValue(entryPtr);
-		if (!TclIsVarUndefined(varPtr)
-			|| TclIsVarNamespaceVar(varPtr)) {
-		    varName = Tcl_GetHashKey(&nsPtr->varTable, entryPtr);
-		    if ((simplePattern == NULL)
-			    || Tcl_StringMatch(varName, simplePattern)) {
-			if (specificNsInPattern) {
-			    elemObjPtr = Tcl_NewObj();
-			    Tcl_GetVariableFullName(interp, (Tcl_Var) varPtr,
-				    elemObjPtr);
-			} else {
-			    elemObjPtr = Tcl_NewStringObj(varName, -1);
-			}
-			Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr);
-		    }
-		}
-		entryPtr = Tcl_NextHashEntry(&search);
-	    }
-
-	    /*
-	     * If the effective namespace isn't the global :: namespace, and a
-	     * specific namespace wasn't requested in the pattern (i.e., the
-	     * pattern only specifies variable names), then add in all global
-	     * :: variables that match the simple pattern. Of course, add in
-	     * only those variables that aren't hidden by a variable in the
-	     * effective namespace.
-	     */
-
-	    if ((nsPtr != globalNsPtr) && !specificNsInPattern) {
-		entryPtr = Tcl_FirstHashEntry(&globalNsPtr->varTable,&search);
-		while (entryPtr != NULL) {
-		    varPtr = (Var *) Tcl_GetHashValue(entryPtr);
-		    if (!TclIsVarUndefined(varPtr)
-			    || TclIsVarNamespaceVar(varPtr)) {
-			varName = Tcl_GetHashKey(&globalNsPtr->varTable,
-				entryPtr);
-			if ((simplePattern == NULL)
-				|| Tcl_StringMatch(varName, simplePattern)) {
-			    if (Tcl_FindHashEntry(&nsPtr->varTable,
-				    varName) == NULL) {
-				Tcl_ListObjAppendElement(interp, listPtr,
-					Tcl_NewStringObj(varName, -1));
-			    }
-			}
-		    }
-		    entryPtr = Tcl_NextHashEntry(&search);
-		}
-	    }
-	}
-    } else if (((Interp *)interp)->varFramePtr->procPtr != NULL) {
-	AppendLocals(interp, listPtr, simplePattern, 1);
-    }
-
-    Tcl_SetObjResult(interp, listPtr);
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
  * Tcl_JoinObjCmd --
  *
  *	This procedure is invoked to process the "join" Tcl command. See the
diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index 8176295..9748a60 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -12,7 +12,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclCompCmds.c,v 1.113 2007/07/11 21:27:28 msofer Exp $
+ * RCS: @(#) $Id: tclCompCmds.c,v 1.114 2007/07/31 17:03:36 msofer Exp $
  */
 
 #include "tclInt.h"
@@ -403,8 +403,7 @@ TclCompileCatchCmd(
 	    return TCL_ERROR;
 	}
 	resultIndex = TclFindCompiledLocal(resultNameTokenPtr[1].start,
-		resultNameTokenPtr[1].size, /*create*/ 1, VAR_SCALAR,
-		envPtr->procPtr);
+		resultNameTokenPtr[1].size, /*create*/ 1, envPtr->procPtr);
 
 	/* DKF */
 	if (parsePtr->numWords == 4) {
@@ -418,8 +417,7 @@ TclCompileCatchCmd(
 		return TCL_ERROR;
 	    }
 	    optsIndex = TclFindCompiledLocal(optsNameTokenPtr[1].start,
-		    optsNameTokenPtr[1].size, /*create*/ 1, VAR_SCALAR,
-		    envPtr->procPtr);
+		    optsNameTokenPtr[1].size, /*create*/ 1, envPtr->procPtr);
 	}
     }
 
@@ -658,8 +656,7 @@ TclCompileDictCmd(
 	if (!TclIsLocalScalar(name, nameChars)) {
 	    return TCL_ERROR;
 	}
-	dictVarIndex = TclFindCompiledLocal(name, nameChars, 1, VAR_SCALAR,
-		procPtr);
+	dictVarIndex = TclFindCompiledLocal(name, nameChars, 1, procPtr);
 	for (i=1 ; i<numWords ; i++) {
 	    CompileWord(envPtr, tokenPtr, interp, i);
 	    tokenPtr = TokenAfter(tokenPtr);
@@ -705,8 +702,7 @@ TclCompileDictCmd(
 	if (!TclIsLocalScalar(name, nameChars)) {
 	    return TCL_ERROR;
 	}
-	dictVarIndex = TclFindCompiledLocal(name, nameChars, 1, VAR_SCALAR,
-		procPtr);
+	dictVarIndex = TclFindCompiledLocal(name, nameChars, 1, procPtr);
 	CompileWord(envPtr, keyTokenPtr, interp, 3);
 	TclEmitInstInt4( INST_DICT_INCR_IMM, incrAmount,	envPtr);
 	TclEmitInt4(	 dictVarIndex,				envPtr);
@@ -770,15 +766,13 @@ TclCompileDictCmd(
 	    ckfree((char *) argv);
 	    return TCL_ERROR;
 	}
-	keyVarIndex = TclFindCompiledLocal(argv[0], nameChars, 1, VAR_SCALAR,
-		procPtr);
+	keyVarIndex = TclFindCompiledLocal(argv[0], nameChars, 1, procPtr);
 	nameChars = strlen(argv[1]);
 	if (!TclIsLocalScalar(argv[1], nameChars)) {
 	    ckfree((char *) argv);
 	    return TCL_ERROR;
 	}
-	valueVarIndex = TclFindCompiledLocal(argv[1], nameChars, 1, VAR_SCALAR,
-		procPtr);
+	valueVarIndex = TclFindCompiledLocal(argv[1], nameChars, 1, procPtr);
 	ckfree((char *) argv);
 
 	/*
@@ -788,7 +782,7 @@ TclCompileDictCmd(
 	 * unset (at which point it should also have been finished with).
 	 */
 
-	infoIndex = TclFindCompiledLocal(NULL, 0, 1, VAR_SCALAR, procPtr);
+	infoIndex = TclFindCompiledLocal(NULL, 0, 1, procPtr);
 
 	/*
 	 * Preparation complete; issue instructions. Note that this code
@@ -934,8 +928,7 @@ TclCompileDictCmd(
 	if (!TclIsLocalScalar(name, nameChars)) {
 	    return TCL_ERROR;
 	}
-	dictIndex = TclFindCompiledLocal(name, nameChars, 1, VAR_SCALAR,
-		procPtr);
+	dictIndex = TclFindCompiledLocal(name, nameChars, 1, procPtr);
 
 	duiPtr = (DictUpdateInfo *)
 		ckalloc(sizeof(DictUpdateInfo) + sizeof(int) * (numVars - 1));
@@ -958,8 +951,8 @@ TclCompileDictCmd(
 		TclStackFree(interp, keyTokenPtrs);
 		return TCL_ERROR;
 	    }
-	    duiPtr->varIndices[i] = TclFindCompiledLocal(name, nameChars, 1,
-		    VAR_SCALAR, procPtr);
+	    duiPtr->varIndices[i] =
+		TclFindCompiledLocal(name, nameChars, 1, procPtr);
 	    tokenPtr = TokenAfter(tokenPtr);
 	}
 	if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
@@ -969,7 +962,7 @@ TclCompileDictCmd(
 	}
 	bodyTokenPtr = tokenPtr;
 
-	keyTmpIndex = TclFindCompiledLocal(NULL, 0, 1, VAR_SCALAR, procPtr);
+	keyTmpIndex = TclFindCompiledLocal(NULL, 0, 1, procPtr);
 
 	/*
 	 * The list of variables to bind is stored in auxiliary data so that
@@ -1040,8 +1033,7 @@ TclCompileDictCmd(
 	if (!TclIsLocalScalar(name, nameChars)) {
 	    return TCL_ERROR;
 	}
-	dictVarIndex = TclFindCompiledLocal(name, nameChars, 1, VAR_SCALAR,
-		procPtr);
+	dictVarIndex = TclFindCompiledLocal(name, nameChars, 1, procPtr);
 	for (i=1 ; i<numWords ; i++) {
 	    CompileWord(envPtr, tokenPtr, interp, i);
 	    tokenPtr = TokenAfter(tokenPtr);
@@ -1070,8 +1062,7 @@ TclCompileDictCmd(
 	if (!TclIsLocalScalar(name, nameChars)) {
 	    return TCL_ERROR;
 	}
-	dictVarIndex = TclFindCompiledLocal(name, nameChars, 1, VAR_SCALAR,
-		procPtr);
+	dictVarIndex = TclFindCompiledLocal(name, nameChars, 1, procPtr);
 	CompileWord(envPtr, keyTokenPtr, interp, 3);
 	CompileWord(envPtr, valueTokenPtr, interp, 4);
 	TclEmitInstInt4( INST_DICT_LAPPEND, dictVarIndex,	envPtr);
@@ -1514,13 +1505,13 @@ TclCompileForeachCmd(
     firstValueTemp = -1;
     for (loopIndex = 0;  loopIndex < numLists;  loopIndex++) {
 	tempVar = TclFindCompiledLocal(NULL, /*nameChars*/ 0,
-		/*create*/ 1, VAR_SCALAR, procPtr);
+		/*create*/ 1, procPtr);
 	if (loopIndex == 0) {
 	    firstValueTemp = tempVar;
 	}
     }
     loopCtTemp = TclFindCompiledLocal(NULL, /*nameChars*/ 0,
-	    /*create*/ 1, VAR_SCALAR, procPtr);
+	    /*create*/ 1, procPtr);
 
     /*
      * Create and initialize the ForeachInfo and ForeachVarList data
@@ -1544,7 +1535,7 @@ TclCompileForeachCmd(
 	    int nameChars = strlen(varName);
 
 	    varListPtr->varIndexes[j] = TclFindCompiledLocal(varName,
-		    nameChars, /*create*/ 1, VAR_SCALAR, procPtr);
+		    nameChars, /*create*/ 1, procPtr);
 	}
 	infoPtr->varLists[loopIndex] = varListPtr;
     }
@@ -4663,7 +4654,6 @@ PushVarName(
 	if ((envPtr->procPtr != NULL) && !hasNsQualifiers) {
 	    localIndex = TclFindCompiledLocal(name, nameChars,
 		    /*create*/ flags & TCL_CREATE_VAR,
-		    /*flags*/ ((elName==NULL)? VAR_SCALAR : VAR_ARRAY),
 		    envPtr->procPtr);
 	    if ((flags & TCL_NO_LARGE_INDEX) && (localIndex > 255)) {
 		/*
@@ -4879,8 +4869,7 @@ CompileComparisonOpCmd(
 
 	return TCL_ERROR;
     } else {
-	int tmpIndex = TclFindCompiledLocal(NULL, 0, 1, VAR_SCALAR,
-		envPtr->procPtr);
+	int tmpIndex = TclFindCompiledLocal(NULL, 0, 1, envPtr->procPtr);
 	int words;
 
 	tokenPtr = TokenAfter(parsePtr->tokenPtr);
@@ -5334,7 +5323,6 @@ IndexTailVarIfKnown(
 
     localIndex = TclFindCompiledLocal(tailName, len,
 	    /*create*/ TCL_CREATE_VAR,
-	    /*flags*/  0,
 	    envPtr->procPtr);
     Tcl_DecrRefCount(tailPtr);
     return localIndex;
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index d55df75..de7f4c2 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -11,7 +11,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclCompile.c,v 1.124 2007/07/11 21:27:28 msofer Exp $
+ * RCS: @(#) $Id: tclCompile.c,v 1.125 2007/07/31 17:03:37 msofer Exp $
  */
 
 #include "tclInt.h"
@@ -724,8 +724,9 @@ TclCleanupByteCode(
      * A single heap object holds the ByteCode structure and its code, object,
      * command location, and auxiliary data arrays. This means we only need to
      * 1) decrement the ref counts of the LiteralEntry's in its literal array,
-     * 2) call the free procs for the auxiliary data items, and 3) free the
-     * ByteCode structure's heap object.
+     * 2) call the free procs for the auxiliary data items, 3) free the
+     * localCache if it is unused, and finally 4) free the ByteCode
+     * structure's heap object. 
      *
      * The case for TCL_BYTECODE_PRECOMPILED (precompiled ByteCodes, like
      * those generated from tbcload) is special, as they doesn't make use of
@@ -806,6 +807,10 @@ TclCleanupByteCode(
 	}
     }
 
+    if (codePtr->localCachePtr && (--codePtr->localCachePtr->refCount == 0)) {
+	TclFreeLocalCache(interp, codePtr->localCachePtr);
+    }
+
     TclHandleRelease(codePtr->interpHandle);
     ckfree((char *) codePtr);
 }
@@ -1657,7 +1662,7 @@ TclCompileTokens(
 	    localVar = -1;
 	    if (localVarName != -1) {
 		localVar = TclFindCompiledLocal(name, nameBytes, localVarName,
-			/*flags*/ 0, envPtr->procPtr);
+			envPtr->procPtr);
 	    }
 	    if (localVar < 0) {
 		TclEmitPush(TclRegisterNewLiteral(envPtr, name, nameBytes),
@@ -2066,6 +2071,8 @@ TclInitByteCodeObj(
     Tcl_SetHashValue(Tcl_CreateHashEntry(iPtr->lineBCPtr, (char *) codePtr,
 	    &new), envPtr->extCmdMapPtr);
     envPtr->extCmdMapPtr = NULL;
+
+    codePtr->localCachePtr = NULL;
 }
 
 /*
@@ -2101,9 +2108,6 @@ TclFindCompiledLocal(
     int nameBytes,		/* Number of bytes in the name. */
     int create,			/* If 1, allocate a local frame entry for the
 				 * variable if it is new. */
-    int flags,			/* Flag bits for the compiled local if
-				 * created. Only VAR_SCALAR, VAR_ARRAY, and
-				 * VAR_LINK make sense. */
     register Proc *procPtr)	/* Points to structure describing procedure
 				 * containing the variable reference. */
 {
@@ -2151,7 +2155,7 @@ TclFindCompiledLocal(
 	localPtr->nextPtr = NULL;
 	localPtr->nameLength = nameBytes;
 	localPtr->frameIndex = localVar;
-	localPtr->flags = flags | VAR_UNDEFINED;
+	localPtr->flags = 0;
 	if (name == NULL) {
 	    localPtr->flags |= VAR_TEMPORARY;
 	}
@@ -3317,7 +3321,7 @@ TclPrintByteCodeObj(
 	    CompiledLocal *localPtr = procPtr->firstLocalPtr;
 	    for (i = 0;  i < numCompiledLocals;  i++) {
 		fprintf(stdout, "      slot %d%s%s%s%s%s%s", i,
-			(localPtr->flags & VAR_SCALAR) ? ", scalar" : "",
+			(localPtr->flags & (VAR_ARRAY|VAR_LINK)) ? "" : ", scalar",
 			(localPtr->flags & VAR_ARRAY) ? ", array" : "",
 			(localPtr->flags & VAR_LINK) ? ", link" : "",
 			(localPtr->flags & VAR_ARGUMENT) ? ", arg" : "",
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index 691d673..bdc190e 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -8,7 +8,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclCompile.h,v 1.74 2007/06/21 12:43:18 dkf Exp $
+ * RCS: @(#) $Id: tclCompile.h,v 1.75 2007/07/31 17:03:37 msofer Exp $
  */
 
 #ifndef _TCLCOMPILATION
@@ -416,6 +416,9 @@ typedef struct ByteCode {
 				 * code deltas. Source lengths are always
 				 * positive. This sequence is just after the
 				 * last byte in the source delta sequence. */
+    LocalCache *localCachePtr;  /* Pointer to the start of the cached variable
+				 * names and initialisation data for local
+				 * variables. */
 #ifdef TCL_COMPILE_STATS
     Tcl_Time createTime;	/* Absolute time when the ByteCode was
 				 * created. */
@@ -847,6 +850,10 @@ MODULE_SCOPE int	TclCreateAuxData(ClientData clientData,
 MODULE_SCOPE int	TclCreateExceptRange(ExceptionRangeType type,
 			    CompileEnv *envPtr);
 MODULE_SCOPE ExecEnv *	TclCreateExecEnv(Tcl_Interp *interp);
+MODULE_SCOPE Tcl_Obj *  TclCreateLiteral(Interp *iPtr, char *bytes,
+	                    int length, unsigned int hash, int *newPtr,
+	                    Namespace *nsPtr, int flags,
+	                    LiteralEntry **globalPtrPtr);
 MODULE_SCOPE void	TclDeleteExecEnv(ExecEnv *eePtr);
 MODULE_SCOPE void	TclDeleteLiteralTable(Tcl_Interp *interp,
 			    LiteralTable *tablePtr);
@@ -859,7 +866,7 @@ MODULE_SCOPE int	TclExecuteByteCode(Tcl_Interp *interp,
 			    ByteCode *codePtr);
 MODULE_SCOPE void	TclFinalizeAuxDataTypeTable(void);
 MODULE_SCOPE int	TclFindCompiledLocal(CONST char *name, int nameChars,
-			    int create, int flags, Proc *procPtr);
+			    int create, Proc *procPtr);
 MODULE_SCOPE LiteralEntry * TclLookupLiteralEntry(Tcl_Interp *interp,
 			    Tcl_Obj *objPtr);
 MODULE_SCOPE int	TclFixupForwardJump(CompileEnv *envPtr,
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index fb4570e..1112c40 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -12,7 +12,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclExecute.c,v 1.306 2007/07/24 03:05:53 msofer Exp $
+ * RCS: @(#) $Id: tclExecute.c,v 1.307 2007/07/31 17:03:37 msofer Exp $
  */
 
 #include "tclInt.h"
@@ -177,6 +177,27 @@ static BuiltinFunc tclBuiltinFuncTable[] = {
 #endif
 
 /*
+ * These variable-access macros have to coincide with those in tclVar.c
+ */
+
+#define VarHashGetValue(hPtr) \
+    ((Var *) ((char *)hPtr - offsetof(VarInHash, entry)))
+
+static inline Var *
+VarHashCreateVar(TclVarHashTable *tablePtr, Tcl_Obj *key, int *newPtr)
+{
+    Tcl_HashEntry *hPtr = Tcl_CreateHashEntry((Tcl_HashTable *) tablePtr, (char *) key, newPtr);
+    if (hPtr) {
+	return VarHashGetValue(hPtr);
+    } else {
+	return NULL;
+    }
+}
+
+#define VarHashFindVar(tablePtr, key) \
+    VarHashCreateVar((tablePtr), (key), NULL)
+
+/*
  * The new macro for ending an instruction; note that a reasonable C-optimiser
  * will resolve all branches at compile time. (result) is always a constant;
  * the macro NEXT_INST_F handles constant (nCleanup), NEXT_INST_V is resolved
@@ -2226,14 +2247,13 @@ TclExecuteByteCode(
      */
     {
 	int opnd, pcAdjustment;
-	char *part1, *part2;
+	Tcl_Obj *part1Ptr, *part2Ptr;
 	Var *varPtr, *arrayPtr;
 	Tcl_Obj *objPtr;
 
     case INST_LOAD_SCALAR1:
 	opnd = TclGetUInt1AtPtr(pc+1);
 	varPtr = &(compiledLocals[opnd]);
-	part1 = varPtr->name;
 	while (TclIsVarLink(varPtr)) {
 	    varPtr = varPtr->value.linkPtr;
 	}
@@ -2250,13 +2270,12 @@ TclExecuteByteCode(
 	pcAdjustment = 2;
 	cleanup = 0;
 	arrayPtr = NULL;
-	part2 = NULL;
+	part1Ptr = part2Ptr = NULL;
 	goto doCallPtrGetVar;
 
     case INST_LOAD_SCALAR4:
 	opnd = TclGetUInt4AtPtr(pc+1);
 	varPtr = &(compiledLocals[opnd]);
-	part1 = varPtr->name;
 	while (TclIsVarLink(varPtr)) {
 	    varPtr = varPtr->value.linkPtr;
 	}
@@ -2273,30 +2292,71 @@ TclExecuteByteCode(
 	pcAdjustment = 5;
 	cleanup = 0;
 	arrayPtr = NULL;
-	part2 = NULL;
+	part1Ptr = part2Ptr = NULL;
+	goto doCallPtrGetVar;
+
+    case INST_LOAD_ARRAY4:
+	opnd = TclGetUInt4AtPtr(pc+1);
+	pcAdjustment = 5;
+	goto doLoadArray;
+
+    case INST_LOAD_ARRAY1:
+	opnd = TclGetUInt1AtPtr(pc+1);
+	pcAdjustment = 2;
+
+    doLoadArray:
+	part1Ptr = NULL;
+	part2Ptr = OBJ_AT_TOS;
+	arrayPtr = &(compiledLocals[opnd]);
+	while (TclIsVarLink(arrayPtr)) {
+	    arrayPtr = arrayPtr->value.linkPtr;
+	}
+	TRACE(("%u \"%.30s\" => ", opnd, part2));
+	if (TclIsVarArray(arrayPtr) && !(arrayPtr->flags & VAR_TRACED_READ)) {
+	    varPtr = VarHashFindVar(arrayPtr->value.tablePtr, part2Ptr);
+	    if (varPtr) {
+		if (TclIsVarDirectReadable(varPtr)) {
+		    /*
+		     * No errors, no traces: just get the value.
+		     */
+
+		    objResultPtr = varPtr->value.objPtr;
+		    TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
+		    NEXT_INST_F(pcAdjustment, 1, 1);
+		}
+	    }
+	}
+	varPtr = TclLookupArrayElement(interp, part1Ptr, part2Ptr,
+		TCL_LEAVE_ERR_MSG, "read", 0, 1, arrayPtr, opnd);
+	if (varPtr == NULL) {
+	    TRACE_APPEND(("ERROR: %.30s\n",
+				 O2S(Tcl_GetObjResult(interp))));
+	    result = TCL_ERROR;
+	    goto checkForCatch;
+	}
+	cleanup = 1;
 	goto doCallPtrGetVar;
 
     case INST_LOAD_ARRAY_STK:
 	cleanup = 2;
-	part2 = Tcl_GetString(OBJ_AT_TOS);	/* element name */
-	objPtr = OBJ_UNDER_TOS;			/* array name */
+	part2Ptr = OBJ_AT_TOS;	  /* element name */
+	objPtr = OBJ_UNDER_TOS;   /* array name */
 	TRACE(("\"%.30s(%.30s)\" => ", O2S(objPtr), part2));
 	goto doLoadStk;
 
     case INST_LOAD_STK:
     case INST_LOAD_SCALAR_STK:
 	cleanup = 1;
-	part2 = NULL;
+	part2Ptr = NULL;
 	objPtr = OBJ_AT_TOS;			/* variable name */
 	TRACE(("\"%.30s\" => ", O2S(objPtr)));
 
     doLoadStk:
-	part1 = TclGetString(objPtr);
-	varPtr = TclObjLookupVar(interp, objPtr, part2, TCL_LEAVE_ERR_MSG,
+	part1Ptr = objPtr;
+	varPtr = TclObjLookupVarEx(interp, part1Ptr, part2Ptr, TCL_LEAVE_ERR_MSG,
 		"read", /*createPart1*/ 0, /*createPart2*/ 1, &arrayPtr);
 	if (varPtr) {
-	    if (TclIsVarDirectReadable(varPtr)
-		    && ((arrayPtr == NULL) || TclIsVarUntraced(arrayPtr))) {
+	    if (TclIsVarDirectReadable2(varPtr, arrayPtr)) {
 		/*
 		 * No errors, no traces: just get the value.
 		 */
@@ -2305,6 +2365,7 @@ TclExecuteByteCode(
 		NEXT_INST_V(1, cleanup, 1);
 	    }
 	    pcAdjustment = 1;
+	    opnd = -1;
 	    goto doCallPtrGetVar;
 	} else {
 	    TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
@@ -2312,57 +2373,6 @@ TclExecuteByteCode(
 	    goto checkForCatch;
 	}
 
-    case INST_LOAD_ARRAY4:
-	opnd = TclGetUInt4AtPtr(pc+1);
-	pcAdjustment = 5;
-	goto doLoadArray;
-
-    case INST_LOAD_ARRAY1:
-	opnd = TclGetUInt1AtPtr(pc+1);
-	pcAdjustment = 2;
-
-    doLoadArray:
-	part2 = TclGetString(OBJ_AT_TOS);
-	arrayPtr = &(compiledLocals[opnd]);
-	part1 = arrayPtr->name;
-	while (TclIsVarLink(arrayPtr)) {
-	    arrayPtr = arrayPtr->value.linkPtr;
-	}
-	TRACE(("%u \"%.30s\" => ", opnd, part2));
-	if (!TclIsVarUndefined(arrayPtr)
-		&& TclIsVarArray(arrayPtr)
-		&& TclIsVarUntraced(arrayPtr)) {
-	    Tcl_HashEntry *hPtr = Tcl_FindHashEntry(arrayPtr->value.tablePtr,
-		    part2);
-	    if (hPtr) {
-		varPtr = (Var *) Tcl_GetHashValue(hPtr);
-	    } else {
-		goto doLoadArrayNextBranch;
-	    }
-	} else {
-	doLoadArrayNextBranch:
-	    varPtr = TclLookupArrayElement(interp, part1, part2,
-		    TCL_LEAVE_ERR_MSG, "read", 0, 1, arrayPtr);
-	    if (varPtr == NULL) {
-		TRACE_APPEND(("ERROR: %.30s\n",
-			O2S(Tcl_GetObjResult(interp))));
-		result = TCL_ERROR;
-		goto checkForCatch;
-	    }
-	}
-	if (TclIsVarDirectReadable(varPtr)
-		&& ((arrayPtr == NULL) || TclIsVarUntraced(arrayPtr))) {
-	    /*
-	     * No errors, no traces: just get the value.
-	     */
-
-	    objResultPtr = varPtr->value.objPtr;
-	    TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
-	    NEXT_INST_F(pcAdjustment, 1, 1);
-	}
-	cleanup = 1;
-	goto doCallPtrGetVar;
-
     doCallPtrGetVar:
 	/*
 	 * There are either errors or the variable is traced: call
@@ -2370,8 +2380,8 @@ TclExecuteByteCode(
 	 */
 
 	DECACHE_STACK_INFO();
-	objResultPtr = TclPtrGetVar(interp, varPtr, arrayPtr, part1, part2,
-		TCL_LEAVE_ERR_MSG);
+	objResultPtr = TclPtrGetVar(interp, varPtr, arrayPtr, part1Ptr, part2Ptr,
+		TCL_LEAVE_ERR_MSG, opnd);
 	CACHE_STACK_INFO();
 	if (objResultPtr) {
 	    TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
@@ -2399,64 +2409,143 @@ TclExecuteByteCode(
 
     {
 	int opnd, pcAdjustment, storeFlags;
-	char *part1, *part2;
+	Tcl_Obj *part1Ptr, *part2Ptr;
 	Var *varPtr, *arrayPtr;
 	Tcl_Obj *objPtr, *valuePtr;
 
+    case INST_STORE_ARRAY4:
+	opnd = TclGetUInt4AtPtr(pc+1);
+	pcAdjustment = 5;
+	goto doStoreArrayDirect;
+
+    case INST_STORE_ARRAY1:
+	opnd = TclGetUInt1AtPtr(pc+1);
+	pcAdjustment = 2;
+
+    doStoreArrayDirect:
+	valuePtr = OBJ_AT_TOS;
+	part2Ptr = OBJ_UNDER_TOS;
+	arrayPtr = &(compiledLocals[opnd]);
+	TRACE(("%u \"%.30s\" <- \"%.30s\" => ", opnd, part2, O2S(valuePtr)));
+	while (TclIsVarLink(arrayPtr)) {
+	    arrayPtr = arrayPtr->value.linkPtr;
+	}
+	if (TclIsVarArray(arrayPtr) && !(arrayPtr->flags & VAR_TRACED_WRITE)) {
+	    varPtr = VarHashFindVar(arrayPtr->value.tablePtr, part2Ptr);
+	    if (varPtr) {
+		if (TclIsVarDirectWritable(varPtr)) {
+		    tosPtr--;
+		    Tcl_DecrRefCount(OBJ_AT_TOS);
+		    OBJ_AT_TOS = valuePtr;
+		    goto doStoreVarDirect;
+		}
+	    }
+	}
+	cleanup = 2;
+	storeFlags = TCL_LEAVE_ERR_MSG;
+	part1Ptr = NULL;
+	goto doStoreArrayDirectFailed;
+	
+    case INST_STORE_SCALAR4:
+	opnd = TclGetUInt4AtPtr(pc+1);
+	pcAdjustment = 5;
+	goto doStoreScalarDirect;
+
+    case INST_STORE_SCALAR1:
+	opnd = TclGetUInt1AtPtr(pc+1);
+	pcAdjustment = 2;
+
+    doStoreScalarDirect:
+	valuePtr = OBJ_AT_TOS;
+	varPtr = &(compiledLocals[opnd]);
+	TRACE(("%u <- \"%.30s\" => ", opnd, O2S(valuePtr)));
+	while (TclIsVarLink(varPtr)) {
+	    varPtr = varPtr->value.linkPtr;
+	}
+	if (TclIsVarDirectWritable(varPtr)) {
+    doStoreVarDirect:
+	    /*
+	     * No traces, no errors, plain 'set': we can safely inline. The
+	     * value *will* be set to what's requested, so that the stack top
+	     * remains pointing to the same Tcl_Obj.
+	     */
+
+	    valuePtr = varPtr->value.objPtr;
+	    if (valuePtr != NULL) {
+		TclDecrRefCount(valuePtr);
+	    }
+	    objResultPtr = OBJ_AT_TOS;	    
+	    varPtr->value.objPtr = objResultPtr;
+#ifndef TCL_COMPILE_DEBUG
+	    if (*(pc+pcAdjustment) == INST_POP) {
+		tosPtr--;
+		NEXT_INST_F((pcAdjustment+1), 0, 0);	    
+	    }
+#else
+	    TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
+#endif
+	    Tcl_IncrRefCount(objResultPtr);	    
+	    NEXT_INST_F(pcAdjustment, 0, 0);	    
+	}
+	storeFlags = TCL_LEAVE_ERR_MSG;
+	part1Ptr = NULL;
+	goto doStoreScalar;
+	
     case INST_LAPPEND_STK:
 	valuePtr = OBJ_AT_TOS; /* value to append */
-	part2 = NULL;
+	part2Ptr = NULL;
 	storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE
 		| TCL_LIST_ELEMENT | TCL_TRACE_READS);
 	goto doStoreStk;
 
     case INST_LAPPEND_ARRAY_STK:
 	valuePtr = OBJ_AT_TOS; /* value to append */
-	part2 = TclGetString(OBJ_UNDER_TOS);
+	part2Ptr = OBJ_UNDER_TOS;
 	storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE
 		| TCL_LIST_ELEMENT | TCL_TRACE_READS);
 	goto doStoreStk;
 
     case INST_APPEND_STK:
 	valuePtr = OBJ_AT_TOS; /* value to append */
-	part2 = NULL;
+	part2Ptr = NULL;
 	storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE);
 	goto doStoreStk;
 
     case INST_APPEND_ARRAY_STK:
 	valuePtr = OBJ_AT_TOS; /* value to append */
-	part2 = TclGetString(OBJ_UNDER_TOS);
+	part2Ptr = OBJ_UNDER_TOS;
 	storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE);
 	goto doStoreStk;
 
     case INST_STORE_ARRAY_STK:
 	valuePtr = OBJ_AT_TOS;
-	part2 = TclGetString(OBJ_UNDER_TOS);
+	part2Ptr = OBJ_UNDER_TOS;
 	storeFlags = TCL_LEAVE_ERR_MSG;
 	goto doStoreStk;
 
     case INST_STORE_STK:
     case INST_STORE_SCALAR_STK:
 	valuePtr = OBJ_AT_TOS;
-	part2 = NULL;
+	part2Ptr = NULL;
 	storeFlags = TCL_LEAVE_ERR_MSG;
 
     doStoreStk:
-	objPtr = OBJ_AT_DEPTH(1 + (part2 != NULL)); /* variable name */
-	part1 = TclGetString(objPtr);
+	objPtr = OBJ_AT_DEPTH(1 + (part2Ptr != NULL)); /* variable name */
+	part1Ptr = objPtr;
 #ifdef TCL_COMPILE_DEBUG
-	if (part2 == NULL) {
+	if (part2Ptr == NULL) {
 	    TRACE(("\"%.30s\" <- \"%.30s\" =>", part1, O2S(valuePtr)));
 	} else {
 	    TRACE(("\"%.30s(%.30s)\" <- \"%.30s\" => ",
 		    part1, part2, O2S(valuePtr)));
 	}
 #endif
-	varPtr = TclObjLookupVar(interp, objPtr, part2, TCL_LEAVE_ERR_MSG,
+	varPtr = TclObjLookupVarEx(interp, objPtr, part2Ptr, TCL_LEAVE_ERR_MSG,
 		"set", /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr);
 	if (varPtr) {
-	    cleanup = ((part2 == NULL)? 2 : 3);
+	    cleanup = ((part2Ptr == NULL)? 2 : 3);
 	    pcAdjustment = 1;
+	    opnd = -1;
 	    goto doCallPtrSetVar;
 	} else {
 	    TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
@@ -2490,40 +2579,28 @@ TclExecuteByteCode(
 	storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE);
 	goto doStoreArray;
 
-    case INST_STORE_ARRAY4:
-	opnd = TclGetUInt4AtPtr(pc+1);
-	pcAdjustment = 5;
-	storeFlags = TCL_LEAVE_ERR_MSG;
-	goto doStoreArray;
-
-    case INST_STORE_ARRAY1:
-	opnd = TclGetUInt1AtPtr(pc+1);
-	pcAdjustment = 2;
-	storeFlags = TCL_LEAVE_ERR_MSG;
-
     doStoreArray:
 	valuePtr = OBJ_AT_TOS;
-	part2 = TclGetString(OBJ_UNDER_TOS);
+	part2Ptr = OBJ_UNDER_TOS;
 	arrayPtr = &(compiledLocals[opnd]);
-	part1 = arrayPtr->name;
-	cleanup = 2;
 	TRACE(("%u \"%.30s\" <- \"%.30s\" => ", opnd, part2, O2S(valuePtr)));
 	while (TclIsVarLink(arrayPtr)) {
 	    arrayPtr = arrayPtr->value.linkPtr;
 	}
-	if (!TclIsVarUndefined(arrayPtr)
-		&& TclIsVarArray(arrayPtr)
-		&& TclIsVarUntraced(arrayPtr)) {
-	    Tcl_HashEntry *hPtr = Tcl_FindHashEntry(arrayPtr->value.tablePtr,
-		    part2);
-	    if (hPtr) {
-		varPtr = (Var *) Tcl_GetHashValue(hPtr);
-		goto doCallPtrSetVar;
-	    }
-	}
-	varPtr = TclLookupArrayElement(interp, part1, part2,
-		TCL_LEAVE_ERR_MSG, "set", 1, 1, arrayPtr);
+	cleanup = 2;
+	part1Ptr = NULL;
+	
+    doStoreArrayDirectFailed:
+	varPtr = TclLookupArrayElement(interp, part1Ptr, part2Ptr,
+		TCL_LEAVE_ERR_MSG, "set", 1, 1, arrayPtr, opnd);
 	if (varPtr) {
+	    if ((storeFlags == TCL_LEAVE_ERR_MSG) && TclIsVarDirectWritable(varPtr)) {
+		tosPtr--;
+		Tcl_DecrRefCount(OBJ_AT_TOS);
+		OBJ_AT_TOS = valuePtr;		
+		goto doStoreVarDirect;
+	    }
+	    part1Ptr = NULL;
 	    goto doCallPtrSetVar;
 	} else {
 	    TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
@@ -2556,79 +2633,36 @@ TclExecuteByteCode(
 	pcAdjustment = 2;
 	storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE);
 	goto doStoreScalar;
-
-    case INST_STORE_SCALAR4:
-	opnd = TclGetUInt4AtPtr(pc+1);
-	pcAdjustment = 5;
-	storeFlags = TCL_LEAVE_ERR_MSG;
-	goto doStoreScalar;
-
-    case INST_STORE_SCALAR1:
-	opnd = TclGetUInt1AtPtr(pc+1);
-	pcAdjustment = 2;
-	storeFlags = TCL_LEAVE_ERR_MSG;
-
+	
     doStoreScalar:
 	valuePtr = OBJ_AT_TOS;
 	varPtr = &(compiledLocals[opnd]);
-	part1 = varPtr->name;
 	TRACE(("%u <- \"%.30s\" => ", opnd, O2S(valuePtr)));
 	while (TclIsVarLink(varPtr)) {
 	    varPtr = varPtr->value.linkPtr;
 	}
 	cleanup = 1;
 	arrayPtr = NULL;
-	part2 = NULL;
+	part1Ptr = part2Ptr = NULL;
 
     doCallPtrSetVar:
-	if ((storeFlags == TCL_LEAVE_ERR_MSG)
-		&& TclIsVarDirectWritable(varPtr)
-		&& ((arrayPtr == NULL) || TclIsVarUntraced(arrayPtr))) {
-	    /*
-	     * No traces, no errors, plain 'set': we can safely inline. The
-	     * value *will* be set to what's requested, so that the stack top
-	     * remains pointing to the same Tcl_Obj.
-	     */
-
-	    valuePtr = varPtr->value.objPtr;
-	    objResultPtr = OBJ_AT_TOS;
-	    if (valuePtr != objResultPtr) {
-		if (valuePtr != NULL) {
-		    TclDecrRefCount(valuePtr);
-		} else {
-		    TclSetVarScalar(varPtr);
-		    TclClearVarUndefined(varPtr);
-		}
-		varPtr->value.objPtr = objResultPtr;
-		Tcl_IncrRefCount(objResultPtr);
-	    }
+	DECACHE_STACK_INFO();
+	objResultPtr = TclPtrSetVar(interp, varPtr, arrayPtr,
+		part1Ptr, part2Ptr, valuePtr, storeFlags, opnd);
+	CACHE_STACK_INFO();
+	if (objResultPtr) {
 #ifndef TCL_COMPILE_DEBUG
 	    if (*(pc+pcAdjustment) == INST_POP) {
 		NEXT_INST_V((pcAdjustment+1), cleanup, 0);
 	    }
-#else
-	    TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
 #endif
+	    TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
 	    NEXT_INST_V(pcAdjustment, cleanup, 1);
 	} else {
-	    DECACHE_STACK_INFO();
-	    objResultPtr = TclPtrSetVar(interp, varPtr, arrayPtr,
-		    part1, part2, valuePtr, storeFlags);
-	    CACHE_STACK_INFO();
-	    if (objResultPtr) {
-#ifndef TCL_COMPILE_DEBUG
-		if (*(pc+pcAdjustment) == INST_POP) {
-		    NEXT_INST_V((pcAdjustment+1), cleanup, 0);
-		}
-#endif
-		TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
-		NEXT_INST_V(pcAdjustment, cleanup, 1);
-	    } else {
-		TRACE_APPEND(("ERROR: %.30s\n",
-			O2S(Tcl_GetObjResult(interp))));
-		result = TCL_ERROR;
-		goto checkForCatch;
-	    }
+	    TRACE_APPEND(("ERROR: %.30s\n",
+	            O2S(Tcl_GetObjResult(interp))));
+	    result = TCL_ERROR;
+	    goto checkForCatch;
 	}
     }
 
@@ -2655,7 +2689,7 @@ TclExecuteByteCode(
 	Tcl_WideInt w;
 #endif
 	long i;
-	char *part1, *part2;
+	Tcl_Obj *part1Ptr, *part2Ptr;
 	Var *varPtr, *arrayPtr;
 
     case INST_INCR_SCALAR1:
@@ -2688,21 +2722,21 @@ TclExecuteByteCode(
     doIncrStk:
 	if ((*pc == INST_INCR_ARRAY_STK_IMM)
 		|| (*pc == INST_INCR_ARRAY_STK)) {
-	    part2 = TclGetString(OBJ_AT_TOS);
+	    part2Ptr = OBJ_AT_TOS;
 	    objPtr = OBJ_UNDER_TOS;
 	    TRACE(("\"%.30s(%.30s)\" (by %ld) => ",
 		    O2S(objPtr), part2, i));
 	} else {
-	    part2 = NULL;
+	    part2Ptr = NULL;
 	    objPtr = OBJ_AT_TOS;
 	    TRACE(("\"%.30s\" (by %ld) => ", O2S(objPtr), i));
 	}
-	part1 = TclGetString(objPtr);
-
-	varPtr = TclObjLookupVar(interp, objPtr, part2, TCL_LEAVE_ERR_MSG,
+	part1Ptr = objPtr;
+	opnd = -1;
+	varPtr = TclObjLookupVarEx(interp, objPtr, part2Ptr, TCL_LEAVE_ERR_MSG,
 		"read", 1, 1, &arrayPtr);
 	if (varPtr) {
-	    cleanup = ((part2 == NULL)? 1 : 2);
+	    cleanup = ((part2Ptr == NULL)? 1 : 2);
 	    goto doIncrVar;
 	} else {
 	    Tcl_AddObjErrorInfo(interp,
@@ -2721,16 +2755,16 @@ TclExecuteByteCode(
 	pcAdjustment = 3;
 
     doIncrArray:
-	part2 = TclGetString(OBJ_AT_TOS);
+	part1Ptr = NULL;
+	part2Ptr = OBJ_AT_TOS;
 	arrayPtr = &(compiledLocals[opnd]);
-	part1 = arrayPtr->name;
 	cleanup = 1;
 	while (TclIsVarLink(arrayPtr)) {
 	    arrayPtr = arrayPtr->value.linkPtr;
 	}
 	TRACE(("%u \"%.30s\" (by %ld) => ", opnd, part2, i));
-	varPtr = TclLookupArrayElement(interp, part1, part2,
-		TCL_LEAVE_ERR_MSG, "read", 1, 1, arrayPtr);
+	varPtr = TclLookupArrayElement(interp, part1Ptr, part2Ptr,
+		TCL_LEAVE_ERR_MSG, "read", 1, 1, arrayPtr, opnd);
 	if (varPtr) {
 	    goto doIncrVar;
 	} else {
@@ -2750,7 +2784,7 @@ TclExecuteByteCode(
 	    varPtr = varPtr->value.linkPtr;
 	}
 
-	if (TclIsVarDirectReadable(varPtr)) {
+	if (TclIsVarDirectModifyable(varPtr)) {
 	    ClientData ptr;
 	    int type;
 
@@ -2868,18 +2902,16 @@ TclExecuteByteCode(
 
     doIncrScalar:
 	varPtr = &(compiledLocals[opnd]);
-	part1 = varPtr->name;
 	while (TclIsVarLink(varPtr)) {
 	    varPtr = varPtr->value.linkPtr;
 	}
 	arrayPtr = NULL;
-	part2 = NULL;
+	part1Ptr = part2Ptr = NULL;
 	cleanup = 0;
 	TRACE(("%u %ld => ", opnd, i));
 
     doIncrVar:
-	if (TclIsVarDirectReadable(varPtr)
-		&& ((arrayPtr == NULL) || TclIsVarUntraced(arrayPtr))) {
+	if (TclIsVarDirectModifyable2(varPtr, arrayPtr)) {
 	    objPtr = varPtr->value.objPtr;
 	    if (Tcl_IsShared(objPtr)) {
 		objPtr->refCount--;	/* We know it's shared */
@@ -2901,7 +2933,7 @@ TclExecuteByteCode(
 	} else {
 	    DECACHE_STACK_INFO();
 	    objResultPtr = TclPtrIncrObjVar(interp, varPtr, arrayPtr,
-		    part1, part2, incrPtr, TCL_LEAVE_ERR_MSG);
+		    part1Ptr, part2Ptr, incrPtr, TCL_LEAVE_ERR_MSG, opnd);
 	    CACHE_STACK_INFO();
 	    Tcl_DecrRefCount(incrPtr);
 	    if (objResultPtr == NULL) {
@@ -2943,7 +2975,7 @@ TclExecuteByteCode(
 
 		savedFramePtr = iPtr->varFramePtr;
 		iPtr->varFramePtr = framePtr;
-		otherPtr = TclObjLookupVar(interp, OBJ_AT_TOS, NULL,
+		otherPtr = TclObjLookupVarEx(interp, OBJ_AT_TOS, NULL,
 			(TCL_LEAVE_ERR_MSG), "access",
 			/*createPart1*/ 1, /*createPart2*/ 1, &varPtr);
 		iPtr->varFramePtr = savedFramePtr;
@@ -2958,7 +2990,7 @@ TclExecuteByteCode(
 
     case INST_VARIABLE:
 	TRACE(("variable "));
-	otherPtr = TclObjLookupVar(interp, OBJ_AT_TOS, NULL,
+	otherPtr = TclObjLookupVarEx(interp, OBJ_AT_TOS, NULL,
 		(TCL_NAMESPACE_ONLY | TCL_LEAVE_ERR_MSG), "access",
 		/*createPart1*/ 1, /*createPart2*/ 1, &varPtr);
 	if (otherPtr) {
@@ -2966,10 +2998,7 @@ TclExecuteByteCode(
 	     * Do the [variable] magic
 	     */
 
-	    if (!TclIsVarNamespaceVar(otherPtr)) {
-		TclSetVarNamespaceVar(otherPtr);
-		otherPtr->refCount++;
-	    }
+	    TclSetVarNamespaceVar(otherPtr);
 	    result = TCL_OK;
 	    goto doLinkVars;
 	}
@@ -2990,7 +3019,7 @@ TclExecuteByteCode(
 
 		savedNsPtr = (Tcl_Namespace *) iPtr->varFramePtr->nsPtr;
 		iPtr->varFramePtr->nsPtr = (Namespace *) nsPtr;
-		otherPtr = TclObjLookupVar(interp, OBJ_AT_TOS, NULL,
+		otherPtr = TclObjLookupVarEx(interp, OBJ_AT_TOS, NULL,
 			(TCL_NAMESPACE_ONLY | TCL_LEAVE_ERR_MSG), "access",
 			/*createPart1*/ 1, /*createPart2*/ 1, &varPtr);
 		iPtr->varFramePtr->nsPtr = (Namespace *) savedNsPtr;
@@ -3021,7 +3050,7 @@ TclExecuteByteCode(
 
 	opnd = TclGetInt4AtPtr(pc+1);;
 	varPtr = &(compiledLocals[opnd]);
-	if ((varPtr != otherPtr) && (varPtr->tracePtr == NULL)
+	if ((varPtr != otherPtr) && !TclIsVarTraced(varPtr)
 		&& (TclIsVarUndefined(varPtr) || TclIsVarLink(varPtr))) {
 	    if (!TclIsVarUndefined(varPtr)) {
 		/* Then it is a defined link */
@@ -3029,17 +3058,20 @@ TclExecuteByteCode(
 		if (linkPtr == otherPtr) {
 		    goto doLinkVarsDone;
 		}
-		linkPtr->refCount--;
-		if (TclIsVarUndefined(linkPtr)) {
-		    TclCleanupVar(linkPtr, NULL);
+		if (TclIsVarInHash(linkPtr)) {
+		    VarHashRefCount(linkPtr)--;
+		    if (TclIsVarUndefined(linkPtr)) {
+			TclCleanupVar(linkPtr, NULL);
+		    }
 		}
 	    }
 	    TclSetVarLink(varPtr);
-	    TclClearVarUndefined(varPtr);
 	    varPtr->value.linkPtr = otherPtr;
-	    otherPtr->refCount++;
+	    if (TclIsVarInHash(otherPtr)) {
+		VarHashRefCount(otherPtr)++;
+	    }
 	} else {
-	    result = TclPtrMakeUpvar(interp, otherPtr, NULL, 0, opnd);
+	    result = TclPtrObjMakeUpvar(interp, otherPtr, NULL, 0, opnd);
 	    if (result != TCL_OK) {
 		goto checkForCatch;
 	    }
@@ -5651,8 +5683,6 @@ TclExecuteByteCode(
 	} else {
 	    TclSetLongObj(oldValuePtr, -1);
 	}
-	TclSetVarScalar(iterVarPtr);
-	TclClearVarUndefined(iterVarPtr);
 	TRACE(("%u => loop iter count temp %d\n", opnd, iterTmpIndex));
 
 #ifndef TCL_COMPILE_DEBUG
@@ -5682,7 +5712,6 @@ TclExecuteByteCode(
 	int iterNum, listTmpIndex, listLen, numVars;
 	int varIndex, valIndex, continueLoop, j;
 	long i;
-	char *part1;
 
 	opnd = TclGetUInt4AtPtr(pc+1);
 	infoPtr = (ForeachInfo *) codePtr->auxDataArrayPtr[opnd].clientData;
@@ -5752,7 +5781,6 @@ TclExecuteByteCode(
 
 		    varIndex = varListPtr->varIndexes[j];
 		    varPtr = &(compiledLocals[varIndex]);
-		    part1 = varPtr->name;
 		    while (TclIsVarLink(varPtr)) {
 			varPtr = varPtr->value.linkPtr;
 		    }
@@ -5761,17 +5789,14 @@ TclExecuteByteCode(
 			if (valuePtr != value2Ptr) {
 			    if (value2Ptr != NULL) {
 				TclDecrRefCount(value2Ptr);
-			    } else {
-				TclSetVarScalar(varPtr);
-				TclClearVarUndefined(varPtr);
 			    }
 			    varPtr->value.objPtr = valuePtr;
 			    Tcl_IncrRefCount(valuePtr);
 			}
 		    } else {
 			DECACHE_STACK_INFO();
-			value2Ptr = TclPtrSetVar(interp, varPtr, NULL, part1,
-				NULL, valuePtr, TCL_LEAVE_ERR_MSG);
+			value2Ptr = TclPtrSetVar(interp, varPtr, NULL, NULL,
+				NULL, valuePtr, TCL_LEAVE_ERR_MSG, varIndex);
 			CACHE_STACK_INFO();
 			if (value2Ptr == NULL) {
 			    TRACE_WITH_OBJ((
@@ -5857,7 +5882,6 @@ TclExecuteByteCode(
 	int opnd, opnd2, allocateDict;
 	Tcl_Obj *dictPtr, *valPtr;
 	Var *varPtr;
-	char *part1;
 
     case INST_DICT_GET:
 	opnd = TclGetUInt4AtPtr(pc+1);
@@ -5902,7 +5926,6 @@ TclExecuteByteCode(
 	opnd2 = TclGetUInt4AtPtr(pc+5);
 
 	varPtr = &(compiledLocals[opnd2]);
-	part1 = varPtr->name;
 	while (TclIsVarLink(varPtr)) {
 	    varPtr = varPtr->value.linkPtr;
 	}
@@ -5911,7 +5934,7 @@ TclExecuteByteCode(
 	    dictPtr = varPtr->value.objPtr;
 	} else {
 	    DECACHE_STACK_INFO();
-	    dictPtr = TclPtrGetVar(interp, varPtr, NULL, part1, NULL, 0);
+	    dictPtr = TclPtrGetVar(interp, varPtr, NULL, NULL, NULL, 0, opnd2);
 	    CACHE_STACK_INFO();
 	}
 	if (dictPtr == NULL) {
@@ -5980,9 +6003,6 @@ TclExecuteByteCode(
 		Tcl_IncrRefCount(dictPtr);
 		if (oldValuePtr != NULL) {
 		    Tcl_DecrRefCount(oldValuePtr);
-		} else {
-		    TclSetVarScalar(varPtr);
-		    TclClearVarUndefined(varPtr);
 		}
 		varPtr->value.objPtr = dictPtr;
 	    }
@@ -5990,8 +6010,8 @@ TclExecuteByteCode(
 	} else {
 	    Tcl_IncrRefCount(dictPtr);
 	    DECACHE_STACK_INFO();
-	    objResultPtr = TclPtrSetVar(interp, varPtr, NULL, part1, NULL,
-		    dictPtr, TCL_LEAVE_ERR_MSG);
+	    objResultPtr = TclPtrSetVar(interp, varPtr, NULL, NULL, NULL,
+		    dictPtr, TCL_LEAVE_ERR_MSG, opnd2);
 	    CACHE_STACK_INFO();
 	    Tcl_DecrRefCount(dictPtr);
 	    if (objResultPtr == NULL) {
@@ -6015,7 +6035,6 @@ TclExecuteByteCode(
 	cleanup = 2;
 
 	varPtr = &(compiledLocals[opnd]);
-	part1 = varPtr->name;
 	while (TclIsVarLink(varPtr)) {
 	    varPtr = varPtr->value.linkPtr;
 	}
@@ -6024,7 +6043,7 @@ TclExecuteByteCode(
 	    dictPtr = varPtr->value.objPtr;
 	} else {
 	    DECACHE_STACK_INFO();
-	    dictPtr = TclPtrGetVar(interp, varPtr, NULL, part1, NULL, 0);
+	    dictPtr = TclPtrGetVar(interp, varPtr, NULL, NULL, NULL, 0, opnd);
 	    CACHE_STACK_INFO();
 	}
 	if (dictPtr == NULL) {
@@ -6102,9 +6121,6 @@ TclExecuteByteCode(
 		Tcl_IncrRefCount(dictPtr);
 		if (oldValuePtr != NULL) {
 		    Tcl_DecrRefCount(oldValuePtr);
-		} else {
-		    TclSetVarScalar(varPtr);
-		    TclClearVarUndefined(varPtr);
 		}
 		varPtr->value.objPtr = dictPtr;
 	    }
@@ -6112,8 +6128,8 @@ TclExecuteByteCode(
 	} else {
 	    Tcl_IncrRefCount(dictPtr);
 	    DECACHE_STACK_INFO();
-	    objResultPtr = TclPtrSetVar(interp, varPtr, NULL, part1, NULL,
-		    dictPtr, TCL_LEAVE_ERR_MSG);
+	    objResultPtr = TclPtrSetVar(interp, varPtr, NULL, NULL, NULL,
+		    dictPtr, TCL_LEAVE_ERR_MSG, opnd);
 	    CACHE_STACK_INFO();
 	    Tcl_DecrRefCount(dictPtr);
 	    if (objResultPtr == NULL) {
@@ -6154,14 +6170,13 @@ TclExecuteByteCode(
 	statePtr->typePtr = &dictIteratorType;
 	statePtr->internalRep.twoPtrValue.ptr1 = (void *) searchPtr;
 	statePtr->internalRep.twoPtrValue.ptr2 = (void *) dictPtr;
-	varPtr = compiledLocals + opnd;
-	if (varPtr->value.objPtr == NULL) {
-	    TclSetVarScalar(compiledLocals + opnd);
-	    TclClearVarUndefined(compiledLocals + opnd);
-	} else if (varPtr->value.objPtr->typePtr == &dictIteratorType) {
-	    Tcl_Panic("mis-issued dictFirst!");
-	} else {
-	    Tcl_DecrRefCount(varPtr->value.objPtr);
+	varPtr = (compiledLocals + opnd);
+	if (varPtr->value.objPtr) {
+	    if (varPtr->value.objPtr->typePtr != &dictIteratorType) {
+		Tcl_DecrRefCount(varPtr->value.objPtr);
+	    } else {
+		Tcl_Panic("mis-issued dictFirst!");
+	    }
 	}
 	varPtr->value.objPtr = statePtr;
 	Tcl_IncrRefCount(statePtr);
@@ -6231,14 +6246,12 @@ TclExecuteByteCode(
 	Tcl_Obj **keyPtrPtr, *dictPtr;
 	DictUpdateInfo *duiPtr;
 	Var *varPtr;
-	char *part1;
 
     case INST_DICT_UPDATE_START:
 	opnd = TclGetUInt4AtPtr(pc+1);
 	opnd2 = TclGetUInt4AtPtr(pc+5);
 	varPtr = &(compiledLocals[opnd]);
 	duiPtr = codePtr->auxDataArrayPtr[opnd2].clientData;
-	part1 = varPtr->name;
 	while (TclIsVarLink(varPtr)) {
 	    varPtr = varPtr->value.linkPtr;
 	}
@@ -6247,8 +6260,8 @@ TclExecuteByteCode(
 	    dictPtr = varPtr->value.objPtr;
 	} else {
 	    DECACHE_STACK_INFO();
-	    dictPtr = TclPtrGetVar(interp, varPtr, NULL, part1, NULL,
-		    TCL_LEAVE_ERR_MSG);
+	    dictPtr = TclPtrGetVar(interp, varPtr, NULL, NULL, NULL,
+		    TCL_LEAVE_ERR_MSG, opnd);
 	    CACHE_STACK_INFO();
 	    if (dictPtr == NULL) {
 		goto dictUpdateStartFailed;
@@ -6269,15 +6282,17 @@ TclExecuteByteCode(
 		goto dictUpdateStartFailed;
 	    }
 	    varPtr = &(compiledLocals[duiPtr->varIndices[i]]);
-	    part1 = varPtr->name;
 	    while (TclIsVarLink(varPtr)) {
 		varPtr = varPtr->value.linkPtr;
 	    }
 	    DECACHE_STACK_INFO();
 	    if (valPtr == NULL) {
-		Tcl_UnsetVar(interp, part1, 0);
-	    } else if (TclPtrSetVar(interp, varPtr, NULL, part1, NULL,
-		    valPtr, TCL_LEAVE_ERR_MSG) == NULL) {
+		TclObjUnsetVar2(interp,
+			localName(iPtr->varFramePtr, duiPtr->varIndices[i]),
+			NULL, 0);
+	    } else if (TclPtrSetVar(interp, varPtr, NULL, NULL, NULL,
+		    valPtr, TCL_LEAVE_ERR_MSG,
+		    duiPtr->varIndices[i]) == NULL) {
 		CACHE_STACK_INFO();
 	    dictUpdateStartFailed:
 		cleanup = 1;
@@ -6293,7 +6308,6 @@ TclExecuteByteCode(
 	opnd2 = TclGetUInt4AtPtr(pc+5);
 	varPtr = &(compiledLocals[opnd]);
 	duiPtr = codePtr->auxDataArrayPtr[opnd2].clientData;
-	part1 = varPtr->name;
 	while (TclIsVarLink(varPtr)) {
 	    varPtr = varPtr->value.linkPtr;
 	}
@@ -6302,7 +6316,7 @@ TclExecuteByteCode(
 	    dictPtr = varPtr->value.objPtr;
 	} else {
 	    DECACHE_STACK_INFO();
-	    dictPtr = TclPtrGetVar(interp, varPtr, NULL, part1, NULL, 0);
+	    dictPtr = TclPtrGetVar(interp, varPtr, NULL, NULL, NULL, 0, opnd);
 	    CACHE_STACK_INFO();
 	}
 	if (dictPtr == NULL) {
@@ -6322,10 +6336,8 @@ TclExecuteByteCode(
 	for (i=0 ; i<length ; i++) {
 	    Tcl_Obj *valPtr;
 	    Var *var2Ptr;
-	    char *part1a;
 
 	    var2Ptr = &(compiledLocals[duiPtr->varIndices[i]]);
-	    part1a = var2Ptr->name;
 	    while (TclIsVarLink(var2Ptr)) {
 		var2Ptr = var2Ptr->value.linkPtr;
 	    }
@@ -6333,7 +6345,8 @@ TclExecuteByteCode(
 		valPtr = var2Ptr->value.objPtr;
 	    } else {
 		DECACHE_STACK_INFO();
-		valPtr = TclPtrGetVar(interp, var2Ptr, NULL, part1a, NULL, 0);
+		valPtr = TclPtrGetVar(interp, var2Ptr, NULL, NULL, NULL, 0,
+			duiPtr->varIndices[i]);
 		CACHE_STACK_INFO();
 	    }
 	    if (valPtr == NULL) {
@@ -6348,8 +6361,8 @@ TclExecuteByteCode(
 	    varPtr->value.objPtr = dictPtr;
 	} else {
 	    DECACHE_STACK_INFO();
-	    objResultPtr = TclPtrSetVar(interp, varPtr, NULL, part1, NULL,
-		    dictPtr, TCL_LEAVE_ERR_MSG);
+	    objResultPtr = TclPtrSetVar(interp, varPtr, NULL, NULL, NULL,
+		    dictPtr, TCL_LEAVE_ERR_MSG, opnd);
 	    CACHE_STACK_INFO();
 	    if (objResultPtr == NULL) {
 		if (allocdict) {
diff --git a/generic/tclHash.c b/generic/tclHash.c
index 35de98c..97e42e2 100644
--- a/generic/tclHash.c
+++ b/generic/tclHash.c
@@ -10,7 +10,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclHash.c,v 1.31 2007/07/02 21:10:52 dgp Exp $
+ * RCS: @(#) $Id: tclHash.c,v 1.32 2007/07/31 17:03:38 msofer Exp $
  */
 
 #include "tclInt.h"
@@ -343,6 +343,7 @@ Tcl_CreateHashEntry(
     } else {
 	hPtr = (Tcl_HashEntry *) ckalloc((unsigned) sizeof(Tcl_HashEntry));
 	hPtr->key.oneWordValue = (char *) key;
+	hPtr->clientData = 0;
     }
 
     hPtr->tablePtr = tablePtr;
@@ -355,7 +356,6 @@ Tcl_CreateHashEntry(
     hPtr->nextPtr = *hPtr->bucketPtr;
     *hPtr->bucketPtr = hPtr;
 #endif
-    hPtr->clientData = 0;
     tablePtr->numEntries++;
 
     /*
@@ -724,6 +724,7 @@ AllocArrayEntry(
 	    count > 0; count--, iPtr1++, iPtr2++) {
 	*iPtr2 = *iPtr1;
     }
+    hPtr->clientData = 0;
 
     return hPtr;
 }
@@ -831,7 +832,7 @@ AllocStringEntry(
     }
     hPtr = (Tcl_HashEntry *) ckalloc(size);
     strcpy(hPtr->key.string, string);
-
+    hPtr->clientData = 0;
     return hPtr;
 }
 
diff --git a/generic/tclInt.decls b/generic/tclInt.decls
index 72cb162..f2abb35 100644
--- a/generic/tclInt.decls
+++ b/generic/tclInt.decls
@@ -12,7 +12,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 # 
-# RCS: @(#) $Id: tclInt.decls,v 1.110 2007/06/20 18:46:13 dgp Exp $
+# RCS: @(#) $Id: tclInt.decls,v 1.111 2007/07/31 17:03:38 msofer Exp $
 
 library tcl
 
@@ -73,7 +73,7 @@ declare 11 generic {
     void TclDeleteCompiledLocalVars(Interp *iPtr, CallFrame *framePtr)
 }
 declare 12 generic {
-    void TclDeleteVars(Interp *iPtr, Tcl_HashTable *tablePtr)
+    void TclDeleteVars(Interp *iPtr, TclVarHashTable *tablePtr)
 }
 # Removed in 8.5
 #declare 13 generic {
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 7ab0750..032a2f6 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -12,7 +12,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclInt.h,v 1.324 2007/07/24 03:05:53 msofer Exp $
+ * RCS: @(#) $Id: tclInt.h,v 1.325 2007/07/31 17:03:38 msofer Exp $
  */
 
 #ifndef _TCLINT
@@ -191,6 +191,19 @@ typedef struct Tcl_Ensemble Tcl_Ensemble;
 typedef struct NamespacePathEntry NamespacePathEntry;
 
 /*
+ * Special hashtable for variables: this is just a Tcl_HashTable with an nsPtr
+ * field added at the end: in this way variables can find their namespace
+ * without having to copy a pointer in their struct: they can access it via
+ * their hPtr->tablePtr. 
+ */
+
+typedef struct TclVarHashTable {
+    Tcl_HashTable table;
+    struct Namespace *nsPtr;
+} TclVarHashTable;
+
+
+/*
  * The structure below defines a namespace.
  * Note: the first five fields must match exactly the fields in a
  * Tcl_Namespace structure (see tcl.h). If you change one, be sure to change
@@ -234,7 +247,7 @@ typedef struct Namespace {
 				 * ImportedCmdRef structure) to the Command
 				 * structure in the source namespace's command
 				 * table. */
-    Tcl_HashTable varTable;	/* Contains all the (global) variables
+    TclVarHashTable varTable;	/* Contains all the (global) variables
 				 * currently in this namespace. Indexed by
 				 * strings; values have type (Var *). */
     char **exportArrayPtr;	/* Points to an array of string patterns
@@ -497,10 +510,12 @@ typedef struct ArraySearch {
  */
 
 typedef struct Var {
+    int flags;			/* Miscellaneous bits of information about
+				 * variable. See below for definitions. */
     union {
 	Tcl_Obj *objPtr;	/* The variable's object value. Used for
 				 * scalar variables and array elements. */
-	Tcl_HashTable *tablePtr;/* For array variables, this points to
+	TclVarHashTable *tablePtr;/* For array variables, this points to
 				 * information about the hash table used to
 				 * implement the associative array. Points to
 				 * ckalloc-ed data. */
@@ -509,48 +524,30 @@ typedef struct Var {
 				 * "upvar", this field points to the
 				 * referenced variable's Var struct. */
     } value;
-    char *name;			/* NULL if the variable is in a hashtable,
-				 * otherwise points to the variable's name. It
-				 * is used, e.g., by TclLookupVar and "info
-				 * locals". The storage for the characters of
-				 * the name is not owned by the Var and must
-				 * not be freed when freeing the Var. */
-    Namespace *nsPtr;		/* Points to the namespace that contains this
-				 * variable or NULL if the variable is a local
-				 * variable in a Tcl procedure. */
-    Tcl_HashEntry *hPtr;	/* If variable is in a hashtable, either the
-				 * hash table entry that refers to this
-				 * variable or NULL if the variable has been
-				 * detached from its hash table (e.g. an array
-				 * is deleted, but some of its elements are
-				 * still referred to in upvars). NULL if the
-				 * variable is not in a hashtable. This is
-				 * used to delete an variable from its
-				 * hashtable if it is no longer needed. */
-    int refCount;		/* Counts number of active uses of this
-				 * variable, not including its entry in the
-				 * call frame or the hash table: 1 for each
-				 * additional variable whose linkPtr points
-				 * here, 1 for each nested trace active on
-				 * variable, and 1 if the variable is a
-				 * namespace variable. This record can't be
-				 * deleted until refCount becomes 0. */
-    VarTrace *tracePtr;		/* First in list of all traces set for this
-				 * variable. */
-    ArraySearch *searchPtr;	/* First in list of all searches active for
-				 * this variable, or NULL if none. */
-    int flags;			/* Miscellaneous bits of information about
-				 * variable. See below for definitions. */
 } Var;
 
-/*
- * Flag bits for variables. The first three (VAR_SCALAR, VAR_ARRAY, and
- * VAR_LINK) are mutually exclusive and give the "type" of the variable.
- * VAR_UNDEFINED is independent of the variable's type.
+typedef struct VarInHash {
+    Var var;                    
+    int refCount;		/* Counts number of active uses of this
+				 * variable: 1 for the entry in the hash
+				 * table, 1 for each additional variable whose
+				 * linkPtr points here, 1 for each nested
+				 * trace active on variable, and 1 if the
+				 * variable is a namespace variable. This
+				 * record can't be deleted until refCount
+				 * becomes 0. */ 
+    Tcl_HashEntry entry;	/* The hash table entry that refers to this
+				 * variable. This is used to find the name of
+				 * the variable and to delete it from its 
+				 * hashtable if it is no longer needed. It
+				 * also holds the variable's name. */
+} VarInHash;
+
+/*
+ * Flag bits for variables. The first two (VAR_ARRAY and VAR_LINK) are
+ * mutually exclusive and give the "type" of the variable. If none is set,
+ * this is a scalar variable.
  *
- * VAR_SCALAR -			1 means this is a scalar variable and not an
- *				array or link. The "objPtr" field points to
- *				the variable's value, a Tcl object.
  * VAR_ARRAY -			1 means this is an array variable rather than
  *				a scalar variable or link. The "tablePtr"
  *				field points to the array's hashtable for its
@@ -562,21 +559,17 @@ typedef struct Var {
  *				through "upvar" and "global" commands, or
  *				through references to variables in enclosing
  *				namespaces.
- * VAR_UNDEFINED -		1 means that the variable is in the process of
- *				being deleted. An undefined variable logically
- *				does not exist and survives only while it has
- *				a trace, or if it is a global variable
- *				currently being used by some procedure.
+ *
+ * Flags that indicate the type and status of storage; none is set for
+ * compiled local variables (Var structs).
+ *
  * VAR_IN_HASHTABLE -		1 means this variable is in a hashtable and
  *				the Var structure is malloced. 0 if it is a
  *				local variable that was assigned a slot in a
  *				procedure frame by the compiler so the Var
  *				storage is part of the call frame.
- * VAR_TRACE_ACTIVE -		1 means that trace processing is currently
- *				underway for a read or write access, so new
- *				read or write accesses should not cause trace
- *				procedures to be called and the variable can't
- *				be deleted.
+ * VAR_DEAD_HASH                1 means that this var's entry in the hashtable
+ *                              has already been deleted.
  * VAR_ARRAY_ELEMENT -		1 means that this variable is an array
  *				element, so it is not legal for it to be an
  *				array itself (the VAR_ARRAY flag had better
@@ -590,6 +583,19 @@ typedef struct Var {
  *				incremented to reflect the "reference" from
  *				its namespace.
  *
+ * Flag values relating to the variable's trace and search status.
+ *
+ * VAR_TRACED_READ
+ * VAR_TRACED_WRITE
+ * VAR_TRACED_UNSET
+ * VAR_TRACED_ARRAY
+ * VAR_TRACE_ACTIVE -		1 means that trace processing is currently
+ *				underway for a read or write access, so new
+ *				read or write accesses should not cause trace
+ *				procedures to be called and the variable can't
+ *				be deleted.
+ * VAR_SEARCH_ACTIVE
+ *
  * The following additional flags are used with the CompiledLocal type defined
  * below:
  *
@@ -600,21 +606,49 @@ typedef struct Var {
  *				name.
  * VAR_RESOLVED -		1 if name resolution has been done for this
  *				variable.
+ * VAR_IS_ARGS                  1 if this variable is the last argument and is
+ *                              named "args".
+ */
+
+/* FLAGS RENUMBERED: everything breaks already, make things simpler.
+ * 
+ * IMPORTANT: skip the values 0x10, 0x20, 0x40, 0x800 corresponding to
+ * TCL_TRACE_(READS/WRITES/UNSETS/ARRAY): makes code simpler in tclTrace.c  
+ *
+ * Keep the flag values for VAR_ARGUMENT and VAR_TEMPORARY so that old values
+ * in precompiled scripts keep working. 
  */
 
-#define VAR_SCALAR		0x1
-#define VAR_ARRAY		0x2
-#define VAR_LINK		0x4
-#define VAR_UNDEFINED		0x8
-#define VAR_IN_HASHTABLE	0x10
-#define VAR_TRACE_ACTIVE	0x20
-#define VAR_ARRAY_ELEMENT	0x40
-#define VAR_NAMESPACE_VAR	0x80
 
-#define VAR_ARGUMENT		0x100
-#define VAR_TEMPORARY		0x200
-#define VAR_RESOLVED		0x400
-#define VAR_IS_ARGS		0x800
+/* Type of value (0 is scalar) */
+#define VAR_ARRAY		0x1
+#define VAR_LINK		0x2
+
+/* Type of storage (0 is compiled local) */
+#define VAR_IN_HASHTABLE	0x4
+#define VAR_DEAD_HASH           0x8
+#define VAR_ARRAY_ELEMENT	0x1000
+#define VAR_NAMESPACE_VAR	0x2000
+
+#define VAR_ALL_HASH (VAR_IN_HASHTABLE|VAR_DEAD_HASH|VAR_NAMESPACE_VAR|VAR_ARRAY_ELEMENT)
+
+/* Trace and search state */
+
+#define VAR_TRACED_READ        0x10       /* TCL_TRACE_READS  */
+#define VAR_TRACED_WRITE       0x20       /* TCL_TRACE_WRITES */
+#define VAR_TRACED_UNSET       0x40       /* TCL_TRACE_UNSETS */
+#define VAR_TRACED_ARRAY       0x800      /* TCL_TRACE_ARRAY  */
+#define VAR_TRACE_ACTIVE       0x80
+#define VAR_SEARCH_ACTIVE      0x4000
+#define VAR_ALL_TRACES \
+   (VAR_TRACED_READ|VAR_TRACED_WRITE|VAR_TRACED_ARRAY|VAR_TRACED_UNSET)
+
+
+/* Special handling on initialisation (only CompiledLocal) */
+#define VAR_ARGUMENT		0x100     /* KEEP OLD VALUE! See tclProc.c */
+#define VAR_TEMPORARY		0x200     /* KEEP OLD VALUE! See tclProc.c */
+#define VAR_IS_ARGS		0x400     
+#define VAR_RESOLVED		0x8000
 
 /*
  * Macros to ensure that various flag bits are set properly for variables.
@@ -629,22 +663,22 @@ typedef struct Var {
  */
 
 #define TclSetVarScalar(varPtr) \
-    (varPtr)->flags = ((varPtr)->flags & ~(VAR_ARRAY|VAR_LINK)) | VAR_SCALAR
+    (varPtr)->flags &= ~(VAR_ARRAY|VAR_LINK)
 
 #define TclSetVarArray(varPtr) \
-    (varPtr)->flags = ((varPtr)->flags & ~(VAR_SCALAR|VAR_LINK)) | VAR_ARRAY
+    (varPtr)->flags = ((varPtr)->flags & ~VAR_LINK) | VAR_ARRAY
 
 #define TclSetVarLink(varPtr) \
-    (varPtr)->flags = ((varPtr)->flags & ~(VAR_SCALAR|VAR_ARRAY)) | VAR_LINK
+    (varPtr)->flags = ((varPtr)->flags & ~VAR_ARRAY) | VAR_LINK
 
 #define TclSetVarArrayElement(varPtr) \
     (varPtr)->flags = ((varPtr)->flags & ~VAR_ARRAY) | VAR_ARRAY_ELEMENT
 
 #define TclSetVarUndefined(varPtr) \
-    (varPtr)->flags |= VAR_UNDEFINED
+    (varPtr)->flags &= ~(VAR_ARRAY|VAR_LINK);\
+    (varPtr)->value.objPtr = NULL
 
-#define TclClearVarUndefined(varPtr) \
-    (varPtr)->flags &= ~VAR_UNDEFINED
+#define TclClearVarUndefined(varPtr) 
 
 #define TclSetVarTraceActive(varPtr) \
     (varPtr)->flags |= VAR_TRACE_ACTIVE
@@ -653,10 +687,16 @@ typedef struct Var {
     (varPtr)->flags &= ~VAR_TRACE_ACTIVE
 
 #define TclSetVarNamespaceVar(varPtr) \
-    (varPtr)->flags |= VAR_NAMESPACE_VAR
+    if (TclIsVarInHash(varPtr) && ! TclIsVarNamespaceVar(varPtr)) {\
+        (varPtr)->flags |= VAR_NAMESPACE_VAR;\
+        ((VarInHash *)(varPtr))->refCount++;\
+    }
 
 #define TclClearVarNamespaceVar(varPtr) \
-    (varPtr)->flags &= ~VAR_NAMESPACE_VAR
+    if (TclIsVarNamespaceVar(varPtr)) {\
+        (varPtr)->flags &= ~VAR_NAMESPACE_VAR;\
+        ((VarInHash *)(varPtr))->refCount--;\
+    }
 
 /*
  * Macros to read various flag bits of variables.
@@ -673,7 +713,7 @@ typedef struct Var {
  */
 
 #define TclIsVarScalar(varPtr) \
-    ((varPtr)->flags & VAR_SCALAR)
+    !((varPtr)->flags & (VAR_ARRAY|VAR_LINK))
 
 #define TclIsVarLink(varPtr) \
     ((varPtr)->flags & VAR_LINK)
@@ -682,7 +722,7 @@ typedef struct Var {
     ((varPtr)->flags & VAR_ARRAY)
 
 #define TclIsVarUndefined(varPtr) \
-    ((varPtr)->flags & VAR_UNDEFINED)
+    ((varPtr)->value.objPtr == NULL)
 
 #define TclIsVarArrayElement(varPtr) \
     ((varPtr)->flags & VAR_ARRAY_ELEMENT)
@@ -702,24 +742,50 @@ typedef struct Var {
 #define TclIsVarTraceActive(varPtr) \
     ((varPtr)->flags & VAR_TRACE_ACTIVE)
 
-#define TclIsVarUntraced(varPtr) \
-    ((varPtr)->tracePtr == NULL)
+#define TclIsVarTraced(varPtr) \
+   ((varPtr)->flags & VAR_ALL_TRACES)
+
+#define TclIsVarInHash(varPtr) \
+    ((varPtr)->flags & VAR_IN_HASHTABLE)
+
+#define TclIsVarDeadHash(varPtr) \
+    ((varPtr)->flags & VAR_DEAD_HASH)
+
+#define TclGetVarNsPtr(varPtr) \
+    (TclIsVarInHash(varPtr) \
+         ? ((TclVarHashTable *) ((((VarInHash *) (varPtr))->entry.tablePtr)))->nsPtr \
+	 : NULL)
+
+#define VarHashRefCount(varPtr) \
+    ((VarInHash *) (varPtr))->refCount
 
 /*
  * Macros for direct variable access by TEBC
  */
 
 #define TclIsVarDirectReadable(varPtr) \
-	(TclIsVarScalar(varPtr) \
-    && !TclIsVarUndefined(varPtr) \
-    && TclIsVarUntraced(varPtr))
+    (   !((varPtr)->flags & (VAR_ARRAY|VAR_LINK|VAR_TRACED_READ)) \
+    &&  (varPtr)->value.objPtr)
 
 #define TclIsVarDirectWritable(varPtr) \
-    (   !(((varPtr)->flags & VAR_IN_HASHTABLE) \
-		&& ((varPtr)->hPtr == NULL)) \
-     && TclIsVarUntraced(varPtr) \
-     && (TclIsVarScalar(varPtr) \
-	     || TclIsVarUndefined(varPtr)))
+    !((varPtr)->flags & (VAR_ARRAY|VAR_LINK|VAR_TRACED_WRITE|VAR_DEAD_HASH))
+
+#define TclIsVarDirectModifyable(varPtr) \
+    (   !((varPtr)->flags & (VAR_ARRAY|VAR_LINK|VAR_TRACED_READ|VAR_TRACED_WRITE)) \
+    &&  (varPtr)->value.objPtr)
+
+#define TclIsVarDirectReadable2(varPtr, arrayPtr) \
+    (TclIsVarDirectReadable(varPtr) &&\
+        (!(arrayPtr) || !((arrayPtr)->flags & VAR_TRACED_READ)))
+
+#define TclIsVarDirectWritable2(varPtr, arrayPtr) \
+    (TclIsVarDirectWritable(varPtr) &&\
+        (!(arrayPtr) || !((arrayPtr)->flags & VAR_TRACED_WRITE)))
+
+#define TclIsVarDirectModifyable2(varPtr, arrayPtr) \
+    (TclIsVarDirectModifyable(varPtr) &&\
+        (!(arrayPtr) || !((arrayPtr)->flags & (VAR_TRACED_READ|VAR_TRACED_WRITE))))
+
 
 /*
  *----------------------------------------------------------------
@@ -900,6 +966,22 @@ typedef struct AssocData {
  * Tcl_CallFrame structure in tcl.h. If you change one, change the other.
  */
 
+/*
+ * Will be grown to contain: pointers to the varnames (allocated at the end),
+ * plus the init values for each variable (suitable to be memcopied on init)
+ */
+
+typedef struct LocalCache {
+    int refCount;
+    int numVars;
+    Tcl_Obj *varName0;
+} LocalCache;
+
+#define localName(framePtr, i) \
+    ((&((framePtr)->localCachePtr->varName0))[(i)])
+
+MODULE_SCOPE void TclFreeLocalCache(Tcl_Interp *interp, LocalCache *localCachePtr);
+
 typedef struct CallFrame {
     Namespace *nsPtr;		/* Points to the namespace used to resolve
 				 * commands and global variables. */
@@ -933,7 +1015,8 @@ typedef struct CallFrame {
 				 * the number of compiled local variables
 				 * (local variables assigned entries ["slots"]
 				 * in the compiledLocals array below). */
-    Tcl_HashTable *varTablePtr;	/* Hash table containing local variables not
+    TclVarHashTable *varTablePtr;
+                                /* Hash table containing local variables not
 				 * recognized by the compiler, or created at
 				 * execution time through, e.g., upvar.
 				 * Initially NULL and created if needed. */
@@ -952,6 +1035,7 @@ typedef struct CallFrame {
 				 * have some means of discovering what the
 				 * meaning of the value is, which we do not
 				 * specify. */
+    LocalCache *localCachePtr;
 } CallFrame;
 
 #define FRAME_IS_PROC   0x1
@@ -1736,6 +1820,14 @@ typedef struct Interp {
     int packagePrefer;          /* Current package selection mode. */
 
     /*
+     * Hashtables for variable traces and searches
+     */
+
+    Tcl_HashTable varTraces;   /* Hashtable holding the start of a variable's
+				 * active trace list; varPtr is the key. */
+    Tcl_HashTable varSearches; /* Hashtable holding the start of a variable's
+				 * active searches list; varPtr is the key */
+    /*
      * Statistical information about the bytecode compiler and interpreter's
      * operation.
      */
@@ -2297,6 +2389,12 @@ MODULE_SCOPE int	TclIncrObj(Tcl_Interp *interp, Tcl_Obj *valuePtr,
 			    Tcl_Obj *incrPtr);
 MODULE_SCOPE Tcl_Obj *	TclIncrObjVar2(Tcl_Interp *interp, Tcl_Obj *part1Ptr,
 			    Tcl_Obj *part2Ptr, Tcl_Obj *incrPtr, int flags);
+MODULE_SCOPE int	TclInfoGlobalsCmd(ClientData dummy, Tcl_Interp *interp,
+			    int objc, Tcl_Obj *CONST objv[]);
+MODULE_SCOPE int	TclInfoLocalsCmd(ClientData dummy, Tcl_Interp *interp,
+			    int objc, Tcl_Obj *CONST objv[]);
+MODULE_SCOPE int	TclInfoVarsCmd(ClientData dummy, Tcl_Interp *interp,
+			    int objc, Tcl_Obj *CONST objv[]);
 MODULE_SCOPE void	TclInitAlloc(void);
 MODULE_SCOPE void	TclInitDbCkalloc(void);
 MODULE_SCOPE void	TclInitDoubleConversion(void);
@@ -2308,6 +2406,8 @@ MODULE_SCOPE void	TclInitLimitSupport(Tcl_Interp *interp);
 MODULE_SCOPE void	TclInitNamespaceSubsystem(void);
 MODULE_SCOPE void	TclInitNotifier(void);
 MODULE_SCOPE void	TclInitObjSubsystem(void);
+MODULE_SCOPE void       TclInitVarHashTable(TclVarHashTable *tablePtr,
+                        Namespace *nsPtr);
 MODULE_SCOPE void	TclInitSubsystems(void);
 MODULE_SCOPE int	TclInterpReady(Tcl_Interp *interp);
 MODULE_SCOPE int	TclIsLocalScalar(CONST char *src, int len);
@@ -2339,9 +2439,14 @@ MODULE_SCOPE int	TclMergeReturnOptions(Tcl_Interp *interp, int objc,
 			    Tcl_Obj *CONST objv[], Tcl_Obj **optionsPtrPtr,
 			    int *codePtr, int *levelPtr);
 MODULE_SCOPE int	TclNokia770Doubles();
+MODULE_SCOPE void       TclObjVarErrMsg(Tcl_Interp *interp, Tcl_Obj *part1Ptr,
+	                    Tcl_Obj *part2Ptr, const char *operation,
+	                    const char *reason, int index);
 MODULE_SCOPE int	TclObjInvokeNamespace(Tcl_Interp *interp,
 			    int objc, Tcl_Obj *CONST objv[],
 			    Tcl_Namespace *nsPtr, int flags);
+MODULE_SCOPE int	TclObjUnsetVar2(Tcl_Interp *interp,
+			    Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, int flags);
 MODULE_SCOPE int	TclParseBackslash(CONST char *src,
 			    int numBytes, int *readPtr, char *dst);
 MODULE_SCOPE int	TclParseHex(CONST char *src, int numBytes,
@@ -2904,25 +3009,43 @@ MODULE_SCOPE int	TclCompileStreqOpCmd(Tcl_Interp *interp,
  * the public interface.
  */
 
+MODULE_SCOPE Var *	TclObjLookupVarEx(Tcl_Interp * interp, 
+				Tcl_Obj * part1Ptr, Tcl_Obj * part2Ptr, 
+				int flags, CONST char * msg, 
+				CONST int createPart1, CONST int createPart2, 
+				Var ** arrayPtrPtr);
 MODULE_SCOPE Var *	TclLookupArrayElement(Tcl_Interp *interp,
-			    CONST char *arrayName, CONST char *elName,
+			    Tcl_Obj *arrayNamePtr, Tcl_Obj *elNamePtr,
 			    CONST int flags, CONST char *msg,
 			    CONST int createPart1, CONST int createPart2,
-			    Var *arrayPtr);
+			    Var *arrayPtr, int index);
 MODULE_SCOPE Tcl_Obj *	TclPtrGetVar(Tcl_Interp *interp,
-			    Var *varPtr, Var *arrayPtr, CONST char *part1,
-			    CONST char *part2, CONST int flags);
+			    Var *varPtr, Var *arrayPtr, Tcl_Obj *part1Ptr,
+			    Tcl_Obj *part2Ptr, CONST int flags, int index);
 MODULE_SCOPE Tcl_Obj *	TclPtrSetVar(Tcl_Interp *interp,
-			    Var *varPtr, Var *arrayPtr, CONST char *part1,
-			    CONST char *part2, Tcl_Obj *newValuePtr,
-			    CONST int flags);
+			    Var *varPtr, Var *arrayPtr, Tcl_Obj *part1Ptr,
+			    Tcl_Obj *part2Ptr, Tcl_Obj *newValuePtr,
+			    CONST int flags, int index);
 MODULE_SCOPE Tcl_Obj *	TclPtrIncrObjVar (Tcl_Interp *interp,
-			    Var *varPtr, Var *arrayPtr, CONST char *part1,
-			    CONST char *part2, Tcl_Obj *incrPtr,
-			    CONST int flags);
+			    Var *varPtr, Var *arrayPtr, Tcl_Obj *part1Ptr,
+			    Tcl_Obj *part2Ptr, Tcl_Obj *incrPtr,
+			    CONST int flags, int index);
+MODULE_SCOPE int        TclPtrObjMakeUpvar(Tcl_Interp *interp, Var *otherPtr,
+	                    Tcl_Obj *myNamePtr, int myFlags, int index);
 MODULE_SCOPE void	TclInvalidateNsPath(Namespace *nsPtr);
 
 /*
+ * The new extended interface to the variable traces
+ */
+
+MODULE_SCOPE int	TclObjCallVarTraces (Interp * iPtr, Var * arrayPtr, 
+			    Var * varPtr, Tcl_Obj * part1Ptr, 
+			    Tcl_Obj * part2Ptr, int flags, 
+			    int leaveErrMsg, int index);
+
+
+
+/*
  *----------------------------------------------------------------
  * Macros used by the Tcl core to create and release Tcl objects.
  * TclNewObj(objPtr) creates a new object denoting an empty string.
diff --git a/generic/tclIntDecls.h b/generic/tclIntDecls.h
index 7d827db..abef656 100644
--- a/generic/tclIntDecls.h
+++ b/generic/tclIntDecls.h
@@ -11,7 +11,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclIntDecls.h,v 1.101 2007/06/20 18:46:13 dgp Exp $
+ * RCS: @(#) $Id: tclIntDecls.h,v 1.102 2007/07/31 17:03:38 msofer Exp $
  */
 
 #ifndef _TCLINTDECLS
@@ -123,7 +123,7 @@ EXTERN void		TclDeleteCompiledLocalVars (Interp * iPtr,
 #define TclDeleteVars_TCL_DECLARED
 /* 12 */
 EXTERN void		TclDeleteVars (Interp * iPtr, 
-				Tcl_HashTable * tablePtr);
+				TclVarHashTable * tablePtr);
 #endif
 /* Slot 13 is reserved */
 #ifndef TclDumpMemoryInfo_TCL_DECLARED
@@ -1066,7 +1066,7 @@ typedef struct TclIntStubs {
 #endif /* __WIN32__ */
     int (*tclCreateProc) (Tcl_Interp * interp, Namespace * nsPtr, CONST char * procName, Tcl_Obj * argsPtr, Tcl_Obj * bodyPtr, Proc ** procPtrPtr); /* 10 */
     void (*tclDeleteCompiledLocalVars) (Interp * iPtr, CallFrame * framePtr); /* 11 */
-    void (*tclDeleteVars) (Interp * iPtr, Tcl_HashTable * tablePtr); /* 12 */
+    void (*tclDeleteVars) (Interp * iPtr, TclVarHashTable * tablePtr); /* 12 */
     void *reserved13;
     void (*tclDumpMemoryInfo) (FILE * outFile); /* 14 */
     void *reserved15;
diff --git a/generic/tclLiteral.c b/generic/tclLiteral.c
index 3f1d059..ba9b812 100644
--- a/generic/tclLiteral.c
+++ b/generic/tclLiteral.c
@@ -13,7 +13,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclLiteral.c,v 1.30 2007/03/21 16:25:28 dgp Exp $
+ * RCS: @(#) $Id: tclLiteral.c,v 1.31 2007/07/31 17:03:39 msofer Exp $
  */
 
 #include "tclInt.h"
@@ -31,7 +31,7 @@
  */
 
 static int		AddLocalLiteralEntry(CompileEnv *envPtr,
-			    LiteralEntry *globalPtr, int localHash);
+			    Tcl_Obj *objPtr, int localHash);
 static void		ExpandLocalLiteralArray(CompileEnv *envPtr);
 static unsigned int	HashString(const char *bytes, int length);
 static void		RebuildLiteralTable(LiteralTable *tablePtr);
@@ -216,21 +216,20 @@ TclDeleteLiteralTable(
 /*
  *----------------------------------------------------------------------
  *
- * TclRegisterLiteral --
+ * TclCreateLiteral --
  *
- *	Find, or if necessary create, an object in a CompileEnv literal array
- *	that has a string representation matching the argument string.
+ *	Find, or if necessary create, an object in the interpreter's literal
+ *	table that has a string representation matching the argument
+ *	string. If nsPtr!=NULL then only literals stored for the namespace are
+ *	considered. 
  *
  * Results:
- *	The index in the CompileEnv's literal array that references a shared
- *	literal matching the string. The object is created if necessary.
+ *	The literal object. If it was created in this call *newPtr is set to
+ *      1, else 0. NULL is returned if newPtr==NULL and no literal is found.
  *
  * Side effects:
- *	To maximize sharing, we look up the string in the interpreter's global
- *	literal table. If not found, we create a new shared literal in the
- *	global table. We then add a reference to the shared literal in the
- *	CompileEnv's literal array.
- *
+ *      Increments the ref count of the global LiteralEntry since the caller
+ *      now holds a reference. 
  *	If LITERAL_ON_HEAP is set in flags, this function is given ownership
  *	of the string: if an object is created then its string representation
  *	is set directly from string, otherwise the string is freed. Typically,
@@ -240,77 +239,29 @@ TclDeleteLiteralTable(
  *----------------------------------------------------------------------
  */
 
-int
-TclRegisterLiteral(
-    CompileEnv *envPtr,		/* Points to the CompileEnv in whose object
-				 * array an object is found or created. */
-    register char *bytes,	/* Points to string for which to find or
-				 * create an object in CompileEnv's object
-				 * array. */
-    int length,			/* Number of bytes in the string. If < 0, the
-				 * string consists of all bytes up to the
-				 * first null character. */
-    int flags)			/* If LITERAL_ON_HEAP then the caller already
-				 * malloc'd bytes and ownership is passed to
-				 * this function. If LITERAL_NS_SCOPE then
-				 * the literal shouldnot be shared accross
-				 * namespaces. */
+Tcl_Obj *
+TclCreateLiteral(
+    Interp *iPtr,
+    char *bytes,
+    int length,
+    unsigned int hash,       /* The string's hash. If -1, it will be computed here */
+    int *newPtr,
+    Namespace *nsPtr,
+    int flags,
+    LiteralEntry **globalPtrPtr)
 {
-    Interp *iPtr = envPtr->iPtr;
     LiteralTable *globalTablePtr = &(iPtr->literalTable);
-    LiteralTable *localTablePtr = &(envPtr->localLitTable);
-    register LiteralEntry *globalPtr, *localPtr;
-    register Tcl_Obj *objPtr;
-    unsigned int hash;
-    int localHash, globalHash, objIndex;
-    Namespace *nsPtr;
-
-    if (length < 0) {
-	length = (bytes ? strlen(bytes) : 0);
-    }
-    hash = HashString(bytes, length);
-
-    /*
-     * Is the literal already in the CompileEnv's local literal array? If so,
-     * just return its index.
-     */
-
-    localHash = (hash & localTablePtr->mask);
-    for (localPtr=localTablePtr->buckets[localHash] ; localPtr!=NULL;
-	    localPtr = localPtr->nextPtr) {
-	objPtr = localPtr->objPtr;
-	if ((objPtr->length == length) && ((length == 0)
-		|| ((objPtr->bytes[0] == bytes[0])
-		&& (memcmp(objPtr->bytes, bytes, (unsigned) length) == 0)))) {
-	    if (flags & LITERAL_ON_HEAP) {
-		ckfree(bytes);
-	    }
-	    objIndex = (localPtr - envPtr->literalArrayPtr);
-#ifdef TCL_COMPILE_DEBUG
-	    TclVerifyLocalLiteralTable(envPtr);
-#endif /*TCL_COMPILE_DEBUG*/
-
-	    return objIndex;
-	}
-    }
-
-    /*
-     * The literal is new to this CompileEnv. Should it be shared accross
-     * namespaces? If it is a fully qualified name, the namespace
-     * specification is not needed to avoid sharing.
-     */
-
-    if ((flags & LITERAL_NS_SCOPE) && iPtr->varFramePtr
-	    && ((length <2) || (bytes[0] != ':') || (bytes[1] != ':'))) {
-	nsPtr = iPtr->varFramePtr->nsPtr;
-    } else {
-	nsPtr = NULL;
-    }
-
+    LiteralEntry *globalPtr;
+    int globalHash;
+    Tcl_Obj *objPtr;
+    
     /*
      * Is it in the interpreter's global literal table?
      */
 
+    if (hash == (unsigned int) -1) {
+	hash = HashString(bytes, length);
+    }
     globalHash = (hash & globalTablePtr->mask);
     for (globalPtr=globalTablePtr->buckets[globalHash] ; globalPtr!=NULL;
 	    globalPtr = globalPtr->nextPtr) {
@@ -320,29 +271,32 @@ TclRegisterLiteral(
 		|| ((objPtr->bytes[0] == bytes[0])
 		&& (memcmp(objPtr->bytes, bytes, (unsigned) length) == 0)))) {
 	    /*
-	     * A global literal was found. Add an entry to the CompileEnv's
-	     * local literal array.
+	     * A literal was found: return it
 	     */
 
+	    if (newPtr) {
+		*newPtr = 0;
+	    }
+	    if (globalPtrPtr) {
+		*globalPtrPtr = globalPtr;
+	    }
 	    if (flags & LITERAL_ON_HEAP) {
 		ckfree(bytes);
 	    }
-	    objIndex = AddLocalLiteralEntry(envPtr, globalPtr, localHash);
-#ifdef TCL_COMPILE_DEBUG
-	    if (globalPtr->refCount < 1) {
-		Tcl_Panic("TclRegisterLiteral: global literal \"%.*s\" had bad refCount %d",
-			(length>60? 60 : length), bytes, globalPtr->refCount);
-	    }
-	    TclVerifyLocalLiteralTable(envPtr);
-#endif /*TCL_COMPILE_DEBUG*/
-	    return objIndex;
+	    globalPtr->refCount++;
+	    return objPtr;
 	}
     }
+    if (!newPtr) {
+	if (flags & LITERAL_ON_HEAP) {
+	    ckfree(bytes);
+	}
+	return NULL;
+    }
 
     /*
      * The literal is new to the interpreter. Add it to the global literal
-     * table then add an entry to the CompileEnv's local literal array.
-     * Convert the object to an integer object if possible.
+     * table.
      */
 
     TclNewObj(objPtr);
@@ -363,7 +317,7 @@ TclRegisterLiteral(
 
     globalPtr = (LiteralEntry *) ckalloc((unsigned) sizeof(LiteralEntry));
     globalPtr->objPtr = objPtr;
-    globalPtr->refCount = 0;
+    globalPtr->refCount = 1;
     globalPtr->nsPtr = nsPtr;
     globalPtr->nextPtr = globalTablePtr->buckets[globalHash];
     globalTablePtr->buckets[globalHash] = globalPtr;
@@ -377,11 +331,9 @@ TclRegisterLiteral(
     if (globalTablePtr->numEntries >= globalTablePtr->rebuildSize) {
 	RebuildLiteralTable(globalTablePtr);
     }
-    objIndex = AddLocalLiteralEntry(envPtr, globalPtr, localHash);
 
 #ifdef TCL_COMPILE_DEBUG
     TclVerifyGlobalLiteralTable(iPtr);
-    TclVerifyLocalLiteralTable(envPtr);
     {
 	LiteralEntry *entryPtr;
 	int found, i;
@@ -409,6 +361,121 @@ TclRegisterLiteral(
     iPtr->stats.literalCount[TclLog2(length)]++;
 #endif /*TCL_COMPILE_STATS*/
 
+    if (globalPtrPtr) {
+	*globalPtrPtr = globalPtr;
+    }
+    *newPtr = 1;
+    return objPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclRegisterLiteral --
+ *
+ *	Find, or if necessary create, an object in a CompileEnv literal array
+ *	that has a string representation matching the argument string.
+ *
+ * Results:
+ *	The index in the CompileEnv's literal array that references a shared
+ *	literal matching the string. The object is created if necessary.
+ *
+ * Side effects:
+ *	To maximize sharing, we look up the string in the interpreter's global
+ *	literal table. If not found, we create a new shared literal in the
+ *	global table. We then add a reference to the shared literal in the
+ *	CompileEnv's literal array.
+ *
+ *	If LITERAL_ON_HEAP is set in flags, this function is given ownership
+ *	of the string: if an object is created then its string representation
+ *	is set directly from string, otherwise the string is freed. Typically,
+ *	a caller sets LITERAL_ON_HEAP if "string" is an already heap-allocated
+ *	buffer holding the result of backslash substitutions.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclRegisterLiteral(
+    CompileEnv *envPtr,		/* Points to the CompileEnv in whose object
+				 * array an object is found or created. */
+    register char *bytes,	/* Points to string for which to find or
+				 * create an object in CompileEnv's object
+				 * array. */
+    int length,			/* Number of bytes in the string. If < 0, the
+				 * string consists of all bytes up to the
+				 * first null character. */
+    int flags)			/* If LITERAL_ON_HEAP then the caller already
+				 * malloc'd bytes and ownership is passed to
+				 * this function. If LITERAL_NS_SCOPE then
+				 * the literal shouldnot be shared accross
+				 * namespaces. */
+{
+    Interp *iPtr = envPtr->iPtr;
+    LiteralTable *localTablePtr = &(envPtr->localLitTable);
+    LiteralEntry *globalPtr, *localPtr;
+    Tcl_Obj *objPtr;
+    unsigned int hash;
+    int localHash, objIndex, new;
+    Namespace *nsPtr;
+
+    if (length < 0) {
+	length = (bytes ? strlen(bytes) : 0);
+    }
+    hash = HashString(bytes, length);
+
+    /*
+     * Is the literal already in the CompileEnv's local literal array? If so,
+     * just return its index.
+     */
+
+    localHash = (hash & localTablePtr->mask);
+    for (localPtr=localTablePtr->buckets[localHash] ; localPtr!=NULL;
+	    localPtr = localPtr->nextPtr) {
+	objPtr = localPtr->objPtr;
+	if ((objPtr->length == length) && ((length == 0)
+		|| ((objPtr->bytes[0] == bytes[0])
+		&& (memcmp(objPtr->bytes, bytes, (unsigned) length) == 0)))) {
+	    if (flags & LITERAL_ON_HEAP) {
+		ckfree(bytes);
+	    }
+	    objIndex = (localPtr - envPtr->literalArrayPtr);
+#ifdef TCL_COMPILE_DEBUG
+	    TclVerifyLocalLiteralTable(envPtr);
+#endif /*TCL_COMPILE_DEBUG*/
+
+	    return objIndex;
+	}
+    }
+
+    /*
+     * The literal is new to this CompileEnv. Should it be shared accross
+     * namespaces? If it is a fully qualified name, the namespace
+     * specification is not needed to avoid sharing.
+     */
+
+    if ((flags & LITERAL_NS_SCOPE) && iPtr->varFramePtr
+	    && ((length <2) || (bytes[0] != ':') || (bytes[1] != ':'))) {
+	nsPtr = iPtr->varFramePtr->nsPtr;
+    } else {
+	nsPtr = NULL;
+    }
+
+    /*
+     * Is it in the interpreter's global literal table? If not, create it.
+     */
+
+    objPtr = TclCreateLiteral(iPtr, bytes, length, hash, &new, nsPtr,
+	    flags, &globalPtr);
+    objIndex = AddLocalLiteralEntry(envPtr, objPtr, localHash);
+
+#ifdef TCL_COMPILE_DEBUG
+    if (globalPtr->refCount < 1) {
+	Tcl_Panic("TclRegisterLiteral: global literal \"%.*s\" had bad refCount %d",
+		(length>60? 60 : length), bytes, globalPtr->refCount);
+    }
+    TclVerifyLocalLiteralTable(envPtr);
+#endif /*TCL_COMPILE_DEBUG*/
     return objIndex;
 }
 
@@ -582,10 +649,8 @@ TclAddLiteralObj(
  *	literal.
  *
  * Side effects:
- *	Increments the ref count of the global LiteralEntry since the
- *	CompileEnv now refers to the literal. Expands the literal array if
- *	necessary. May rebuild the hash bucket array of the CompileEnv's
- *	literal array if it becomes too large.
+ *	Expands the literal array if necessary. May rebuild the hash bucket
+ *      array of the CompileEnv's literal array if it becomes too large.
  *
  *----------------------------------------------------------------------
  */
@@ -594,15 +659,14 @@ static int
 AddLocalLiteralEntry(
     register CompileEnv *envPtr,/* Points to CompileEnv in whose literal array
 				 * the object is to be inserted. */
-    LiteralEntry *globalPtr,	/* Points to the global LiteralEntry for the
-				 * literal to add to the CompileEnv. */
+    Tcl_Obj *objPtr,	        /* The literal to add to the CompileEnv. */
     int localHash)		/* Hash value for the literal's string. */
 {
     register LiteralTable *localTablePtr = &(envPtr->localLitTable);
     LiteralEntry *localPtr;
     int objIndex;
 
-    objIndex = TclAddLiteralObj(envPtr, globalPtr->objPtr, &localPtr);
+    objIndex = TclAddLiteralObj(envPtr, objPtr, &localPtr);
 
     /*
      * Add the literal to the local table.
@@ -612,8 +676,6 @@ AddLocalLiteralEntry(
     localTablePtr->buckets[localHash] = localPtr;
     localTablePtr->numEntries++;
 
-    globalPtr->refCount++;
-
     /*
      * If the CompileEnv's local literal table has exceeded a decent size,
      * rebuild it with more buckets.
@@ -633,14 +695,14 @@ AddLocalLiteralEntry(
 	for (i=0 ; i<localTablePtr->numBuckets ; i++) {
 	    for (localPtr=localTablePtr->buckets[i] ; localPtr!=NULL ;
 		    localPtr=localPtr->nextPtr) {
-		if (localPtr->objPtr == globalPtr->objPtr) {
+		if (localPtr->objPtr == objPtr) {
 		    found = 1;
 		}
 	    }
 	}
 
 	if (!found) {
-	    bytes = Tcl_GetStringFromObj(globalPtr->objPtr, &length);
+	    bytes = Tcl_GetStringFromObj(objPtr, &length);
 	    Tcl_Panic("AddLocalLiteralEntry: literal \"%.*s\" wasn't found locally",
 		    (length>60? 60 : length), bytes);
 	}
diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c
index b8ec6e8..7e4a0b0 100644
--- a/generic/tclNamesp.c
+++ b/generic/tclNamesp.c
@@ -22,7 +22,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclNamesp.c,v 1.146 2007/07/05 12:03:27 msofer Exp $
+ * RCS: @(#) $Id: tclNamesp.c,v 1.147 2007/07/31 17:03:39 msofer Exp $
  */
 
 #include "tclInt.h"
@@ -404,7 +404,8 @@ Tcl_PushCallFrame(
     framePtr->numCompiledLocals = 0;
     framePtr->compiledLocals = NULL;
     framePtr->clientData = NULL;
-
+    framePtr->localCachePtr = NULL;
+    
     /*
      * Push the new call frame onto the interpreter's stack of procedure call
      * frames making it the current frame.
@@ -462,6 +463,10 @@ Tcl_PopCallFrame(
     }
     if (framePtr->numCompiledLocals > 0) {
 	TclDeleteCompiledLocalVars(iPtr, framePtr);
+	if (--framePtr->localCachePtr->refCount == 0) {
+	    TclFreeLocalCache(interp, framePtr->localCachePtr);
+	}
+	framePtr->localCachePtr = NULL;
     }
 
     /*
@@ -793,7 +798,7 @@ Tcl_CreateNamespace(
     nsPtr->activationCount = 0;
     nsPtr->refCount = 0;
     Tcl_InitHashTable(&nsPtr->cmdTable, TCL_STRING_KEYS);
-    Tcl_InitHashTable(&nsPtr->varTable, TCL_STRING_KEYS);
+    TclInitVarHashTable(&nsPtr->varTable, nsPtr);
     nsPtr->exportArrayPtr = NULL;
     nsPtr->numExportPatterns = 0;
     nsPtr->maxExportPatterns = 0;
@@ -1056,7 +1061,7 @@ TclTeardownNamespace(
      */
 
     TclDeleteNamespaceVars(nsPtr);
-    Tcl_InitHashTable(&nsPtr->varTable, TCL_STRING_KEYS);
+    TclInitVarHashTable(&nsPtr->varTable, nsPtr);
 
     /*
      * Delete all commands in this namespace. Be careful when traversing the
@@ -2490,129 +2495,6 @@ Tcl_FindCommand(
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_FindNamespaceVar --
- *
- *	Searches for a namespace variable, a variable not local to a
- *	procedure. The variable can be either a scalar or an array, but may
- *	not be an element of an array.
- *
- * Results:
- *	Returns a token for the variable if it is found. Otherwise, if it
- *	can't be found or there is an error, returns NULL and leaves an error
- *	message in the interpreter's result object if "flags" contains
- *	TCL_LEAVE_ERR_MSG.
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
-
-Tcl_Var
-Tcl_FindNamespaceVar(
-    Tcl_Interp *interp,		/* The interpreter in which to find the
-				 * variable. */
-    const char *name,		/* Variable's name. If it starts with "::",
-				 * will be looked up in global namespace.
-				 * Else, looked up first in contextNsPtr
-				 * (current namespace if contextNsPtr is
-				 * NULL), then in global namespace. */
-    Tcl_Namespace *contextNsPtr,/* Ignored if TCL_GLOBAL_ONLY flag set.
-				 * Otherwise, points to namespace in which to
-				 * resolve name. If NULL, look up name in the
-				 * current namespace. */
-    int flags)			/* An OR'd combination of flags:
-				 * TCL_GLOBAL_ONLY (look up name only in
-				 * global namespace), TCL_NAMESPACE_ONLY (look
-				 * up only in contextNsPtr, or the current
-				 * namespace if contextNsPtr is NULL), and
-				 * TCL_LEAVE_ERR_MSG. If both TCL_GLOBAL_ONLY
-				 * and TCL_NAMESPACE_ONLY are given,
-				 * TCL_GLOBAL_ONLY is ignored. */
-{
-    Interp *iPtr = (Interp *) interp;
-    ResolverScheme *resPtr;
-    Namespace *nsPtr[2], *cxtNsPtr;
-    const char *simpleName;
-    Tcl_HashEntry *entryPtr;
-    Var *varPtr;
-    register int search;
-    int result;
-    Tcl_Var var;
-
-    /*
-     * If this namespace has a variable resolver, then give it first crack at
-     * the variable resolution. It may return a Tcl_Var value, it may signal
-     * to continue onward, or it may signal an error.
-     */
-
-    if ((flags & TCL_GLOBAL_ONLY) != 0) {
-	cxtNsPtr = (Namespace *) TclGetGlobalNamespace(interp);
-    } else if (contextNsPtr != NULL) {
-	cxtNsPtr = (Namespace *) contextNsPtr;
-    } else {
-	cxtNsPtr = (Namespace *) TclGetCurrentNamespace(interp);
-    }
-
-    if (cxtNsPtr->varResProc != NULL || iPtr->resolverPtr != NULL) {
-	resPtr = iPtr->resolverPtr;
-
-	if (cxtNsPtr->varResProc) {
-	    result = (*cxtNsPtr->varResProc)(interp, name,
-		    (Tcl_Namespace *) cxtNsPtr, flags, &var);
-	} else {
-	    result = TCL_CONTINUE;
-	}
-
-	while (result == TCL_CONTINUE && resPtr) {
-	    if (resPtr->varResProc) {
-		result = (*resPtr->varResProc)(interp, name,
-			(Tcl_Namespace *) cxtNsPtr, flags, &var);
-	    }
-	    resPtr = resPtr->nextPtr;
-	}
-
-	if (result == TCL_OK) {
-	    return var;
-	} else if (result != TCL_CONTINUE) {
-	    return (Tcl_Var) NULL;
-	}
-    }
-
-    /*
-     * Find the namespace(s) that contain the variable.
-     */
-
-    TclGetNamespaceForQualName(interp, name, (Namespace *) contextNsPtr,
-	    flags, &nsPtr[0], &nsPtr[1], &cxtNsPtr, &simpleName);
-
-    /*
-     * Look for the variable in the variable table of its namespace. Be sure
-     * to check both possible search paths: from the specified namespace
-     * context and from the global namespace.
-     */
-
-    varPtr = NULL;
-    for (search = 0;  (search < 2) && (varPtr == NULL);  search++) {
-	if ((nsPtr[search] != NULL) && (simpleName != NULL)) {
-	    entryPtr = Tcl_FindHashEntry(&nsPtr[search]->varTable, simpleName);
-	    if (entryPtr != NULL) {
-		varPtr = (Var *) Tcl_GetHashValue(entryPtr);
-	    }
-	}
-    }
-    if (varPtr != NULL) {
-	return (Tcl_Var) varPtr;
-    } else if (flags & TCL_LEAVE_ERR_MSG) {
-	Tcl_ResetResult(interp);
-	Tcl_AppendResult(interp, "unknown variable \"", name, "\"", NULL);
-    }
-    return (Tcl_Var) NULL;
-}
-
-/*
- *----------------------------------------------------------------------
- *
  * TclResetShadowedCmdRefs --
  *
  *	Called when a command is added to a namespace to check for existing
@@ -2796,7 +2678,7 @@ TclGetNamespaceFromObj(
      * to discard the old rep and create a new one.      
      */
 
-    resPtr = (ResolvedNsName *) objPtr->internalRep.otherValuePtr;
+    resPtr = (ResolvedNsName *) objPtr->internalRep.twoPtrValue.ptr1;
     if ((objPtr->typePtr != &tclNsNameType)
 	    || (resPtr == NULL)
 	    || (resPtr->refNsPtr &&
@@ -2807,7 +2689,7 @@ TclGetNamespaceFromObj(
 
 	result = tclNsNameType.setFromAnyProc(interp, objPtr);
 
-	resPtr = (ResolvedNsName *) objPtr->internalRep.otherValuePtr;
+	resPtr = (ResolvedNsName *) objPtr->internalRep.twoPtrValue.ptr1;
 	if ((result == TCL_OK) && resPtr) {
 	    nsPtr = resPtr->nsPtr;
 	    if (nsPtr && (nsPtr->flags & NS_DEAD)) {
@@ -4596,7 +4478,7 @@ NamespaceUpvarCmd(
 
 	savedNsPtr = (Tcl_Namespace *) iPtr->varFramePtr->nsPtr;
 	iPtr->varFramePtr->nsPtr = (Namespace *) nsPtr;
-	otherPtr = TclObjLookupVar(interp, objv[0], NULL,
+	otherPtr = TclObjLookupVarEx(interp, objv[0], NULL,
 		(TCL_NAMESPACE_ONLY | TCL_LEAVE_ERR_MSG), "access",
 		/*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr);
 	iPtr->varFramePtr->nsPtr = (Namespace *) savedNsPtr;
@@ -4722,7 +4604,7 @@ FreeNsNameInternalRep(
 				 * to free */
 {
     register ResolvedNsName *resNamePtr = (ResolvedNsName *)
-	    objPtr->internalRep.otherValuePtr;
+	    objPtr->internalRep.twoPtrValue.ptr1;
     Namespace *nsPtr;
 
     /*
@@ -4775,9 +4657,9 @@ DupNsNameInternalRep(
     register Tcl_Obj *copyPtr)	/* Object with internal rep to set. */
 {
     register ResolvedNsName *resNamePtr = (ResolvedNsName *)
-	    srcPtr->internalRep.otherValuePtr;
+	    srcPtr->internalRep.twoPtrValue.ptr1;
 
-    copyPtr->internalRep.otherValuePtr = (void *) resNamePtr;
+    copyPtr->internalRep.twoPtrValue.ptr1 = (void *) resNamePtr;
     if (resNamePtr != NULL) {
 	resNamePtr->refCount++;
     }
@@ -4840,7 +4722,7 @@ SetNsNameFromAny(
 
     if (nsPtr) {
 	nsPtr->refCount++;
-	resNamePtr = (ResolvedNsName *) objPtr->internalRep.otherValuePtr;
+	resNamePtr = (ResolvedNsName *) objPtr->internalRep.twoPtrValue.ptr1;
 	if ((objPtr->typePtr == &tclNsNameType)
 		&& resNamePtr && (resNamePtr->refCount == 1)) {
 	    /*
@@ -4855,7 +4737,7 @@ SetNsNameFromAny(
 	    TclFreeIntRep(objPtr);
 	    resNamePtr = (ResolvedNsName *) ckalloc(sizeof(ResolvedNsName));
 	    resNamePtr->refCount = 1;	
-	    objPtr->internalRep.otherValuePtr = (void *) resNamePtr;
+	    objPtr->internalRep.twoPtrValue.ptr1 = (void *) resNamePtr;
 	    objPtr->typePtr = &tclNsNameType;
 	}
 	resNamePtr->nsPtr = nsPtr;
@@ -4868,7 +4750,7 @@ SetNsNameFromAny(
 	}
     } else {
 	TclFreeIntRep(objPtr);
-	objPtr->internalRep.otherValuePtr = (void *) NULL;
+	objPtr->internalRep.twoPtrValue.ptr1 = (void *) NULL;
 	objPtr->typePtr = &tclNsNameType;
     }
     return TCL_OK;
@@ -6994,27 +6876,32 @@ Tcl_LogCommandInfo(
 	    ? "while executing" : "invoked from within"),
 	    (overflow ? limit : length), command, (overflow ? "..." : "")));
 
-    varPtr = TclObjLookupVar(interp, iPtr->eiVar, NULL, TCL_GLOBAL_ONLY,
+    varPtr = TclObjLookupVarEx(interp, iPtr->eiVar, NULL, TCL_GLOBAL_ONLY,
 	    NULL, 0, 0, &arrayPtr);
-    if ((varPtr == NULL) || (varPtr->tracePtr == NULL)) {
+    if ((varPtr == NULL) || !TclIsVarTraced(varPtr)) {
 	/*
 	 * Should not happen.
 	 */
 
 	return;
-    }
-    if (varPtr->tracePtr->traceProc != EstablishErrorInfoTraces) {
-	/*
-	 * The most recent trace set on ::errorInfo is not the one the core
-	 * itself puts on last. This means some other code is tracing the
-	 * variable, and the additional trace(s) might be write traces that
-	 * expect the timing of writes to ::errorInfo that existed Tcl
-	 * releases before 8.5. To satisfy that compatibility need, we write
-	 * the current -errorinfo value to the ::errorInfo variable.
-	 */
+    } else {
+	Tcl_HashEntry *hPtr = Tcl_FindHashEntry(&iPtr->varTraces,
+		(char *) varPtr);
+	VarTrace *tracePtr = (VarTrace *) Tcl_GetHashValue(hPtr);
 
-	Tcl_ObjSetVar2(interp, iPtr->eiVar, NULL,
-		iPtr->errorInfo, TCL_GLOBAL_ONLY);
+	if (tracePtr->traceProc != EstablishErrorInfoTraces) {
+	    /*
+	     * The most recent trace set on ::errorInfo is not the one the core
+	     * itself puts on last. This means some other code is tracing the
+	     * variable, and the additional trace(s) might be write traces that
+	     * expect the timing of writes to ::errorInfo that existed Tcl
+	     * releases before 8.5. To satisfy that compatibility need, we write
+	     * the current -errorinfo value to the ::errorInfo variable.
+	     */
+	    
+	    Tcl_ObjSetVar2(interp, iPtr->eiVar, NULL,
+		    iPtr->errorInfo, TCL_GLOBAL_ONLY);
+	}
     }
 }
 
diff --git a/generic/tclObj.c b/generic/tclObj.c
index 8188d7e..1e92cf2 100644
--- a/generic/tclObj.c
+++ b/generic/tclObj.c
@@ -12,7 +12,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclObj.c,v 1.130 2007/07/05 12:03:27 msofer Exp $
+ * RCS: @(#) $Id: tclObj.c,v 1.131 2007/07/31 17:03:39 msofer Exp $
  */
 
 #include "tclInt.h"
@@ -3288,7 +3288,8 @@ AllocObjEntry(
     hPtr = (Tcl_HashEntry *) ckalloc((unsigned) (sizeof(Tcl_HashEntry)));
     hPtr->key.oneWordValue = (char *) objPtr;
     Tcl_IncrRefCount(objPtr);
-
+    hPtr->clientData = NULL;
+    
     return hPtr;
 }
 
diff --git a/generic/tclProc.c b/generic/tclProc.c
index 8cd8aa1..c6e0219 100644
--- a/generic/tclProc.c
+++ b/generic/tclProc.c
@@ -11,7 +11,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclProc.c,v 1.125 2007/06/20 18:46:14 dgp Exp $
+ * RCS: @(#) $Id: tclProc.c,v 1.126 2007/07/31 17:03:39 msofer Exp $
  */
 
 #include "tclInt.h"
@@ -27,13 +27,15 @@ static void		FreeLambdaInternalRep(Tcl_Obj *objPtr);
 static int		InitArgsAndLocals(Tcl_Interp *interp,
 			    Tcl_Obj *procNameObj, int skip);
 static void		InitCompiledLocals(Tcl_Interp *interp,
-			    ByteCode *codePtr, CompiledLocal *localPtr,
-			    Var *varPtr, Namespace *nsPtr);
+			    ByteCode *codePtr, Var *defPtr,
+	                    Namespace *nsPtr);
+static void             InitLocalCache(Proc *procPtr);
 static int		PushProcCallFrame(ClientData clientData,
 			    register Tcl_Interp *interp, int objc,
 			    Tcl_Obj *CONST objv[], int isLambda);
 static void		ProcBodyDup(Tcl_Obj *srcPtr, Tcl_Obj *dupPtr);
 static void		ProcBodyFree(Tcl_Obj *objPtr);
+static int              ProcWrongNumArgs(Tcl_Interp *interp, int skip);
 static void		MakeProcError(Tcl_Interp *interp,
 			    Tcl_Obj *procNameObj);
 static void		MakeLambdaError(Tcl_Interp *interp,
@@ -527,13 +529,17 @@ TclCreateProc(
 	     * we and out VAR_UNDEFINED to support bridging precompiled <= 8.3
 	     * code in 8.4 where this is now used as an optimization
 	     * indicator. Yes, this is a hack. -- hobbs
+	     *
+	     * FIXME! Is this right? It does depend on VAR_ARGUMENT not
+	     * changing. Note that a change of VAR_TEMPORARY would not be so
+	     * important, as there are no variable names in precompiled
+	     * bytecodes anyway - right? 
 	     */
 
 	    if ((localPtr->nameLength != nameLength)
 		    || (strcmp(localPtr->name, fieldValues[0]))
 		    || (localPtr->frameIndex != i)
-		    || ((localPtr->flags & ~VAR_UNDEFINED)
-			    != (VAR_SCALAR | VAR_ARGUMENT))
+		    || !(localPtr->flags & VAR_ARGUMENT) /* /// CHECK HERE! */
 		    || (localPtr->defValuePtr == NULL && fieldCount == 2)
 		    || (localPtr->defValuePtr != NULL && fieldCount != 2)) {
 		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
@@ -588,7 +594,7 @@ TclCreateProc(
 	    localPtr->nextPtr = NULL;
 	    localPtr->nameLength = nameLength;
 	    localPtr->frameIndex = i;
-	    localPtr->flags = VAR_SCALAR | VAR_ARGUMENT;
+	    localPtr->flags = VAR_ARGUMENT;
 	    localPtr->resolveInfo = NULL;
 
 	    if (fieldCount == 2) {
@@ -1031,161 +1037,21 @@ TclIsProc(
  */
 
 static int
-InitArgsAndLocals(
-    register Tcl_Interp *interp,/* Interpreter in which procedure was
-				 * invoked. */
-    Tcl_Obj *procNameObj,	/* Procedure name for error reporting. */
-    int skip)			/* Number of initial arguments to be skipped,
-				 * i.e., words in the "command name". */
+ProcWrongNumArgs(
+    Tcl_Interp *interp, int skip)
 {
     CallFrame *framePtr = ((Interp *)interp)->varFramePtr;
     register Proc *procPtr = framePtr->procPtr;
-    ByteCode *codePtr = procPtr->bodyPtr->internalRep.otherValuePtr;
-    register Var *varPtr;
-    register CompiledLocal *localPtr;
-    int localCt, numArgs, argCt, i, imax;
-    Var *compiledLocals;
-    Tcl_Obj *const *argObjs;
+    register Var *defPtr;
+    int localCt = procPtr->numCompiledLocals, numArgs, i;
     Tcl_Obj **desiredObjs;
-    const char *final;
-
-    /*
-     * Create the "compiledLocals" array. Make sure it is large enough to hold
-     * all the procedure's compiled local variables, including its formal
-     * parameters.
-     */
-
-    localCt = procPtr->numCompiledLocals;
-    compiledLocals = (Var*) TclStackAlloc(interp, (int)(localCt*sizeof(Var)));
-    framePtr->numCompiledLocals = localCt;
-    framePtr->compiledLocals = compiledLocals;
-
-    /*
-     * Match and assign the call's actual parameters to the procedure's formal
-     * arguments. The formal arguments are described by the first numArgs
-     * entries in both the Proc structure's local variable list and the call
-     * frame's local variable array.
-     */
-
-    numArgs = procPtr->numArgs;
-    argCt = framePtr->objc - skip;	/* Set it to the number of args to the
-					 * procedure. */
-    argObjs = framePtr->objv + skip;
-    varPtr = framePtr->compiledLocals;
-    localPtr = procPtr->firstLocalPtr;
-    if (numArgs == 0) {
-	if (argCt) {
-	    goto incorrectArgs;
-	} else {
-	    goto correctArgs;
-	}
-    }
-    imax = ((argCt < numArgs-1) ? argCt : numArgs-1);
-    for (i = 0; i < imax; i++) {
-	/*
-	 * "Normal" arguments; last formal is special, depends on it being
-	 * 'args'.
-	 */
-
-	Tcl_Obj *objPtr = argObjs[i];
-
-	varPtr->value.objPtr = objPtr;
-	Tcl_IncrRefCount(objPtr);	/* Local var is a reference. */
-	varPtr->name = localPtr->name;
-	varPtr->nsPtr = NULL;
-	varPtr->hPtr = NULL;
-	varPtr->refCount = 0;
-	varPtr->tracePtr = NULL;
-	varPtr->searchPtr = NULL;
-	varPtr->flags = localPtr->flags;
-	varPtr++;
-	localPtr = localPtr->nextPtr;
-    }
-    for (; i < numArgs-1; i++) {
-	/*
-	 * This loop is entered if argCt < (numArgs-1). Set default values;
-	 * last formal is special.
-	 */
-
-	if (localPtr->defValuePtr != NULL) {
-	    Tcl_Obj *objPtr = localPtr->defValuePtr;
-
-	    varPtr->value.objPtr = objPtr;
-	    Tcl_IncrRefCount(objPtr);	/* Local var is a reference. */
-	    varPtr->name = localPtr->name;
-	    varPtr->nsPtr = NULL;
-	    varPtr->hPtr = NULL;
-	    varPtr->refCount = 0;
-	    varPtr->tracePtr = NULL;
-	    varPtr->searchPtr = NULL;
-	    varPtr->flags = localPtr->flags;
-	    varPtr++;
-	    localPtr = localPtr->nextPtr;
-	} else {
-	    goto incorrectArgs;
-	}
-    }
-
-    /*
-     * When we get here, the last formal argument remains to be defined:
-     * localPtr and varPtr point to the last argument to be initialized.
-     */
-
-    if (localPtr->flags & VAR_IS_ARGS) {
-	Tcl_Obj *listPtr = Tcl_NewListObj(argCt-i, argObjs+i);
-
-	varPtr->value.objPtr = listPtr;
-	Tcl_IncrRefCount(listPtr);	/* Local var is a reference. */
-    } else if (argCt == numArgs) {
-	Tcl_Obj *objPtr = argObjs[i];
-
-	varPtr->value.objPtr = objPtr;
-	Tcl_IncrRefCount(objPtr);	/* Local var is a reference. */
-    } else if ((argCt < numArgs) && (localPtr->defValuePtr != NULL)) {
-	Tcl_Obj *objPtr = localPtr->defValuePtr;
-
-	varPtr->value.objPtr = objPtr;
-	Tcl_IncrRefCount(objPtr);	/* Local var is a reference. */
-    } else {
-	goto incorrectArgs;
-    }
-
-    varPtr->name = localPtr->name;
-    varPtr->nsPtr = NULL;
-    varPtr->hPtr = NULL;
-    varPtr->refCount = 0;
-    varPtr->tracePtr = NULL;
-    varPtr->searchPtr = NULL;
-    varPtr->flags = localPtr->flags;
-
-    localPtr = localPtr->nextPtr;
-    varPtr++;
-
-    /*
-     * Initialise and resolve the remaining compiledLocals.
-     */
-
-  correctArgs:
-    if (localPtr) {
-	InitCompiledLocals(interp, codePtr, localPtr, varPtr, framePtr->nsPtr);
-    }
-
-    return TCL_OK;
-
-
-    incorrectArgs:
-    /*
-     * Do initialise all compiled locals, to avoid problems at
-     * DeleteLocalVars.
-     */
-
-    final = NULL;
-    InitCompiledLocals(interp, codePtr, localPtr, varPtr, framePtr->nsPtr);
-
+    const char *final = NULL;
+    
     /*
      * Build up desired argument list for Tcl_WrongNumArgs
      */
 
+    numArgs = framePtr->procPtr->numArgs;
     desiredObjs = (Tcl_Obj **) TclStackAlloc(interp,
 	    (int) sizeof(Tcl_Obj *) * (numArgs+1));
 
@@ -1198,22 +1064,23 @@ InitArgsAndLocals(
 #endif /* AVOID_HACKS_FOR_ITCL */
     Tcl_IncrRefCount(desiredObjs[0]);
 
-    localPtr = procPtr->firstLocalPtr;
-    for (i=1 ; i<=numArgs ; i++) {
+    defPtr = (Var *) (&framePtr->localCachePtr->varName0 + localCt);
+    for (i=1 ; i<=numArgs ; i++, defPtr++) {
 	Tcl_Obj *argObj;
+	Tcl_Obj *namePtr = localName(framePtr, i-1);
 
-	if (localPtr->defValuePtr != NULL) {
+	if (defPtr->value.objPtr != NULL) {
 	    TclNewObj(argObj);
-	    Tcl_AppendStringsToObj(argObj, "?", localPtr->name, "?", NULL);
-	} else if ((i==numArgs) && !strcmp(localPtr->name, "args")) {
+	    Tcl_AppendStringsToObj(argObj, "?", TclGetString(namePtr), "?", NULL);
+	} else if (defPtr->flags & VAR_IS_ARGS) {
 	    numArgs--;
 	    final = "...";
 	    break;
 	} else {
-	    argObj = Tcl_NewStringObj(localPtr->name, -1);
+	    argObj = namePtr;
+	    Tcl_IncrRefCount(namePtr);
 	}
 	desiredObjs[i] = argObj;
-	localPtr = localPtr->nextPtr;
     }
 
     Tcl_ResetResult(interp);
@@ -1229,6 +1096,46 @@ InitArgsAndLocals(
 /*
  *----------------------------------------------------------------------
  *
+ * TclInitCompiledLocals --
+ *
+ *	This routine is invoked in order to initialize the compiled locals
+ *	table for a new call frame.
+ *
+ *	DEPRECATED: functionality has been inlined elsewhere; this function
+ *	remains to insure binary compatibility with Itcl.
+ *
+
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	May invoke various name resolvers in order to determine which
+ *	variables are being referenced at runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+void
+TclInitCompiledLocals(
+    Tcl_Interp *interp,		/* Current interpreter. */
+    CallFrame *framePtr,	/* Call frame to initialize. */
+    Namespace *nsPtr)		/* Pointer to current namespace. */
+{
+    Var *varPtr = framePtr->compiledLocals;
+    Tcl_Obj *bodyPtr;
+    ByteCode *codePtr;
+
+    bodyPtr = framePtr->procPtr->bodyPtr;
+    if (bodyPtr->typePtr != &tclByteCodeType) {
+	Tcl_Panic("body object for proc attached to frame is not a byte code type");
+    }
+    codePtr = bodyPtr->internalRep.otherValuePtr;
+
+    InitCompiledLocals(interp, codePtr, varPtr, nsPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * InitCompiledLocals --
  *
  *	This routine is invoked in order to initialize the compiled locals
@@ -1248,14 +1155,29 @@ static void
 InitCompiledLocals(
     Tcl_Interp *interp,		/* Current interpreter. */
     ByteCode *codePtr,
-    CompiledLocal *localPtr,
     Var *varPtr,
     Namespace *nsPtr)		/* Pointer to current namespace. */
 {
     Interp *iPtr = (Interp *) interp;
     int haveResolvers = (nsPtr->compiledVarResProc || iPtr->resolverPtr);
-    CompiledLocal *firstLocalPtr;
+    CompiledLocal *firstLocalPtr, *localPtr;
+    int varNum;
+
+    /*
+     * Find the localPtr corresponding to varPtr
+     */
 
+    varNum = varPtr - iPtr->framePtr->compiledLocals;
+    localPtr = iPtr->framePtr->procPtr->firstLocalPtr;
+    while (varNum--) {
+	localPtr = localPtr->nextPtr;
+    }
+
+    /*
+        //FIXME: old bytecompiled code: drop whatever flags are coming in (except
+        //maybe for VAR_TEMPORARY? Who cares really?) A job for tbcload, not us.
+    */
+    
     if (!(haveResolvers && (codePtr->flags & TCL_BYTECODE_RESOLVE_VARS))) {
 	/*
 	 * Initialize the array of local variables stored in the call frame.
@@ -1266,31 +1188,21 @@ InitCompiledLocals(
 
     doInitCompiledLocals:
 	if (!haveResolvers) {
+	    /*
+	     * Should not be called: deadwood.
+	     */
+	    
 	    for (; localPtr != NULL; varPtr++, localPtr = localPtr->nextPtr) {
-		varPtr->value.objPtr = NULL;
-		varPtr->name = localPtr->name;	/* Will be just '\0' if temp
-						 * var. */
-		varPtr->nsPtr = NULL;
-		varPtr->hPtr = NULL;
-		varPtr->refCount = 0;
-		varPtr->tracePtr = NULL;
-		varPtr->searchPtr = NULL;
 		varPtr->flags = localPtr->flags;
+		varPtr->value.objPtr = NULL;
 	    }
 	    return;
 	} else {
 	    Tcl_ResolvedVarInfo *resVarInfo;
 
 	    for (; localPtr != NULL; varPtr++, localPtr = localPtr->nextPtr) {
-		varPtr->value.objPtr = NULL;
-		varPtr->name = localPtr->name;	/* Will be just '\0' if temp
-						 * var. */
-		varPtr->nsPtr = NULL;
-		varPtr->hPtr = NULL;
-		varPtr->refCount = 0;
-		varPtr->tracePtr = NULL;
-		varPtr->searchPtr = NULL;
 		varPtr->flags = localPtr->flags;
+		varPtr->value.objPtr = NULL;
 
 		/*
 		 * Now invoke the resolvers to determine the exact variables
@@ -1302,9 +1214,9 @@ InitCompiledLocals(
 		    Var *resolvedVarPtr = (Var *)
 			    (*resVarInfo->fetchProc)(interp, resVarInfo);
 		    if (resolvedVarPtr) {
-			resolvedVarPtr->refCount++;
-			varPtr->value.linkPtr = resolvedVarPtr;
+			VarHashRefCount(resolvedVarPtr)++;
 			varPtr->flags = VAR_LINK;
+			varPtr->value.linkPtr = resolvedVarPtr;
 		    }
 		}
 	    }
@@ -1361,46 +1273,224 @@ InitCompiledLocals(
 	goto doInitCompiledLocals;
     }
 }
-
-/*
- *----------------------------------------------------------------------
- *
- * TclInitCompiledLocals --
- *
- *	This routine is invoked in order to initialize the compiled locals
- *	table for a new call frame.
- *
- *	DEPRECATED: functionality has been inlined elsewhere; this function
- *	remains to insure binary compatibility with Itcl.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	May invoke various name resolvers in order to determine which
- *	variables are being referenced at runtime.
- *
- *----------------------------------------------------------------------
- */
 
 void
-TclInitCompiledLocals(
-    Tcl_Interp *interp,		/* Current interpreter. */
-    CallFrame *framePtr,	/* Call frame to initialize. */
-    Namespace *nsPtr)		/* Pointer to current namespace. */
+TclFreeLocalCache(
+    Tcl_Interp *interp,
+    LocalCache *localCachePtr)
 {
-    Var *varPtr = framePtr->compiledLocals;
-    Tcl_Obj *bodyPtr;
-    ByteCode *codePtr;
-    CompiledLocal *localPtr = framePtr->procPtr->firstLocalPtr;
+    int i;
+    Tcl_Obj **namePtrPtr = &localCachePtr->varName0;
 
-    bodyPtr = framePtr->procPtr->bodyPtr;
-    if (bodyPtr->typePtr != &tclByteCodeType) {
-	Tcl_Panic("body object for proc attached to frame is not a byte code type");
+    for (i = 0; i < localCachePtr->numVars; i++, namePtrPtr++) {
+	Tcl_Obj *objPtr = *namePtrPtr;
+	/*
+	 * Note that this can be called with interp==NULL, on interp 
+	 * deletion. In that case, the literal table and objects go away 
+	 * on their own.
+	 */
+	if (objPtr) {
+	    if (interp) {
+		TclReleaseLiteral(interp, objPtr);
+	    } else {
+		Tcl_DecrRefCount(objPtr);
+	    }
+	}
     }
-    codePtr = bodyPtr->internalRep.otherValuePtr;
+    ckfree((char *) localCachePtr);
+}
 
-    InitCompiledLocals(interp, codePtr, localPtr, varPtr, nsPtr);
+static void
+InitLocalCache(Proc *procPtr)
+{
+    Interp *iPtr = procPtr->iPtr;
+    ByteCode *codePtr = procPtr->bodyPtr->internalRep.otherValuePtr;
+    CompiledLocal *localPtr = codePtr->procPtr->firstLocalPtr;
+    int localCt = procPtr->numCompiledLocals;
+    int numArgs = procPtr->numArgs, i = 0;
+
+    Tcl_Obj **namePtr;
+    Var *varPtr;
+    LocalCache *localCachePtr;
+    int new;
+    
+    /*
+     * Cache the names and initial values of local variables; store the
+     * cache in both the framePtr for this execution and in the codePtr
+     * for future calls.
+     */
+    
+    localCachePtr = (LocalCache *) ckalloc(sizeof(LocalCache)
+	    + (localCt-1)*sizeof(Tcl_Obj *)
+	    + numArgs*sizeof(Var));
+    
+    namePtr = &localCachePtr->varName0;
+    varPtr = (Var *) (namePtr + localCt);
+    localPtr = codePtr->procPtr->firstLocalPtr;
+    while (localPtr) {
+	if (TclIsVarTemporary(localPtr)) {
+	    *namePtr = NULL;
+	} else {
+	    *namePtr = TclCreateLiteral(iPtr, localPtr->name,
+		    localPtr->nameLength, /* hash */ (unsigned int) -1,
+		    &new, /* nsPtr */ NULL, 0, NULL);
+	    Tcl_IncrRefCount(*namePtr);
+	}
+	
+	if (i < numArgs) {
+	    varPtr->flags = (localPtr->flags & VAR_IS_ARGS);
+	    varPtr->value.objPtr = localPtr->defValuePtr;
+	    varPtr++;
+	    i++;
+	}
+	namePtr++;
+	localPtr=localPtr->nextPtr;
+    }
+    codePtr->localCachePtr = localCachePtr;
+    localCachePtr->refCount = 1;
+    localCachePtr->numVars  = localCt;
+}
+
+static int
+InitArgsAndLocals(
+    register Tcl_Interp *interp,/* Interpreter in which procedure was
+				 * invoked. */
+    Tcl_Obj *procNameObj,	/* Procedure name for error reporting. */
+    int skip)			/* Number of initial arguments to be skipped,
+				 * i.e., words in the "command name". */
+{
+    CallFrame *framePtr = ((Interp *)interp)->varFramePtr;
+    register Proc *procPtr = framePtr->procPtr;
+    ByteCode *codePtr = procPtr->bodyPtr->internalRep.otherValuePtr;
+    register Var *varPtr, *defPtr;
+    int localCt = procPtr->numCompiledLocals, numArgs, argCt, i, imax;
+    Tcl_Obj *const *argObjs;
+        
+    /*
+     * Make sure that the local cache of variable names and initial values has
+     * been initialised properly .
+     */
+
+    if (localCt) {
+	if (!codePtr->localCachePtr) {
+	    InitLocalCache(procPtr) ;
+	}
+	framePtr->localCachePtr = codePtr->localCachePtr;
+	framePtr->localCachePtr->refCount++;
+	defPtr = (Var *) (&framePtr->localCachePtr->varName0 + localCt);
+    } else {
+	defPtr = NULL;
+    }
+    
+    /*
+     * Create the "compiledLocals" array. Make sure it is large enough to hold
+     * all the procedure's compiled local variables, including its formal
+     * parameters.
+     */
+
+    varPtr = (Var*) TclStackAlloc(interp, (int)(localCt*sizeof(Var)));
+    framePtr->compiledLocals = varPtr;
+    framePtr->numCompiledLocals = localCt;
+
+    /*
+     * Match and assign the call's actual parameters to the procedure's formal
+     * arguments. The formal arguments are described by the first numArgs
+     * entries in both the Proc structure's local variable list and the call
+     * frame's local variable array.
+     */
+
+    numArgs = procPtr->numArgs;
+    argCt = framePtr->objc - skip;	/* Set it to the number of args to the
+					 * procedure. */
+    argObjs = framePtr->objv + skip;
+    if (numArgs == 0) {
+	if (argCt) {
+	    goto incorrectArgs;
+	} else {
+	    goto correctArgs;
+	}
+    }
+    imax = ((argCt < numArgs-1) ? argCt : numArgs-1);
+    for (i = 0; i < imax; i++, varPtr++, defPtr++) {
+	/*
+	 * "Normal" arguments; last formal is special, depends on it being
+	 * 'args'.
+	 */
+
+	Tcl_Obj *objPtr = argObjs[i];
+
+	varPtr->flags = 0;
+	varPtr->value.objPtr = objPtr;
+	Tcl_IncrRefCount(objPtr);	/* Local var is a reference. */
+    }
+    for (; i < numArgs-1; i++, varPtr++, defPtr++) {
+	/*
+	 * This loop is entered if argCt < (numArgs-1). Set default values;
+	 * last formal is special.
+	 */
+
+	Tcl_Obj *objPtr = defPtr->value.objPtr;
+
+	if (objPtr) {
+	    varPtr->flags = 0;
+	    varPtr->value.objPtr = objPtr;
+	    Tcl_IncrRefCount(objPtr);	/* Local var reference. */
+	} else {
+	    goto incorrectArgs;
+	}
+    }
+
+    /*
+     * When we get here, the last formal argument remains to be defined:
+     * defPtr and varPtr point to the last argument to be initialized.
+     */
+
+
+    varPtr->flags = 0;
+    if (defPtr->flags & VAR_IS_ARGS) {
+	Tcl_Obj *listPtr = Tcl_NewListObj(argCt-i, argObjs+i);
+
+	varPtr->value.objPtr = listPtr;
+	Tcl_IncrRefCount(listPtr);	/* Local var is a reference. */
+    } else if (argCt == numArgs) {
+	Tcl_Obj *objPtr = argObjs[i];
+
+	varPtr->value.objPtr = objPtr;
+	Tcl_IncrRefCount(objPtr);	/* Local var is a reference. */
+    } else if ((argCt < numArgs) && (defPtr->value.objPtr != NULL)) {
+	Tcl_Obj *objPtr = defPtr->value.objPtr;
+
+	varPtr->value.objPtr = objPtr;
+	Tcl_IncrRefCount(objPtr);	/* Local var is a reference. */
+    } else {
+	goto incorrectArgs;
+    }
+    varPtr++;
+
+    /*
+     * Initialise and resolve the remaining compiledLocals. In the absence of
+     * resolvers, they are undefined local vars: (flags=0, value=NULL).
+     */
+
+  correctArgs:
+    if (numArgs < localCt) {
+	if (!framePtr->nsPtr->compiledVarResProc && !((Interp *)interp)->resolverPtr) {
+	    memset(varPtr, 0, (localCt - numArgs)*sizeof(Var));
+	} else {
+	    InitCompiledLocals(interp, codePtr, varPtr, framePtr->nsPtr);
+	}
+    }
+
+    return TCL_OK;
+
+
+    incorrectArgs:
+    /*
+     * Initialise all compiled locals to avoid problems at DeleteLocalVars.
+     */
+
+    memset(varPtr, 0, ((framePtr->compiledLocals + localCt)-varPtr)*sizeof(Var));
+    return ProcWrongNumArgs(interp, skip);
 }
 
 /*
@@ -1437,7 +1527,8 @@ PushProcCallFrame(
     Namespace *nsPtr = procPtr->cmdPtr->nsPtr;
     CallFrame *framePtr, **framePtrPtr;
     int result;
-
+    ByteCode *codePtr;
+    
     /*
      * If necessary (i.e. if we haven't got a suitable compilation already
      * cached) compile the procedure's body. The compiler will allocate frame
@@ -1448,7 +1539,6 @@ PushProcCallFrame(
 
     if (procPtr->bodyPtr->typePtr == &tclByteCodeType) {
 	Interp *iPtr = (Interp *) interp;
-	ByteCode *codePtr = procPtr->bodyPtr->internalRep.otherValuePtr;
 
 	/*
 	 * When we've got bytecode, this is the check for validity. That is,
@@ -1459,6 +1549,7 @@ PushProcCallFrame(
 	 * commands and/or resolver changes are considered).
 	 */
 
+	codePtr = procPtr->bodyPtr->internalRep.otherValuePtr;
  	if (((Interp *) *codePtr->interpHandle != iPtr)
 		|| (codePtr->compileEpoch != iPtr->compileEpoch)
 		|| (codePtr->nsPtr != nsPtr)
diff --git a/generic/tclThreadStorage.c b/generic/tclThreadStorage.c
index 9f25c32..70a0c11 100644
--- a/generic/tclThreadStorage.c
+++ b/generic/tclThreadStorage.c
@@ -8,7 +8,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclThreadStorage.c,v 1.12 2006/11/13 22:39:56 kennykb Exp $
+ * RCS: @(#) $Id: tclThreadStorage.c,v 1.13 2007/07/31 17:03:39 msofer Exp $
  */
 
 #include "tclInt.h"
@@ -136,7 +136,8 @@ AllocThreadStorageEntry(
 
     hPtr = (Tcl_HashEntry *) TclpSysAlloc(sizeof(Tcl_HashEntry), 0);
     hPtr->key.oneWordValue = keyPtr;
-
+    hPtr->clientData = NULL;
+    
     return hPtr;
 }
 
diff --git a/generic/tclTrace.c b/generic/tclTrace.c
index 0acce21..6ee7798 100644
--- a/generic/tclTrace.c
+++ b/generic/tclTrace.c
@@ -11,7 +11,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclTrace.c,v 1.43 2007/07/24 03:14:40 msofer Exp $
+ * RCS: @(#) $Id: tclTrace.c,v 1.44 2007/07/31 17:03:39 msofer Exp $
  */
 
 #include "tclInt.h"
@@ -2407,8 +2407,8 @@ TclVarTraceExists(
 	return NULL;
     }
 
-    if ((varPtr->tracePtr != NULL)
-	    || ((arrayPtr != NULL) && (arrayPtr->tracePtr != NULL))) {
+    if ((varPtr->flags & VAR_TRACED_READ)
+	    || (arrayPtr && (arrayPtr->flags & VAR_TRACED_READ))) {
 	TclCallVarTraces((Interp *)interp, arrayPtr, varPtr, varName, NULL,
 		TCL_TRACE_READS, /* leaveErrMsg */ 0);
     }
@@ -2450,6 +2450,34 @@ TclVarTraceExists(
  */
 
 int
+TclObjCallVarTraces(
+    Interp *iPtr,		/* Interpreter containing variable. */
+    register Var *arrayPtr,	/* Pointer to array variable that contains the
+				 * variable, or NULL if the variable isn't an
+				 * element of an array. */
+    Var *varPtr,		/* Variable whose traces are to be invoked. */
+    Tcl_Obj *part1Ptr,
+    Tcl_Obj *part2Ptr,		/* Variable's two-part name. */
+    int flags,			/* Flags passed to trace functions: indicates
+				 * what's happening to variable, plus maybe
+				 * TCL_GLOBAL_ONLY or TCL_NAMESPACE_ONLY */
+    int leaveErrMsg,		/* If true, and one of the traces indicates an
+				 * error, then leave an error message and
+				 * stack trace information in *iPTr. */
+    int index)
+{
+    char *part1, *part2;
+
+    if (!part1Ptr) {
+	part1Ptr = localName(iPtr->varFramePtr, index);
+    }
+    part1 = TclGetString(part1Ptr);
+    part2 = part2Ptr? TclGetString(part2Ptr) : NULL;
+    
+    return TclCallVarTraces(iPtr, arrayPtr, varPtr, part1, part2, flags, leaveErrMsg);
+}
+
+int
 TclCallVarTraces(
     Interp *iPtr,		/* Interpreter containing variable. */
     register Var *arrayPtr,	/* Pointer to array variable that contains the
@@ -2474,7 +2502,9 @@ TclCallVarTraces(
     int code = TCL_OK;
     int disposeFlags = 0;
     Tcl_InterpState state = NULL;
-
+    Tcl_HashEntry *hPtr;
+    int traceflags = flags & VAR_ALL_TRACES;
+    
     /*
      * If there are already similar trace functions active for the variable,
      * don't call them again.
@@ -2484,9 +2514,11 @@ TclCallVarTraces(
 	return code;
     }
     TclSetVarTraceActive(varPtr);
-    varPtr->refCount++;
-    if (arrayPtr != NULL) {
-	arrayPtr->refCount++;
+    if (TclIsVarInHash(varPtr)) {
+	VarHashRefCount(varPtr)++;
+    }
+    if (arrayPtr && TclIsVarInHash(arrayPtr)) {
+	VarHashRefCount(arrayPtr)++;
     }
 
     /*
@@ -2538,10 +2570,12 @@ TclCallVarTraces(
     active.nextPtr = iPtr->activeVarTracePtr;
     iPtr->activeVarTracePtr = &active;
     Tcl_Preserve((ClientData) iPtr);
-    if (arrayPtr != NULL && !TclIsVarTraceActive(arrayPtr)) {
+    if (arrayPtr && !TclIsVarTraceActive(arrayPtr) && (arrayPtr->flags & traceflags)) {
+	hPtr = Tcl_FindHashEntry(&iPtr->varTraces,
+		(char *) arrayPtr);
 	active.varPtr = arrayPtr;
-	for (tracePtr = arrayPtr->tracePtr;  tracePtr != NULL;
-		tracePtr = active.nextTracePtr) {
+	for (tracePtr = (VarTrace *) Tcl_GetHashValue(hPtr);
+	     tracePtr != NULL; tracePtr = active.nextTracePtr) {
 	    active.nextTracePtr = tracePtr->nextPtr;
 	    if (!(tracePtr->flags & flags)) {
 		continue;
@@ -2582,36 +2616,40 @@ TclCallVarTraces(
 	flags |= TCL_TRACE_DESTROYED;
     }
     active.varPtr = varPtr;
-    for (tracePtr = varPtr->tracePtr; tracePtr != NULL;
-	    tracePtr = active.nextTracePtr) {
-	active.nextTracePtr = tracePtr->nextPtr;
-	if (!(tracePtr->flags & flags)) {
-	    continue;
-	}
-	Tcl_Preserve((ClientData) tracePtr);
-	if (state == NULL) {
-	    state = Tcl_SaveInterpState((Tcl_Interp *)iPtr, code);
-	}
-	if (Tcl_InterpDeleted((Tcl_Interp *)iPtr)) {
-	    flags |= TCL_INTERP_DESTROYED;
-	}
-	result = (*tracePtr->traceProc)(tracePtr->clientData,
-		(Tcl_Interp *) iPtr, part1, part2, flags);
-	if (result != NULL) {
-	    if (flags & TCL_TRACE_UNSETS) {
-		/*
-		 * Ignore errors in unset traces.
-		 */
-
-		DisposeTraceResult(tracePtr->flags, result);
-	    } else {
-		disposeFlags = tracePtr->flags;
-		code = TCL_ERROR;
+    if (varPtr->flags & traceflags) {
+	hPtr = Tcl_FindHashEntry(&iPtr->varTraces,
+		(char *) varPtr);
+	for (tracePtr = (VarTrace *) Tcl_GetHashValue(hPtr);
+	     tracePtr != NULL; tracePtr = active.nextTracePtr) {
+	    active.nextTracePtr = tracePtr->nextPtr;
+	    if (!(tracePtr->flags & flags)) {
+		continue;
+	    }
+	    Tcl_Preserve((ClientData) tracePtr);
+	    if (state == NULL) {
+		state = Tcl_SaveInterpState((Tcl_Interp *)iPtr, code);
+	    }
+	    if (Tcl_InterpDeleted((Tcl_Interp *)iPtr)) {
+		flags |= TCL_INTERP_DESTROYED;
+	    }
+	    result = (*tracePtr->traceProc)(tracePtr->clientData,
+		    (Tcl_Interp *) iPtr, part1, part2, flags);
+	    if (result != NULL) {
+		if (flags & TCL_TRACE_UNSETS) {
+		    /*
+		     * Ignore errors in unset traces.
+		     */
+		    
+		    DisposeTraceResult(tracePtr->flags, result);
+		} else {
+		    disposeFlags = tracePtr->flags;
+		    code = TCL_ERROR;
+		}
+	    }
+	    Tcl_Release((ClientData) tracePtr);
+	    if (code == TCL_ERROR) {
+		goto done;
 	    }
-	}
-	Tcl_Release((ClientData) tracePtr);
-	if (code == TCL_ERROR) {
-	    goto done;
 	}
     }
 
@@ -2684,14 +2722,16 @@ TclCallVarTraces(
 	}
     }
 
-    if (arrayPtr != NULL) {
-	arrayPtr->refCount--;
+    if (arrayPtr && TclIsVarInHash(arrayPtr)) {
+	VarHashRefCount(arrayPtr)--;
     }
     if (copiedName) {
 	Tcl_DStringFree(&nameCopy);
     }
     TclClearVarTraceActive(varPtr);
-    varPtr->refCount--;
+    if (TclIsVarInHash(varPtr)) {
+	VarHashRefCount(varPtr)--;
+    }
     iPtr->activeVarTracePtr = active.nextPtr;
     Tcl_Release((ClientData) iPtr);
     return code;
@@ -2793,11 +2833,12 @@ Tcl_UntraceVar2(
     ClientData clientData)	/* Arbitrary argument to pass to proc. */
 {
     register VarTrace *tracePtr;
-    VarTrace *prevPtr;
+    VarTrace *prevPtr, *nextPtr;
     Var *varPtr, *arrayPtr;
     Interp *iPtr = (Interp *) interp;
     ActiveVarTrace *activePtr;
-    int flagMask;
+    int flagMask, allFlags = 0;
+    Tcl_HashEntry *hPtr;
 
     /*
      * Set up a mask to mask out the parts of the flags that we are not
@@ -2807,7 +2848,7 @@ Tcl_UntraceVar2(
     flagMask = TCL_GLOBAL_ONLY | TCL_NAMESPACE_ONLY;
     varPtr = TclLookupVar(interp, part1, part2, flags & flagMask, /*msg*/ NULL,
 	    /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr);
-    if (varPtr == NULL) {
+    if (varPtr == NULL || !(varPtr->flags & VAR_ALL_TRACES & flags)) {
 	return;
     }
 
@@ -2822,15 +2863,19 @@ Tcl_UntraceVar2(
     flagMask |= TCL_TRACE_OLD_STYLE;
 #endif
     flags &= flagMask;
-    for (tracePtr = varPtr->tracePtr, prevPtr = NULL; ;
+
+    hPtr = Tcl_FindHashEntry(&iPtr->varTraces,
+	    (char *) varPtr);
+    for (tracePtr = (VarTrace *) Tcl_GetHashValue(hPtr), prevPtr = NULL; ;
 	    prevPtr = tracePtr, tracePtr = tracePtr->nextPtr) {
 	if (tracePtr == NULL) {
-	    return;
+	    goto updateFlags;
 	}
 	if ((tracePtr->traceProc == proc) && (tracePtr->flags == flags)
 		&& (tracePtr->clientData == clientData)) {
 	    break;
 	}
+	allFlags |= tracePtr->flags;
     }
 
     /*
@@ -2845,19 +2890,32 @@ Tcl_UntraceVar2(
 	    activePtr->nextTracePtr = tracePtr->nextPtr;
 	}
     }
+    nextPtr = tracePtr->nextPtr;
     if (prevPtr == NULL) {
-	varPtr->tracePtr = tracePtr->nextPtr;
+	if (nextPtr) {
+	    Tcl_SetHashValue(hPtr, nextPtr);
+	} else {
+	    Tcl_DeleteHashEntry(hPtr);
+	}
     } else {
-	prevPtr->nextPtr = tracePtr->nextPtr;
+	prevPtr->nextPtr = 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)) {
+    for (tracePtr = nextPtr; tracePtr != NULL;
+	    tracePtr = tracePtr->nextPtr) {
+	allFlags |= tracePtr->flags;
+    }
+    
+    updateFlags:
+    varPtr->flags &= ~VAR_ALL_TRACES;
+    if (allFlags & VAR_ALL_TRACES) {
+	varPtr->flags |= (allFlags & VAR_ALL_TRACES);
+    } else if (TclIsVarUndefined(varPtr)) {
+	/*
+	 * If this is the last trace on the variable, and the variable is
+	 * unset and unused, then free up the variable.
+	 */
 	TclCleanupVar(varPtr, NULL);
     }
 }
@@ -2934,8 +2992,10 @@ Tcl_VarTraceInfo2(
 				 * next trace after that one. If NULL, this
 				 * call will return the first trace. */
 {
+    Interp *iPtr = (Interp *) interp;
     register VarTrace *tracePtr;
     Var *varPtr, *arrayPtr;
+    Tcl_HashEntry *hPtr;
 
     varPtr = TclLookupVar(interp, part1, part2,
 	    flags & (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY), /*msg*/ NULL,
@@ -2948,19 +3008,25 @@ Tcl_VarTraceInfo2(
      * 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;
+    hPtr = Tcl_FindHashEntry(&iPtr->varTraces,
+	    (char *) varPtr);
+
+    if (hPtr) {
+	tracePtr = Tcl_GetHashValue(hPtr);
+
+	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;
+	for (; tracePtr!=NULL ; tracePtr=tracePtr->nextPtr) {
+	    if (tracePtr->traceProc == proc) {
+		return tracePtr->clientData;
+	    }
 	}
     }
     return NULL;
@@ -2982,6 +3048,7 @@ Tcl_VarTraceInfo2(
  *	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.
+ *     The variable's flags are updated.
  *
  *----------------------------------------------------------------------
  */
@@ -3019,7 +3086,7 @@ Tcl_TraceVar(
  *	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.
+ *	proc. The variable's flags are updated.
  *
  *----------------------------------------------------------------------
  */
@@ -3092,8 +3159,11 @@ TraceVarEx(
 				 * caller to free if this function returns
 				 * TCL_ERROR. */
 {
+    Interp *iPtr = (Interp *) interp;
     Var *varPtr, *arrayPtr;
     int flagMask;
+    Tcl_HashEntry *hPtr;
+    int new;
 
     /*
      * We strip 'flags' down to just the parts which are relevant to
@@ -3130,8 +3200,18 @@ TraceVarEx(
     flagMask |= TCL_TRACE_OLD_STYLE;
 #endif
     tracePtr->flags = tracePtr->flags & flagMask;
-    tracePtr->nextPtr = varPtr->tracePtr;
-    varPtr->tracePtr = tracePtr;
+
+    hPtr = Tcl_CreateHashEntry(&iPtr->varTraces,
+	    (char *) varPtr, &new);
+    if (new) {
+	tracePtr->nextPtr = NULL;
+    } else {
+	tracePtr->nextPtr = (VarTrace *) Tcl_GetHashValue(hPtr);
+    }
+    Tcl_SetHashValue(hPtr, (char *) tracePtr);
+
+    varPtr->flags |= (tracePtr->flags & VAR_ALL_TRACES);
+
     return TCL_OK;
 }
 
diff --git a/generic/tclVar.c b/generic/tclVar.c
index b0036d5..d032cef 100644
--- a/generic/tclVar.c
+++ b/generic/tclVar.c
@@ -11,15 +11,97 @@
  * Copyright (c) 1994-1997 Sun Microsystems, Inc.
  * Copyright (c) 1998-1999 by Scriptics Corporation.
  * Copyright (c) 2001 by Kevin B. Kenny. All rights reserved.
+ * Copyright (c) 2007 Miguel Sofer
  *
  * 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.144 2007/06/28 13:56:21 msofer Exp $
+ * RCS: @(#) $Id: tclVar.c,v 1.145 2007/07/31 17:03:41 msofer Exp $
  */
 
 #include "tclInt.h"
 
+ /*
+  * Prototypes for the variable hash key methods.
+  */
+
+static Tcl_HashEntry *	AllocVarEntry(Tcl_HashTable *tablePtr,
+			    VOID *keyPtr);
+static void		FreeVarEntry(Tcl_HashEntry *hPtr);
+static int		CompareVarKeys(VOID *keyPtr, Tcl_HashEntry *hPtr);
+static unsigned int	HashVarKey(Tcl_HashTable *tablePtr, VOID *keyPtr);
+
+Tcl_HashKeyType tclVarHashKeyType = {
+    TCL_HASH_KEY_TYPE_VERSION,		/* version */
+    0,					/* flags */
+    HashVarKey,			        /* hashKeyProc */
+    CompareVarKeys,			/* compareKeysProc */
+    AllocVarEntry,			/* allocEntryProc */
+    FreeVarEntry			/* freeEntryProc */
+};
+
+static inline Var * VarHashCreateVar(TclVarHashTable *tablePtr, Tcl_Obj *key, int *newPtr);
+static inline Var * VarHashFirstVar(TclVarHashTable *tablePtr, Tcl_HashSearch *searchPtr);
+static inline Var * VarHashNextVar(Tcl_HashSearch *searchPtr);
+static inline void  CleanupVar(Var *varPtr, Var *arrayPtr);
+
+#define VarHashGetValue(hPtr) \
+    ((Var *) ((char *)hPtr - offsetof(VarInHash, entry)))
+
+static inline Var *
+VarHashCreateVar(TclVarHashTable *tablePtr, Tcl_Obj *key, int *newPtr)
+{
+    Tcl_HashEntry *hPtr = Tcl_CreateHashEntry((Tcl_HashTable *) tablePtr, (char *) key, newPtr);
+    if (hPtr) {
+	return VarHashGetValue(hPtr);
+    } else {
+	return NULL;
+    }
+}
+
+#define VarHashFindVar(tablePtr, key) \
+    VarHashCreateVar((tablePtr), (key), NULL)
+
+#define VarHashInvalidateEntry(varPtr) \
+    ((varPtr)->flags |= VAR_DEAD_HASH)
+
+#define VarHashDeleteEntry(varPtr) \
+    Tcl_DeleteHashEntry(&(((VarInHash *) varPtr)->entry))
+
+#define VarHashFirstEntry(tablePtr, searchPtr) \
+    Tcl_FirstHashEntry((Tcl_HashTable *) (tablePtr), (searchPtr))
+
+#define VarHashNextEntry(searchPtr) \
+    Tcl_NextHashEntry((searchPtr))
+
+static inline Var *
+VarHashFirstVar(TclVarHashTable *tablePtr, Tcl_HashSearch *searchPtr)
+{
+    Tcl_HashEntry *hPtr = VarHashFirstEntry(tablePtr, searchPtr);
+    if (hPtr) {
+	return VarHashGetValue(hPtr);
+    } else {
+	return NULL;
+    }
+}
+
+static inline Var *
+VarHashNextVar(Tcl_HashSearch *searchPtr)
+{
+    Tcl_HashEntry *hPtr = VarHashNextEntry(searchPtr);
+    if (hPtr) {
+	return VarHashGetValue(hPtr);
+    } else {
+	return NULL;
+    }
+}
+
+#define VarHashGetKey(varPtr) \
+    (((VarInHash *)(varPtr))->entry.key.objPtr)
+
+#define VarHashDeleteTable(tablePtr) \
+    Tcl_DeleteHashTable((Tcl_HashTable *) (tablePtr))
+
 /*
  * The strings below are used to indicate what went wrong when a variable
  * access is denied.
@@ -49,19 +131,20 @@ static const char *isArrayElement =
  * Forward references to functions defined later in this file:
  */
 
-static void		DeleteSearches(Var *arrayVarPtr);
-static void		DeleteArray(Interp *iPtr, const char *arrayName,
+static void		AppendLocals(Tcl_Interp *interp, Tcl_Obj *listPtr,
+			    Tcl_Obj *patternPtr, int includeLinks);
+static void		DeleteSearches(Interp *iPtr, Var *arrayVarPtr);
+static void		DeleteArray(Interp *iPtr, Tcl_Obj *arrayNamePtr,
 			    Var *varPtr, int flags);
 static int		ObjMakeUpvar(Tcl_Interp *interp,
 			    CallFrame *framePtr, Tcl_Obj *otherP1Ptr,
 			    const char *otherP2, const int otherFlags,
-			    const char *myName, int myFlags, int index);
-static Var *		NewVar(void);
+			    Tcl_Obj *myNamePtr, int myFlags, int index);
 static ArraySearch *	ParseSearchId(Tcl_Interp *interp, const Var *varPtr,
-			    const char *varName, Tcl_Obj *handleObj);
+			    Tcl_Obj *varNamePtr, Tcl_Obj *handleObj);
 static void		UnsetVarStruct(Var *varPtr, Var *arrayPtr,
-			    Interp *iPtr, const char *part1,
-			    const char *part2, int flags, int reachable);
+			    Interp *iPtr, Tcl_Obj *part1Ptr,
+			    Tcl_Obj *part2Ptr, int flags);
 static int		SetArraySearchObj(Tcl_Interp *interp, Tcl_Obj *objPtr);
 
 /*
@@ -70,10 +153,8 @@ static int		SetArraySearchObj(Tcl_Interp *interp, Tcl_Obj *objPtr);
  */
 
 MODULE_SCOPE Var *	TclLookupSimpleVar(Tcl_Interp *interp,
-			    const char *varName, int flags, const int create,
+			    Tcl_Obj *varNamePtr, int flags, const int create,
 			    const char **errMsgPtr, int *indexPtr);
-MODULE_SCOPE int	TclObjUnsetVar2(Tcl_Interp *interp,
-			    Tcl_Obj *part1Ptr, const char *part2, int flags);
 
 static Tcl_DupInternalRepProc	DupLocalVarName;
 static Tcl_FreeInternalRepProc	FreeParsedVarName;
@@ -145,6 +226,69 @@ Tcl_ObjType tclArraySearchType = {
     "array search",
     NULL, NULL, NULL, SetArraySearchObj
 };
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCleanupVar --
+ *
+ *	This function is called when it looks like it may be OK to free up a
+ *	variable's storage. If the variable is in a hashtable, its Var
+ *	structure and hash table entry will be freed along with those of its
+ *	containing array, if any. This function is called, for example, when
+ *	a trace on a variable deletes a variable.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	If the variable (or its containing array) really is dead and in a
+ *	hashtable, then its Var structure, and possibly its hash table entry,
+ *	is freed up.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static inline void
+CleanupVar(
+    Var *varPtr,		/* Pointer to variable that may be a candidate
+				 * for being expunged. */
+    Var *arrayPtr)		/* Array that contains the variable, or NULL
+				 * if this variable isn't an array element. */
+{
+    if (TclIsVarUndefined(varPtr) && TclIsVarInHash(varPtr)
+	    && !TclIsVarTraced(varPtr)
+	    && (VarHashRefCount(varPtr) == !TclIsVarDeadHash(varPtr))) {
+	if (VarHashRefCount(varPtr) == 0) {
+	    ckfree((char *) varPtr);
+	} else {
+	    VarHashDeleteEntry(varPtr);
+	}
+    }
+    if (arrayPtr != NULL) {
+	if (TclIsVarUndefined(arrayPtr) && TclIsVarInHash(arrayPtr)
+		&& !TclIsVarTraced(arrayPtr)
+		&& (VarHashRefCount(arrayPtr) == !TclIsVarDeadHash(arrayPtr))) {
+	    if (VarHashRefCount(arrayPtr) == 0) {
+		ckfree((char *) arrayPtr);
+	    } else {
+		VarHashDeleteEntry(arrayPtr);
+	    }
+	}
+    }
+}
+
+void
+TclCleanupVar(
+    Var *varPtr,		/* Pointer to variable that may be a candidate
+				 * for being expunged. */
+    Var *arrayPtr)		/* Array that contains the variable, or NULL
+				 * if this variable isn't an array element. */
+{
+    return CleanupVar(varPtr, arrayPtr);
+}
+
 
 /*
  *----------------------------------------------------------------------
@@ -153,8 +297,8 @@ Tcl_ObjType tclArraySearchType = {
  *
  *	This function 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.
+ *	trace code. It is kept in tcl8.5 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
@@ -208,89 +352,17 @@ TclLookupVar(
 				 * address of array variable. Otherwise this
 				 * is set to NULL. */
 {
+    Tcl_Obj *part1Ptr;
     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 function 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) {
-			TclVarErrMsg(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;
-    }
+    part1Ptr = Tcl_NewStringObj(part1, -1);
+    Tcl_IncrRefCount(part1Ptr);
 
-    varPtr = TclLookupSimpleVar(interp, part1, flags, createPart1,
-	    &errMsg, &index);
-    if (varPtr == NULL) {
-	if ((errMsg != NULL) && (flags & TCL_LEAVE_ERR_MSG)) {
-	    TclVarErrMsg(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);
-    }
+    varPtr = TclObjLookupVar(interp, part1Ptr, part2, flags, msg,
+	    createPart1, createPart2, arrayPtrPtr);
 
+    TclDecrRefCount(part1Ptr);
     return varPtr;
-#undef VAR_NAME_BUF_SIZE
 }
 
 /*
@@ -357,6 +429,36 @@ TclObjLookupVar(
 				 * address of array variable. Otherwise this
 				 * is set to NULL. */
 {
+    Tcl_Obj *part2Ptr;
+    Var *resPtr;
+
+    if (part2) {
+	part2Ptr = Tcl_NewStringObj(part2, -1);
+	Tcl_IncrRefCount(part2Ptr);
+    } else {
+	part2Ptr = NULL;
+    }
+    
+    resPtr = TclObjLookupVarEx(interp, part1Ptr, part2Ptr, 
+	    flags, msg, createPart1, createPart2, arrayPtrPtr);
+
+    if (part2Ptr) {
+	Tcl_DecrRefCount(part2Ptr);
+    }
+
+    return resPtr;
+}
+
+Var *
+TclObjLookupVarEx(Tcl_Interp * interp, 
+	Tcl_Obj * part1Ptr,
+	Tcl_Obj * part2Ptr, 
+	int flags,
+	CONST char * msg, 
+	CONST int createPart1,
+	CONST int createPart2, 
+	Var ** arrayPtrPtr)
+{
     Interp *iPtr = (Interp *) interp;
     register Var *varPtr;	/* Points to the variable's in-frame Var
 				 * structure. */
@@ -368,7 +470,9 @@ TclObjLookupVar(
     const char *errMsg = NULL;
     CallFrame *varFramePtr = iPtr->varFramePtr;
     Namespace *nsPtr;
-
+    char *part2 = part2Ptr? TclGetString(part2Ptr):NULL;
+    char *newPart2 = NULL;
+    
     /*
      * If part1Ptr is a tclParsedVarNameType, separate it into the pre-parsed
      * parts.
@@ -377,19 +481,22 @@ TclObjLookupVar(
     *arrayPtrPtr = NULL;
     if (typePtr == &tclParsedVarNameType) {
 	if (part1Ptr->internalRep.twoPtrValue.ptr1 != NULL) {
-	    if (part2 != NULL) {
+	    if (part2Ptr != NULL) {
 		/*
 		 * ERROR: part1Ptr is already an array element, cannot specify
 		 * a part2.
 		 */
 
 		if (flags & TCL_LEAVE_ERR_MSG) {
-		    part1 = TclGetString(part1Ptr);
-		    TclVarErrMsg(interp, part1, part2, msg, needArray);
+		    TclObjVarErrMsg(interp, part1Ptr, part2Ptr, msg, needArray, -1);
 		}
 		return NULL;
 	    }
-	    part2 = part1Ptr->internalRep.twoPtrValue.ptr2;
+	    part2 = newPart2 = part1Ptr->internalRep.twoPtrValue.ptr2;
+	    if (newPart2) {
+		part2Ptr = Tcl_NewStringObj(newPart2, -1);
+		Tcl_IncrRefCount(part2Ptr);
+	    }
 	    part1Ptr = part1Ptr->internalRep.twoPtrValue.ptr1;
 	    typePtr = part1Ptr->typePtr;
 	}
@@ -397,23 +504,34 @@ TclObjLookupVar(
     }
     part1 = Tcl_GetStringFromObj(part1Ptr, &len1);
 
-    nsPtr = varFramePtr->nsPtr;
-    if (nsPtr->varResProc != NULL || iPtr->resolverPtr != NULL) {
+    if (varFramePtr) {
+	nsPtr = varFramePtr->nsPtr;
+	if (nsPtr->varResProc != NULL || iPtr->resolverPtr != NULL) {
+	    goto doParse;
+	}
+    } else {
+	/*
+	 * Some variables in the global ns have to be initialized before the
+	 * root call frame is in place.
+	 */
+
+	nsPtr = NULL;
 	goto doParse;
     }
 
     if (typePtr == &localVarNameType) {
 	int localIndex = (int) part1Ptr->internalRep.longValue;
-
+	
 	if (HasLocalVars(varFramePtr)
 		&& !(flags & (TCL_GLOBAL_ONLY | TCL_NAMESPACE_ONLY))
 		&& (localIndex < varFramePtr->numCompiledLocals)) {
 	    /*
 	     * use the cached index if the names coincide.
 	     */
-
-	    varPtr = &(varFramePtr->compiledLocals[localIndex]);
-	    if ((varPtr->name != NULL) && (strcmp(part1, varPtr->name) == 0)) {
+	    Tcl_Obj *namePtr = localName(iPtr->varFramePtr, localIndex);
+	    
+	    if (namePtr && (strcmp(part1, TclGetString(namePtr)) == 0)) {
+		varPtr = (Var *) &(varFramePtr->compiledLocals[localIndex]);
 		goto donePart1;
 	    }
 	}
@@ -438,14 +556,14 @@ TclObjLookupVar(
 		 */
 		!TclIsVarUndefined(varPtr))));
 
-	if (useReference && (varPtr->hPtr != NULL)) {
+	if (useReference && !TclIsVarDeadHash(varPtr)) {
 	    /*
 	     * 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
+	     * If TclIsVarDeadHash(varPtr), 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
@@ -465,14 +583,13 @@ TclObjLookupVar(
 	 */
 
 	register int i;
-	char *newPart2;
 
 	len2 = -1;
 	for (i = 0; i < len1; i++) {
 	    if (*(part1 + i) == '(') {
-		if (part2 != NULL) {
+		if (part2Ptr != NULL) {
 		    if (flags & TCL_LEAVE_ERR_MSG) {
-			TclVarErrMsg(interp, part1, part2, msg, needArray);
+			TclObjVarErrMsg(interp, part1Ptr, part2Ptr, msg, needArray, -1);
 		    }
 		}
 
@@ -489,6 +606,8 @@ TclObjLookupVar(
 		memcpy(newPart2, part2, (unsigned int) len2);
 		*(newPart2+len2) = '\0';
 		part2 = newPart2;
+		part2Ptr = Tcl_NewStringObj(newPart2, -1);
+		Tcl_IncrRefCount(part2Ptr);
 
 		/*
 		 * Free the internal rep of the original part1Ptr, now renamed
@@ -528,11 +647,14 @@ TclObjLookupVar(
     TclFreeIntRep(part1Ptr);
     part1Ptr->typePtr = NULL;
 
-    varPtr = TclLookupSimpleVar(interp, part1, flags, createPart1,
+    varPtr = TclLookupSimpleVar(interp, part1Ptr, flags, createPart1,
 	    &errMsg, &index);
     if (varPtr == NULL) {
 	if ((errMsg != NULL) && (flags & TCL_LEAVE_ERR_MSG)) {
-	    TclVarErrMsg(interp, part1, part2, msg, errMsg);
+	    TclObjVarErrMsg(interp, part1Ptr, part2Ptr, msg, errMsg, -1);
+	}
+	if (newPart2) {
+	    Tcl_DecrRefCount(part2Ptr);
 	}
 	return NULL;
     }
@@ -577,8 +699,8 @@ TclObjLookupVar(
     if (varPtr == NULL) {
 	if (flags & TCL_LEAVE_ERR_MSG) {
 	    part1 = TclGetString(part1Ptr);
-	    TclVarErrMsg(interp, part1, part2, msg,
-		    "Cached variable reference is NULL.");
+	    TclObjVarErrMsg(interp, part1Ptr, part2Ptr, msg,
+		    "Cached variable reference is NULL.", -1);
 	}
 	return NULL;
     }
@@ -587,15 +709,17 @@ TclObjLookupVar(
 	varPtr = varPtr->value.linkPtr;
     }
 
-    if (part2 != NULL) {
+    if (part2Ptr != NULL) {
 	/*
 	 * Array element sought: look it up.
 	 */
 
-	part1 = TclGetString(part1Ptr);
 	*arrayPtrPtr = varPtr;
-	varPtr = TclLookupArrayElement(interp, part1, part2, flags, msg,
-		createPart1, createPart2, varPtr);
+	varPtr = TclLookupArrayElement(interp, part1Ptr, part2Ptr, flags, msg,
+		createPart1, createPart2, varPtr, -1);
+	if (newPart2) {
+	    Tcl_DecrRefCount(part2Ptr);
+	}
     }
     return varPtr;
 }
@@ -659,7 +783,7 @@ TclObjLookupVar(
 Var *
 TclLookupSimpleVar(
     Tcl_Interp *interp,		/* Interpreter to use for lookup. */
-    const char *varName,	/* This is a simple variable name that could
+    Tcl_Obj *varNamePtr,	/* This is a simple variable name that could
 				 * represent a scalar or an array. */
     int flags,			/* Only TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY,
 				 * LOOKUP_FOR_UPVAR and TCL_LEAVE_ERR_MSG bits
@@ -676,15 +800,15 @@ TclLookupSimpleVar(
 				 * 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
+    TclVarHashTable *tablePtr;	/* Points to the hashtable, if any, in which
 				 * to look up the variable. */
     Tcl_Var var;		/* Used to search for global names. */
     Var *varPtr;		/* Points to the Var structure returned for
 				 * the variable. */
     Namespace *varNsPtr, *cxtNsPtr, *dummy1Ptr, *dummy2Ptr;
     ResolverScheme *resPtr;
-    Tcl_HashEntry *hPtr;
     int new, i, result;
+    const char *varName = TclGetString(varNamePtr);
 
     varPtr = NULL;
     varNsPtr = NULL;		/* set non-NULL if a nonlocal variable */
@@ -771,14 +895,12 @@ TclLookupSimpleVar(
 	 * otherwise generate our own error!
 	 */
 
-	var = Tcl_FindNamespaceVar(interp, varName, (Tcl_Namespace *) cxtNsPtr,
+	varPtr = (Var *) Tcl_FindNamespaceVar(interp, varName, (Tcl_Namespace *) cxtNsPtr,
 		flags & ~TCL_LEAVE_ERR_MSG);
 
-	if (var != (Tcl_Var) NULL) {
-	    varPtr = (Var *) var;
-	}
-
 	if (varPtr == NULL) {
+	    Tcl_Obj *tailPtr;
+	    
 	    if (create) {	/* var wasn't found so create it */
 		TclGetNamespaceForQualName(interp, varName, cxtNsPtr,
 			flags, &varNsPtr, &dummy1Ptr, &dummy2Ptr, &tail);
@@ -789,12 +911,12 @@ TclLookupSimpleVar(
 		if (tail == NULL) {
 		    *errMsgPtr = missingName;
 		    return NULL;
+		} else if (tail != varName) {
+		    tailPtr = Tcl_NewStringObj(tail, -1);
+		} else {
+		    tailPtr = varNamePtr;
 		}
-		hPtr = Tcl_CreateHashEntry(&varNsPtr->varTable, tail, &new);
-		varPtr = NewVar();
-		Tcl_SetHashValue(hPtr, varPtr);
-		varPtr->hPtr = hPtr;
-		varPtr->nsPtr = varNsPtr;
+		varPtr = VarHashCreateVar(&varNsPtr->varTable, tailPtr, &new);
 		if (lookGlobal) {
 		    /*
 		     * The variable was created starting from the global
@@ -814,50 +936,35 @@ TclLookupSimpleVar(
     } 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;
+	Tcl_Obj **objPtrPtr = &varFramePtr->localCachePtr->varName0;
+	
+	for (i=0 ; i<localCt ; i++, objPtrPtr++) {
+	    Tcl_Obj *objPtr = *objPtrPtr;
+	    if (objPtr) {
+		char *localName = TclGetString(objPtr);
 		if ((varName[0] == localName[0])
-			&& (varNameLen == localPtr->nameLength)
 			&& (strcmp(varName, localName) == 0)) {
 		    *indexPtr = i;
-		    return localVarPtr;
+		    return (Var *) &varFramePtr->compiledLocals[i];
 		}
 	    }
-	    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);
+		tablePtr = (TclVarHashTable *) ckalloc(sizeof(TclVarHashTable));
+		TclInitVarHashTable(tablePtr, NULL);
 		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);
-	    }
+	    varPtr = VarHashCreateVar(tablePtr, varNamePtr, &new);
 	} else {
-	    hPtr = NULL;
+	    varPtr = NULL;
 	    if (tablePtr != NULL) {
-		hPtr = Tcl_FindHashEntry(tablePtr, varName);
+		varPtr = VarHashFindVar(tablePtr, varNamePtr);
 	    }
-	    if (hPtr == NULL) {
+	    if (varPtr == NULL) {
 		*errMsgPtr = noSuchVar;
-		return NULL;
 	    }
-	    varPtr = (Var *) Tcl_GetHashValue(hPtr);
 	}
     }
     return varPtr;
@@ -903,8 +1010,9 @@ TclLookupSimpleVar(
 Var *
 TclLookupArrayElement(
     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. */
+    Tcl_Obj *arrayNamePtr,	/* This is the name of the array, or NULL if
+				 * index>= 0. */
+    Tcl_Obj *elNamePtr,		/* 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
@@ -916,11 +1024,13 @@ TclLookupArrayElement(
     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. */
+    Var *arrayPtr,		/* Pointer to the array's Var structure. */
+    int index)                  /* If >=0, the index of the local array. */
 {
-    Tcl_HashEntry *hPtr;
     int new;
     Var *varPtr;
+    TclVarHashTable *tablePtr;
+    Namespace *nsPtr;
 
     /*
      * We're dealing with an array element. Make sure the variable is an array
@@ -930,7 +1040,7 @@ TclLookupArrayElement(
     if (TclIsVarUndefined(arrayPtr) && !TclIsVarArrayElement(arrayPtr)) {
 	if (!createArray) {
 	    if (flags & TCL_LEAVE_ERR_MSG) {
-		TclVarErrMsg(interp, arrayName, elName, msg, noSuchVar);
+		TclObjVarErrMsg(interp, arrayNamePtr, elNamePtr, msg, noSuchVar, index);
 	    }
 	    return NULL;
 	}
@@ -940,49 +1050,49 @@ TclLookupArrayElement(
 	 * deleted namespace!
 	 */
 
-	if ((arrayPtr->flags & VAR_IN_HASHTABLE) && (arrayPtr->hPtr == NULL)) {
+	if (TclIsVarDeadHash(arrayPtr)) {
 	    if (flags & TCL_LEAVE_ERR_MSG) {
-		TclVarErrMsg(interp, arrayName, elName, msg, danglingVar);
+		TclObjVarErrMsg(interp, arrayNamePtr, elNamePtr, msg, danglingVar, index);
 	    }
 	    return NULL;
 	}
 
 	TclSetVarArray(arrayPtr);
-	TclClearVarUndefined(arrayPtr);
-	arrayPtr->value.tablePtr = (Tcl_HashTable *)
-		ckalloc(sizeof(Tcl_HashTable));
-	Tcl_InitHashTable(arrayPtr->value.tablePtr, TCL_STRING_KEYS);
+	tablePtr = (TclVarHashTable *) ckalloc(sizeof(TclVarHashTable));	
+	arrayPtr->value.tablePtr = tablePtr;	    
+	
+	if (TclIsVarInHash(arrayPtr) && TclGetVarNsPtr(arrayPtr)) {
+	    nsPtr = TclGetVarNsPtr(arrayPtr);
+	} else {
+	    nsPtr = NULL;
+	}
+	TclInitVarHashTable(arrayPtr->value.tablePtr, nsPtr);
     } else if (!TclIsVarArray(arrayPtr)) {
 	if (flags & TCL_LEAVE_ERR_MSG) {
-	    TclVarErrMsg(interp, arrayName, elName, msg, needArray);
+	    TclObjVarErrMsg(interp, arrayNamePtr, elNamePtr, msg, needArray, index);
 	}
 	return NULL;
     }
 
     if (createElem) {
-	hPtr = Tcl_CreateHashEntry(arrayPtr->value.tablePtr, elName, &new);
+	varPtr = VarHashCreateVar(arrayPtr->value.tablePtr, elNamePtr, &new);
 	if (new) {
-	    if (arrayPtr->searchPtr != NULL) {
-		DeleteSearches(arrayPtr);
+	    if (arrayPtr->flags & VAR_SEARCH_ACTIVE) {
+		DeleteSearches((Interp *) interp, 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) {
+	varPtr = VarHashFindVar(arrayPtr->value.tablePtr, elNamePtr);
+	if (varPtr == NULL) {
 	    if (flags & TCL_LEAVE_ERR_MSG) {
-		TclVarErrMsg(interp, arrayName, elName, msg, noSuchElement);
-		Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ELEMENT", elName,
+		TclObjVarErrMsg(interp, arrayNamePtr, elNamePtr, msg, noSuchElement, index);
+		Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ELEMENT", TclGetString(elNamePtr),
 			NULL);
 	    }
-	    return NULL;
 	}
     }
-    return (Var *) Tcl_GetHashValue(hPtr);
+    return varPtr;
 }
 
 /*
@@ -1097,17 +1207,25 @@ Tcl_GetVar2Ex(
     int flags)			/* OR-ed combination of TCL_GLOBAL_ONLY, and
 				 * TCL_LEAVE_ERR_MSG bits. */
 {
-    Var *varPtr, *arrayPtr;
+    Tcl_Obj *part1Ptr, *part2Ptr, *resPtr;
 
-    /* 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;
+    part1Ptr = Tcl_NewStringObj(part1, -1);
+    Tcl_IncrRefCount(part1Ptr);
+    if (part2) {
+	part2Ptr = Tcl_NewStringObj(part2, -1);
+	Tcl_IncrRefCount(part2Ptr);
+    } else {
+	part2Ptr = NULL;
     }
+    
+    resPtr = Tcl_ObjGetVar2(interp, part1Ptr, part2Ptr, flags);
 
-    return TclPtrGetVar(interp, varPtr, arrayPtr, part1, part2, flags);
+    Tcl_DecrRefCount(part1Ptr);
+    if (part2Ptr) {
+	Tcl_DecrRefCount(part2Ptr);
+    }
+    
+    return resPtr;
 }
 
 /*
@@ -1147,20 +1265,16 @@ Tcl_ObjGetVar2(
 				 * TCL_LEAVE_ERR_MSG bits. */
 {
     Var *varPtr, *arrayPtr;
-    char *part1, *part2;
-
-    part1 = TclGetString(part1Ptr);
-    part2 = ((part2Ptr == NULL) ? NULL : TclGetString(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",
+    varPtr = TclObjLookupVarEx(interp, part1Ptr, part2Ptr, flags, "read",
 	    /*createPart1*/ 0, /*createPart2*/ 1, &arrayPtr);
     if (varPtr == NULL) {
 	return NULL;
     }
 
-    return TclPtrGetVar(interp, varPtr, arrayPtr, part1, part2, flags);
+    return TclPtrGetVar(interp, varPtr, arrayPtr, part1Ptr, part2Ptr, flags, -1);
 }
 
 /*
@@ -1192,25 +1306,27 @@ TclPtrGetVar(
     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
+    Tcl_Obj *part1Ptr,		/* 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
+    Tcl_Obj *part2Ptr,		/* If non-NULL, gives the name of an element
 				 * in the array part1. */
-    const int flags)		/* OR-ed combination of TCL_GLOBAL_ONLY, and
+    const int flags,		/* OR-ed combination of TCL_GLOBAL_ONLY, and
 				 * TCL_LEAVE_ERR_MSG bits. */
+    int index)
 {
     Interp *iPtr = (Interp *) interp;
     const char *msg;
 
     /*
-     * Invoke any traces that have been set for the variable.
+     * Invoke any read traces that have been set for the variable.
      */
 
-    if ((varPtr->tracePtr != NULL)
-	    || ((arrayPtr != NULL) && (arrayPtr->tracePtr != NULL))) {
-	if (TCL_ERROR == TclCallVarTraces(iPtr, arrayPtr, varPtr, part1, part2,
+    if ((varPtr->flags & VAR_TRACED_READ)
+	    || (arrayPtr && (arrayPtr->flags & VAR_TRACED_READ))) {
+	if (TCL_ERROR == TclObjCallVarTraces(iPtr, arrayPtr, varPtr,
+		part1Ptr, part2Ptr,
 		(flags & (TCL_NAMESPACE_ONLY|TCL_GLOBAL_ONLY))
-		| TCL_TRACE_READS, (flags & TCL_LEAVE_ERR_MSG))) {
+		| TCL_TRACE_READS, (flags & TCL_LEAVE_ERR_MSG), index)) {
 	    goto errorReturn;
 	}
     }
@@ -1224,7 +1340,7 @@ TclPtrGetVar(
     }
 
     if (flags & TCL_LEAVE_ERR_MSG) {
-	if (TclIsVarUndefined(varPtr) && (arrayPtr != NULL)
+	if (TclIsVarUndefined(varPtr) && arrayPtr
 		&& !TclIsVarUndefined(arrayPtr)) {
 	    msg = noSuchElement;
 	} else if (TclIsVarArray(varPtr)) {
@@ -1232,7 +1348,7 @@ TclPtrGetVar(
 	} else {
 	    msg = noSuchVar;
 	}
-	TclVarErrMsg(interp, part1, part2, "read", msg);
+	TclObjVarErrMsg(interp, part1Ptr, part2Ptr, "read", msg, index);
     }
 
     /*
@@ -1443,22 +1559,25 @@ Tcl_SetVar2Ex(
 				 * TCL_APPEND_VALUE, TCL_LIST_ELEMENT or
 				 * TCL_LEAVE_ERR_MSG. */
 {
-    Var *varPtr, *arrayPtr;
+    Tcl_Obj *part1Ptr, *part2Ptr, *resPtr;
 
-    /* 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) {
-	if (newValuePtr->refCount == 0) {
-	    Tcl_DecrRefCount(newValuePtr);
-	}
-	return NULL;
+    part1Ptr = Tcl_NewStringObj(part1, -1);
+    Tcl_IncrRefCount(part1Ptr);
+    if (part2) {
+	part2Ptr = Tcl_NewStringObj(part2, -1);
+	Tcl_IncrRefCount(part2Ptr);
+    } else {
+	part2Ptr = NULL;
     }
+    
+    resPtr = Tcl_ObjSetVar2(interp, part1Ptr, part2Ptr, newValuePtr, flags);
 
-    return TclPtrSetVar(interp, varPtr, arrayPtr, part1, part2,
-	    newValuePtr, flags);
+    Tcl_DecrRefCount(part1Ptr);
+    if (part2Ptr) {
+	Tcl_DecrRefCount(part2Ptr);
+    }
+    
+    return resPtr;
 }
 
 /*
@@ -1502,15 +1621,10 @@ Tcl_ObjSetVar2(
 				 * TCL_LEAVE_ERR_MSG. */
 {
     Var *varPtr, *arrayPtr;
-    char *part1, *part2;
-
-    part1 = TclGetString(part1Ptr);
-    part2 = ((part2Ptr == NULL) ? NULL : TclGetString(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",
+    varPtr = TclObjLookupVarEx(interp, part1Ptr, part2Ptr, flags, "set",
 	    /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr);
     if (varPtr == NULL) {
 	if (newValuePtr->refCount == 0) {
@@ -1519,8 +1633,8 @@ Tcl_ObjSetVar2(
 	return NULL;
     }
 
-    return TclPtrSetVar(interp, varPtr, arrayPtr, part1, part2,
-	    newValuePtr, flags);
+    return TclPtrSetVar(interp, varPtr, arrayPtr, part1Ptr, part2Ptr,
+	    newValuePtr, flags, -1);
 }
 
 /*
@@ -1556,18 +1670,20 @@ TclPtrSetVar(
     Var *arrayPtr,		/* Reference to the array containing the
 				 * variable, or NULL if the variable is a
 				 * scalar. */
-    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
+    Tcl_Obj *part1Ptr,		/* Name of an array (if part2 is non-NULL) or
+				 * the name of a variable. NULL if index >= 0*/
+    Tcl_Obj *part2Ptr,		/* 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
+    const int flags,		/* OR-ed combination of TCL_GLOBAL_ONLY, and
 				 * TCL_LEAVE_ERR_MSG bits. */
+    int index)                  /* index of local var where part1 is to be
+				 * found. */
 {
     Interp *iPtr = (Interp *) interp;
     Tcl_Obj *oldValuePtr;
     Tcl_Obj *resultPtr = NULL;
-    int result;
+    int result;    
 
     /*
      * If the variable is in a hashtable and its hPtr field is NULL, then we
@@ -1577,12 +1693,12 @@ TclPtrSetVar(
      * allocation and is meaningless anyway).
      */
 
-    if ((varPtr->flags & VAR_IN_HASHTABLE) && (varPtr->hPtr == NULL)) {
+    if (TclIsVarDeadHash(varPtr)) {
 	if (flags & TCL_LEAVE_ERR_MSG) {
 	    if (TclIsVarArrayElement(varPtr)) {
-		TclVarErrMsg(interp, part1, part2, "set", danglingElement);
+		TclObjVarErrMsg(interp, part1Ptr, part2Ptr, "set", danglingElement, index);
 	    } else {
-		TclVarErrMsg(interp, part1, part2, "set", danglingVar);
+		TclObjVarErrMsg(interp, part1Ptr, part2Ptr, "set", danglingVar, index);
 	    }
 	}
 	goto earlyError;
@@ -1592,9 +1708,9 @@ TclPtrSetVar(
      * It's an error to try to set an array variable itself.
      */
 
-    if (TclIsVarArray(varPtr) && !TclIsVarUndefined(varPtr)) {
+    if (TclIsVarArray(varPtr)) {
 	if (flags & TCL_LEAVE_ERR_MSG) {
-	    TclVarErrMsg(interp, part1, part2, "set", isArray);
+	    TclObjVarErrMsg(interp, part1Ptr, part2Ptr, "set", isArray, index);
 	}
 	goto earlyError;
     }
@@ -1605,10 +1721,11 @@ TclPtrSetVar(
      * instructions.
      */
 
-    if ((flags & TCL_TRACE_READS) && ((varPtr->tracePtr != NULL)
-	    || ((arrayPtr != NULL) && (arrayPtr->tracePtr != NULL)))) {
-	if (TCL_ERROR == TclCallVarTraces(iPtr, arrayPtr, varPtr, part1, part2,
-		TCL_TRACE_READS, (flags & TCL_LEAVE_ERR_MSG))) {
+    if ((flags & TCL_TRACE_READS) && ((varPtr->flags & VAR_TRACED_READ)
+	    || (arrayPtr && (arrayPtr->flags & VAR_TRACED_READ)))) {
+	if (TCL_ERROR == TclObjCallVarTraces(iPtr, arrayPtr, varPtr,
+		part1Ptr, part2Ptr,
+		TCL_TRACE_READS, (flags & TCL_LEAVE_ERR_MSG), index)) {
 	    goto earlyError;
 	}
     }
@@ -1620,16 +1737,22 @@ TclPtrSetVar(
      * otherwise we must create a new copy to modify: this is "copy on write".
      */
 
+    oldValuePtr = varPtr->value.objPtr;
     if (flags & TCL_LIST_ELEMENT && !(flags & TCL_APPEND_VALUE)) {
-	TclSetVarUndefined(varPtr);
+	varPtr->value.objPtr = NULL;
     }
-    oldValuePtr = varPtr->value.objPtr;
     if (flags & (TCL_APPEND_VALUE|TCL_LIST_ELEMENT)) {
+#if 0
+	/*
+	 * Can't happen now!
+	 */
+	
 	if (TclIsVarUndefined(varPtr) && (oldValuePtr != NULL)) {
 	    TclDecrRefCount(oldValuePtr);	/* discard old value */
 	    varPtr->value.objPtr = NULL;
 	    oldValuePtr = NULL;
 	}
+#endif
 	if (flags & TCL_LIST_ELEMENT) {		/* append list element */
 	    if (oldValuePtr == NULL) {
 		TclNewObj(oldValuePtr);
@@ -1641,8 +1764,7 @@ TclPtrSetVar(
 		oldValuePtr = varPtr->value.objPtr;
 		Tcl_IncrRefCount(oldValuePtr);	/* since var is referenced */
 	    }
-	    result = Tcl_ListObjAppendElement(interp, oldValuePtr,
-		    newValuePtr);
+	    result = Tcl_ListObjAppendElement(interp, oldValuePtr, newValuePtr);
 	    if (result != TCL_OK) {
 		goto earlyError;
 	    }
@@ -1681,21 +1803,17 @@ TclPtrSetVar(
 	    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 == TclCallVarTraces(iPtr, arrayPtr, varPtr, part1, part2,
-		(flags & (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY))
-		| TCL_TRACE_WRITES, (flags & TCL_LEAVE_ERR_MSG))) {
+    if ((varPtr->flags & VAR_TRACED_WRITE)
+	    || (arrayPtr && (arrayPtr->flags & VAR_TRACED_WRITE))) {
+	if (TCL_ERROR == TclObjCallVarTraces(iPtr, arrayPtr, varPtr,
+		 part1Ptr, part2Ptr,
+	        (flags & (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY))|TCL_TRACE_WRITES,
+		(flags & TCL_LEAVE_ERR_MSG), index)) {
 	    goto cleanup;
 	}
     }
@@ -1778,20 +1896,16 @@ TclIncrObjVar2(
 				 * 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",
+    varPtr = TclObjLookupVarEx(interp, part1Ptr, part2Ptr, flags, "read",
 	    1, 1, &arrayPtr);
     if (varPtr == NULL) {
 	Tcl_AddObjErrorInfo(interp,
 		"\n    (reading value of variable to increment)", -1);
 	return NULL;
     }
-    return TclPtrIncrObjVar(interp, varPtr, arrayPtr, part1, part2,
-	    incrPtr, flags);
+    return TclPtrIncrObjVar(interp, varPtr, arrayPtr, part1Ptr, part2Ptr,
+	    incrPtr, flags, -1);
 }
 
 /*
@@ -1827,25 +1941,30 @@ TclPtrIncrObjVar(
     Var *arrayPtr,		/* Reference to the array containing the
 				 * variable, or NULL if the variable is a
 				 * scalar. */
-    const char *part1,		/* Points to an object holding the name of an
+    Tcl_Obj *part1Ptr,		/* 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
+    Tcl_Obj *part2Ptr,		/* If non-null, points to an object holding
 				 * the name of an element in the array
 				 * part1Ptr. */
     Tcl_Obj *incrPtr,		/* Increment value */
 /* TODO: Which of these flag values really make sense? */
-    const int flags)		/* Various flags that tell how to incr value:
+    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. */
+    int index)
 {
     register Tcl_Obj *varValuePtr, *newValuePtr = NULL;
     int duplicated, code;
-
-    varPtr->refCount++;
-    varValuePtr = TclPtrGetVar(interp, varPtr, arrayPtr, part1, part2, flags);
-    varPtr->refCount--;
+    
+    if (TclIsVarInHash(varPtr)) {
+	VarHashRefCount(varPtr)++;
+    }
+    varValuePtr = TclPtrGetVar(interp, varPtr, arrayPtr, part1Ptr, part2Ptr, flags, index);
+    if (TclIsVarInHash(varPtr)) {
+	VarHashRefCount(varPtr)--;
+    }
     if (varValuePtr == NULL) {
 	varValuePtr = Tcl_NewIntObj(0);
     }
@@ -1857,8 +1976,8 @@ TclPtrIncrObjVar(
     }
     code = TclIncrObj(interp, varValuePtr, incrPtr);
     if (code == TCL_OK) {
-	newValuePtr = TclPtrSetVar(interp, varPtr, arrayPtr, part1, part2,
-		varValuePtr, flags);
+	newValuePtr = TclPtrSetVar(interp, varPtr, arrayPtr, part1Ptr, part2Ptr,
+		varValuePtr, flags, index);
     } else if (duplicated) {
 	Tcl_DecrRefCount(varValuePtr);
     }
@@ -1931,15 +2050,23 @@ Tcl_UnsetVar2(
 				 * TCL_LEAVE_ERR_MSG. */
 {
     int result;
-    Tcl_Obj *part1Ptr;
+    Tcl_Obj *part1Ptr, *part2Ptr = NULL;
 
     part1Ptr = Tcl_NewStringObj(part1, -1);
     Tcl_IncrRefCount(part1Ptr);
+    if (part2) {
+	part2Ptr = Tcl_NewStringObj(part2, -1);
+	Tcl_IncrRefCount(part2Ptr);
+    }
+	
     /* 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);
+    result = TclObjUnsetVar2(interp, part1Ptr, part2Ptr, flags);
 
+    Tcl_DecrRefCount(part1Ptr);
+    if (part2Ptr) {
+	Tcl_DecrRefCount(part2Ptr);
+    }	
     return result;
 }
 
@@ -1969,7 +2096,7 @@ TclObjUnsetVar2(
     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. */
+    Tcl_Obj *part2Ptr,		/* 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. */
@@ -1978,10 +2105,8 @@ TclObjUnsetVar2(
     Interp *iPtr = (Interp *) interp;
     Var *arrayPtr;
     int result;
-    char *part1;
 
-    part1 = TclGetString(part1Ptr);
-    varPtr = TclObjLookupVar(interp, part1Ptr, part2, flags, "unset",
+    varPtr = TclObjLookupVarEx(interp, part1Ptr, part2Ptr, flags, "unset",
 	    /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr);
     if (varPtr == NULL) {
 	return TCL_ERROR;
@@ -1996,9 +2121,11 @@ TclObjUnsetVar2(
      * the variable's name.
      */
 
-    varPtr->refCount++;
+    if (TclIsVarInHash(varPtr)) {
+	VarHashRefCount(varPtr)++;
+    }
 
-    UnsetVarStruct(varPtr, arrayPtr, iPtr, part1, part2, flags, 1);
+    UnsetVarStruct(varPtr, arrayPtr, iPtr, part1Ptr, part2Ptr, flags);
 
     /*
      * It's an error to unset an undefined variable.
@@ -2006,8 +2133,8 @@ TclObjUnsetVar2(
 
     if (result != TCL_OK) {
 	if (flags & TCL_LEAVE_ERR_MSG) {
-	    TclVarErrMsg(interp, part1, part2, "unset",
-		    ((arrayPtr == NULL) ? noSuchVar : noSuchElement));
+	    TclObjVarErrMsg(interp, part1Ptr, part2Ptr, "unset",
+		    ((arrayPtr == NULL) ? noSuchVar : noSuchElement), -1);
 	}
     }
 
@@ -2030,8 +2157,10 @@ TclObjUnsetVar2(
      * its value object, if any, was decremented above.
      */
 
-    varPtr->refCount--;
-    TclCleanupVar(varPtr, arrayPtr);
+    if (TclIsVarInHash(varPtr)) {
+	VarHashRefCount(varPtr)--;
+	CleanupVar(varPtr, arrayPtr);
+    }
     return result;
 }
 
@@ -2059,23 +2188,21 @@ UnsetVarStruct(
     Var *varPtr,
     Var *arrayPtr,
     Interp *iPtr,
-    const char *part1,  /* NULL if it is to be computed on demand, only for
-			 * variables in a hashtable */
-    const char *part2,
-    int flags,
-    int reachable)      /* indicates if the variable is accessible by name */
+    Tcl_Obj *part1Ptr,
+    Tcl_Obj *part2Ptr,
+    int flags)
 {
     Var dummyVar;
-    Var *dummyVarPtr;
-    ActiveVarTrace *activePtr;
-    Tcl_Obj *part1Ptr = NULL;
-    int traced = !TclIsVarUntraced(varPtr)
-	    || (arrayPtr && !TclIsVarUntraced(arrayPtr));
-
-    if (arrayPtr && arrayPtr->searchPtr) {
-	DeleteSearches(arrayPtr);
+    int traced = TclIsVarTraced(varPtr)
+	    || (arrayPtr && (arrayPtr->flags & VAR_TRACED_UNSET));
+    
+    if (arrayPtr && (arrayPtr->flags & VAR_SEARCH_ACTIVE)) {
+	DeleteSearches(iPtr, arrayPtr);
+    } else if (varPtr->flags & VAR_SEARCH_ACTIVE) {
+	DeleteSearches(iPtr, varPtr);
     }
 
+
     /*
      * The code below is tricky, because of the possibility that a trace
      * function might try to access a variable being deleted. To handle this
@@ -2088,18 +2215,10 @@ UnsetVarStruct(
      *    gotten recreated by a trace).
      */
 
-    if (reachable && (traced || TclIsVarArray(varPtr))) {
-	dummyVar = *varPtr;
-	dummyVarPtr = &dummyVar;
-	TclSetVarUndefined(varPtr);
-	TclSetVarScalar(varPtr);
-	varPtr->value.objPtr = NULL; /* dummyVar points to any value object */
-	varPtr->tracePtr = NULL;
-	varPtr->searchPtr = NULL;
-    } else {
-	dummyVarPtr = varPtr;
-    }
-
+    dummyVar = *varPtr;
+    dummyVar.flags &= ~VAR_ALL_HASH;
+    TclSetVarUndefined(varPtr);
+        
     /*
      * Call trace functions for the variable being deleted. Then delete its
      * traces. Be sure to abort any other traces for the variable that are
@@ -2111,65 +2230,67 @@ UnsetVarStruct(
      */
 
     if (traced) {
-	/*
-	 * Get the variable's name if NULL was passed;
-	 */
+	VarTrace *tracePtr = NULL;
+	Tcl_HashEntry *tPtr = NULL;
 
-	if (part1 == NULL) {
-	    Tcl_Interp *interp = (Tcl_Interp *) iPtr;
-	    TclNewObj(part1Ptr);
-	    Tcl_IncrRefCount(part1Ptr);
-	    Tcl_GetVariableFullName(interp, (Tcl_Var) dummyVarPtr, part1Ptr);
-	    part1 = TclGetString(part1Ptr);
+	if (TclIsVarTraced(&dummyVar)) {
+	    /*
+	     * Transfer any existing traces on var, IF there are unset
+	     * traces. Otherwise just delete them.
+	     */	
+
+	    int new;
+	    Tcl_HashEntry *tPtr =
+		Tcl_FindHashEntry(&iPtr->varTraces, (char *) varPtr);
+
+	    tracePtr = Tcl_GetHashValue(tPtr);
+	    varPtr->flags &= ~VAR_ALL_TRACES;
+	    Tcl_DeleteHashEntry(tPtr);
+	    if (dummyVar.flags & VAR_TRACED_UNSET) {
+		tPtr = Tcl_CreateHashEntry(&iPtr->varTraces, (char *) &dummyVar, &new);
+		Tcl_SetHashValue(tPtr, tracePtr);
+	    } else {
+		tPtr = NULL;
+	    }
 	}
-	
-	dummyVarPtr->flags &= ~VAR_TRACE_ACTIVE;
-	TclCallVarTraces(iPtr, arrayPtr, dummyVarPtr, part1, part2, (flags
-		& (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY))
-		| TCL_TRACE_UNSETS, /* leaveErrMsg */ 0);
-	while (dummyVarPtr->tracePtr != NULL) {
-	    VarTrace *tracePtr = dummyVarPtr->tracePtr;
-	    dummyVarPtr->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 ((dummyVar.flags & VAR_TRACED_UNSET) || (arrayPtr->flags & VAR_TRACED_UNSET)) {
+	    dummyVar.flags &= ~VAR_TRACE_ACTIVE;
+	    TclObjCallVarTraces(iPtr, arrayPtr, (Var *) &dummyVar, part1Ptr, part2Ptr,
+		    (flags & (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY))| TCL_TRACE_UNSETS,
+		    /* leaveErrMsg */ 0, -1);
+	    if (tPtr) {
+		Tcl_DeleteHashEntry(tPtr);
 	    }
 	}
-	if (part1Ptr) {
-	    Tcl_DecrRefCount(part1Ptr);
-	    part1 = NULL;
+
+	if (tracePtr) {
+	    ActiveVarTrace *activePtr;
+	    
+	    while (tracePtr) {
+		VarTrace *prevPtr = tracePtr;
+		tracePtr = tracePtr->nextPtr;
+		Tcl_EventuallyFree((ClientData) prevPtr, TCL_DYNAMIC);
+	    }
+	    for (activePtr = iPtr->activeVarTracePtr;  activePtr != NULL;
+		 activePtr = activePtr->nextPtr) {
+		if (activePtr->varPtr == varPtr) {
+		    activePtr->nextTracePtr = NULL;
+		}
+	    }
+	    dummyVar.flags &= ~VAR_ALL_TRACES;
 	}
     }
+    
 
-    if (TclIsVarScalar(dummyVarPtr)
-	    && (dummyVarPtr->value.objPtr != NULL)) {
+    if (TclIsVarScalar(&dummyVar) && (dummyVar.value.objPtr != NULL)) {
 	/*
 	 * Decrement the ref count of the var's value
 	 */
 	
-	Tcl_Obj *objPtr = dummyVarPtr->value.objPtr;
+	Tcl_Obj *objPtr = dummyVar.value.objPtr;
 	TclDecrRefCount(objPtr);
-	dummyVarPtr->value.objPtr = NULL;
-    } else if (TclIsVarLink(varPtr)) {
-	/*
-	 * 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.
-	 */
-	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);
-	}
-    } else if (TclIsVarArray(dummyVarPtr) && !TclIsVarUndefined(dummyVarPtr)) {
+    } else if (TclIsVarArray(&dummyVar)) {
 	/*
 	 * If the variable is an array, delete all of its elements. This must
 	 * be done after calling and deleting the traces on the array, above
@@ -2178,25 +2299,28 @@ UnsetVarStruct(
 	 * computed at DeleteArray.  
 	 */
 	
-	DeleteArray(iPtr, part1, dummyVarPtr, (flags 
+	DeleteArray(iPtr, part1Ptr, (Var *) &dummyVar, (flags 
 		& (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY))
 		| TCL_TRACE_UNSETS);
+    } else if (TclIsVarLink(&dummyVar)) {
+	/*
+	 * For global/upvar variables referenced in procedures, decrement the 
+	 * reference count on the variable referred to, and free the
+	 * referenced variable if it's no longer needed.
+	 */
+	Var *linkPtr = dummyVar.value.linkPtr;
+	if (TclIsVarInHash(linkPtr)) {
+	    VarHashRefCount(linkPtr)--;
+	    CleanupVar(linkPtr, NULL);
+	}
     }
 
-    if (dummyVarPtr == varPtr) {
-	TclSetVarUndefined(varPtr);
-	TclSetVarScalar(varPtr);
-    }
-    
     /*
      * If the variable was a namespace variable, decrement its reference
      * count.
      */
 
-    if (TclIsVarNamespaceVar(varPtr)) {
-	TclClearVarNamespaceVar(varPtr);
-	varPtr->refCount--;
-    }
+    TclClearVarNamespaceVar(varPtr);
 }
 
 /*
@@ -2293,8 +2417,6 @@ Tcl_AppendObjCmd(
     Tcl_Obj *const objv[])	/* Argument objects. */
 {
     Var *varPtr, *arrayPtr;
-    char *part1;
-
     register Tcl_Obj *varValuePtr = NULL;
     				/* Initialized to avoid compiler warning. */
     int i;
@@ -2310,9 +2432,8 @@ Tcl_AppendObjCmd(
 	    return TCL_ERROR;
 	}
     } else {
-	varPtr = TclObjLookupVar(interp, objv[1], NULL, TCL_LEAVE_ERR_MSG,
+	varPtr = TclObjLookupVarEx(interp, objv[1], NULL, TCL_LEAVE_ERR_MSG,
 		"set", /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr);
-	part1 = TclGetString(objv[1]);
 	if (varPtr == NULL) {
 	    return TCL_ERROR;
 	}
@@ -2324,8 +2445,8 @@ Tcl_AppendObjCmd(
 	     * variable again.
 	     */
 
-	    varValuePtr = TclPtrSetVar(interp, varPtr, arrayPtr, part1, NULL,
-		    objv[i], (TCL_APPEND_VALUE | TCL_LEAVE_ERR_MSG));
+	    varValuePtr = TclPtrSetVar(interp, varPtr, arrayPtr, objv[1], NULL,
+		    objv[i], (TCL_APPEND_VALUE | TCL_LEAVE_ERR_MSG), -1);
 	    if (varValuePtr == NULL) {
 		return TCL_ERROR;
 	    }
@@ -2363,7 +2484,6 @@ Tcl_LappendObjCmd(
     Tcl_Obj *varValuePtr, *newValuePtr;
     int numElems, createdNewObj;
     Var *varPtr, *arrayPtr;
-    char *part1;
     int result;
 
     if (objc < 2) {
@@ -2409,21 +2529,24 @@ Tcl_LappendObjCmd(
 	 * and unused.
 	 */
 
-	varPtr = TclObjLookupVar(interp, objv[1], NULL, TCL_LEAVE_ERR_MSG,
+	varPtr = TclObjLookupVarEx(interp, objv[1], NULL, TCL_LEAVE_ERR_MSG,
 		"set", /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr);
 	if (varPtr == NULL) {
 	    return TCL_ERROR;
 	}
-	varPtr->refCount++;
-	if (arrayPtr != NULL) {
-	    arrayPtr->refCount++;
+	if (TclIsVarInHash(varPtr)) {
+	    VarHashRefCount(varPtr)++;
 	}
-	part1 = TclGetString(objv[1]);
-	varValuePtr = TclPtrGetVar(interp, varPtr, arrayPtr, part1, NULL,
-		TCL_LEAVE_ERR_MSG);
-	varPtr->refCount--;
-	if (arrayPtr != NULL) {
-	    arrayPtr->refCount--;
+	if (arrayPtr && TclIsVarInHash(arrayPtr)) {
+	    VarHashRefCount(arrayPtr)++;
+	}
+	varValuePtr = TclPtrGetVar(interp, varPtr, arrayPtr, objv[1], NULL,
+		TCL_LEAVE_ERR_MSG, -1);
+	if (TclIsVarInHash(varPtr)) {
+	    VarHashRefCount(varPtr)--;
+	}
+	if (arrayPtr && TclIsVarInHash(arrayPtr)) {
+	    VarHashRefCount(arrayPtr)--;
 	}
 
 	if (varValuePtr == NULL) {
@@ -2458,8 +2581,8 @@ Tcl_LappendObjCmd(
 	 * and we didn't create the variable.
 	 */
 
-	newValuePtr = TclPtrSetVar(interp, varPtr, arrayPtr, part1, NULL,
-		varValuePtr, TCL_LEAVE_ERR_MSG);
+	newValuePtr = TclPtrSetVar(interp, varPtr, arrayPtr, objv[1], NULL,
+		varValuePtr, TCL_LEAVE_ERR_MSG, -1);
 	if (newValuePtr == NULL) {
 	    return TCL_ERROR;
 	}
@@ -2519,7 +2642,6 @@ Tcl_ArrayObjCmd(
     Tcl_HashEntry *hPtr;
     Tcl_Obj *varNamePtr;
     int notArray;
-    char *varName;
     int index, result;
 
     if (objc < 3) {
@@ -2537,8 +2659,7 @@ Tcl_ArrayObjCmd(
      */
 
     varNamePtr = objv[2];
-    varName = TclGetString(varNamePtr);
-    varPtr = TclObjLookupVar(interp, varNamePtr, NULL, /*flags*/ 0,
+    varPtr = TclObjLookupVarEx(interp, varNamePtr, NULL, /*flags*/ 0,
 	    /*msg*/ 0, /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr);
 
     /*
@@ -2546,11 +2667,11 @@ Tcl_ArrayObjCmd(
      * array get, etc.
      */
 
-    if (varPtr != NULL && varPtr->tracePtr != NULL
+    if (varPtr && (varPtr->flags & VAR_TRACED_ARRAY)
 	    && (TclIsVarArray(varPtr) || TclIsVarUndefined(varPtr))) {
-	if (TCL_ERROR == TclCallVarTraces(iPtr, arrayPtr, varPtr, varName,
+	if (TCL_ERROR == TclObjCallVarTraces(iPtr, arrayPtr, varPtr, varNamePtr,
 		NULL, (TCL_LEAVE_ERR_MSG|TCL_NAMESPACE_ONLY|TCL_GLOBAL_ONLY|
-		TCL_TRACE_ARRAY), /* leaveErrMsg */ 1)) {
+		TCL_TRACE_ARRAY), /* leaveErrMsg */ 1, -1)) {
 	    return TCL_ERROR;
 	}
     }
@@ -2578,7 +2699,7 @@ Tcl_ArrayObjCmd(
 	if (notArray) {
 	    goto error;
 	}
-	searchPtr = ParseSearchId(interp, varPtr, varName, objv[3]);
+	searchPtr = ParseSearchId(interp, varPtr, varNamePtr, objv[3]);
 	if (searchPtr == NULL) {
 	    return TCL_ERROR;
 	}
@@ -2586,7 +2707,7 @@ Tcl_ArrayObjCmd(
 	    Var *varPtr2;
 
 	    if (searchPtr->nextEntry != NULL) {
-		varPtr2 = (Var *) Tcl_GetHashValue(searchPtr->nextEntry);
+		varPtr2 = VarHashGetValue(searchPtr->nextEntry);
 		if (!TclIsVarUndefined(varPtr2)) {
 		    break;
 		}
@@ -2610,14 +2731,20 @@ Tcl_ArrayObjCmd(
 	if (notArray) {
 	    goto error;
 	}
-	searchPtr = ParseSearchId(interp, varPtr, varName, objv[3]);
+	searchPtr = ParseSearchId(interp, varPtr, varNamePtr, objv[3]);
 	if (searchPtr == NULL) {
 	    return TCL_ERROR;
 	}
-	if (varPtr->searchPtr == searchPtr) {
-	    varPtr->searchPtr = searchPtr->nextPtr;
+	hPtr = Tcl_FindHashEntry(&iPtr->varSearches,(char *) varPtr);
+	if (searchPtr == Tcl_GetHashValue(hPtr)) {
+	    if (searchPtr->nextPtr) {
+		Tcl_SetHashValue(hPtr, searchPtr->nextPtr);
+	    } else {
+		varPtr->flags &= ~VAR_SEARCH_ACTIVE;
+		Tcl_DeleteHashEntry(hPtr);	    
+	    }
 	} else {
-	    for (prevPtr=varPtr->searchPtr ;; prevPtr=prevPtr->nextPtr) {
+	    for (prevPtr=Tcl_GetHashValue(hPtr) ;; prevPtr=prevPtr->nextPtr) {
 		if (prevPtr->nextPtr == searchPtr) {
 		    prevPtr->nextPtr = searchPtr->nextPtr;
 		    break;
@@ -2630,6 +2757,7 @@ Tcl_ArrayObjCmd(
     case ARRAY_NEXTELEMENT: {
 	ArraySearch *searchPtr;
 	Tcl_HashEntry *hPtr;
+	Var *varPtr2;
 
 	if (objc != 4) {
 	    Tcl_WrongNumArgs(interp, 2, objv, "arrayName searchId");
@@ -2638,13 +2766,11 @@ Tcl_ArrayObjCmd(
 	if (notArray) {
 	    goto error;
 	}
-	searchPtr = ParseSearchId(interp, varPtr, varName, objv[3]);
+	searchPtr = ParseSearchId(interp, varPtr, varNamePtr, objv[3]);
 	if (searchPtr == NULL) {
 	    return TCL_ERROR;
 	}
 	while (1) {
-	    Var *varPtr2;
-
 	    hPtr = searchPtr->nextEntry;
 	    if (hPtr == NULL) {
 		hPtr = Tcl_NextHashEntry(&searchPtr->search);
@@ -2654,17 +2780,19 @@ Tcl_ArrayObjCmd(
 	    } else {
 		searchPtr->nextEntry = NULL;
 	    }
-	    varPtr2 = (Var *) Tcl_GetHashValue(hPtr);
+	    varPtr2 = VarHashGetValue(hPtr);
 	    if (!TclIsVarUndefined(varPtr2)) {
 		break;
 	    }
 	}
-	Tcl_SetObjResult(interp, Tcl_NewStringObj(
-		Tcl_GetHashKey(varPtr->value.tablePtr, hPtr), -1));
+	Tcl_SetObjResult(interp, VarHashGetKey(varPtr2));
 	break;
     }
     case ARRAY_STARTSEARCH: {
 	ArraySearch *searchPtr;
+	int new;
+	char *varName = TclGetString(varNamePtr);
+	
 
 	if (objc != 3) {
 	    Tcl_WrongNumArgs(interp, 2, objv, "arrayName");
@@ -2674,21 +2802,25 @@ Tcl_ArrayObjCmd(
 	    goto error;
 	}
 	searchPtr = (ArraySearch *) ckalloc(sizeof(ArraySearch));
-	if (varPtr->searchPtr == NULL) {
+	hPtr = Tcl_CreateHashEntry(&iPtr->varSearches,
+		(char *) varPtr, &new);
+	if (new) {
 	    searchPtr->id = 1;
 	    Tcl_AppendResult(interp, "s-1-", varName, NULL);
+	    varPtr->flags |= VAR_SEARCH_ACTIVE;
+	    searchPtr->nextPtr = NULL;
 	} else {
 	    char string[TCL_INTEGER_SPACE];
 
-	    searchPtr->id = varPtr->searchPtr->id + 1;
+	    searchPtr->id = ((ArraySearch *) Tcl_GetHashValue(hPtr))->id + 1;
 	    TclFormatInt(string, searchPtr->id);
 	    Tcl_AppendResult(interp, "s-", string, "-", varName, NULL);
+	    searchPtr->nextPtr = Tcl_GetHashValue(hPtr);
 	}
 	searchPtr->varPtr = varPtr;
-	searchPtr->nextEntry = Tcl_FirstHashEntry(varPtr->value.tablePtr,
+	searchPtr->nextEntry = VarHashFirstEntry(varPtr->value.tablePtr,
 		&searchPtr->search);
-	searchPtr->nextPtr = varPtr->searchPtr;
-	varPtr->searchPtr = searchPtr;
+	Tcl_SetHashValue(hPtr, searchPtr);
 	break;
     }
 
@@ -2725,37 +2857,34 @@ Tcl_ArrayObjCmd(
 	TclNewObj(nameLstPtr);
 	Tcl_IncrRefCount(nameLstPtr);
 	if ((pattern != NULL) && TclMatchIsTrivial(pattern)) {
-	    hPtr = Tcl_FindHashEntry(varPtr->value.tablePtr, pattern);
-	    if (hPtr == NULL) {
+	    varPtr2 = VarHashFindVar(varPtr->value.tablePtr, objv[3]);
+	    if (varPtr2 == NULL) {
 		goto searchDone;
 	    }
-	    varPtr2 = (Var *) Tcl_GetHashValue(hPtr);
 	    if (TclIsVarUndefined(varPtr2)) {
 		goto searchDone;
 	    }
 	    result = Tcl_ListObjAppendElement(interp, nameLstPtr,
-		    Tcl_NewStringObj(pattern, -1));
+		    VarHashGetKey(varPtr2));
 	    if (result != TCL_OK) {
 		TclDecrRefCount(nameLstPtr);
 		return result;
 	    }
 	    goto searchDone;
 	}
-	for (hPtr=Tcl_FirstHashEntry(varPtr->value.tablePtr, &search);
-		hPtr!=NULL ; hPtr=Tcl_NextHashEntry(&search)) {
-	    varPtr2 = (Var *) Tcl_GetHashValue(hPtr);
+	for (varPtr2 = VarHashFirstVar(varPtr->value.tablePtr, &search);
+		varPtr2; varPtr2 = VarHashNextVar(&search)) {
 	    if (TclIsVarUndefined(varPtr2)) {
 		continue;
 	    }
-	    name = Tcl_GetHashKey(varPtr->value.tablePtr, hPtr);
+	    namePtr = VarHashGetKey(varPtr2); 
+	    name = TclGetString(namePtr);
 	    if ((objc == 4) && !Tcl_StringMatch(name, pattern)) {
 		continue;	/* element name doesn't match pattern */
 	    }
 
-	    namePtr = Tcl_NewStringObj(name, -1);
 	    result = Tcl_ListObjAppendElement(interp, nameLstPtr, namePtr);
 	    if (result != TCL_OK) {
-		TclDecrRefCount(namePtr);	/* free unneeded name obj */
 		TclDecrRefCount(nameLstPtr);
 		return result;
 	    }
@@ -2767,23 +2896,23 @@ Tcl_ArrayObjCmd(
 	 * while we're working.
 	 */
 
-	varPtr->refCount++;
+	if (TclIsVarInHash(varPtr)) {
+	    VarHashRefCount(varPtr)++;
+	}
 
 	/*
 	 * Get the array values corresponding to each element name
 	 */
 
 	TclNewObj(tmpResPtr);
-	result = Tcl_ListObjGetElements(interp, nameLstPtr,
-		&count, &namePtrPtr);
+	result = Tcl_ListObjGetElements(interp, nameLstPtr, &count, &namePtrPtr);
 	if (result != TCL_OK) {
 	    goto errorInArrayGet;
 	}
 
 	for (i=0 ; i<count ; i++) {
 	    namePtr = *namePtrPtr++;
-	    valuePtr = Tcl_ObjGetVar2(interp, objv[2], namePtr,
-		    TCL_LEAVE_ERR_MSG);
+	    valuePtr = Tcl_ObjGetVar2(interp, objv[2], namePtr, TCL_LEAVE_ERR_MSG);
 	    if (valuePtr == NULL) {
 		/*
 		 * Some trace played a trick on us; we need to diagnose to
@@ -2791,7 +2920,7 @@ Tcl_ArrayObjCmd(
 		 * the modification modify the complete array?
 		 */
 
-		if (TclIsVarArray(varPtr) && !TclIsVarUndefined(varPtr)) {
+		if (TclIsVarArray(varPtr)) {
 		    /*
 		     * The array itself looks OK, the variable was undefined:
 		     * forget it.
@@ -2808,13 +2937,17 @@ Tcl_ArrayObjCmd(
 		goto errorInArrayGet;
 	    }
 	}
-	varPtr->refCount--;
+	if (TclIsVarInHash(varPtr)) {
+	    VarHashRefCount(varPtr)--;
+	}
 	Tcl_SetObjResult(interp, tmpResPtr);
 	TclDecrRefCount(nameLstPtr);
 	break;
 
     errorInArrayGet:
-	varPtr->refCount--;
+	if (TclIsVarInHash(varPtr)) {
+	    VarHashRefCount(varPtr)--;
+	}
 	TclDecrRefCount(nameLstPtr);
 	TclDecrRefCount(tmpResPtr);	/* free unneeded temp result */
 	return result;
@@ -2852,11 +2985,10 @@ Tcl_ArrayObjCmd(
 	TclNewObj(resultPtr);
 	if (((enum options) mode)==OPT_GLOB && pattern!=NULL &&
 		TclMatchIsTrivial(pattern)) {
-	    hPtr = Tcl_FindHashEntry(varPtr->value.tablePtr, pattern);
-	    if ((hPtr != NULL) &&
-		    !TclIsVarUndefined((Var *) Tcl_GetHashValue(hPtr))) {
+	    varPtr2 = VarHashFindVar(varPtr->value.tablePtr, objv[3]);
+	    if ((varPtr2 != NULL) && !TclIsVarUndefined(varPtr2)) {
 		result = Tcl_ListObjAppendElement(interp, resultPtr,
-			Tcl_NewStringObj(pattern, -1));
+			VarHashGetKey(varPtr2));
 		if (result != TCL_OK) {
 		    TclDecrRefCount(resultPtr);
 		    return result;
@@ -2865,13 +2997,13 @@ Tcl_ArrayObjCmd(
 	    Tcl_SetObjResult(interp, resultPtr);
 	    return TCL_OK;
 	}
-	for (hPtr=Tcl_FirstHashEntry(varPtr->value.tablePtr, &search);
-		hPtr!=NULL ; hPtr=Tcl_NextHashEntry(&search)) {
-	    varPtr2 = (Var *) Tcl_GetHashValue(hPtr);
+	for (varPtr2=VarHashFirstVar(varPtr->value.tablePtr, &search);
+		varPtr2!=NULL ; varPtr2=VarHashNextVar(&search)) {
 	    if (TclIsVarUndefined(varPtr2)) {
 		continue;
 	    }
-	    name = Tcl_GetHashKey(varPtr->value.tablePtr, hPtr);
+	    namePtr = VarHashGetKey(varPtr2);
+	    name = TclGetString(namePtr);
 	    if (objc > 3) {
 		switch ((enum options) mode) {
 		case OPT_EXACT:
@@ -2893,10 +3025,8 @@ Tcl_ArrayObjCmd(
 		}
 	    }
 
-	    namePtr = Tcl_NewStringObj(name, -1);
 	    result = Tcl_ListObjAppendElement(interp, resultPtr, namePtr);
 	    if (result != TCL_OK) {
-		TclDecrRefCount(resultPtr);
 		TclDecrRefCount(namePtr);	/* free unneeded name obj */
 		return result;
 	    }
@@ -2914,7 +3044,6 @@ Tcl_ArrayObjCmd(
 	Tcl_HashSearch search;
 	Var *varPtr2;
 	char *pattern = NULL;
-	char *name;
 
 	if ((objc != 3) && (objc != 4)) {
 	    Tcl_WrongNumArgs(interp, 2, objv, "arrayName ?pattern?");
@@ -2934,22 +3063,22 @@ Tcl_ArrayObjCmd(
 	} else {
 	    pattern = TclGetString(objv[3]);
 	    if (TclMatchIsTrivial(pattern)) {
-		hPtr = Tcl_FindHashEntry(varPtr->value.tablePtr, pattern);
-		if (hPtr != NULL &&
-			!TclIsVarUndefined((Var *)Tcl_GetHashValue(hPtr))){
-		    return TclObjUnsetVar2(interp, varNamePtr, pattern, 0);
+		varPtr2 = VarHashFindVar(varPtr->value.tablePtr, objv[3]);
+		if (varPtr2 != NULL && !TclIsVarUndefined(varPtr2)) {
+		    return TclObjUnsetVar2(interp, varNamePtr, objv[3], 0);
 		}
 		return TCL_OK;
 	    }
-	    for (hPtr=Tcl_FirstHashEntry(varPtr->value.tablePtr, &search);
-		    hPtr!=NULL ; hPtr=Tcl_NextHashEntry(&search)) {
-		varPtr2 = (Var *) Tcl_GetHashValue(hPtr);
+	    for (varPtr2=VarHashFirstVar(varPtr->value.tablePtr, &search);
+		    varPtr2!=NULL ; varPtr2=VarHashNextVar(&search)) {
+		Tcl_Obj *namePtr;
+		
 		if (TclIsVarUndefined(varPtr2)) {
 		    continue;
 		}
-		name = Tcl_GetHashKey(varPtr->value.tablePtr, hPtr);
-		if (Tcl_StringMatch(name, pattern) &&
-			TclObjUnsetVar2(interp, varNamePtr, name,
+		namePtr = VarHashGetKey(varPtr2);
+		if (Tcl_StringMatch(TclGetString(namePtr), pattern) &&
+			TclObjUnsetVar2(interp, varNamePtr, namePtr,
 				0) != TCL_OK) {
 		    return TCL_ERROR;
 		}
@@ -2975,9 +3104,8 @@ Tcl_ArrayObjCmd(
 	 */
 
 	if (!notArray) {
-	    for (hPtr=Tcl_FirstHashEntry(varPtr->value.tablePtr, &search);
-		    hPtr!=NULL ; hPtr=Tcl_NextHashEntry(&search)) {
-		varPtr2 = (Var *) Tcl_GetHashValue(hPtr);
+	    for (varPtr2=VarHashFirstVar(varPtr->value.tablePtr, &search);
+		    varPtr2!=NULL ; varPtr2=VarHashNextVar(&search)) {
 		if (TclIsVarUndefined(varPtr2)) {
 		    continue;
 		}
@@ -2995,7 +3123,7 @@ Tcl_ArrayObjCmd(
 	    goto error;
 	}
 
-	stats = Tcl_HashStats(varPtr->value.tablePtr);
+	stats = Tcl_HashStats((Tcl_HashTable *) varPtr->value.tablePtr);
 	if (stats != NULL) {
 	    Tcl_SetObjResult(interp, Tcl_NewStringObj(stats, -1));
 	    ckfree((void *)stats);
@@ -3009,7 +3137,7 @@ Tcl_ArrayObjCmd(
     return TCL_OK;
 
   error:
-    Tcl_AppendResult(interp, "\"", varName, "\" isn't an array", NULL);
+    Tcl_AppendResult(interp, "\"", TclGetString(varNamePtr), "\" isn't an array", NULL);
     return TCL_ERROR;
 }
 
@@ -3039,26 +3167,19 @@ TclArraySet(
 				 * NULL, create an empty array. */
 {
     Var *varPtr, *arrayPtr;
-    int result, i, nameLen;
-    char *varName, *p;
-
-    varName = Tcl_GetStringFromObj(arrayNameObj, &nameLen);
-    p = varName + nameLen - 1;
-    if (*p == ')') {
-	while (--p >= varName) {
-	    if (*p == '(') {
-		TclVarErrMsg(interp, varName, NULL, "set", needArray);
-		return TCL_ERROR;
-	    }
-	}
-    }
+    int result, i;
 
-    varPtr = TclObjLookupVar(interp, arrayNameObj, NULL,
+    varPtr = TclObjLookupVarEx(interp, arrayNameObj, NULL,
 	    /*flags*/ TCL_LEAVE_ERR_MSG, /*msg*/ "set", /*createPart1*/ 1,
-	    /*createPart2*/ 0, &arrayPtr);
+	    /*createPart2*/ 1, &arrayPtr);
     if (varPtr == NULL) {
 	return TCL_ERROR;
     }
+    if (arrayPtr) {
+	CleanupVar(varPtr, arrayPtr);
+	TclObjVarErrMsg(interp, arrayNameObj, NULL, "set", needArray, -1);
+	return TCL_ERROR;
+    }
 
     if (arrayElemObj == NULL) {
 	goto ensureArray;
@@ -3095,16 +3216,15 @@ TclArraySet(
 		Tcl_DictObjNext(&search, &keyPtr, &valuePtr, &done)) {
 	    /*
 	     * At this point, it would be nice if the key was directly usable
-	     * by the array. This isn't the case though.
+	     * by the array. This isn't the case though. ///
 	     */
 
-	    char *part2 = TclGetString(keyPtr);
-	    Var *elemVarPtr = TclLookupArrayElement(interp, varName,
-		    part2, TCL_LEAVE_ERR_MSG, "set", 1, 1, varPtr);
+	    Var *elemVarPtr = TclLookupArrayElement(interp, arrayNameObj,
+		    keyPtr, TCL_LEAVE_ERR_MSG, "set", 1, 1, varPtr, -1);
 
 	    if ((elemVarPtr == NULL) ||
-		    (TclPtrSetVar(interp, elemVarPtr, varPtr, varName,
-		    part2, valuePtr, TCL_LEAVE_ERR_MSG) == NULL)) {
+		    (TclPtrSetVar(interp, elemVarPtr, varPtr, arrayNameObj,
+		    keyPtr, valuePtr, TCL_LEAVE_ERR_MSG, -1) == NULL)) {
 		Tcl_DictObjDone(&search);
 		return TCL_ERROR;
 	    }
@@ -3140,13 +3260,12 @@ TclArraySet(
 
 	copyListObj = TclListObjCopy(NULL, arrayElemObj);
 	for (i=0 ; i<elemLen ; i+=2) {
-	    char *part2 = TclGetString(elemPtrs[i]);
-	    Var *elemVarPtr = TclLookupArrayElement(interp, varName,
-		    part2, TCL_LEAVE_ERR_MSG, "set", 1, 1, varPtr);
+	    Var *elemVarPtr = TclLookupArrayElement(interp, arrayNameObj,
+		    elemPtrs[i], TCL_LEAVE_ERR_MSG, "set", 1, 1, varPtr, -1);
 
 	    if ((elemVarPtr == NULL) ||
-		    (TclPtrSetVar(interp, elemVarPtr, varPtr, varName, part2,
-		    elemPtrs[i+1], TCL_LEAVE_ERR_MSG) == NULL)) {
+		    (TclPtrSetVar(interp, elemVarPtr, varPtr, arrayNameObj, elemPtrs[i],
+		    elemPtrs[i+1], TCL_LEAVE_ERR_MSG, -1) == NULL)) {
 		result = TCL_ERROR;
 		break;
 	    }
@@ -3162,7 +3281,7 @@ TclArraySet(
 
   ensureArray:
     if (varPtr != NULL) {
-	if (!TclIsVarUndefined(varPtr) && TclIsVarArray(varPtr)) {
+	if (TclIsVarArray(varPtr)) {
 	    /*
 	     * Already an array, done.
 	     */
@@ -3174,15 +3293,14 @@ TclArraySet(
 	     * Either an array element, or a scalar: lose!
 	     */
 
-	    TclVarErrMsg(interp, varName, NULL, "array set", needArray);
+	    TclObjVarErrMsg(interp, arrayNameObj, NULL, "array set", needArray, -1);
 	    return TCL_ERROR;
 	}
     }
     TclSetVarArray(varPtr);
-    TclClearVarUndefined(varPtr);
-    varPtr->value.tablePtr = (Tcl_HashTable *)
-	    ckalloc(sizeof(Tcl_HashTable));
-    Tcl_InitHashTable(varPtr->value.tablePtr, TCL_STRING_KEYS);
+    varPtr->value.tablePtr = (TclVarHashTable *)
+	    ckalloc(sizeof(TclVarHashTable));    
+    TclInitVarHashTable(varPtr->value.tablePtr, TclGetVarNsPtr(varPtr));
     return TCL_OK;
 }
 
@@ -3216,7 +3334,7 @@ ObjMakeUpvar(
     const char *otherP2,	/* Two-part name of variable in framePtr. */
     const int otherFlags,	/* 0, TCL_GLOBAL_ONLY or TCL_NAMESPACE_ONLY:
 				 * indicates scope of "other" variable. */
-    const char *myName,		/* Name of variable which will refer to
+    Tcl_Obj *myNamePtr,		/* Name of variable which will refer to
 				 * otherP1/otherP2. Must be a scalar. */
     int myFlags,		/* 0, TCL_GLOBAL_ONLY or TCL_NAMESPACE_ONLY:
 				 * indicates scope of myName. */
@@ -3259,19 +3377,21 @@ ObjMakeUpvar(
      */
 
     if (index < 0) {
-	if (((arrayPtr ? arrayPtr->nsPtr : otherPtr->nsPtr) == NULL)
+	if (((arrayPtr
+		     ? (TclIsVarInHash(arrayPtr) && TclGetVarNsPtr(arrayPtr))
+		     : (TclIsVarInHash(otherPtr) && TclGetVarNsPtr(otherPtr))) == 0)
 		&& ((myFlags & (TCL_GLOBAL_ONLY | TCL_NAMESPACE_ONLY))
 			|| (varFramePtr == NULL)
 			|| !HasLocalVars(varFramePtr)
-			|| (strstr(myName, "::") != NULL))) {
+			|| (strstr(TclGetString(myNamePtr), "::") != NULL))) {
 	    Tcl_AppendResult((Tcl_Interp *) iPtr, "bad variable name \"",
-		    myName, "\": upvar won't create namespace variable that "
+		    TclGetString(myNamePtr), "\": upvar won't create namespace variable that "
 		    "refers to procedure variable", NULL);
 	    return TCL_ERROR;
 	}
     }
 
-    return TclPtrMakeUpvar(interp, otherPtr, myName, myFlags, index);
+    return TclPtrObjMakeUpvar(interp, otherPtr, myNamePtr, myFlags, index);
 }
 
 /*
@@ -3306,18 +3426,48 @@ TclPtrMakeUpvar(
     int index)			/* If the variable to be linked is an indexed
 				 * scalar, this is its index. Otherwise, -1 */
 {
+    Tcl_Obj *myNamePtr;
+    int result;
+
+    if (myName) {
+	myNamePtr = Tcl_NewStringObj(myName, -1);
+	Tcl_IncrRefCount(myNamePtr);
+    } else {
+	myNamePtr = NULL;
+    }
+    result = TclPtrObjMakeUpvar(interp, otherPtr, myNamePtr, myFlags, index);
+    if (myNamePtr) {
+	Tcl_DecrRefCount(myNamePtr);
+    }
+    return result;
+}
+
+int
+TclPtrObjMakeUpvar(
+    Tcl_Interp *interp,		/* Interpreter containing variables. Used for
+				 * error messages, too. */
+    Var *otherPtr,		/* Pointer to the variable being linked-to */
+    Tcl_Obj *myNamePtr,		/* Name of variable which will refer to
+				 * otherP1/otherP2. Must be a scalar. */
+    int myFlags,		/* 0, TCL_GLOBAL_ONLY or TCL_NAMESPACE_ONLY:
+				 * indicates scope of myName. */
+    int index)			/* If the variable to be linked is an indexed
+				 * scalar, this is its index. Otherwise, -1 */
+{
     Interp *iPtr = (Interp *) interp;
     CallFrame *varFramePtr = iPtr->varFramePtr;
     Var *varPtr;
     const char *errMsg;
-    const char *p;    
+    const char *p;
+    const char *myName;
     
     if (index >= 0) {
 	if (!HasLocalVars(varFramePtr)) {
 	    Tcl_Panic("ObjMakeUpvar called with an index outside from a proc");
 	}
-	varPtr = &(varFramePtr->compiledLocals[index]);
-	myName = varPtr->name;
+	varPtr = (Var *) &(varFramePtr->compiledLocals[index]);
+	myNamePtr = localName(iPtr->varFramePtr, index);
+	myName = myNamePtr? TclGetString(myNamePtr) : NULL;
     } else {
 	/*
 	 * Do not permit the new variable to look like an array reference, as
@@ -3326,6 +3476,7 @@ TclPtrMakeUpvar(
 	 * (and must remain consistent) with the code in TclObjLookupVar().
 	 */
 
+	myName = TclGetString(myNamePtr);
 	p = strstr(myName, "(");
 	if (p != NULL) {
 	    p += strlen(p)-1;
@@ -3350,10 +3501,10 @@ TclPtrMakeUpvar(
 	 *   - Bug #631741 - do not use special namespace or interp resolvers.
 	 */
 
-	varPtr = TclLookupSimpleVar(interp, myName, (myFlags|LOOKUP_FOR_UPVAR),
+	varPtr = TclLookupSimpleVar(interp, myNamePtr, (myFlags|LOOKUP_FOR_UPVAR),
 		/* create */ 1, &errMsg, &index);
 	if (varPtr == NULL) {
-	    TclVarErrMsg(interp, myName, NULL, "create", errMsg);
+	    TclObjVarErrMsg(interp, myNamePtr, NULL, "create", errMsg, -1);
 	    return TCL_ERROR;
 	}
     }
@@ -3364,7 +3515,7 @@ TclPtrMakeUpvar(
 	return TCL_ERROR;
     }
 
-    if (varPtr->tracePtr != NULL) {
+    if (TclIsVarTraced(varPtr)) {
 	Tcl_AppendResult((Tcl_Interp *) iPtr, "variable \"", myName,
 		"\" has traces: can't use for upvar", NULL);
 	return TCL_ERROR;
@@ -3381,9 +3532,11 @@ TclPtrMakeUpvar(
 	    if (linkPtr == otherPtr) {
 		return TCL_OK;
 	    }
-	    linkPtr->refCount--;
-	    if (TclIsVarUndefined(linkPtr)) {
-		TclCleanupVar(linkPtr, NULL);
+	    if (TclIsVarInHash(linkPtr)) {
+		VarHashRefCount(linkPtr)--;		
+		if (TclIsVarUndefined(linkPtr)) {
+		    CleanupVar(linkPtr, NULL);
+		}
 	    }
 	} else {
 	    Tcl_AppendResult((Tcl_Interp *) iPtr, "variable \"", myName,
@@ -3392,9 +3545,10 @@ TclPtrMakeUpvar(
 	}
     }
     TclSetVarLink(varPtr);
-    TclClearVarUndefined(varPtr);
     varPtr->value.linkPtr = otherPtr;
-    otherPtr->refCount++;
+    if (TclIsVarInHash(otherPtr)) {
+	VarHashRefCount(otherPtr)++;
+    }
     return TCL_OK;
 }
 
@@ -3469,7 +3623,7 @@ Tcl_UpVar2(
 {
     int result;
     CallFrame *framePtr;
-    Tcl_Obj *part1Ptr;
+    Tcl_Obj *part1Ptr, *localNamePtr;
 
     if (TclGetFrame(interp, frameName, &framePtr) == -1) {
 	return TCL_ERROR;
@@ -3477,10 +3631,13 @@ Tcl_UpVar2(
 
     part1Ptr = Tcl_NewStringObj(part1, -1);
     Tcl_IncrRefCount(part1Ptr);
-    result = ObjMakeUpvar(interp, framePtr, part1Ptr, part2, 0,
-	    localName, flags, -1);
-    TclDecrRefCount(part1Ptr);
+    localNamePtr = Tcl_NewStringObj(localName, -1);
+    Tcl_IncrRefCount(localNamePtr);
 
+    result = ObjMakeUpvar(interp, framePtr, part1Ptr, part2, 0,
+	    localNamePtr, flags, -1);
+    Tcl_DecrRefCount(part1Ptr);
+    Tcl_DecrRefCount(localNamePtr);
     return result;
 }
 
@@ -3513,26 +3670,35 @@ Tcl_GetVariableFullName(
 {
     Interp *iPtr = (Interp *) interp;
     register Var *varPtr = (Var *) variable;
-    char *name;
+    Tcl_Obj *namePtr;
+    Namespace *nsPtr;
 
     /*
      * Add the full name of the containing namespace (if any), followed by the
      * "::" separator, then the variable name.
      */
 
-    if (varPtr != NULL) {
+    if (varPtr) {
 	if (!TclIsVarArrayElement(varPtr)) {
-	    if (varPtr->nsPtr != NULL) {
-		Tcl_AppendToObj(objPtr, varPtr->nsPtr->fullName, -1);
-		if (varPtr->nsPtr != iPtr->globalNsPtr) {
+	    nsPtr = TclGetVarNsPtr(varPtr);
+	    if (nsPtr) {
+		Tcl_AppendToObj(objPtr, nsPtr->fullName, -1);
+		if (nsPtr != iPtr->globalNsPtr) {
 		    Tcl_AppendToObj(objPtr, "::", 2);
 		}
 	    }
-	    if (varPtr->name != NULL) {
-		Tcl_AppendToObj(objPtr, varPtr->name, -1);
-	    } else if (varPtr->hPtr != NULL) {
-		name = Tcl_GetHashKey(varPtr->hPtr->tablePtr, varPtr->hPtr);
-		Tcl_AppendToObj(objPtr, name, -1);
+	    if (TclIsVarInHash(varPtr)) {
+		if (!TclIsVarDeadHash(varPtr)) {
+		    namePtr = VarHashGetKey(varPtr);
+		    Tcl_AppendObjToObj(objPtr, namePtr);
+		}
+	    } else if (iPtr->varFramePtr->procPtr) {
+		int index = varPtr - iPtr->varFramePtr->compiledLocals;
+
+		if (index < iPtr->varFramePtr->numCompiledLocals) {
+		    namePtr = localName(iPtr->varFramePtr, index);
+		    Tcl_AppendObjToObj(objPtr, namePtr);
+		}
 	    }
 	}
     }
@@ -3563,7 +3729,7 @@ Tcl_GlobalObjCmd(
     Tcl_Obj *const objv[])	/* Argument objects. */
 {
     Interp *iPtr = (Interp *) interp;
-    register Tcl_Obj *objPtr;
+    register Tcl_Obj *objPtr, *tailPtr;
     char *varName;
     register char *tail;
     int result, i;
@@ -3605,12 +3771,24 @@ Tcl_GlobalObjCmd(
 	    tail++;
 	}
 
+	if (tail == varName) {
+	    tailPtr = objPtr;
+	} else {
+	    tailPtr = Tcl_NewStringObj(tail, -1);
+	    Tcl_IncrRefCount(tailPtr);
+	}
+
 	/*
 	 * Link to the variable "varName" in the global :: namespace.
 	 */
 
 	result = ObjMakeUpvar(interp, NULL, objPtr, NULL,
-		TCL_GLOBAL_ONLY, /*myName*/ tail, /*myFlags*/ 0, -1);
+		TCL_GLOBAL_ONLY, /*myName*/ tailPtr, /*myFlags*/ 0, -1);
+
+	if (tail != varName) {
+	    Tcl_DecrRefCount(tailPtr);
+	}
+
 	if (result != TCL_OK) {
 	    return result;
 	}
@@ -3664,7 +3842,7 @@ Tcl_VariableObjCmd(
     Var *varPtr, *arrayPtr;
     Tcl_Obj *varValuePtr;
     int i, result;
-    Tcl_Obj *varNamePtr;
+    Tcl_Obj *varNamePtr, *tailPtr;
 
     if (objc < 2) {
 	Tcl_WrongNumArgs(interp, 1, objv, "?name value...? name ?value?");
@@ -3679,7 +3857,7 @@ Tcl_VariableObjCmd(
 
 	varNamePtr = objv[i];
 	varName = TclGetString(varNamePtr);
-	varPtr = TclObjLookupVar(interp, varNamePtr, NULL,
+	varPtr = TclObjLookupVarEx(interp, varNamePtr, NULL,
 		(TCL_NAMESPACE_ONLY | TCL_LEAVE_ERR_MSG), "define",
 		/*createPart1*/ 1, /*createPart2*/ 0, &arrayPtr);
 
@@ -3689,7 +3867,7 @@ Tcl_VariableObjCmd(
 	     * non-NULL, it is, so throw up an error and return.
 	     */
 
-	    TclVarErrMsg(interp, varName, NULL, "define", isArrayElement);
+	    TclObjVarErrMsg(interp, varNamePtr, NULL, "define", isArrayElement, -1);
 	    return TCL_ERROR;
 	}
 
@@ -3703,10 +3881,7 @@ Tcl_VariableObjCmd(
 	 * destroyed or until the variable is unset.
 	 */
 
-	if (!TclIsVarNamespaceVar(varPtr)) {
-	    TclSetVarNamespaceVar(varPtr);
-	    varPtr->refCount++;
-	}
+	TclSetVarNamespaceVar(varPtr);
 
 	/*
 	 * If a value was specified, set the variable to that value.
@@ -3716,8 +3891,8 @@ Tcl_VariableObjCmd(
 	 */
 
 	if (i+1 < objc) {	/* a value was specified */
-	    varValuePtr = TclPtrSetVar(interp, varPtr, arrayPtr, varName, NULL,
-		    objv[i+1], (TCL_NAMESPACE_ONLY | TCL_LEAVE_ERR_MSG));
+	    varValuePtr = TclPtrSetVar(interp, varPtr, arrayPtr, varNamePtr, NULL,
+		    objv[i+1], (TCL_NAMESPACE_ONLY | TCL_LEAVE_ERR_MSG), -1);
 	    if (varValuePtr == NULL) {
 		return TCL_ERROR;
 	    }
@@ -3750,9 +3925,21 @@ Tcl_VariableObjCmd(
 	     * current namespace.
 	     */
 
+	    if (tail == varName) {
+		tailPtr = varNamePtr;
+	    } else {
+		tailPtr = Tcl_NewStringObj(tail, -1);
+		Tcl_IncrRefCount(tailPtr);
+	    }
+	    
 	    result = ObjMakeUpvar(interp, NULL, varNamePtr, /*otherP2*/ NULL,
 		    /*otherFlags*/ TCL_NAMESPACE_ONLY,
-		    /*myName*/ tail, /*myFlags*/ 0, -1);
+		    /*myName*/ tailPtr, /*myFlags*/ 0, -1);
+
+	    if (tail != varName) {
+		Tcl_DecrRefCount(tailPtr);
+	    }
+	    
 	    if (result != TCL_OK) {
 		return result;
 	    }
@@ -3787,7 +3974,6 @@ Tcl_UpvarObjCmd(
     Tcl_Obj *const objv[])	/* Argument objects. */
 {
     CallFrame *framePtr;
-    char *localName;
     int result;
 
     if (objc < 3) {
@@ -3819,9 +4005,8 @@ Tcl_UpvarObjCmd(
      */
 
     for (; objc>0 ; objc-=2, objv+=2) {
-	localName = TclGetString(objv[1]);
 	result = ObjMakeUpvar(interp, framePtr, /* othervarName */ objv[0],
-		NULL, 0, /* myVarName */ localName, /*flags*/ 0, -1);
+		NULL, 0, /* myVarName */ objv[1], /*flags*/ 0, -1);
 	if (result != TCL_OK) {
 	    return TCL_ERROR;
 	}
@@ -3832,44 +4017,6 @@ Tcl_UpvarObjCmd(
 /*
  *----------------------------------------------------------------------
  *
- * NewVar --
- *
- *	Create a new heap-allocated variable that will eventually be entered
- *	into a hashtable.
- *
- * Results:
- *	The return value is a pointer to the new variable structure. It is
- *	marked as a scalar variable (and not a link or array variable). Its
- *	value initially is NULL. The variable is not part of any hash table
- *	yet. Since it will be in a hashtable and not in a call frame, its name
- *	field is set NULL. It is initially marked as undefined.
- *
- * Side effects:
- *	Storage gets allocated.
- *
- *----------------------------------------------------------------------
- */
-
-static Var *
-NewVar(void)
-{
-    register Var *varPtr;
-
-    varPtr = (Var *) ckalloc(sizeof(Var));
-    varPtr->value.objPtr = NULL;
-    varPtr->name = NULL;
-    varPtr->nsPtr = NULL;
-    varPtr->hPtr = NULL;
-    varPtr->refCount = 0;
-    varPtr->tracePtr = NULL;
-    varPtr->searchPtr = NULL;
-    varPtr->flags = (VAR_SCALAR | VAR_UNDEFINED | VAR_IN_HASHTABLE);
-    return varPtr;
-}
-
-/*
- *----------------------------------------------------------------------
- *
  * SetArraySearchObj --
  *
  *	This function converts the given tcl object into one that has the
@@ -3959,17 +4106,19 @@ static ArraySearch *
 ParseSearchId(
     Tcl_Interp *interp,		/* Interpreter containing variable. */
     const Var *varPtr,		/* Array variable search is for. */
-    const char *varName,	/* Name of array variable that search is
+    Tcl_Obj *varNamePtr,	/* Name of array variable that search is
 				 * supposed to be for. */
     Tcl_Obj *handleObj)		/* Object containing id of search. Must have
 				 * form "search-num-var" where "num" is a
 				 * decimal number and "var" is a variable
 				 * name. */
 {
+    Interp *iPtr = (Interp *) interp;
     register char *string;
     register size_t offset;
     int id;
     ArraySearch *searchPtr;
+    char *varName = TclGetString(varNamePtr);
 
     /*
      * Parse the id.
@@ -4012,10 +4161,15 @@ ParseSearchId(
      * this list every time.
      */
 
-    for (searchPtr = varPtr->searchPtr; searchPtr != NULL;
-	    searchPtr = searchPtr->nextPtr) {
-	if (searchPtr->id == id) {
-	    return searchPtr;
+    if (varPtr->flags & VAR_SEARCH_ACTIVE) {
+	Tcl_HashEntry *hPtr =
+	        Tcl_FindHashEntry(&iPtr->varSearches,(char *) varPtr);
+	
+	for (searchPtr = (ArraySearch *) Tcl_GetHashValue(hPtr);
+	         searchPtr != NULL; searchPtr = searchPtr->nextPtr) {
+	    if (searchPtr->id == id) {
+		return searchPtr;
+	    }
 	}
     }
     Tcl_AppendResult(interp, "couldn't find search \"", string, "\"", NULL);
@@ -4042,16 +4196,23 @@ ParseSearchId(
 
 static void
 DeleteSearches(
+    Interp *iPtr,
     register Var *arrayVarPtr)	/* Variable whose searches are to be
 				 * deleted. */
 {
-    ArraySearch *searchPtr;
-
-    while (arrayVarPtr->searchPtr != NULL) {
-	searchPtr = arrayVarPtr->searchPtr;
-	arrayVarPtr->searchPtr = searchPtr->nextPtr;
-	ckfree((char *) searchPtr);
-    }
+    ArraySearch *searchPtr, *nextPtr;
+    Tcl_HashEntry *sPtr;
+
+    if (arrayVarPtr->flags & VAR_SEARCH_ACTIVE) {
+	sPtr = Tcl_FindHashEntry(&iPtr->varSearches, (char *) arrayVarPtr);
+	for (searchPtr = (ArraySearch *) Tcl_GetHashValue(sPtr);
+	         searchPtr != NULL; searchPtr = nextPtr) {
+	    nextPtr = searchPtr->nextPtr;
+	    ckfree((char *) searchPtr);
+	}
+	arrayVarPtr->flags &= ~VAR_SEARCH_ACTIVE;
+	Tcl_DeleteHashEntry(sPtr);
+    }	
 }
 
 /*
@@ -4076,12 +4237,12 @@ void
 TclDeleteNamespaceVars(
     Namespace *nsPtr)
 {
-    Tcl_HashTable *tablePtr = &nsPtr->varTable;
+    TclVarHashTable *tablePtr = &nsPtr->varTable;
     Tcl_Interp *interp = nsPtr->interp;
     Interp *iPtr = (Interp *)interp;
     Tcl_HashSearch search;
-    Tcl_HashEntry *hPtr;
     int flags = 0;
+    Var *varPtr;
 
     /*
      * Determine what flags to pass to the trace callback functions.
@@ -4093,30 +4254,33 @@ TclDeleteNamespaceVars(
 	flags = TCL_NAMESPACE_ONLY;
     }
 
-    for (hPtr = Tcl_FirstHashEntry(tablePtr, &search);  hPtr != NULL;
-	 hPtr = Tcl_FirstHashEntry(tablePtr, &search)) {
-	register Var *varPtr = (Var *) Tcl_GetHashValue(hPtr);
-	varPtr->refCount++;	/* Make sure we get to remove from hash */
-	UnsetVarStruct(varPtr, NULL, iPtr, /* part1 */ NULL, NULL, flags, 1);
-	varPtr->refCount--;
+    for (varPtr = VarHashFirstVar(tablePtr, &search);  varPtr != NULL;
+	 varPtr = VarHashFirstVar(tablePtr, &search)) {
+	VarHashRefCount(varPtr)++;	/* Make sure we get to remove from hash */
+	UnsetVarStruct(varPtr, NULL, iPtr, /* part1 */ VarHashGetKey(varPtr), NULL, flags);
 
 	/*
 	 * Remove the variable from the table and force it undefined in case
 	 * an unset trace brought it back from the dead.
 	 */
 
-	Tcl_DeleteHashEntry(hPtr);
-	varPtr->hPtr = NULL;
-	TclSetVarUndefined(varPtr);
-	TclSetVarScalar(varPtr);
-	while (varPtr->tracePtr != NULL) {
-	    VarTrace *tracePtr = varPtr->tracePtr;
-	    varPtr->tracePtr = tracePtr->nextPtr;
-	    Tcl_EventuallyFree((ClientData) tracePtr, TCL_DYNAMIC);
+	if (TclIsVarTraced(varPtr)) {
+	    Tcl_HashEntry *tPtr = Tcl_FindHashEntry(&iPtr->varTraces,
+		    (char *) varPtr);
+	    VarTrace *tracePtr = (VarTrace *) Tcl_GetHashValue(tPtr);
+	    while (tracePtr) {
+		VarTrace *prevPtr = tracePtr;
+
+		tracePtr = tracePtr->nextPtr;
+		Tcl_EventuallyFree((ClientData) prevPtr, TCL_DYNAMIC);
+	    }
+	    Tcl_DeleteHashEntry(tPtr);
+	    varPtr->flags &= ~VAR_ALL_TRACES;
 	}
-	TclCleanupVar(varPtr, NULL);
+	VarHashRefCount(varPtr)--;
+	VarHashDeleteEntry(varPtr);
     }
-    Tcl_DeleteHashTable(tablePtr);
+    VarHashDeleteTable(tablePtr);
 }
 
 /*
@@ -4142,12 +4306,11 @@ TclDeleteNamespaceVars(
 void
 TclDeleteVars(
     Interp *iPtr,		/* Interpreter to which variables belong. */
-    Tcl_HashTable *tablePtr)	/* Hash table containing variables to
+    TclVarHashTable *tablePtr)	/* Hash table containing variables to
 				 * delete. */
 {
     Tcl_Interp *interp = (Tcl_Interp *) iPtr;
     Tcl_HashSearch search;
-    Tcl_HashEntry *hPtr;
     register Var *varPtr;
     int flags;
     Namespace *currNsPtr = (Namespace *) TclGetCurrentNamespace(interp);
@@ -4163,24 +4326,17 @@ TclDeleteVars(
 	flags |= TCL_NAMESPACE_ONLY;
     }
 
-    for (hPtr = Tcl_FirstHashEntry(tablePtr, &search); hPtr != NULL;
-	    hPtr = Tcl_NextHashEntry(&search)) {
-	varPtr = (Var *) Tcl_GetHashValue(hPtr);
-
-	UnsetVarStruct(varPtr, NULL, iPtr, NULL, NULL, flags, 0);
-	varPtr->hPtr = NULL;
-
+    for (varPtr = VarHashFirstVar(tablePtr, &search); varPtr != NULL;
+	    varPtr = VarHashNextVar(&search)) {
 	/*
-	 * Recycle the variable's memory space if there aren't any upvar's
-	 * pointing to it. If there are upvars to this variable, then the
-	 * variable will get freed when the last upvar goes away.
+	 * Lie about the validity of the hashtable entry. In this way the
+	 * variables will be deleted by VarHashDeleteTable.
 	 */
-
-	if (varPtr->refCount == 0) {
-	    ckfree((char *) varPtr); /* this Var must be VAR_IN_HASHTABLE */
-	}
+	
+	VarHashInvalidateEntry(varPtr);
+	UnsetVarStruct(varPtr, NULL, iPtr, VarHashGetKey(varPtr), NULL, flags);
     }
-    Tcl_DeleteHashTable(tablePtr);
+    VarHashDeleteTable(tablePtr);
 }
 
 /*
@@ -4213,77 +4369,13 @@ TclDeleteCompiledLocalVars(
 {
     register Var *varPtr;
     int numLocals, i;
-
+    Tcl_Obj **namePtrPtr;
+    
     numLocals = framePtr->numCompiledLocals;
     varPtr = framePtr->compiledLocals;
-    for (i=0 ; i<numLocals ; i++) {
-#if 1
-	UnsetVarStruct(varPtr, NULL, iPtr, varPtr->name, NULL, TCL_TRACE_UNSETS, 0);
-	varPtr++;
-#else
-    if (!TclIsVarUntraced(varPtr)) {
-	ActiveVarTrace *activePtr;
-	
-	varPtr->flags &= ~VAR_TRACE_ACTIVE;
-	TclCallVarTraces(iPtr, NULL, varPtr, varPtr->name, NULL,
-		TCL_TRACE_UNSETS, /* leaveErrMsg */ 0);
-	while (varPtr->tracePtr != NULL) {
-	    VarTrace *tracePtr = varPtr->tracePtr;
-	    varPtr->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 (TclIsVarScalar(varPtr)
-	    && (varPtr->value.objPtr != NULL)) {
-	/*
-	 * Decrement the ref count of the var's value
-	 */
-	
-	Tcl_Obj *objPtr = varPtr->value.objPtr;
-	TclDecrRefCount(objPtr);
-	varPtr->value.objPtr = NULL;
-    } else if (TclIsVarArray(varPtr) && !TclIsVarUndefined(varPtr)) {
-	/*
-	 * 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 the array is traced, its name is
-	 * already in part1. If not, and the name is required for some
-	 * element, it will be computed at DeleteArray. 
-	 */
-	
-	DeleteArray(iPtr, varPtr->name, varPtr, TCL_TRACE_UNSETS);
-    } else if (TclIsVarLink(varPtr)) {
-	/*
-	 * 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.
-	 */
-	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);
-	}
-    }
-
-    TclSetVarUndefined(varPtr);
-    TclSetVarScalar(varPtr);
-    varPtr->tracePtr = NULL;
-    varPtr->searchPtr = NULL;
-
-    varPtr++;
-#endif
+    namePtrPtr = &localName(framePtr, 0);
+    for (i=0 ; i<numLocals ; i++, namePtrPtr++, varPtr++) {
+	UnsetVarStruct(varPtr, NULL, iPtr, *namePtrPtr, NULL, TCL_TRACE_UNSETS);
     }
 }
 
@@ -4311,7 +4403,7 @@ TclDeleteCompiledLocalVars(
 static void
 DeleteArray(
     Interp *iPtr,		/* Interpreter containing array. */
-    const char *arrayName,	/* Name of array (used for trace callbacks),
+    Tcl_Obj *arrayNamePtr,	/* Name of array (used for trace callbacks),
 				 * or NULL if it is to be computed on demand */
     Var *varPtr,		/* Pointer to variable structure. */
     int flags)			/* Flags to pass to TclCallVarTraces:
@@ -4319,44 +4411,51 @@ DeleteArray(
 				 * TCL_NAMESPACE_ONLY or TCL_GLOBAL_ONLY. */
 {
     Tcl_HashSearch search;
-    register Tcl_HashEntry *hPtr;
+    Tcl_HashEntry *tPtr;
     register Var *elPtr;
     ActiveVarTrace *activePtr;
-    Tcl_Obj *objPtr, *arrayNamePtr = NULL;
+    Tcl_Obj *objPtr;
+    VarTrace *tracePtr;
 
-    DeleteSearches(varPtr);
-    for (hPtr = Tcl_FirstHashEntry(varPtr->value.tablePtr, &search);
-	    hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
-	elPtr = (Var *) Tcl_GetHashValue(hPtr);
+    if (varPtr->flags & VAR_SEARCH_ACTIVE) {
+	DeleteSearches(iPtr, varPtr);
+    }
+    for (elPtr = VarHashFirstVar(varPtr->value.tablePtr, &search);
+	    elPtr != NULL; elPtr = VarHashNextVar(&search)) {
 	if (TclIsVarScalar(elPtr) && (elPtr->value.objPtr != NULL)) {
 	    objPtr = elPtr->value.objPtr;
 	    TclDecrRefCount(objPtr);
 	    elPtr->value.objPtr = NULL;
 	}
-	elPtr->hPtr = NULL;
-	if (elPtr->tracePtr != NULL) {
+
+	/*
+	 * Lie about the validity of the hashtable entry. In this way the
+	 * variables will be deleted by VarHashDeleteTable.
+	 */
+	
+	VarHashInvalidateEntry(elPtr);
+	if (TclIsVarTraced(elPtr)) {
 	    /*
 	     * Compute the array name if it was not supplied
 	     */
 
-	    if (arrayName == NULL) {
-		Tcl_Interp *interp = varPtr->nsPtr->interp;
-		TclNewObj(arrayNamePtr);
-		Tcl_IncrRefCount(arrayNamePtr);
-		Tcl_GetVariableFullName(interp, (Tcl_Var) varPtr, arrayNamePtr);
-		arrayName = TclGetString(arrayNamePtr);
+	    if (elPtr->flags & VAR_TRACED_UNSET) {
+		Tcl_Obj *elNamePtr = VarHashGetKey(elPtr);
+		
+		elPtr->flags &= ~VAR_TRACE_ACTIVE;
+		TclObjCallVarTraces(iPtr, NULL, elPtr, arrayNamePtr,
+			elNamePtr, flags,/* leaveErrMsg */ 0, -1);
 	    }
-	    
-	    elPtr->flags &= ~VAR_TRACE_ACTIVE;
-	    TclCallVarTraces(iPtr, NULL, elPtr, arrayName,
-		    Tcl_GetHashKey(varPtr->value.tablePtr, hPtr), flags,
-		    /* leaveErrMsg */ 0);
-	    while (elPtr->tracePtr != NULL) {
-		VarTrace *tracePtr = elPtr->tracePtr;
-
-		elPtr->tracePtr = tracePtr->nextPtr;
-		Tcl_EventuallyFree((ClientData) tracePtr, TCL_DYNAMIC);
+	    tPtr = Tcl_FindHashEntry(&iPtr->varTraces, (char *) elPtr);
+	    tracePtr = (VarTrace *) Tcl_GetHashValue(tPtr);
+	    while (tracePtr) {
+		VarTrace *prevPtr = tracePtr;
+
+		tracePtr = tracePtr->nextPtr;
+		Tcl_EventuallyFree((ClientData) prevPtr, TCL_DYNAMIC);
 	    }
+	    Tcl_DeleteHashEntry(tPtr);
+	    elPtr->flags &= ~VAR_ALL_TRACES;
 	    for (activePtr = iPtr->activeVarTracePtr; activePtr != NULL;
 		    activePtr = activePtr->nextPtr) {
 		if (activePtr->varPtr == elPtr) {
@@ -4365,7 +4464,6 @@ DeleteArray(
 	    }
 	}
 	TclSetVarUndefined(elPtr);
-	TclSetVarScalar(elPtr);
 
 	/*
 	 * Even though array elements are not supposed to be namespace
@@ -4374,73 +4472,16 @@ DeleteArray(
 	 * the corresponding Var struct, and is otherwise harmless.
 	 */
 
-	if (TclIsVarNamespaceVar(elPtr)) {
-	    TclClearVarNamespaceVar(elPtr);
-	    elPtr->refCount--;
-	}
-	if (elPtr->refCount == 0) {
-	    ckfree((char *) elPtr); /* element Vars are VAR_IN_HASHTABLE */
-	}
-    }
-    if (arrayNamePtr) {
-	Tcl_DecrRefCount(arrayNamePtr);
+	TclClearVarNamespaceVar(elPtr);
     }
-    Tcl_DeleteHashTable(varPtr->value.tablePtr);
+    VarHashDeleteTable(varPtr->value.tablePtr);
     ckfree((char *) varPtr->value.tablePtr);
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * TclCleanupVar --
- *
- *	This function is called when it looks like it may be OK to free up a
- *	variable's storage. If the variable is in a hashtable, its Var
- *	structure and hash table entry will be freed along with those of its
- *	containing array, if any. This function is called, for example, when
- *	a trace on a variable deletes a variable.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	If the variable (or its containing array) really is dead and in a
- *	hashtable, then its Var structure, and possibly its hash table entry,
- *	is freed up.
- *
- *----------------------------------------------------------------------
- */
-
-void
-TclCleanupVar(
-    Var *varPtr,		/* Pointer to variable that may be a candidate
-				 * for being expunged. */
-    Var *arrayPtr)		/* Array that contains the variable, or NULL
-				 * if this variable isn't an array element. */
-{
-    if (TclIsVarUndefined(varPtr) && (varPtr->refCount == 0)
-	    && (varPtr->tracePtr == NULL)
-	    && (varPtr->flags & VAR_IN_HASHTABLE)) {
-	if (varPtr->hPtr != NULL) {
-	    Tcl_DeleteHashEntry(varPtr->hPtr);
-	}
-	ckfree((char *) varPtr);
-    }
-    if (arrayPtr != NULL) {
-	if (TclIsVarUndefined(arrayPtr) && (arrayPtr->refCount == 0)
-		&& (arrayPtr->tracePtr == NULL)
-		&& (arrayPtr->flags & VAR_IN_HASHTABLE)) {
-	    if (arrayPtr->hPtr != NULL) {
-		Tcl_DeleteHashEntry(arrayPtr->hPtr);
-	    }
-	    ckfree((char *) arrayPtr);
-	}
-    }
-}
-/*
- *----------------------------------------------------------------------
- *
- * TclVarErrMsg --
+ * TclTclObjVarErrMsg --
  *
  *	Generate a reasonable error message describing why a variable
  *	operation failed.
@@ -4459,16 +4500,49 @@ TclCleanupVar(
 void
 TclVarErrMsg(
     Tcl_Interp *interp,		/* Interpreter in which to record message. */
-    const char *part1,
+    const char *part1,          
     const char *part2,		/* Variable's two-part name. */
     const char *operation,	/* String describing operation that failed,
 				 * e.g. "read", "set", or "unset". */
     const char *reason)		/* String describing why operation failed. */
 {
+    Tcl_Obj *part1Ptr = NULL, *part2Ptr = NULL;
+
+    part1Ptr = Tcl_NewStringObj(part1, -1);
+    Tcl_IncrRefCount(part1Ptr);
+    if (part2) {
+	part2Ptr = Tcl_NewStringObj(part2, -1);
+	Tcl_IncrRefCount(part2Ptr);
+    } else {
+	part2 = NULL;
+    }
+    
+    TclObjVarErrMsg(interp, part1Ptr, part2Ptr, operation, reason, -1);
+
+    Tcl_DecrRefCount(part1Ptr);
+    if (part2Ptr) {
+	Tcl_DecrRefCount(part2Ptr);
+    }
+}
+
+void
+TclObjVarErrMsg(
+    Tcl_Interp *interp,		/* Interpreter in which to record message. */
+    Tcl_Obj *part1Ptr,          /* (may be NULL, if index >= 0) */
+    Tcl_Obj *part2Ptr,		/* Variable's two-part name. */
+    const char *operation,	/* String describing operation that failed,
+				 * e.g. "read", "set", or "unset". */
+    const char *reason,		/* String describing why operation failed. */
+    int index)
+{
     Tcl_ResetResult(interp);
-    Tcl_AppendResult(interp, "can't ", operation, " \"", part1, NULL);
-    if (part2 != NULL) {
-	Tcl_AppendResult(interp, "(", part2, ")", NULL);
+    if (!part1Ptr) {
+	part1Ptr = localName(((Interp*)interp)->varFramePtr, index);
+    }
+    Tcl_AppendResult(interp, "can't ", operation, " \"",
+	    TclGetString(part1Ptr), NULL);
+    if (part2Ptr) {
+	Tcl_AppendResult(interp, "(", TclGetString(part2Ptr), ")", NULL);
     }
     Tcl_AppendResult(interp, "\": ", reason, NULL);
 }
@@ -4534,9 +4608,11 @@ FreeNsVarName(
 {
     register Var *varPtr = objPtr->internalRep.twoPtrValue.ptr2;
 
-    varPtr->refCount--;
-    if (TclIsVarUndefined(varPtr) && (varPtr->refCount == 0)) {
-	TclCleanupVar(varPtr, NULL);
+    if (TclIsVarInHash(varPtr)) {
+	varPtr->refCount--;
+	if (TclIsVarUndefined(varPtr) && (varPtr->refCount == 0)) {
+	    CleanupVar(varPtr, NULL);
+	}
     }
 }
 
@@ -4550,7 +4626,9 @@ DupNsVarName(
 
     dupPtr->internalRep.twoPtrValue.ptr1 = nsPtr;
     dupPtr->internalRep.twoPtrValue.ptr2 = varPtr;
-    varPtr->refCount++;
+    if (TclIsVarInHash(varPtr)) {
+	varPtr->refCount++;
+    }
     dupPtr->typePtr = &tclNsVarNameType;
 }
 #endif
@@ -4636,6 +4714,701 @@ UpdateParsedVarName(
 }
 
 /*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_FindNamespaceVar -- MOVED OVER from tclNamesp.c
+ *
+ *	Searches for a namespace variable, a variable not local to a
+ *	procedure. The variable can be either a scalar or an array, but may
+ *	not be an element of an array.
+ *
+ * Results:
+ *	Returns a token for the variable if it is found. Otherwise, if it
+ *	can't be found or there is an error, returns NULL and leaves an error
+ *	message in the interpreter's result object if "flags" contains
+ *	TCL_LEAVE_ERR_MSG.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Var
+Tcl_FindNamespaceVar(
+    Tcl_Interp *interp,		/* The interpreter in which to find the
+				 * variable. */
+    const char *name,		/* Variable's name. If it starts with "::",
+				 * will be looked up in global namespace.
+				 * Else, looked up first in contextNsPtr
+				 * (current namespace if contextNsPtr is
+				 * NULL), then in global namespace. */
+    Tcl_Namespace *contextNsPtr,/* Ignored if TCL_GLOBAL_ONLY flag set.
+				 * Otherwise, points to namespace in which to
+				 * resolve name. If NULL, look up name in the
+				 * current namespace. */
+    int flags)			/* An OR'd combination of flags:
+				 * TCL_GLOBAL_ONLY (look up name only in
+				 * global namespace), TCL_NAMESPACE_ONLY (look
+				 * up only in contextNsPtr, or the current
+				 * namespace if contextNsPtr is NULL), and
+				 * TCL_LEAVE_ERR_MSG. If both TCL_GLOBAL_ONLY
+				 * and TCL_NAMESPACE_ONLY are given,
+				 * TCL_GLOBAL_ONLY is ignored. */
+{
+    Interp *iPtr = (Interp *) interp;
+    ResolverScheme *resPtr;
+    Namespace *nsPtr[2], *cxtNsPtr;
+    const char *simpleName;
+    Var *varPtr;
+    register int search;
+    int result;
+    Tcl_Var var;
+    Tcl_Obj *simpleNamePtr;
+    
+    /*
+     * If this namespace has a variable resolver, then give it first crack at
+     * the variable resolution. It may return a Tcl_Var value, it may signal
+     * to continue onward, or it may signal an error.
+     */
+
+    if ((flags & TCL_GLOBAL_ONLY) != 0) {
+	cxtNsPtr = (Namespace *) TclGetGlobalNamespace(interp);
+    } else if (contextNsPtr != NULL) {
+	cxtNsPtr = (Namespace *) contextNsPtr;
+    } else {
+	cxtNsPtr = (Namespace *) TclGetCurrentNamespace(interp);
+    }
+
+    if (cxtNsPtr->varResProc != NULL || iPtr->resolverPtr != NULL) {
+	resPtr = iPtr->resolverPtr;
+
+	if (cxtNsPtr->varResProc) {
+	    result = (*cxtNsPtr->varResProc)(interp, name,
+		    (Tcl_Namespace *) cxtNsPtr, flags, &var);
+	} else {
+	    result = TCL_CONTINUE;
+	}
+
+	while (result == TCL_CONTINUE && resPtr) {
+	    if (resPtr->varResProc) {
+		result = (*resPtr->varResProc)(interp, name,
+			(Tcl_Namespace *) cxtNsPtr, flags, &var);
+	    }
+	    resPtr = resPtr->nextPtr;
+	}
+
+	if (result == TCL_OK) {
+	    return var;
+	} else if (result != TCL_CONTINUE) {
+	    return (Tcl_Var) NULL;
+	}
+    }
+
+    /*
+     * Find the namespace(s) that contain the variable.
+     */
+
+    TclGetNamespaceForQualName(interp, name, (Namespace *) contextNsPtr,
+	    flags, &nsPtr[0], &nsPtr[1], &cxtNsPtr, &simpleName);
+
+    /*
+     * Look for the variable in the variable table of its namespace. Be sure
+     * to check both possible search paths: from the specified namespace
+     * context and from the global namespace.
+     */
+
+    varPtr = NULL;
+    simpleNamePtr = Tcl_NewStringObj(simpleName, -1);
+    Tcl_IncrRefCount(simpleNamePtr);
+    for (search = 0;  (search < 2) && (varPtr == NULL);  search++) {
+	if ((nsPtr[search] != NULL) && (simpleName != NULL)) {
+	    varPtr = VarHashFindVar(&nsPtr[search]->varTable, simpleNamePtr);
+	}
+    }
+    Tcl_DecrRefCount(simpleNamePtr);
+    if (varPtr != NULL) {
+	return (Tcl_Var) varPtr;
+    } else if (flags & TCL_LEAVE_ERR_MSG) {
+	Tcl_ResetResult(interp);
+	Tcl_AppendResult(interp, "unknown variable \"", name, "\"", NULL);
+    }
+    return (Tcl_Var) NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InfoVarsCmd -- (moved over from tclCmdIL.c)
+ *
+ *	Called to implement the "info vars" command that returns the list of
+ *	variables in the interpreter that match an optional pattern. The
+ *	pattern, if any, consists of an optional sequence of namespace names
+ *	separated by "::" qualifiers, which is followed by a glob-style
+ *	pattern that restricts which variables are returned. Handles the
+ *	following syntax:
+ *
+ *	    info vars ?pattern?
+ *
+ * Results:
+ *	Returns TCL_OK if successful and TCL_ERROR if there is an error.
+ *
+ * Side effects:
+ *	Returns a result in the interpreter's result object. If there is an
+ *	error, the result is an error message.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclInfoVarsCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *CONST objv[])	/* Argument objects. */
+{
+    Interp *iPtr = (Interp *) interp;
+    char *varName, *pattern;
+    CONST char *simplePattern;
+    Tcl_HashSearch search;
+    Var *varPtr;
+    Namespace *nsPtr;
+    Namespace *globalNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp);
+    Namespace *currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
+    Tcl_Obj *listPtr, *elemObjPtr;
+    int specificNsInPattern = 0;/* Init. to avoid compiler warning. */
+    Tcl_Obj *simplePatternPtr = NULL, *varNamePtr;
+    
+    /*
+     * Get the pattern and find the "effective namespace" in which to list
+     * variables. We only use this effective namespace if there's no active
+     * Tcl procedure frame.
+     */
+
+    if (objc == 1) {
+	simplePattern = NULL;
+	nsPtr = currNsPtr;
+	specificNsInPattern = 0;
+    } else if (objc == 2) {
+	/*
+	 * From the pattern, get the effective namespace and the simple
+	 * pattern (no namespace qualifiers or ::'s) at the end. If an error
+	 * was found while parsing the pattern, return it. Otherwise, if the
+	 * namespace wasn't found, just leave nsPtr NULL: we will return an
+	 * empty list since no variables there can be found.
+	 */
+
+	Namespace *dummy1NsPtr, *dummy2NsPtr;
+
+	pattern = TclGetString(objv[1]);
+	TclGetNamespaceForQualName(interp, pattern, (Namespace *) NULL,
+		/*flags*/ 0, &nsPtr, &dummy1NsPtr, &dummy2NsPtr,
+		&simplePattern);
+
+	if (nsPtr != NULL) {	/* We successfully found the pattern's ns. */
+	    specificNsInPattern = (strcmp(simplePattern, pattern) != 0);
+	    if (simplePattern == pattern) {
+		simplePatternPtr = objv[1];
+	    } else {
+		simplePatternPtr = Tcl_NewStringObj(simplePattern, -1);
+	    }
+	    Tcl_IncrRefCount(simplePatternPtr);
+	}
+    } else {
+	Tcl_WrongNumArgs(interp, 1, objv, "?pattern?");
+	return TCL_ERROR;
+    }
+
+    /*
+     * If the namespace specified in the pattern wasn't found, just return.
+     */
+
+    if (nsPtr == NULL) {
+	return TCL_OK;
+    }
+
+    listPtr = Tcl_NewListObj(0, NULL);
+
+    if (!(iPtr->varFramePtr->isProcCallFrame & FRAME_IS_PROC)
+	    || specificNsInPattern) {
+	/*
+	 * There is no frame pointer, the frame pointer was pushed only to
+	 * activate a namespace, or we are in a procedure call frame but a
+	 * specific namespace was specified. Create a list containing only the
+	 * variables in the effective namespace's variable table.
+	 */
+
+	if (simplePattern && TclMatchIsTrivial(simplePattern)) {
+	    /*
+	     * If we can just do hash lookups, that simplifies things a lot.
+	     */
+
+	    varPtr = VarHashFindVar(&nsPtr->varTable, simplePatternPtr);
+	    if (varPtr) {
+		if (!TclIsVarUndefined(varPtr)
+			|| TclIsVarNamespaceVar(varPtr)) {
+		    if (specificNsInPattern) {
+			elemObjPtr = Tcl_NewObj();
+			Tcl_GetVariableFullName(interp, (Tcl_Var) varPtr,
+				    elemObjPtr);
+		    } else {
+			elemObjPtr = VarHashGetKey(varPtr);
+		    }
+		    Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr);
+		}
+	    } else if ((nsPtr != globalNsPtr) && !specificNsInPattern) {
+		varPtr = VarHashFindVar(&globalNsPtr->varTable,	simplePatternPtr);
+		if (varPtr) {
+		    if (!TclIsVarUndefined(varPtr)
+			    || TclIsVarNamespaceVar(varPtr)) {
+			Tcl_ListObjAppendElement(interp, listPtr,
+				VarHashGetKey(varPtr));
+		    }
+		}
+	    }
+	} else {
+	    /*
+	     * Have to scan the tables of variables.
+	     */
+
+	    varPtr = VarHashFirstVar(&nsPtr->varTable, &search);
+	    while (varPtr) {
+		if (!TclIsVarUndefined(varPtr)
+			|| TclIsVarNamespaceVar(varPtr)) {
+		    varNamePtr = VarHashGetKey(varPtr);
+		    varName = TclGetString(varNamePtr);
+		    if ((simplePattern == NULL)
+			    || Tcl_StringMatch(varName, simplePattern)) {
+			if (specificNsInPattern) {
+			    elemObjPtr = Tcl_NewObj();
+			    Tcl_GetVariableFullName(interp, (Tcl_Var) varPtr,
+				    elemObjPtr);
+			} else {
+			    elemObjPtr = varNamePtr;
+			}
+			Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr);
+		    }
+		}
+		varPtr = VarHashNextVar(&search);
+	    }
+
+	    /*
+	     * If the effective namespace isn't the global :: namespace, and a
+	     * specific namespace wasn't requested in the pattern (i.e., the
+	     * pattern only specifies variable names), then add in all global
+	     * :: variables that match the simple pattern. Of course, add in
+	     * only those variables that aren't hidden by a variable in the
+	     * effective namespace.
+	     */
+
+	    if ((nsPtr != globalNsPtr) && !specificNsInPattern) {
+		varPtr = VarHashFirstVar(&globalNsPtr->varTable,&search);
+		while (varPtr) {
+		    if (!TclIsVarUndefined(varPtr)
+			    || TclIsVarNamespaceVar(varPtr)) {
+			varNamePtr = VarHashGetKey(varPtr);
+			varName = TclGetString(varNamePtr);
+			if ((simplePattern == NULL)
+				|| Tcl_StringMatch(varName, simplePattern)) {
+			    if (VarHashFindVar(&nsPtr->varTable, varNamePtr) == NULL) {
+				Tcl_ListObjAppendElement(interp, listPtr, varNamePtr);
+			    }
+			}
+		    }
+		    varPtr = VarHashNextVar(&search);
+		}
+	    }
+	}
+    } else if (((Interp *)interp)->varFramePtr->procPtr != NULL) {
+	AppendLocals(interp, listPtr, simplePatternPtr, 1);
+    }
+
+    if (simplePatternPtr) {
+	Tcl_DecrRefCount(simplePatternPtr);
+    }
+    Tcl_SetObjResult(interp, listPtr);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InfoGlobalsCmd -- (moved over from tclCmdIL.c)
+ *
+ *	Called to implement the "info globals" command that returns the list
+ *	of global variables matching an optional pattern. Handles the
+ *	following syntax:
+ *
+ *	    info globals ?pattern?
+ *
+ * Results:
+ *	Returns TCL_OK if successful and TCL_ERROR if there is an error.
+ *
+ * Side effects:
+ *	Returns a result in the interpreter's result object. If there is an
+ *	error, the result is an error message.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclInfoGlobalsCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *CONST objv[])	/* Argument objects. */
+{
+    char *varName, *pattern;
+    Namespace *globalNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp);
+    Tcl_HashSearch search;
+    Var *varPtr;
+    Tcl_Obj *listPtr, *varNamePtr, *patternPtr;
+
+    if (objc == 1) {
+	pattern = NULL;
+    } else if (objc == 2) {
+	pattern = TclGetString(objv[1]);
+
+	/*
+	 * Strip leading global-namespace qualifiers. [Bug 1057461]
+	 */
+
+	if (pattern[0] == ':' && pattern[1] == ':') {
+	    while (*pattern == ':') {
+		pattern++;
+	    }
+	}
+    } else {
+	Tcl_WrongNumArgs(interp, 1, objv, "?pattern?");
+	return TCL_ERROR;
+    }
+
+    /*
+     * Scan through the global :: namespace's variable table and create a list
+     * of all global variables that match the pattern.
+     */
+
+    listPtr = Tcl_NewListObj(0, NULL);
+    if (pattern != NULL && TclMatchIsTrivial(pattern)) {
+	if (pattern == TclGetString(objv[1])) {
+	    patternPtr = objv[1];
+	} else {
+	    patternPtr = Tcl_NewStringObj(pattern, -1);
+	}
+	Tcl_IncrRefCount(patternPtr);
+	
+	varPtr = VarHashFindVar(&globalNsPtr->varTable, patternPtr);
+	if (varPtr) {
+	    if (!TclIsVarUndefined(varPtr)) {
+		Tcl_ListObjAppendElement(interp, listPtr,
+			VarHashGetKey(varPtr));
+	    }
+	}
+	Tcl_DecrRefCount(patternPtr);
+    } else {
+	for (varPtr = VarHashFirstVar(&globalNsPtr->varTable, &search);
+		varPtr != NULL;
+		varPtr = VarHashNextVar(&search)) {
+	    if (TclIsVarUndefined(varPtr)) {
+		continue;
+	    }
+	    varNamePtr = VarHashGetKey(varPtr);
+	    varName = TclGetString(varNamePtr);
+	    if ((pattern == NULL) || Tcl_StringMatch(varName, pattern)) {
+		Tcl_ListObjAppendElement(interp, listPtr, varNamePtr);
+	    }
+	}
+    }
+    Tcl_SetObjResult(interp, listPtr);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclInfoLocalsCmd -- (moved over from tclCmdIl.c)
+ *
+ *	Called to implement the "info locals" command to return a list of
+ *	local variables that match an optional pattern. Handles the following
+ *	syntax:
+ *
+ *	    info locals ?pattern?
+ *
+ * Results:
+ *	Returns TCL_OK if successful and TCL_ERROR if there is an error.
+ *
+ * Side effects:
+ *	Returns a result in the interpreter's result object. If there is an
+ *	error, the result is an error message.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclInfoLocalsCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *CONST objv[])	/* Argument objects. */
+{
+    Interp *iPtr = (Interp *) interp;
+    Tcl_Obj *patternPtr;
+    Tcl_Obj *listPtr;
+
+    if (objc == 1) {
+	patternPtr = NULL;
+    } else if (objc == 2) {
+	patternPtr = objv[1];
+    } else {
+	Tcl_WrongNumArgs(interp, 1, objv, "?pattern?");
+	return TCL_ERROR;
+    }
+
+    if (!(iPtr->varFramePtr->isProcCallFrame & FRAME_IS_PROC )) {
+	return TCL_OK;
+    }
+
+    /*
+     * Return a list containing names of first the compiled locals (i.e. the
+     * ones stored in the call frame), then the variables in the local hash
+     * table (if one exists).
+     */
+
+    listPtr = Tcl_NewListObj(0, NULL);
+    AppendLocals(interp, listPtr, patternPtr, 0);
+    Tcl_SetObjResult(interp, listPtr);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * AppendLocals --
+ *
+ *	Append the local variables for the current frame to the specified list
+ *	object.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+AppendLocals(
+    Tcl_Interp *interp,		/* Current interpreter. */
+    Tcl_Obj *listPtr,		/* List object to append names to. */
+    Tcl_Obj *patternPtr,	/* Pattern to match against. */
+    int includeLinks)		/* 1 if upvars should be included, else 0. */
+{
+    Interp *iPtr = (Interp *) interp;
+    Var *varPtr;
+    int i, localVarCt;
+    Tcl_Obj **varNamePtr;
+    char *varName;
+    TclVarHashTable *localVarTablePtr;
+    Tcl_HashSearch search;
+    const char *pattern = patternPtr? TclGetString(patternPtr) : NULL;
+    Tcl_Obj *objNamePtr;
+    
+    localVarCt = iPtr->varFramePtr->numCompiledLocals;
+    varPtr = iPtr->varFramePtr->compiledLocals;
+    localVarTablePtr = iPtr->varFramePtr->varTablePtr;
+    varNamePtr = &iPtr->varFramePtr->localCachePtr->varName0;
+    
+    for (i = 0; i < localVarCt; i++, varNamePtr++) {
+	/*
+	 * Skip nameless (temporary) variables and undefined variables.
+	 */
+
+	if (*varNamePtr && !TclIsVarUndefined(varPtr)
+		&& (includeLinks || !TclIsVarLink(varPtr))) {
+	    varName = TclGetString(*varNamePtr);
+	    if ((pattern == NULL) || Tcl_StringMatch(varName, pattern)) {
+		Tcl_ListObjAppendElement(interp, listPtr, *varNamePtr);
+	    }
+	}
+	varPtr++;
+    }
+
+    /*
+     * Do nothing if no local variables.
+     */
+
+    if (localVarTablePtr == NULL) {
+	return;
+    }
+
+    /*
+     * Check for the simple and fast case.
+     */
+
+    if ((pattern != NULL) && TclMatchIsTrivial(pattern)) {
+	varPtr = VarHashFindVar(localVarTablePtr, patternPtr);
+	if (varPtr != NULL) {
+	    if (!TclIsVarUndefined(varPtr)
+		    && (includeLinks || !TclIsVarLink(varPtr))) {
+		Tcl_ListObjAppendElement(interp, listPtr,
+			VarHashGetKey(varPtr));
+	    }
+	}
+	return;
+    }
+
+    /*
+     * Scan over and process all local variables.
+     */
+
+    for (varPtr = VarHashFirstVar(localVarTablePtr, &search);
+	    varPtr != NULL;
+	    varPtr = VarHashNextVar(&search)) {
+	if (!TclIsVarUndefined(varPtr)
+		&& (includeLinks || !TclIsVarLink(varPtr))) {
+	    objNamePtr = VarHashGetKey(varPtr);
+	    varName = TclGetString(objNamePtr);
+	    if ((pattern == NULL) || Tcl_StringMatch(varName, pattern)) {
+		Tcl_ListObjAppendElement(interp, listPtr, objNamePtr);
+	    }
+	}
+    }
+}
+
+/*
+ * Hash table implementation - first, just copy and adapt the obj key stuff
+ */
+
+void
+TclInitVarHashTable(
+    TclVarHashTable *tablePtr,
+    Namespace *nsPtr)
+{
+    Tcl_InitCustomHashTable(&tablePtr->table,
+	    TCL_CUSTOM_TYPE_KEYS, &tclVarHashKeyType);
+    tablePtr->nsPtr = nsPtr;
+}
+
+static Tcl_HashEntry *
+AllocVarEntry(
+    Tcl_HashTable *tablePtr,	/* Hash table. */
+    VOID *keyPtr)		/* Key to store in the hash table entry. */
+{
+    Tcl_Obj *objPtr = (Tcl_Obj *) keyPtr;
+    Tcl_HashEntry *hPtr;
+    Var *varPtr;
+
+    varPtr = (Var *) ckalloc(sizeof(VarInHash));
+    varPtr->flags = VAR_IN_HASHTABLE;
+    varPtr->value.objPtr = NULL;
+    VarHashRefCount(varPtr) = 1;
+
+    hPtr = &(((VarInHash *)varPtr)->entry);
+    Tcl_SetHashValue(hPtr, varPtr);
+    hPtr->key.objPtr = objPtr;
+    Tcl_IncrRefCount(objPtr);
+
+    return hPtr;
+}
+
+static void
+FreeVarEntry(Tcl_HashEntry *hPtr)
+{
+    Var *varPtr = VarHashGetValue(hPtr);
+    Tcl_Obj *objPtr = hPtr->key.objPtr;
+
+    if (TclIsVarUndefined(varPtr) && !TclIsVarTraced(varPtr)
+	    && (VarHashRefCount(varPtr) == 1)) {
+	ckfree((char *) varPtr);
+    } else {
+	VarHashInvalidateEntry(varPtr);
+	TclSetVarUndefined(varPtr);	
+	VarHashRefCount(varPtr)--;
+    }
+    Tcl_DecrRefCount(objPtr);
+}
+
+static int
+CompareVarKeys(
+    VOID *keyPtr,		/* New key to compare. */
+    Tcl_HashEntry *hPtr)	/* Existing key to compare. */
+{
+    Tcl_Obj *objPtr1 = (Tcl_Obj *) keyPtr;
+    Tcl_Obj *objPtr2 = hPtr->key.objPtr;
+    register CONST char *p1, *p2;
+    register int l1, l2;
+
+    /*
+     * If the object pointers are the same then they match.
+     */
+
+    if (objPtr1 == objPtr2) {
+	return 1;
+    }
+
+    /*
+     * Don't use Tcl_GetStringFromObj as it would prevent l1 and l2 being
+     * in a register.
+     */
+
+    p1 = TclGetString(objPtr1);
+    l1 = objPtr1->length;
+    p2 = TclGetString(objPtr2);
+    l2 = objPtr2->length;
+
+    /*
+     * Only compare if the string representations are of the same length.
+     */
+
+    if (l1 == l2) {
+	for (;; p1++, p2++, l1--) {
+	    if (*p1 != *p2) {
+		break;
+	    }
+	    if (l1 == 0) {
+		return 1;
+	    }
+	}
+    }
+
+    return 0;
+}
+
+static unsigned int
+HashVarKey(
+    Tcl_HashTable *tablePtr,	/* Hash table. */
+    VOID *keyPtr)		/* Key from which to compute hash value. */
+{
+    Tcl_Obj *objPtr = (Tcl_Obj *) keyPtr;
+    CONST char *string = TclGetString(objPtr);
+    int length = objPtr->length;
+    unsigned int result = 0;
+    int i;
+
+    /*
+     * I tried a zillion different hash functions and asked many other people
+     * for advice. Many people had their own favorite functions, all
+     * different, but no-one had much idea why they were good ones. I chose
+     * the one below (multiply by 9 and add new character) because of the
+     * following reasons:
+     *
+     * 1. Multiplying by 10 is perfect for keys that are decimal strings, and
+     *	  multiplying by 9 is just about as good.
+     * 2. Times-9 is (shift-left-3) plus (old). This means that each
+     *	  character's bits hang around in the low-order bits of the hash value
+     *	  for ever, plus they spread fairly rapidly up to the high-order bits
+     *	  to fill out the hash value. This seems works well both for decimal
+     *	  and *non-decimal strings.
+     */
+
+    for (i=0 ; i<length ; i++) {
+	result += (result << 3) + string[i];
+    }
+    return result;
+}
+
+/*
  * Local Variables:
  * mode: c
  * c-basic-offset: 4
diff --git a/tests/set-old.test b/tests/set-old.test
index 722dbb3..69d0f19 100644
--- a/tests/set-old.test
+++ b/tests/set-old.test
@@ -13,7 +13,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: set-old.test,v 1.17 2003/03/27 21:44:05 msofer Exp $
+# RCS: @(#) $Id: set-old.test,v 1.18 2007/07/31 17:03:41 msofer Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
@@ -550,7 +550,7 @@ test set-old-8.38.6 {array command, set with non-existent namespace} {
 } {1 {can't set "bogusnamespace::var": parent namespace doesn't exist}}
 test set-old-8.38.7 {array command, set with non-existent namespace} {
     list [catch {array set bogusnamespace::var(0) {a b}} msg] $msg
-} {1 {can't set "bogusnamespace::var(0)": variable isn't array}}
+} {1 {can't set "bogusnamespace::var(0)": parent namespace doesn't exist}}
 test set-old-8.39 {array command, size option} {
     catch {unset a}
     array size a