? VarReform-showFlags.tcl
? VarReform.diff.1
? VarReform.diff.2
? VarReform.diff.2.1
? VarReform.diff.2.2
? VarReform.diff.2.3
? VarReform.diff.2.4
? VarReform.diff.2.5
? VarReform.diff.3
? VarReform.diff.3.1
? VarReform.diff.3.2
? VarReform.diff.3.3
? VarReform.diff.4.1
? VarReform.diff.4.2
? VarReform.diff.4.3
? VarReform.diff.5.1
? VarReform.diff.5.2
? VarReform.diff.5.3
? VarReform.diff.5.4
? VarReform.diff.5.5
? VarReform.diff.5.6
? VarReform.diff.7
? VarReform.diff.7.1
? VarReform.diff.7.2
? VarReform.diff.7.3
? VarReform.diff.7.4
? VarReform.diff.7.5
? VarReform.diff.7.6
? VarReform.diff.8.0
? VarReform.diff.8.1
? VarReform.diff.8.2
? VarReform.diff.8.3
? VarReform.diff.8.4
? VarReform.diff.8.5
? VarReform.diff.8.6
? VarReform.diff.8.7
? VarReform.diff.8.8
? VarReform.diff.8.9
? VarReform.diff.8.b
? VarReform.diff.9.0
? VarReform.diff.9.1
? VarReform.diff.9.2
? VarReform.diff.9.3
? VarReform_old
? lit
? generic/VarReform.descr
? generic/VarReform.txt
? generic/VarReform2.txt
? generic/tclInt.h.7.5
? generic/tclInt.h.7.6
? generic/tclInt.h.8.0
? generic/tclInt.h.NEW
? generic/tclVar.c.7.5
? generic/tclVar.c.7.6
? generic/tclVar.c.CVS
? generic/tclVar.c.MOD
? generic/tclVar.c.OK
? generic/tclVar.c.WIP2
? unix/0valgrind
? unix/ERR
? unix/dltest.marker
? unix/httpd_17847
? unix/httpd_19974
? unix/httpd_22406
? unix/httpd_23230
? unix/httpd_25368
? unix/httpd_3272
? unix/httpd_4074
? unix/searchPtr
? unix/tclsh1
? unix/tracePtr
? unix/value.objPtr
? unix/vgcore.20181
? unix/vgcore.20192
? unix/vgcore.20211
? unix/vgcore.25705
? unix/vgcore.25709
? unix/vgcore.3642
? unix/vgcore.3646
? unix/vgcore.3647
? unix/vgcore.3661
? unix/vgcore.3662
Index: generic/tcl.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tcl.h,v
retrieving revision 1.233
diff -u -r1.233 tcl.h
--- generic/tcl.h	2 Jul 2007 21:10:51 -0000	1.233
+++ generic/tcl.h	23 Jul 2007 19:14:08 -0000
@@ -870,6 +870,7 @@
     int dummy9;
     char *dummy10;
     char *dummy11;
+    char *dummy12;
 } Tcl_CallFrame;
 
 /*
Index: generic/tclBasic.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclBasic.c,v
retrieving revision 1.262
diff -u -r1.262 tclBasic.c
--- generic/tclBasic.c	29 Jun 2007 03:16:01 -0000	1.262
+++ generic/tclBasic.c	23 Jul 2007 19:14:09 -0000
@@ -302,6 +302,19 @@
     { "eq", TclSortingOpCmd,  TclCompileStreqOpCmd,   0, NULL },
     { NULL, NULL,	      NULL,		      0, NULL }
 };
+
+/*
+ * Hash key type for the interp's var trace and search tables
+ */
+
+static Tcl_HashKeyType PtrHashKeyType = {
+    TCL_HASH_KEY_TYPE_VERSION,		/* version */
+    TCL_HASH_KEY_RANDOMIZE_HASH,	/* flags */
+    NULL,				/* hashKeyProc */
+    NULL, 			        /* compareKeysProc */
+    NULL,			        /* allocEntryProc */
+    NULL 			        /* freeEntryProc */
+};
 
 /*
  *----------------------------------------------------------------------
@@ -438,6 +451,17 @@
     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_InitCustomHashTable(&iPtr->varTraces,
+	    TCL_CUSTOM_PTR_KEYS, &PtrHashKeyType);
+    Tcl_InitCustomHashTable(&iPtr->varSearches,
+	    TCL_CUSTOM_PTR_KEYS, &PtrHashKeyType);
+        
     iPtr->globalNsPtr = NULL;		/* Force creation of global ns below */
     iPtr->globalNsPtr = (Namespace *) Tcl_CreateNamespace(interp, "",
 	    (ClientData) NULL, NULL);
@@ -1332,6 +1356,10 @@
 	ckfree((char *) iPtr->lineBCPtr);
 	iPtr->lineBCPtr = NULL;
     }
+
+    Tcl_DeleteHashTable(&iPtr->varTraces);
+    Tcl_DeleteHashTable(&iPtr->varSearches);    
+    
     ckfree((char *) iPtr);
 }
 
Index: generic/tclCmdIL.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclCmdIL.c,v
retrieving revision 1.121
diff -u -r1.121 tclCmdIL.c
--- generic/tclCmdIL.c	1 Jul 2007 14:49:43 -0000	1.121
+++ generic/tclCmdIL.c	23 Jul 2007 19:14:11 -0000
@@ -97,8 +97,6 @@
  * 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 @@
 			    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 @@
 			    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 @@
 			    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 @@
     {"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 @@
     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 @@
 /*
  *----------------------------------------------------------------------
  *
- * 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 @@
 /*
  *----------------------------------------------------------------------
  *
- * 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 @@
 /*
  *----------------------------------------------------------------------
  *
- * 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
Index: generic/tclCompCmds.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclCompCmds.c,v
retrieving revision 1.113
diff -u -r1.113 tclCompCmds.c
--- generic/tclCompCmds.c	11 Jul 2007 21:27:28 -0000	1.113
+++ generic/tclCompCmds.c	23 Jul 2007 19:14:12 -0000
@@ -403,8 +403,7 @@
 	    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 @@
 		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 @@
 	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 @@
 	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 @@
 	    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 @@
 	 * 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 @@
 	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 @@
 		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 @@
 	}
 	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 @@
 	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 @@
 	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 @@
     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 @@
 	    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 @@
 	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 @@
 
 	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 @@
 
     localIndex = TclFindCompiledLocal(tailName, len,
 	    /*create*/ TCL_CREATE_VAR,
-	    /*flags*/  0,
 	    envPtr->procPtr);
     Tcl_DecrRefCount(tailPtr);
     return localIndex;
Index: generic/tclCompile.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclCompile.c,v
retrieving revision 1.124
diff -u -r1.124 tclCompile.c
--- generic/tclCompile.c	11 Jul 2007 21:27:28 -0000	1.124
+++ generic/tclCompile.c	23 Jul 2007 19:14:12 -0000
@@ -724,8 +724,9 @@
      * 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 @@
 	}
     }
 
+    if (codePtr->localCachePtr && (--codePtr->localCachePtr->refCount == 0)) {
+	TclFreeLocalCache(interp, codePtr->localCachePtr);
+    }
+
     TclHandleRelease(codePtr->interpHandle);
     ckfree((char *) codePtr);
 }
@@ -1657,7 +1662,7 @@
 	    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 @@
     Tcl_SetHashValue(Tcl_CreateHashEntry(iPtr->lineBCPtr, (char *) codePtr,
 	    &new), envPtr->extCmdMapPtr);
     envPtr->extCmdMapPtr = NULL;
+
+    codePtr->localCachePtr = NULL;
 }
 
 /*
@@ -2101,9 +2108,6 @@
     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 @@
 	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 @@
 	    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" : "",
Index: generic/tclCompile.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclCompile.h,v
retrieving revision 1.74
diff -u -r1.74 tclCompile.h
--- generic/tclCompile.h	21 Jun 2007 12:43:18 -0000	1.74
+++ generic/tclCompile.h	23 Jul 2007 19:14:12 -0000
@@ -416,6 +416,9 @@
 				 * 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	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 @@
 			    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,
Index: generic/tclExecute.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclExecute.c,v
retrieving revision 1.305
diff -u -r1.305 tclExecute.c
--- generic/tclExecute.c	28 Jun 2007 21:24:56 -0000	1.305
+++ generic/tclExecute.c	23 Jul 2007 19:14:13 -0000
@@ -177,6 +177,27 @@
 #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
@@ -410,6 +431,7 @@
     NULL, NULL, NULL, NULL
 };
 
+
 /*
  * Declarations for local procedures to this file:
  */
@@ -597,6 +619,7 @@
 
     TclDecrRefCount(eePtr->constants[0]);
     TclDecrRefCount(eePtr->constants[1]);
+
     ckfree((char *) eePtr);
 }
 
@@ -2256,14 +2279,13 @@
      */
     {
 	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;
 	}
@@ -2280,13 +2302,12 @@
 	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;
 	}
@@ -2303,30 +2324,71 @@
 	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.
 		 */
@@ -2335,6 +2397,7 @@
 		NEXT_INST_V(1, cleanup, 1);
 	    }
 	    pcAdjustment = 1;
+	    opnd = -1;
 	    goto doCallPtrGetVar;
 	} else {
 	    TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
@@ -2342,57 +2405,6 @@
 	    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
@@ -2400,8 +2412,8 @@
 	 */
 
 	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)));
@@ -2429,64 +2441,143 @@
 
     {
 	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))));
@@ -2520,40 +2611,28 @@
 	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))));
@@ -2586,79 +2665,36 @@
 	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;
 	}
     }
 
@@ -2685,7 +2721,7 @@
 	Tcl_WideInt w;
 #endif
 	long i;
-	char *part1, *part2;
+	Tcl_Obj *part1Ptr, *part2Ptr;
 	Var *varPtr, *arrayPtr;
 
     case INST_INCR_SCALAR1:
@@ -2718,21 +2754,21 @@
     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,
@@ -2751,16 +2787,16 @@
 	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 {
@@ -2780,7 +2816,7 @@
 	    varPtr = varPtr->value.linkPtr;
 	}
 
-	if (TclIsVarDirectReadable(varPtr)) {
+	if (TclIsVarDirectModifyable(varPtr)) {
 	    ClientData ptr;
 	    int type;
 
@@ -2898,18 +2934,16 @@
 
     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 */
@@ -2931,7 +2965,7 @@
 	} 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) {
@@ -2973,7 +3007,7 @@
 
 		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;
@@ -2988,7 +3022,7 @@
 
     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) {
@@ -2996,10 +3030,7 @@
 	     * Do the [variable] magic
 	     */
 
-	    if (!TclIsVarNamespaceVar(otherPtr)) {
-		TclSetVarNamespaceVar(otherPtr);
-		otherPtr->refCount++;
-	    }
+	    TclSetVarNamespaceVar(otherPtr);
 	    result = TCL_OK;
 	    goto doLinkVars;
 	}
@@ -3020,7 +3051,7 @@
 
 		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;
@@ -3051,7 +3082,7 @@
 
 	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 */
@@ -3059,17 +3090,20 @@
 		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;
 	    }
@@ -5681,8 +5715,6 @@
 	} else {
 	    TclSetLongObj(oldValuePtr, -1);
 	}
-	TclSetVarScalar(iterVarPtr);
-	TclClearVarUndefined(iterVarPtr);
 	TRACE(("%u => loop iter count temp %d\n", opnd, iterTmpIndex));
 
 #ifndef TCL_COMPILE_DEBUG
@@ -5712,7 +5744,6 @@
 	int iterNum, listTmpIndex, listLen, numVars;
 	int varIndex, valIndex, continueLoop, j;
 	long i;
-	char *part1;
 
 	opnd = TclGetUInt4AtPtr(pc+1);
 	infoPtr = (ForeachInfo *) codePtr->auxDataArrayPtr[opnd].clientData;
@@ -5782,7 +5813,6 @@
 
 		    varIndex = varListPtr->varIndexes[j];
 		    varPtr = &(compiledLocals[varIndex]);
-		    part1 = varPtr->name;
 		    while (TclIsVarLink(varPtr)) {
 			varPtr = varPtr->value.linkPtr;
 		    }
@@ -5791,17 +5821,14 @@
 			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((
@@ -5887,7 +5914,6 @@
 	int opnd, opnd2, allocateDict;
 	Tcl_Obj *dictPtr, *valPtr;
 	Var *varPtr;
-	char *part1;
 
     case INST_DICT_GET:
 	opnd = TclGetUInt4AtPtr(pc+1);
@@ -5932,7 +5958,6 @@
 	opnd2 = TclGetUInt4AtPtr(pc+5);
 
 	varPtr = &(compiledLocals[opnd2]);
-	part1 = varPtr->name;
 	while (TclIsVarLink(varPtr)) {
 	    varPtr = varPtr->value.linkPtr;
 	}
@@ -5941,7 +5966,7 @@
 	    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) {
@@ -6010,9 +6035,6 @@
 		Tcl_IncrRefCount(dictPtr);
 		if (oldValuePtr != NULL) {
 		    Tcl_DecrRefCount(oldValuePtr);
-		} else {
-		    TclSetVarScalar(varPtr);
-		    TclClearVarUndefined(varPtr);
 		}
 		varPtr->value.objPtr = dictPtr;
 	    }
@@ -6020,8 +6042,8 @@
 	} 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) {
@@ -6045,7 +6067,6 @@
 	cleanup = 2;
 
 	varPtr = &(compiledLocals[opnd]);
-	part1 = varPtr->name;
 	while (TclIsVarLink(varPtr)) {
 	    varPtr = varPtr->value.linkPtr;
 	}
@@ -6054,7 +6075,7 @@
 	    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) {
@@ -6132,9 +6153,6 @@
 		Tcl_IncrRefCount(dictPtr);
 		if (oldValuePtr != NULL) {
 		    Tcl_DecrRefCount(oldValuePtr);
-		} else {
-		    TclSetVarScalar(varPtr);
-		    TclClearVarUndefined(varPtr);
 		}
 		varPtr->value.objPtr = dictPtr;
 	    }
@@ -6142,8 +6160,8 @@
 	} 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) {
@@ -6184,14 +6202,13 @@
 	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);
@@ -6261,14 +6278,12 @@
 	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;
 	}
@@ -6277,8 +6292,8 @@
 	    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;
@@ -6299,15 +6314,17 @@
 		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;
@@ -6323,7 +6340,6 @@
 	opnd2 = TclGetUInt4AtPtr(pc+5);
 	varPtr = &(compiledLocals[opnd]);
 	duiPtr = codePtr->auxDataArrayPtr[opnd2].clientData;
-	part1 = varPtr->name;
 	while (TclIsVarLink(varPtr)) {
 	    varPtr = varPtr->value.linkPtr;
 	}
@@ -6332,7 +6348,7 @@
 	    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) {
@@ -6352,10 +6368,8 @@
 	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;
 	    }
@@ -6363,7 +6377,8 @@
 		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) {
@@ -6378,8 +6393,8 @@
 	    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) {
Index: generic/tclHash.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclHash.c,v
retrieving revision 1.31
diff -u -r1.31 tclHash.c
--- generic/tclHash.c	2 Jul 2007 21:10:52 -0000	1.31
+++ generic/tclHash.c	23 Jul 2007 19:14:13 -0000
@@ -343,6 +343,7 @@
     } else {
 	hPtr = (Tcl_HashEntry *) ckalloc((unsigned) sizeof(Tcl_HashEntry));
 	hPtr->key.oneWordValue = (char *) key;
+	hPtr->clientData = 0;
     }
 
     hPtr->tablePtr = tablePtr;
@@ -355,7 +356,6 @@
     hPtr->nextPtr = *hPtr->bucketPtr;
     *hPtr->bucketPtr = hPtr;
 #endif
-    hPtr->clientData = 0;
     tablePtr->numEntries++;
 
     /*
Index: generic/tclInt.decls
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclInt.decls,v
retrieving revision 1.110
diff -u -r1.110 tclInt.decls
--- generic/tclInt.decls	20 Jun 2007 18:46:13 -0000	1.110
+++ generic/tclInt.decls	23 Jul 2007 19:14:13 -0000
@@ -73,7 +73,7 @@
     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 {
Index: generic/tclInt.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclInt.h,v
retrieving revision 1.323
diff -u -r1.323 tclInt.h
--- generic/tclInt.h	2 Jul 2007 17:32:09 -0000	1.323
+++ generic/tclInt.h	23 Jul 2007 19:14:14 -0000
@@ -191,6 +191,19 @@
 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 @@
 				 * 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 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 @@
 				 * "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.
- *
- * 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.
+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_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 @@
  *				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 @@
  *				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 @@
  *				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 @@
  */
 
 #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 @@
     (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 @@
  */
 
 #define TclIsVarScalar(varPtr) \
-    ((varPtr)->flags & VAR_SCALAR)
+    !((varPtr)->flags & (VAR_ARRAY|VAR_LINK))
 
 #define TclIsVarLink(varPtr) \
     ((varPtr)->flags & VAR_LINK)
@@ -682,7 +722,7 @@
     ((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 @@
 #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 @@
  * 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 @@
 				 * 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 @@
 				 * 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 @@
     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.
      */
@@ -2296,6 +2388,12 @@
 			    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);
@@ -2307,6 +2405,8 @@
 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);
@@ -2338,9 +2438,14 @@
 			    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,
@@ -2903,25 +3008,43 @@
  * 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.
Index: generic/tclIntDecls.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclIntDecls.h,v
retrieving revision 1.101
diff -u -r1.101 tclIntDecls.h
--- generic/tclIntDecls.h	20 Jun 2007 18:46:13 -0000	1.101
+++ generic/tclIntDecls.h	23 Jul 2007 19:14:14 -0000
@@ -123,7 +123,7 @@
 #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 @@
 #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;
Index: generic/tclLiteral.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclLiteral.c,v
retrieving revision 1.30
diff -u -r1.30 tclLiteral.c
--- generic/tclLiteral.c	21 Mar 2007 16:25:28 -0000	1.30
+++ generic/tclLiteral.c	23 Jul 2007 19:14:14 -0000
@@ -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 @@
 /*
  *----------------------------------------------------------------------
  *
- * 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 @@
  *----------------------------------------------------------------------
  */
 
-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 @@
 		|| ((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 @@
 
     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 @@
     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 @@
     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 @@
  *	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 @@
 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 @@
     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 @@
 	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);
 	}
Index: generic/tclNamesp.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclNamesp.c,v
retrieving revision 1.146
diff -u -r1.146 tclNamesp.c
--- generic/tclNamesp.c	5 Jul 2007 12:03:27 -0000	1.146
+++ generic/tclNamesp.c	23 Jul 2007 19:14:16 -0000
@@ -404,7 +404,8 @@
     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 @@
     }
     if (framePtr->numCompiledLocals > 0) {
 	TclDeleteCompiledLocalVars(iPtr, framePtr);
+	if (--framePtr->localCachePtr->refCount == 0) {
+	    TclFreeLocalCache(interp, framePtr->localCachePtr);
+	}
+	framePtr->localCachePtr = NULL;
     }
 
     /*
@@ -725,7 +730,7 @@
     Tcl_DString *namePtr, *buffPtr;
     int newEntry, nameLen;
     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
-
+    
     /*
      * If there is no active namespace, the interpreter is being initialized.
      */
@@ -793,7 +798,7 @@
     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 @@
      */
 
     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_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 @@
      * 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 @@
 
 	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 @@
 
 	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 @@
 				 * to free */
 {
     register ResolvedNsName *resNamePtr = (ResolvedNsName *)
-	    objPtr->internalRep.otherValuePtr;
+	    objPtr->internalRep.twoPtrValue.ptr1;
     Namespace *nsPtr;
 
     /*
@@ -4775,9 +4657,9 @@
     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 @@
 
     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 @@
 	    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 @@
 	}
     } else {
 	TclFreeIntRep(objPtr);
-	objPtr->internalRep.otherValuePtr = (void *) NULL;
+	objPtr->internalRep.twoPtrValue.ptr1 = (void *) NULL;
 	objPtr->typePtr = &tclNsNameType;
     }
     return TCL_OK;
@@ -6994,27 +6876,32 @@
 	    ? "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);
+	}
     }
 }
 
Index: generic/tclObj.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclObj.c,v
retrieving revision 1.130
diff -u -r1.130 tclObj.c
--- generic/tclObj.c	5 Jul 2007 12:03:27 -0000	1.130
+++ generic/tclObj.c	23 Jul 2007 19:14:16 -0000
@@ -3288,7 +3288,8 @@
     hPtr = (Tcl_HashEntry *) ckalloc((unsigned) (sizeof(Tcl_HashEntry)));
     hPtr->key.oneWordValue = (char *) objPtr;
     Tcl_IncrRefCount(objPtr);
-
+    hPtr->clientData = NULL;
+    
     return hPtr;
 }
 
Index: generic/tclProc.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclProc.c,v
retrieving revision 1.125
diff -u -r1.125 tclProc.c
--- generic/tclProc.c	20 Jun 2007 18:46:14 -0000	1.125
+++ generic/tclProc.c	23 Jul 2007 19:14:16 -0000
@@ -27,13 +27,15 @@
 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 @@
 	     * 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 @@
 	    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 @@
  */
 
 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 @@
 #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 @@
 /*
  *----------------------------------------------------------------------
  *
+ * 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 @@
 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 @@
 
     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 @@
 		    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 @@
 	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 @@
     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 @@
 
     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 @@
 	 * commands and/or resolver changes are considered).
 	 */
 
+	codePtr = procPtr->bodyPtr->internalRep.otherValuePtr;
  	if (((Interp *) *codePtr->interpHandle != iPtr)
 		|| (codePtr->compileEpoch != iPtr->compileEpoch)
 		|| (codePtr->nsPtr != nsPtr)
@@ -1494,7 +1585,7 @@
     framePtr->objc = objc;
     framePtr->objv = objv;
     framePtr->procPtr = procPtr;
-
+    
     return TCL_OK;
 }
 
@@ -1602,7 +1693,7 @@
 	result = TCL_ERROR;
     } else {
 	register ByteCode *codePtr =
-		procPtr->bodyPtr->internalRep.otherValuePtr;
+	    procPtr->bodyPtr->internalRep.otherValuePtr;
 
 	codePtr->refCount++;
 	result = TclExecuteByteCode(interp, codePtr);
Index: generic/tclThreadStorage.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclThreadStorage.c,v
retrieving revision 1.12
diff -u -r1.12 tclThreadStorage.c
--- generic/tclThreadStorage.c	13 Nov 2006 22:39:56 -0000	1.12
+++ generic/tclThreadStorage.c	23 Jul 2007 19:14:16 -0000
@@ -136,7 +136,8 @@
 
     hPtr = (Tcl_HashEntry *) TclpSysAlloc(sizeof(Tcl_HashEntry), 0);
     hPtr->key.oneWordValue = keyPtr;
-
+    hPtr->clientData = NULL;
+    
     return hPtr;
 }
 
Index: generic/tclTrace.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclTrace.c,v
retrieving revision 1.41
diff -u -r1.41 tclTrace.c
--- generic/tclTrace.c	28 Jun 2007 21:10:38 -0000	1.41
+++ generic/tclTrace.c	23 Jul 2007 19:14:23 -0000
@@ -2441,8 +2441,8 @@
 	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);
     }
@@ -2484,6 +2484,34 @@
  */
 
 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
@@ -2508,7 +2536,9 @@
     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.
@@ -2518,9 +2548,11 @@
 	return code;
     }
     TclSetVarTraceActive(varPtr);
-    varPtr->refCount++;
-    if (arrayPtr != NULL) {
-	arrayPtr->refCount++;
+    if (TclIsVarInHash(varPtr)) {
+	VarHashRefCount(varPtr)++;
+    }
+    if (arrayPtr && TclIsVarInHash(arrayPtr)) {
+	VarHashRefCount(arrayPtr)++;
     }
 
     /*
@@ -2572,10 +2604,12 @@
     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;
@@ -2616,36 +2650,40 @@
 	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;
 	}
     }
 
@@ -2718,14 +2756,16 @@
 	}
     }
 
-    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;
@@ -2827,11 +2867,12 @@
     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
@@ -2856,15 +2897,19 @@
     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;
     }
 
     /*
@@ -2879,19 +2924,32 @@
 	    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);
     }
 }
@@ -2968,8 +3026,10 @@
 				 * 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,
@@ -2982,19 +3042,25 @@
      * 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;
@@ -3016,6 +3082,7 @@
  *	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.
  *
  *----------------------------------------------------------------------
  */
@@ -3053,7 +3120,7 @@
  *	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.
  *
  *----------------------------------------------------------------------
  */
@@ -3126,8 +3193,11 @@
 				 * 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
@@ -3164,8 +3234,18 @@
     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;
 }
 
Index: generic/tclVar.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclVar.c,v
retrieving revision 1.144
diff -u -r1.144 tclVar.c
--- generic/tclVar.c	28 Jun 2007 13:56:21 -0000	1.144
+++ generic/tclVar.c	23 Jul 2007 19:14:23 -0000
@@ -11,6 +11,7 @@
  * 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.
@@ -20,6 +21,87 @@
 
 #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.
@@ -37,7 +119,8 @@
 static const char *missingName =	"missing variable name";
 static const char *isArrayElement =
 	"name refers to an element in an array";
- 
+
+
 /*
  * A test to see if we are in a call frame that has local variables. This is
  * true if we are inside a procedure body.
@@ -49,19 +132,20 @@
  * 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 +154,8 @@
  */
 
 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 +227,69 @@
     "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 +298,8 @@
  *
  *	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 +353,17 @@
 				 * 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 +430,36 @@
 				 * 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 +471,9 @@
     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 +482,22 @@
     *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 +505,34 @@
     }
     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 +557,14 @@
 		 */
 		!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 +584,13 @@
 	 */
 
 	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 +607,8 @@
 		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 +648,14 @@
     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 +700,8 @@
     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 +710,17 @@
 	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 +784,7 @@
 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 +801,15 @@
 				 * 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 +896,12 @@
 	 * 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 +912,12 @@
 		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 +937,35 @@
     } 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 +1011,9 @@
 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 +1025,13 @@
     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 +1041,7 @@
     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 +1051,49 @@
 	 * 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 +1208,25 @@
     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 +1266,16 @@
 				 * 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 +1307,27 @@
     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 +1341,7 @@
     }
 
     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 +1349,7 @@
 	} else {
 	    msg = noSuchVar;
 	}
-	TclVarErrMsg(interp, part1, part2, "read", msg);
+	TclObjVarErrMsg(interp, part1Ptr, part2Ptr, "read", msg, index);
     }
 
     /*
@@ -1443,22 +1560,25 @@
 				 * 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 +1622,10 @@
 				 * 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 +1634,8 @@
 	return NULL;
     }
 
-    return TclPtrSetVar(interp, varPtr, arrayPtr, part1, part2,
-	    newValuePtr, flags);
+    return TclPtrSetVar(interp, varPtr, arrayPtr, part1Ptr, part2Ptr,
+	    newValuePtr, flags, -1);
 }
 
 /*
@@ -1556,18 +1671,20 @@
     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 +1694,12 @@
      * 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 +1709,9 @@
      * 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 +1722,11 @@
      * 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 +1738,22 @@
      * 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 +1765,7 @@
 		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 +1804,17 @@
 	    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 +1897,16 @@
 				 * 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 +1942,30 @@
     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 +1977,8 @@
     }
     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 +2051,23 @@
 				 * 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 +2097,7 @@
     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 +2106,8 @@
     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 +2122,11 @@
      * 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 +2134,8 @@
 
     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 +2158,10 @@
      * 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 +2189,21 @@
     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 +2216,10 @@
      *    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 +2231,67 @@
      */
 
     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);
-	}
-	
-	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);
+	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;
+	    }
 	}
-	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 +2300,28 @@
 	 * 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 +2418,6 @@
     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 +2433,8 @@
 	    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 +2446,8 @@
 	     * 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 +2485,6 @@
     Tcl_Obj *varValuePtr, *newValuePtr;
     int numElems, createdNewObj;
     Var *varPtr, *arrayPtr;
-    char *part1;
     int result;
 
     if (objc < 2) {
@@ -2409,21 +2530,24 @@
 	 * 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 +2582,8 @@
 	 * 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 +2643,6 @@
     Tcl_HashEntry *hPtr;
     Tcl_Obj *varNamePtr;
     int notArray;
-    char *varName;
     int index, result;
 
     if (objc < 3) {
@@ -2537,8 +2660,7 @@
      */
 
     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 +2668,11 @@
      * 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 +2700,7 @@
 	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 +2708,7 @@
 	    Var *varPtr2;
 
 	    if (searchPtr->nextEntry != NULL) {
-		varPtr2 = (Var *) Tcl_GetHashValue(searchPtr->nextEntry);
+		varPtr2 = VarHashGetValue(searchPtr->nextEntry);
 		if (!TclIsVarUndefined(varPtr2)) {
 		    break;
 		}
@@ -2610,14 +2732,20 @@
 	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 +2758,7 @@
     case ARRAY_NEXTELEMENT: {
 	ArraySearch *searchPtr;
 	Tcl_HashEntry *hPtr;
+	Var *varPtr2;
 
 	if (objc != 4) {
 	    Tcl_WrongNumArgs(interp, 2, objv, "arrayName searchId");
@@ -2638,13 +2767,11 @@
 	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 +2781,19 @@
 	    } 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 +2803,25 @@
 	    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 +2858,34 @@
 	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 +2897,23 @@
 	 * 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 +2921,7 @@
 		 * 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 +2938,17 @@
 		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 +2986,10 @@
 	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 +2998,13 @@
 	    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 +3026,8 @@
 		}
 	    }
 
-	    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 +3045,6 @@
 	Tcl_HashSearch search;
 	Var *varPtr2;
 	char *pattern = NULL;
-	char *name;
 
 	if ((objc != 3) && (objc != 4)) {
 	    Tcl_WrongNumArgs(interp, 2, objv, "arrayName ?pattern?");
@@ -2934,22 +3064,22 @@
 	} 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 +3105,8 @@
 	 */
 
 	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 +3124,7 @@
 	    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 +3138,7 @@
     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 +3168,19 @@
 				 * 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 +3217,15 @@
 		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 +3261,12 @@
 
 	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 +3282,7 @@
 
   ensureArray:
     if (varPtr != NULL) {
-	if (!TclIsVarUndefined(varPtr) && TclIsVarArray(varPtr)) {
+	if (TclIsVarArray(varPtr)) {
 	    /*
 	     * Already an array, done.
 	     */
@@ -3174,15 +3294,14 @@
 	     * 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 +3335,7 @@
     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 +3378,21 @@
      */
 
     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 +3427,48 @@
     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 +3477,7 @@
 	 * (and must remain consistent) with the code in TclObjLookupVar().
 	 */
 
+	myName = TclGetString(myNamePtr);
 	p = strstr(myName, "(");
 	if (p != NULL) {
 	    p += strlen(p)-1;
@@ -3350,10 +3502,10 @@
 	 *   - 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 +3516,7 @@
 	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 +3533,11 @@
 	    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 +3546,10 @@
 	}
     }
     TclSetVarLink(varPtr);
-    TclClearVarUndefined(varPtr);
     varPtr->value.linkPtr = otherPtr;
-    otherPtr->refCount++;
+    if (TclIsVarInHash(otherPtr)) {
+	VarHashRefCount(otherPtr)++;
+    }
     return TCL_OK;
 }
 
@@ -3469,7 +3624,7 @@
 {
     int result;
     CallFrame *framePtr;
-    Tcl_Obj *part1Ptr;
+    Tcl_Obj *part1Ptr, *localNamePtr;
 
     if (TclGetFrame(interp, frameName, &framePtr) == -1) {
 	return TCL_ERROR;
@@ -3477,10 +3632,13 @@
 
     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 +3671,35 @@
 {
     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 +3730,7 @@
     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 +3772,24 @@
 	    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 +3843,7 @@
     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 +3858,7 @@
 
 	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 +3868,7 @@
 	     * 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 +3882,7 @@
 	 * 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 +3892,8 @@
 	 */
 
 	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 +3926,21 @@
 	     * 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 +3975,6 @@
     Tcl_Obj *const objv[])	/* Argument objects. */
 {
     CallFrame *framePtr;
-    char *localName;
     int result;
 
     if (objc < 3) {
@@ -3819,9 +4006,8 @@
      */
 
     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 +4018,6 @@
 /*
  *----------------------------------------------------------------------
  *
- * 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 +4107,19 @@
 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 +4162,15 @@
      * 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 +4197,23 @@
 
 static void
 DeleteSearches(
+    Interp *iPtr,
     register Var *arrayVarPtr)	/* Variable whose searches are to be
 				 * deleted. */
 {
-    ArraySearch *searchPtr;
+    ArraySearch *searchPtr, *nextPtr;
+    Tcl_HashEntry *sPtr;
 
-    while (arrayVarPtr->searchPtr != NULL) {
-	searchPtr = arrayVarPtr->searchPtr;
-	arrayVarPtr->searchPtr = searchPtr->nextPtr;
-	ckfree((char *) searchPtr);
-    }
+    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 +4238,12 @@
 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 +4255,33 @@
 	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 +4307,11 @@
 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 +4327,17 @@
 	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 +4370,13 @@
 {
     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 +4404,7 @@
 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 +4412,51 @@
 				 * 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);
-	    }
-	    
-	    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;
+	    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);
+	    }
+	    tPtr = Tcl_FindHashEntry(&iPtr->varTraces, (char *) elPtr);
+	    tracePtr = (VarTrace *) Tcl_GetHashValue(tPtr);
+	    while (tracePtr) {
+		VarTrace *prevPtr = tracePtr;
 
-		elPtr->tracePtr = tracePtr->nextPtr;
-		Tcl_EventuallyFree((ClientData) tracePtr, TCL_DYNAMIC);
+		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 +4465,6 @@
 	    }
 	}
 	TclSetVarUndefined(elPtr);
-	TclSetVarScalar(elPtr);
 
 	/*
 	 * Even though array elements are not supposed to be namespace
@@ -4374,73 +4473,16 @@
 	 * 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 */
-	}
+	TclClearVarNamespaceVar(elPtr);
     }
-    if (arrayNamePtr) {
-	Tcl_DecrRefCount(arrayNamePtr);
-    }
-    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 +4501,49 @@
 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 +4609,11 @@
 {
     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 +4627,9 @@
 
     dupPtr->internalRep.twoPtrValue.ptr1 = nsPtr;
     dupPtr->internalRep.twoPtrValue.ptr2 = varPtr;
-    varPtr->refCount++;
+    if (TclIsVarInHash(varPtr)) {
+	varPtr->refCount++;
+    }
     dupPtr->typePtr = &tclNsVarNameType;
 }
 #endif
@@ -4636,6 +4715,701 @@
 }
 
 /*
+ *----------------------------------------------------------------------
+ *
+ * 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
Index: tests/set-old.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/set-old.test,v
retrieving revision 1.17
diff -u -r1.17 set-old.test
--- tests/set-old.test	27 Mar 2003 21:44:05 -0000	1.17
+++ tests/set-old.test	23 Jul 2007 19:14:37 -0000
@@ -550,7 +550,7 @@
 } {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
