refactored varname pushing code and some of the bytecode instructions dev_hobbs_branch

10 files changed, 417 insertions, 780 deletions

diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 83439f1..a15177b 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -12,7 +12,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclBasic.c,v 1.31.2.1 2001/05/11 20:47:44 hobbs Exp $
+ * RCS: @(#) $Id: tclBasic.c,v 1.31.2.2 2001/05/15 20:07:38 hobbs Exp $
  */
 
 #include "tclInt.h"
@@ -65,7 +65,7 @@ static CmdInfo builtInCmds[] = {
      */
 
     {"append",		(Tcl_CmdProc *) NULL,	Tcl_AppendObjCmd,
-        (CompileProc *) TclCompileAppendCmd,		1},
+	TclCompileAppendCmd,		1},
     {"array",		(Tcl_CmdProc *) NULL,	Tcl_ArrayObjCmd,
         (CompileProc *) NULL,		1},
     {"binary",		(Tcl_CmdProc *) NULL,	Tcl_BinaryObjCmd,
@@ -113,15 +113,15 @@ static CmdInfo builtInCmds[] = {
     {"join",		(Tcl_CmdProc *) NULL,	Tcl_JoinObjCmd,
         (CompileProc *) NULL,		1},
     {"lappend",		(Tcl_CmdProc *) NULL,	Tcl_LappendObjCmd,
-        (CompileProc *) TclCompileLappendCmd,		1},
+        TclCompileLappendCmd,		1},
     {"lindex",		(Tcl_CmdProc *) NULL,	Tcl_LindexObjCmd,
-        (CompileProc *) TclCompileLindexCmd,		1},
+        TclCompileLindexCmd,		1},
     {"linsert",		(Tcl_CmdProc *) NULL,	Tcl_LinsertObjCmd,
         (CompileProc *) NULL,		1},
     {"list",		(Tcl_CmdProc *) NULL,	Tcl_ListObjCmd,
         (CompileProc *) NULL,		1},
     {"llength",		(Tcl_CmdProc *) NULL,	Tcl_LlengthObjCmd,
-        (CompileProc *) TclCompileLlengthCmd,		1},
+        TclCompileLlengthCmd,		1},
     {"load",		(Tcl_CmdProc *) NULL,	Tcl_LoadObjCmd,
         (CompileProc *) NULL,		0},
     {"lrange",		(Tcl_CmdProc *) NULL,	Tcl_LrangeObjCmd,
diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index d6a898a..ba67425 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -9,7 +9,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclCompCmds.c,v 1.7.4.1 2001/05/11 20:47:44 hobbs Exp $
+ * RCS: @(#) $Id: tclCompCmds.c,v 1.7.4.2 2001/05/15 20:07:38 hobbs Exp $
  */
 
 #include "tclInt.h"
@@ -20,8 +20,14 @@
  */
 
 static ClientData	DupForeachInfo _ANSI_ARGS_((ClientData clientData));
-static void		FreeForeachInfo _ANSI_ARGS_((
-			    ClientData clientData));
+static void		FreeForeachInfo _ANSI_ARGS_((ClientData clientData));
+static int		TclPushVarName _ANSI_ARGS_((Tcl_Interp *interp,
+	Tcl_Token *varTokenPtr, CompileEnv *envPtr, int flags,
+	int *localIndexPtr, int *maxDepthPtr, int *simpleVarNamePtr,
+	int *isScalarPtr));
+
+#define TCL_CREATE_VAR		1
+#define TCL_NO_LARGE_INDEX	2
 
 /*
  * The structures below define the AuxData types defined in this file.
@@ -1318,12 +1324,9 @@ TclCompileIncrCmd(interp, parsePtr, envPtr)
     CompileEnv *envPtr;		/* Holds resulting instructions. */
 {
     Tcl_Token *varTokenPtr, *incrTokenPtr;
-    Tcl_Parse elemParse;
-    int gotElemParse = 0;
-    char *name, *elName, *p;
-    int nameChars, elNameChars, haveImmValue, immValue, localIndex, i, code;
+    int simpleVarName, isScalar, localIndex, haveImmValue, immValue;
     int maxDepth = 0;
-    char buffer[160];
+    int code = TCL_OK;
 
     envPtr->maxStackDepth = 0;
     if ((parsePtr->numWords != 2) && (parsePtr->numWords != 3)) {
@@ -1332,105 +1335,16 @@ TclCompileIncrCmd(interp, parsePtr, envPtr)
 	        "wrong # args: should be \"incr varName ?increment?\"", -1);
 	return TCL_ERROR;
     }
-    
-    name = NULL;
-    elName = NULL;
-    elNameChars = 0;
-    localIndex = -1;
-    code = TCL_OK;
 
     varTokenPtr = parsePtr->tokenPtr
 	    + (parsePtr->tokenPtr->numComponents + 1);
-    /*
-     * Check not only that the type is TCL_TOKEN_SIMPLE_WORD, but whether
-     * curly braces surround the variable name.
-     * This really matters for array elements to handle things like
-     *    set {x($foo)} 5
-     * which raises an undefined var error if we are not careful here.
-     * This goes with the hack in TclCompileSetCmd.
-     */
-    if ((varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) &&
-	    (varTokenPtr->start[0] != '{')) {
-	/*
-	 * A simple variable name. Divide it up into "name" and "elName"
-	 * strings. If it is not a local variable, look it up at runtime.
-	 */
-	
-	name = varTokenPtr[1].start;
-	nameChars = varTokenPtr[1].size;
-	for (i = 0, p = name;  i < nameChars;  i++, p++) {
-	    if (*p == '(') {
-		char *openParen = p;
-		p = (name + nameChars-1);	
-		if (*p == ')') { /* last char is ')' => array reference */
-		    nameChars = (openParen - name);
-		    elName = openParen+1;
-		    elNameChars = (p - elName);
-		}
-		break;
-	    }
-	}
-	if (envPtr->procPtr != NULL) {
-	    localIndex = TclFindCompiledLocal(name, nameChars,
-	            /*create*/ 0, /*flags*/ 0, envPtr->procPtr);
-	    if (localIndex > 255) {	      /* we'll push the name */
-		localIndex = -1;
-	    }
-	}
-	if (localIndex < 0) {
-	    TclEmitPush(TclRegisterLiteral(envPtr, name, nameChars,
-			/*onHeap*/ 0), envPtr);
-	    maxDepth = 1;
-	}
 
-	/*
-	 * Compile the element script, if any.
-	 */
-	
-	if (elName != NULL) {
-	    /*
-	     * Temporarily replace the '(' and ')' by '"'s.
-	     */
-	    
-	    *(elName-1) = '"';
-	    *(elName+elNameChars) = '"';
-	    code = Tcl_ParseCommand(interp, elName-1, elNameChars+2,
-                    /*nested*/ 0, &elemParse);
-	    *(elName-1) = '(';
-	    *(elName+elNameChars) = ')';
-	    gotElemParse = 1;
-	    if ((code != TCL_OK) || (elemParse.numWords > 1)) {
-		sprintf(buffer, "\n    (parsing index for array \"%.*s\")",
-			TclMin(nameChars, 100), name);
-		Tcl_AddObjErrorInfo(interp, buffer, -1);
-		code = TCL_ERROR;
-		goto done;
-	    } else if (elemParse.numWords == 1) {
-		code = TclCompileTokens(interp, elemParse.tokenPtr+1,
-                        elemParse.tokenPtr->numComponents, envPtr);
-		if (code != TCL_OK) {
-		    goto done;
-		}
-		maxDepth += envPtr->maxStackDepth;
-	    } else {
-		TclEmitPush(TclRegisterLiteral(envPtr, "", 0,
-                        /*alreadyAlloced*/ 0), envPtr);
-		maxDepth += 1;
-	    }
-	}
-    } else {
-	/*
-	 * Not a simple variable name. Look it up at runtime.
-	 */
-	
-	code = TclCompileTokens(interp, varTokenPtr+1,
-	        varTokenPtr->numComponents, envPtr);
-	if (code != TCL_OK) {
-	    goto done;
-	}
-	maxDepth = envPtr->maxStackDepth;
+    code = TclPushVarName(interp, varTokenPtr, envPtr, TCL_NO_LARGE_INDEX,
+	    &localIndex, &maxDepth, &simpleVarName, &isScalar);
+    if (code != TCL_OK) {
+	goto done;
     }
-    
+
     /*
      * If an increment is given, push it, but see first if it's a small
      * integer.
@@ -1488,20 +1402,18 @@ TclCompileIncrCmd(interp, parsePtr, envPtr)
      * Emit the instruction to increment the variable.
      */
 
-    if (name != NULL) {
-	if (elName == NULL) {
+    if (simpleVarName) {
+	if (isScalar) {
 	    if (localIndex >= 0) {
 		if (haveImmValue) {
-		    TclEmitInstInt1(INST_INCR_SCALAR1_IMM, localIndex,
-				    envPtr);
+		    TclEmitInstInt1(INST_INCR_SCALAR1_IMM, localIndex, envPtr);
 		    TclEmitInt1(immValue, envPtr);
 		} else {
 		    TclEmitInstInt1(INST_INCR_SCALAR1, localIndex, envPtr);
 		}
 	    } else {
 		if (haveImmValue) {
-		    TclEmitInstInt1(INST_INCR_SCALAR_STK_IMM, immValue,
-				   envPtr);
+		    TclEmitInstInt1(INST_INCR_SCALAR_STK_IMM, immValue, envPtr);
 		} else {
 		    TclEmitOpcode(INST_INCR_SCALAR_STK, envPtr);
 		}
@@ -1509,16 +1421,14 @@ TclCompileIncrCmd(interp, parsePtr, envPtr)
 	} else {
 	    if (localIndex >= 0) {
 		if (haveImmValue) {
-		    TclEmitInstInt1(INST_INCR_ARRAY1_IMM, localIndex,
-				    envPtr);
+		    TclEmitInstInt1(INST_INCR_ARRAY1_IMM, localIndex, envPtr);
 		    TclEmitInt1(immValue, envPtr);
 		} else {
 		    TclEmitInstInt1(INST_INCR_ARRAY1, localIndex, envPtr);
 		}
 	    } else {
 		if (haveImmValue) {
-		    TclEmitInstInt1(INST_INCR_ARRAY_STK_IMM, immValue,
-				   envPtr);
+		    TclEmitInstInt1(INST_INCR_ARRAY_STK_IMM, immValue, envPtr);
 		} else {
 		    TclEmitOpcode(INST_INCR_ARRAY_STK, envPtr);
 		}
@@ -1533,9 +1443,6 @@ TclCompileIncrCmd(interp, parsePtr, envPtr)
     }
 	
     done:
-    if (gotElemParse) {
-        Tcl_FreeParse(&elemParse);
-    }
     envPtr->maxStackDepth = maxDepth;
     return code;
 }
@@ -1679,13 +1586,7 @@ TclCompileSetCmd(interp, parsePtr, envPtr)
     CompileEnv *envPtr;		/* Holds resulting instructions. */
 {
     Tcl_Token *varTokenPtr, *valueTokenPtr;
-    Tcl_Parse elemParse;
-    int gotElemParse = 0;
-    register char *p;
-    char *name, *elName;
-    int nameChars, elNameChars;
-    register int i, n;
-    int isAssignment, simpleVarName, localIndex, numWords;
+    int isAssignment, isScalar, simpleVarName, localIndex, numWords;
     int maxDepth = 0;
     int code = TCL_OK;
 
@@ -1707,174 +1608,20 @@ TclCompileSetCmd(interp, parsePtr, envPtr)
      * namespace qualifiers. 
      */
 
-    simpleVarName = 0;
-    name = elName = NULL;
-    nameChars = elNameChars = 0;
-    localIndex = -1;
-
     varTokenPtr = parsePtr->tokenPtr
 	    + (parsePtr->tokenPtr->numComponents + 1);
-    /*
-     * Check not only that the type is TCL_TOKEN_SIMPLE_WORD, but whether
-     * curly braces surround the variable name.
-     * This really matters for array elements to handle things like
-     *    set {x($foo)} 5
-     * which raises an undefined var error if we are not careful here.
-     * This goes with the hack in TclCompileIncrCmd.
-     */
-    if ((varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) &&
-	    (varTokenPtr->start[0] != '{')) {
-	simpleVarName = 1;
-
-	name = varTokenPtr[1].start;
-	nameChars = varTokenPtr[1].size;
-	/* last char is ')' => potential array reference */
-	if ( *(name + nameChars - 1) == ')') {
-	    for (i = 0, p = name;  i < nameChars;  i++, p++) {
-		if (*p == '(') {
-		    elName = p + 1;
-		    elNameChars = nameChars - i - 2;
-		    nameChars = i ;
-		    break;
-		}
-	    }
-	}
-
-	/*
-	 * If elName contains any double quotes ("), we can't inline
-	 * compile the element script using the replace '()' by '"'
-	 * technique below.
-	 */
-
-	for (i = 0, p = elName;  i < elNameChars;  i++, p++) {
-	    if (*p == '"') {
-		simpleVarName = 0;
-		break;
-	    }
-	}
-    } else if (((n = varTokenPtr->numComponents) > 1)
-	    && (varTokenPtr[1].type == TCL_TOKEN_TEXT)
-            && (varTokenPtr[n].type == TCL_TOKEN_TEXT)
-            && (varTokenPtr[n].start[varTokenPtr[n].size - 1] == ')')) {
-        simpleVarName = 0;
-
-        /*
-	 * Check for parentheses inside first token
-	 */
-        for (i = 0, p = varTokenPtr[1].start; 
-	     i < varTokenPtr[1].size; i++, p++) {
-            if (*p == '(') {
-                simpleVarName = 1;
-                break;
-            }
-        }
-        if (simpleVarName) {
-            name = varTokenPtr[1].start;
-            nameChars = p - varTokenPtr[1].start;
-            elName = p + 1;
-            elNameChars = (varTokenPtr[n].start - p) + varTokenPtr[n].size - 2;
 
-            /*
-             * If elName contains any double quotes ("), we can't inline
-             * compile the element script using the replace '()' by '"'
-             * technique below.
-             */
-
-            for (i = 0, p = elName;  i < elNameChars;  i++, p++) {
-                if (*p == '"') {
-                    simpleVarName = 0;
-                    break;
-                }
-            }
-        }
+    code = TclPushVarName(interp, varTokenPtr, envPtr,
+	    isAssignment ? TCL_CREATE_VAR : 0,
+	    &localIndex, &maxDepth, &simpleVarName, &isScalar);
+    if (code != TCL_OK) {
+	goto done;
     }
 
-    if (simpleVarName) {
-	/*
-	 * See whether name has any namespace separators (::'s).
-	 */
-
-	int hasNsQualifiers = 0;
-	for (i = 0, p = name;  i < nameChars;  i++, p++) {
-	    if ((*p == ':') && ((i+1) < nameChars) && (*(p+1) == ':')) {
-		hasNsQualifiers = 1;
-		break;
-	    }
-	}
-	
-	/*
-	 * Look up the var name's index in the array of local vars in the
-	 * proc frame. If retrieving the var's value and it doesn't already
-	 * exist, push its name and look it up at runtime.
-	 */
-
-	if ((envPtr->procPtr != NULL) && !hasNsQualifiers) {
-	    localIndex = TclFindCompiledLocal(name, nameChars,
-		    /*create*/ isAssignment,
-                    /*flags*/ ((elName==NULL)? VAR_SCALAR : VAR_ARRAY),
-		    envPtr->procPtr);
-	}
-	if (localIndex >= 0) {
-	    maxDepth = 0;
-	} else {
-	    TclEmitPush(TclRegisterLiteral(envPtr, name, nameChars,
-		    /*onHeap*/ 0), envPtr);
-	    maxDepth = 1;
-	}
-
-	/*
-	 * Compile the element script, if any.
-	 */
-	
-	if (elName != NULL) {
-	    /*
-	     * Temporarily replace the '(' and ')' by '"'s.
-	     */
-
-	    *(elName-1) = '"';
-	    *(elName+elNameChars) = '"';
-	    code = Tcl_ParseCommand(interp, elName-1, elNameChars+2,
-                    /*nested*/ 0, &elemParse);
-	    *(elName-1) = '(';
-	    *(elName+elNameChars) = ')';
-	    gotElemParse = 1;
-	    if ((code != TCL_OK) || (elemParse.numWords > 1)) {
-		char buffer[160];
-		sprintf(buffer, "\n    (parsing index for array \"%.*s\")",
-		        TclMin(nameChars, 100), name);
-		Tcl_AddObjErrorInfo(interp, buffer, -1);
-		code = TCL_ERROR;
-		goto done;
-	    } else if (elemParse.numWords == 1) {
-		code = TclCompileTokens(interp, elemParse.tokenPtr+1,
-                        elemParse.tokenPtr->numComponents, envPtr);
-		if (code != TCL_OK) {
-		    goto done;
-		}
-		maxDepth += envPtr->maxStackDepth;
-	    } else {
-		TclEmitPush(TclRegisterLiteral(envPtr, "", 0,
-                        /*alreadyAlloced*/ 0), envPtr);
-		maxDepth += 1;
-	    }
-	}
-    } else {
-	/*
-	 * The var name isn't simple: compile and push it.
-	 */
-
-	code = TclCompileTokens(interp, varTokenPtr+1,
-		varTokenPtr->numComponents, envPtr);
-	if (code != TCL_OK) {
-	    goto done;
-	}
-	maxDepth += envPtr->maxStackDepth;
-    }
-	
     /*
      * If we are doing an assignment, push the new value.
      */
-    
+
     if (isAssignment) {
 	valueTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1);
 	if (valueTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
@@ -1890,13 +1637,13 @@ TclCompileSetCmd(interp, parsePtr, envPtr)
 	    maxDepth += envPtr->maxStackDepth;
 	}
     }
-	
+
     /*
      * Emit instructions to set/get the variable.
      */
 
     if (simpleVarName) {
-	if (elName == NULL) {
+	if (isScalar) {
 	    if (localIndex >= 0) {
 		if (localIndex <= 255) {
 		    TclEmitInstInt1((isAssignment?
@@ -1935,9 +1682,6 @@ TclCompileSetCmd(interp, parsePtr, envPtr)
     }
 	
     done:
-    if (gotElemParse) {
-        Tcl_FreeParse(&elemParse);
-    }
     envPtr->maxStackDepth = maxDepth;
     return code;
 }
@@ -2011,11 +1755,11 @@ TclCompileStringCmd(interp, parsePtr, envPtr)
 	+ (parsePtr->tokenPtr->numComponents + 1);
 
     opObj = Tcl_NewStringObj(opTokenPtr->start, opTokenPtr->size);
-
     if (Tcl_GetIndexFromObj(interp, opObj, options, "option", 0,
 	    &index) != TCL_OK) {
 	return TCL_ERROR;
     }
+    Tcl_DecrRefCount(opObj);
 
     varTokenPtr = opTokenPtr + (opTokenPtr->numComponents + 1);
     
@@ -2415,13 +2159,8 @@ TclCompileAppendCmd(interp, parsePtr, envPtr)
     CompileEnv *envPtr;		/* Holds resulting instructions. */
 {
     Tcl_Token *varTokenPtr, *valueTokenPtr;
-    Tcl_Parse elemParse;
-    int gotElemParse = 0;
-    register char *p;
-    char *name, *elName;
-    int nameChars, elNameChars;
-    register int i, n;
-    int simpleVarName, localIndex, numWords;
+    register int i;
+    int simpleVarName, isScalar, localIndex, numWords;
     int maxDepth = 0;
     int code = TCL_OK;
 
@@ -2437,7 +2176,8 @@ TclCompileAppendCmd(interp, parsePtr, envPtr)
     if (numWords == 1) {
 	Tcl_ResetResult(interp);
 	Tcl_AppendToObj(Tcl_GetObjResult(interp),
-		"wrong # args: should be \"append varName ?value value ...?\"", -1);
+		"wrong # args: should be \"append varName ?value value ...?\"",
+		-1);
 	return TCL_ERROR;
     }
     if (numWords == 2) {
@@ -2458,168 +2198,14 @@ TclCompileAppendCmd(interp, parsePtr, envPtr)
      * namespace qualifiers. 
      */
 
-    simpleVarName = 0;
-    name = elName = NULL;
-    nameChars = elNameChars = 0;
-    localIndex = -1;
-
     varTokenPtr = parsePtr->tokenPtr
 	    + (parsePtr->tokenPtr->numComponents + 1);
-    /*
-     * Check not only that the type is TCL_TOKEN_SIMPLE_WORD, but whether
-     * curly braces surround the variable name.
-     * This really matters for array elements to handle things like
-     *    set {x($foo)} 5
-     * which raises an undefined var error if we are not careful here.
-     * This goes with the hack in TclCompileIncrCmd.
-     */
-    if ((varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) &&
-	    (varTokenPtr->start[0] != '{')) {
-	simpleVarName = 1;
-
-	name = varTokenPtr[1].start;
-	nameChars = varTokenPtr[1].size;
-	/* last char is ')' => potential array reference */
-	if ( *(name + nameChars - 1) == ')') {
-	    for (i = 0, p = name;  i < nameChars;  i++, p++) {
-		if (*p == '(') {
-		    elName = p + 1;
-		    elNameChars = nameChars - i - 2;
-		    nameChars = i ;
-		    break;
-		}
-	    }
-	}
-
-	/*
-	 * If elName contains any double quotes ("), we can't inline
-	 * compile the element script using the replace '()' by '"'
-	 * technique below.
-	 */
-
-	for (i = 0, p = elName;  i < elNameChars;  i++, p++) {
-	    if (*p == '"') {
-		simpleVarName = 0;
-		break;
-	    }
-	}
-    } else if (((n = varTokenPtr->numComponents) > 1)
-	    && (varTokenPtr[1].type == TCL_TOKEN_TEXT)
-            && (varTokenPtr[n].type == TCL_TOKEN_TEXT)
-            && (varTokenPtr[n].start[varTokenPtr[n].size - 1] == ')')) {
-        simpleVarName = 0;
-
-        /*
-	 * Check for parentheses inside first token
-	 */
-        for (i = 0, p = varTokenPtr[1].start; 
-	     i < varTokenPtr[1].size; i++, p++) {
-            if (*p == '(') {
-                simpleVarName = 1;
-                break;
-            }
-        }
-        if (simpleVarName) {
-            name = varTokenPtr[1].start;
-            nameChars = p - varTokenPtr[1].start;
-            elName = p + 1;
-            elNameChars = (varTokenPtr[n].start - p) + varTokenPtr[n].size - 2;
-
-            /*
-             * If elName contains any double quotes ("), we can't inline
-             * compile the element script using the replace '()' by '"'
-             * technique below.
-             */
-
-            for (i = 0, p = elName;  i < elNameChars;  i++, p++) {
-                if (*p == '"') {
-                    simpleVarName = 0;
-                    break;
-                }
-            }
-        }
-    }
-
-    if (simpleVarName) {
-	/*
-	 * See whether name has any namespace separators (::'s).
-	 */
-
-	int hasNsQualifiers = 0;
-	for (i = 0, p = name;  i < nameChars;  i++, p++) {
-	    if ((*p == ':') && ((i+1) < nameChars) && (*(p+1) == ':')) {
-		hasNsQualifiers = 1;
-		break;
-	    }
-	}
-	
-	/*
-	 * Look up the var name's index in the array of local vars in the
-	 * proc frame. If retrieving the var's value and it doesn't already
-	 * exist, push its name and look it up at runtime.
-	 */
-
-	if ((envPtr->procPtr != NULL) && !hasNsQualifiers) {
-	    localIndex = TclFindCompiledLocal(name, nameChars,
-		    /*create*/ (numWords > 2),
-                    /*flags*/ ((elName==NULL)? VAR_SCALAR : VAR_ARRAY),
-		    envPtr->procPtr);
-	}
-	if (localIndex >= 0) {
-	    maxDepth = 0;
-	} else {
-	    TclEmitPush(TclRegisterLiteral(envPtr, name, nameChars,
-		    /*onHeap*/ 0), envPtr);
-	    maxDepth = 1;
-	}
-
-	/*
-	 * Compile the element script, if any.
-	 */
-	
-	if (elName != NULL) {
-	    /*
-	     * Temporarily replace the '(' and ')' by '"'s.
-	     */
-
-	    *(elName-1) = '"';
-	    *(elName+elNameChars) = '"';
-	    code = Tcl_ParseCommand(interp, elName-1, elNameChars+2,
-                    /*nested*/ 0, &elemParse);
-	    *(elName-1) = '(';
-	    *(elName+elNameChars) = ')';
-	    gotElemParse = 1;
-	    if ((code != TCL_OK) || (elemParse.numWords > 1)) {
-		char buffer[160];
-		sprintf(buffer, "\n    (parsing index for array \"%.*s\")",
-		        TclMin(nameChars, 100), name);
-		Tcl_AddObjErrorInfo(interp, buffer, -1);
-		code = TCL_ERROR;
-		goto done;
-	    } else if (elemParse.numWords == 1) {
-		code = TclCompileTokens(interp, elemParse.tokenPtr+1,
-                        elemParse.tokenPtr->numComponents, envPtr);
-		if (code != TCL_OK) {
-		    goto done;
-		}
-		maxDepth += envPtr->maxStackDepth;
-	    } else {
-		TclEmitPush(TclRegisterLiteral(envPtr, "", 0,
-                        /*alreadyAlloced*/ 0), envPtr);
-		maxDepth += 1;
-	    }
-	}
-    } else {
-	/*
-	 * The var name isn't simple: compile and push it.
-	 */
 
-	code = TclCompileTokens(interp, varTokenPtr+1,
-		varTokenPtr->numComponents, envPtr);
-	if (code != TCL_OK) {
-	    goto done;
-	}
-	maxDepth += envPtr->maxStackDepth;
+    code = TclPushVarName(interp, varTokenPtr, envPtr,
+	    (numWords > 2) ? TCL_CREATE_VAR : 0,
+	    &localIndex, &maxDepth, &simpleVarName, &isScalar);
+    if (code != TCL_OK) {
+	goto done;
     }
 
     /*
@@ -2649,7 +2235,7 @@ TclCompileAppendCmd(interp, parsePtr, envPtr)
      */
 
     if (simpleVarName) {
-	if (elName == NULL) {
+	if (isScalar) {
 	    if (localIndex >= 0) {
 		if (localIndex <= 255) {
 		    TclEmitInstInt1(INST_APPEND_SCALAR1, localIndex, envPtr);
@@ -2657,7 +2243,7 @@ TclCompileAppendCmd(interp, parsePtr, envPtr)
 		    TclEmitInstInt4(INST_APPEND_SCALAR4, localIndex, envPtr);
 		}
 	    } else {
-		TclEmitOpcode(INST_APPEND_SCALAR_STK, envPtr);
+		TclEmitOpcode(INST_APPEND_STK, envPtr);
 	    }
 	} else {
 	    if (localIndex >= 0) {
@@ -2675,9 +2261,6 @@ TclCompileAppendCmd(interp, parsePtr, envPtr)
     }
 
     done:
-    if (gotElemParse) {
-        Tcl_FreeParse(&elemParse);
-    }
     envPtr->maxStackDepth = maxDepth;
     return code;
 }
@@ -2716,13 +2299,7 @@ TclCompileLappendCmd(interp, parsePtr, envPtr)
     CompileEnv *envPtr;		/* Holds resulting instructions. */
 {
     Tcl_Token *varTokenPtr, *valueTokenPtr;
-    Tcl_Parse elemParse;
-    int gotElemParse = 0;
-    register char *p;
-    char *name, *elName;
-    int nameChars, elNameChars;
-    register int i, n;
-    int numValues, simpleVarName, localIndex, numWords;
+    int numValues, simpleVarName, isScalar, localIndex, numWords;
     int maxDepth = 0;
     int code = TCL_OK;
 
@@ -2754,168 +2331,13 @@ TclCompileLappendCmd(interp, parsePtr, envPtr)
      * namespace qualifiers. 
      */
 
-    simpleVarName = 0;
-    name = elName = NULL;
-    nameChars = elNameChars = 0;
-    localIndex = -1;
-
     varTokenPtr = parsePtr->tokenPtr
 	    + (parsePtr->tokenPtr->numComponents + 1);
-    /*
-     * Check not only that the type is TCL_TOKEN_SIMPLE_WORD, but whether
-     * curly braces surround the variable name.
-     * This really matters for array elements to handle things like
-     *    set {x($foo)} 5
-     * which raises an undefined var error if we are not careful here.
-     * This goes with the hack in TclCompileIncrCmd.
-     */
-    if ((varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) &&
-	    (varTokenPtr->start[0] != '{')) {
-	simpleVarName = 1;
 
-	name = varTokenPtr[1].start;
-	nameChars = varTokenPtr[1].size;
-	/* last char is ')' => potential array reference */
-	if ( *(name + nameChars - 1) == ')') {
-	    for (i = 0, p = name;  i < nameChars;  i++, p++) {
-		if (*p == '(') {
-		    elName = p + 1;
-		    elNameChars = nameChars - i - 2;
-		    nameChars = i ;
-		    break;
-		}
-	    }
-	}
-
-	/*
-	 * If elName contains any double quotes ("), we can't inline
-	 * compile the element script using the replace '()' by '"'
-	 * technique below.
-	 */
-
-	for (i = 0, p = elName;  i < elNameChars;  i++, p++) {
-	    if (*p == '"') {
-		simpleVarName = 0;
-		break;
-	    }
-	}
-    } else if (((n = varTokenPtr->numComponents) > 1)
-	    && (varTokenPtr[1].type == TCL_TOKEN_TEXT)
-            && (varTokenPtr[n].type == TCL_TOKEN_TEXT)
-            && (varTokenPtr[n].start[varTokenPtr[n].size - 1] == ')')) {
-        simpleVarName = 0;
-
-        /*
-	 * Check for parentheses inside first token
-	 */
-        for (i = 0, p = varTokenPtr[1].start; 
-	     i < varTokenPtr[1].size; i++, p++) {
-            if (*p == '(') {
-                simpleVarName = 1;
-                break;
-            }
-        }
-        if (simpleVarName) {
-            name = varTokenPtr[1].start;
-            nameChars = p - varTokenPtr[1].start;
-            elName = p + 1;
-            elNameChars = (varTokenPtr[n].start - p) + varTokenPtr[n].size - 2;
-
-            /*
-             * If elName contains any double quotes ("), we can't inline
-             * compile the element script using the replace '()' by '"'
-             * technique below.
-             */
-
-            for (i = 0, p = elName;  i < elNameChars;  i++, p++) {
-                if (*p == '"') {
-                    simpleVarName = 0;
-                    break;
-                }
-            }
-        }
-    }
-
-    if (simpleVarName) {
-	/*
-	 * See whether name has any namespace separators (::'s).
-	 */
-
-	int hasNsQualifiers = 0;
-	for (i = 0, p = name;  i < nameChars;  i++, p++) {
-	    if ((*p == ':') && ((i+1) < nameChars) && (*(p+1) == ':')) {
-		hasNsQualifiers = 1;
-		break;
-	    }
-	}
-	
-	/*
-	 * Look up the var name's index in the array of local vars in the
-	 * proc frame. If retrieving the var's value and it doesn't already
-	 * exist, push its name and look it up at runtime.
-	 */
-
-	if ((envPtr->procPtr != NULL) && !hasNsQualifiers) {
-	    localIndex = TclFindCompiledLocal(name, nameChars,
-		    /*create*/ numValues,
-                    /*flags*/ ((elName==NULL)? VAR_SCALAR : VAR_ARRAY),
-		    envPtr->procPtr);
-	}
-	if (localIndex >= 0) {
-	    maxDepth = 0;
-	} else {
-	    TclEmitPush(TclRegisterLiteral(envPtr, name, nameChars,
-		    /*onHeap*/ 0), envPtr);
-	    maxDepth = 1;
-	}
-
-	/*
-	 * Compile the element script, if any.
-	 */
-	
-	if (elName != NULL) {
-	    /*
-	     * Temporarily replace the '(' and ')' by '"'s.
-	     */
-
-	    *(elName-1) = '"';
-	    *(elName+elNameChars) = '"';
-	    code = Tcl_ParseCommand(interp, elName-1, elNameChars+2,
-                    /*nested*/ 0, &elemParse);
-	    *(elName-1) = '(';
-	    *(elName+elNameChars) = ')';
-	    gotElemParse = 1;
-	    if ((code != TCL_OK) || (elemParse.numWords > 1)) {
-		char buffer[160];
-		sprintf(buffer, "\n    (parsing index for array \"%.*s\")",
-		        TclMin(nameChars, 100), name);
-		Tcl_AddObjErrorInfo(interp, buffer, -1);
-		code = TCL_ERROR;
-		goto done;
-	    } else if (elemParse.numWords == 1) {
-		code = TclCompileTokens(interp, elemParse.tokenPtr+1,
-                        elemParse.tokenPtr->numComponents, envPtr);
-		if (code != TCL_OK) {
-		    goto done;
-		}
-		maxDepth += envPtr->maxStackDepth;
-	    } else {
-		TclEmitPush(TclRegisterLiteral(envPtr, "", 0,
-                        /*alreadyAlloced*/ 0), envPtr);
-		maxDepth += 1;
-	    }
-	}
-    } else {
-	/*
-	 * The var name isn't simple: compile and push it.
-	 */
-
-	code = TclCompileTokens(interp, varTokenPtr+1,
-		varTokenPtr->numComponents, envPtr);
-	if (code != TCL_OK) {
-	    goto done;
-	}
-	maxDepth += envPtr->maxStackDepth;
+    code = TclPushVarName(interp, varTokenPtr, envPtr, TCL_CREATE_VAR,
+	    &localIndex, &maxDepth, &simpleVarName, &isScalar);
+    if (code != TCL_OK) {
+	goto done;
     }
 
     /*
@@ -2954,7 +2376,7 @@ TclCompileLappendCmd(interp, parsePtr, envPtr)
      */
 
     if (simpleVarName) {
-	if (elName == NULL) {
+	if (isScalar) {
 	    if (localIndex >= 0) {
 		if (localIndex <= 255) {
 		    TclEmitInstInt1(INST_LAPPEND_SCALAR1, localIndex, envPtr);
@@ -2962,7 +2384,7 @@ TclCompileLappendCmd(interp, parsePtr, envPtr)
 		    TclEmitInstInt4(INST_LAPPEND_SCALAR4, localIndex, envPtr);
 		}
 	    } else {
-		TclEmitOpcode(INST_LAPPEND_SCALAR_STK, envPtr);
+		TclEmitOpcode(INST_LAPPEND_STK, envPtr);
 	    }
 	} else {
 	    if (localIndex >= 0) {
@@ -2980,9 +2402,6 @@ TclCompileLappendCmd(interp, parsePtr, envPtr)
     }
 
     done:
-    if (gotElemParse) {
-        Tcl_FreeParse(&elemParse);
-    }
     envPtr->maxStackDepth = maxDepth;
     return code;
 }
@@ -3113,3 +2532,239 @@ TclCompileLlengthCmd(interp, parsePtr, envPtr)
     TclEmitOpcode(INST_LIST_LENGTH, envPtr);
     return TCL_OK;
 }
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclPushVarName --
+ *
+ *	Procedure used in the call to compile the "set" command.
+ *
+ * Results:
+ *	The return value is a standard Tcl result, which is normally TCL_OK
+ *	unless there was an error while parsing string. If an error occurs
+ *	then the interpreter's result contains a standard error message. If
+ *	complation fails because the set command requires a second level of
+ *	substitutions, TCL_OUT_LINE_COMPILE is returned indicating that the
+ *	set command should be compiled "out of line" by emitting code to
+ *	invoke its command procedure (Tcl_SetCmd) at runtime.
+ *
+ *	envPtr->maxStackDepth is updated with the maximum number of stack
+ *	elements needed to execute the incr command.
+ *
+ * Side effects:
+ *	Instructions are added to envPtr to execute the "set" command
+ *	at runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclPushVarName(interp, varTokenPtr, envPtr, flags, localIndexPtr,
+	maxDepthPtr, simpleVarNamePtr, isScalarPtr)
+    Tcl_Interp *interp;		/* Used for error reporting. */
+    Tcl_Token *varTokenPtr;	/* Points to a variable token. */
+    CompileEnv *envPtr;		/* Holds resulting instructions. */
+    int flags;			/* takes TCL_CREATE_VAR or
+				 * TCL_LARGE_INDEX_OK */
+    int *localIndexPtr;		/* must not be NULL */
+    int *maxDepthPtr;		/* must not be NULL, should already have a
+				 * value set in the parent. */
+    int *simpleVarNamePtr;	/* must not be NULL */
+    int *isScalarPtr;		/* must not be NULL */
+{
+    Tcl_Parse elemParse;
+    int gotElemParse = 0;
+    register char *p;
+    char *name, *elName;
+    register int i, n;
+    int nameChars, elNameChars, simpleVarName, localIndex;
+    int maxDepth = 0;
+    int code = TCL_OK;
+
+    /*
+     * Decide if we can use a frame slot for the var/array name or if we
+     * need to emit code to compute and push the name at runtime. We use a
+     * frame slot (entry in the array of local vars) if we are compiling a
+     * procedure body and if the name is simple text that does not include
+     * namespace qualifiers. 
+     */
+
+    simpleVarName = 0;
+    name = elName = NULL;
+    nameChars = elNameChars = 0;
+    localIndex = -1;
+
+    /*
+     * Check not only that the type is TCL_TOKEN_SIMPLE_WORD, but whether
+     * curly braces surround the variable name.
+     * This really matters for array elements to handle things like
+     *    set {x($foo)} 5
+     * which raises an undefined var error if we are not careful here.
+     */
+
+    if ((varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) &&
+	    (varTokenPtr->start[0] != '{')) {
+	/*
+	 * A simple variable name. Divide it up into "name" and "elName"
+	 * strings. If it is not a local variable, look it up at runtime.
+	 */
+	simpleVarName = 1;
+
+	name = varTokenPtr[1].start;
+	nameChars = varTokenPtr[1].size;
+	/* last char is ')' => potential array reference */
+	if ( *(name + nameChars - 1) == ')') {
+	    for (i = 0, p = name;  i < nameChars;  i++, p++) {
+		if (*p == '(') {
+		    elName = p + 1;
+		    elNameChars = nameChars - i - 2;
+		    nameChars = i ;
+		    break;
+		}
+	    }
+	}
+
+	/*
+	 * If elName contains any double quotes ("), we can't inline
+	 * compile the element script using the replace '()' by '"'
+	 * technique below.
+	 */
+
+	for (i = 0, p = elName;  i < elNameChars;  i++, p++) {
+	    if (*p == '"') {
+		simpleVarName = 0;
+		break;
+	    }
+	}
+    } else if (((n = varTokenPtr->numComponents) > 1)
+	    && (varTokenPtr[1].type == TCL_TOKEN_TEXT)
+            && (varTokenPtr[n].type == TCL_TOKEN_TEXT)
+            && (varTokenPtr[n].start[varTokenPtr[n].size - 1] == ')')) {
+        simpleVarName = 0;
+
+        /*
+	 * Check for parentheses inside first token
+	 */
+        for (i = 0, p = varTokenPtr[1].start; 
+	     i < varTokenPtr[1].size; i++, p++) {
+            if (*p == '(') {
+                simpleVarName = 1;
+                break;
+            }
+        }
+        if (simpleVarName) {
+            name = varTokenPtr[1].start;
+            nameChars = p - varTokenPtr[1].start;
+            elName = p + 1;
+            elNameChars = (varTokenPtr[n].start - p) + varTokenPtr[n].size - 2;
+
+            /*
+             * If elName contains any double quotes ("), we can't inline
+             * compile the element script using the replace '()' by '"'
+             * technique below.
+             */
+
+            for (i = 0, p = elName;  i < elNameChars;  i++, p++) {
+                if (*p == '"') {
+                    simpleVarName = 0;
+                    break;
+                }
+            }
+        }
+    }
+
+    if (simpleVarName) {
+	/*
+	 * See whether name has any namespace separators (::'s).
+	 */
+
+	int hasNsQualifiers = 0;
+	for (i = 0, p = name;  i < nameChars;  i++, p++) {
+	    if ((*p == ':') && ((i+1) < nameChars) && (*(p+1) == ':')) {
+		hasNsQualifiers = 1;
+		break;
+	    }
+	}
+
+	/*
+	 * Look up the var name's index in the array of local vars in the
+	 * proc frame. If retrieving the var's value and it doesn't already
+	 * exist, push its name and look it up at runtime.
+	 */
+
+	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)) {
+		/* we'll push the name */
+		localIndex = -1;
+	    }
+	}
+	if (localIndex < 0) {
+	    TclEmitPush(TclRegisterLiteral(envPtr, name, nameChars,
+		    /*onHeap*/ 0), envPtr);
+	    maxDepth = 1;
+	}
+
+	/*
+	 * Compile the element script, if any.
+	 */
+
+	if (elName != NULL) {
+	    /*
+	     * Temporarily replace the '(' and ')' by '"'s.
+	     */
+
+	    *(elName-1) = '"';
+	    *(elName+elNameChars) = '"';
+	    code = Tcl_ParseCommand(interp, elName-1, elNameChars+2,
+                    /*nested*/ 0, &elemParse);
+	    *(elName-1) = '(';
+	    *(elName+elNameChars) = ')';
+	    gotElemParse = 1;
+	    if ((code != TCL_OK) || (elemParse.numWords > 1)) {
+		char buffer[160];
+		sprintf(buffer, "\n    (parsing index for array \"%.*s\")",
+		        TclMin(nameChars, 100), name);
+		Tcl_AddObjErrorInfo(interp, buffer, -1);
+		code = TCL_ERROR;
+		goto done;
+	    } else if (elemParse.numWords == 1) {
+		code = TclCompileTokens(interp, elemParse.tokenPtr+1,
+                        elemParse.tokenPtr->numComponents, envPtr);
+		if (code != TCL_OK) {
+		    goto done;
+		}
+		maxDepth += envPtr->maxStackDepth;
+	    } else {
+		TclEmitPush(TclRegisterLiteral(envPtr, "", 0,
+                        /*alreadyAlloced*/ 0), envPtr);
+		maxDepth += 1;
+	    }
+	}
+    } else {
+	/*
+	 * The var name isn't simple: compile and push it.
+	 */
+
+	code = TclCompileTokens(interp, varTokenPtr+1,
+		varTokenPtr->numComponents, envPtr);
+	if (code != TCL_OK) {
+	    goto done;
+	}
+	maxDepth += envPtr->maxStackDepth;
+    }
+
+    done:
+    if (gotElemParse) {
+        Tcl_FreeParse(&elemParse);
+    }
+    *localIndexPtr	= localIndex;
+    *maxDepthPtr	+= maxDepth;
+    *simpleVarNamePtr	= simpleVarName;
+    *isScalarPtr	= (elName == NULL);
+    return code;
+}
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index c409726..e1d2017 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -10,7 +10,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclCompile.c,v 1.21.4.1 2001/05/11 20:47:44 hobbs Exp $
+ * RCS: @(#) $Id: tclCompile.c,v 1.21.4.2 2001/05/15 20:07:38 hobbs Exp $
  */
 
 #include "tclInt.h"
@@ -232,8 +232,6 @@ InstructionDesc instructionTable[] = {
 	/* Append scalar variable at op1<=255 in frame; value is stktop */
     {"appendScalar4",	  5,   1,   {OPERAND_UINT4}},
 	/* Append scalar variable at op1 > 255 in frame; value is stktop */
-    {"appendScalarStk",	  1,   0,   {OPERAND_NONE}},
-	/* Append scalar; value is stktop, scalar name is stknext */
     {"appendArray1",	  2,   1,   {OPERAND_UINT1}},
 	/* Append array element; array at op1<=255, value is top then elem */
     {"appendArray4",	  5,   1,   {OPERAND_UINT4}},
@@ -246,8 +244,6 @@ InstructionDesc instructionTable[] = {
 	/* Lappend scalar variable at op1<=255 in frame; value is stktop */
     {"lappendScalar4",	  5,   1,   {OPERAND_UINT4}},
 	/* Lappend scalar variable at op1 > 255 in frame; value is stktop */
-    {"lappendScalarStk",	  1,   0,   {OPERAND_NONE}},
-	/* Lappend scalar; value is stktop, scalar name is stknext */
     {"lappendArray1",	  2,   1,   {OPERAND_UINT1}},
 	/* Lappend array element; array at op1<=255, value is top then elem */
     {"lappendArray4",	  5,   1,   {OPERAND_UINT4}},
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index 5c53f43..2cdad55 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -7,7 +7,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclCompile.h,v 1.14.4.1 2001/05/11 20:47:44 hobbs Exp $
+ * RCS: @(#) $Id: tclCompile.h,v 1.14.4.2 2001/05/15 20:07:38 hobbs Exp $
  */
 
 #ifndef _TCLCOMPILATION
@@ -502,29 +502,27 @@ typedef struct ByteCode {
 #define INST_STR_INDEX			77
 #define INST_STR_MATCH			78
 
-/* Opcodes 78 to 79 */
+/* Opcodes 78 to 81 */
 #define INST_LIST			79
 #define INST_LIST_INDEX			80
 #define INST_LIST_LENGTH		81
 
 #define INST_APPEND_SCALAR1		82
 #define INST_APPEND_SCALAR4		83
-#define INST_APPEND_SCALAR_STK		84
-#define INST_APPEND_ARRAY1		85
-#define INST_APPEND_ARRAY4		86
-#define INST_APPEND_ARRAY_STK		87
-#define INST_APPEND_STK			88
-
-#define INST_LAPPEND_SCALAR1		89
-#define INST_LAPPEND_SCALAR4		90
-#define INST_LAPPEND_SCALAR_STK		91
-#define INST_LAPPEND_ARRAY1		92
-#define INST_LAPPEND_ARRAY4		93
-#define INST_LAPPEND_ARRAY_STK		94
-#define INST_LAPPEND_STK		95
+#define INST_APPEND_ARRAY1		84
+#define INST_APPEND_ARRAY4		85
+#define INST_APPEND_ARRAY_STK		86
+#define INST_APPEND_STK			87
+
+#define INST_LAPPEND_SCALAR1		88
+#define INST_LAPPEND_SCALAR4		89
+#define INST_LAPPEND_ARRAY1		90
+#define INST_LAPPEND_ARRAY4		91
+#define INST_LAPPEND_ARRAY_STK		92
+#define INST_LAPPEND_STK		93
 
 /* The last opcode */
-#define LAST_INST_OPCODE        	95
+#define LAST_INST_OPCODE        	93
 
 /*
  * Table describing the Tcl bytecode instructions: their name (for
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 7e5aad4..a8080b9 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -10,7 +10,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclExecute.c,v 1.22.2.2 2001/05/12 00:01:03 hobbs Exp $
+ * RCS: @(#) $Id: tclExecute.c,v 1.22.2.3 2001/05/15 20:07:38 hobbs Exp $
  */
 
 #include "tclInt.h"
@@ -102,7 +102,7 @@ static char *operatorStrings[] = {
     "BUILTIN FUNCTION", "FUNCTION",
     "", "", "", "", "", "", "", "", "eq", "ne",
 };
-    
+
 /*
  * Mapping from Tcl result codes to strings; used for error and debugging
  * messages. 
@@ -203,7 +203,7 @@ long		tclObjsShared[TCL_MAX_SHARED_OBJ_STATS] = { 0, 0, 0, 0, 0 };
 	       (unsigned int)(pc - codePtr->codeStart), \
 	       GetOpcodeName(pc)); \
 	printf a; \
-        TclPrintObject(stdout, (objPtr ? objPtr : ""), 30); \
+        TclPrintObject(stdout, objPtr, 30); \
         fprintf(stdout, "\n"); \
     }
 #define O2S(objPtr) \
@@ -556,7 +556,7 @@ TclExecuteByteCode(interp, codePtr)
 				 * process break, continue, and errors. */
     int result = TCL_OK;	/* Return code returned after execution. */
     int traceInstructions = (tclTraceExec == 3);
-    Tcl_Obj *valuePtr, *value2Ptr, *objPtr, *elemPtr = NULL;
+    Tcl_Obj *valuePtr, *value2Ptr, *objPtr, *elemPtr;
     char *bytes;
     int length;
     long i;
@@ -1097,8 +1097,7 @@ TclExecuteByteCode(interp, codePtr)
 #ifdef TCL_COMPILE_DEBUG
 	    opnd = TclGetUInt1AtPtr(pc+1);
 	    DECACHE_STACK_INFO();
-	    valuePtr = TclGetIndexedScalar(interp, opnd,
-		    /*leaveErrorMsg*/ 1);
+	    valuePtr = TclGetIndexedScalar(interp, opnd, TCL_LEAVE_ERR_MSG);
 	    CACHE_STACK_INFO();
 	    if (valuePtr == NULL) {
 		TRACE_WITH_OBJ(("%u => ERROR: ", opnd),
@@ -1111,7 +1110,7 @@ TclExecuteByteCode(interp, codePtr)
 #else /* TCL_COMPILE_DEBUG */
 	    DECACHE_STACK_INFO();
 	    opnd = TclGetUInt1AtPtr(pc+1);
-	    valuePtr = TclGetIndexedScalar(interp, opnd, /*leaveErrorMsg*/ 1);
+	    valuePtr = TclGetIndexedScalar(interp, opnd, TCL_LEAVE_ERR_MSG);
 	    CACHE_STACK_INFO();
 	    if (valuePtr == NULL) {
 		result = TCL_ERROR;
@@ -1124,8 +1123,7 @@ TclExecuteByteCode(interp, codePtr)
 	case INST_LOAD_SCALAR4:
 	    opnd = TclGetUInt4AtPtr(pc+1);
 	    DECACHE_STACK_INFO();
-	    valuePtr = TclGetIndexedScalar(interp, opnd,
-					   /*leaveErrorMsg*/ 1);
+	    valuePtr = TclGetIndexedScalar(interp, opnd, TCL_LEAVE_ERR_MSG);
 	    CACHE_STACK_INFO();
 	    if (valuePtr == NULL) {
 		TRACE_WITH_OBJ(("%u => ERROR: ", opnd),
@@ -1169,7 +1167,7 @@ TclExecuteByteCode(interp, codePtr)
 
 	    DECACHE_STACK_INFO();
 	    valuePtr = TclGetElementOfIndexedArray(interp, opnd,
-		    elemPtr, /*leaveErrorMsg*/ 1);
+		    elemPtr, TCL_LEAVE_ERR_MSG);
 	    CACHE_STACK_INFO();
 	    if (valuePtr == NULL) {
 		TRACE_WITH_OBJ(("%u \"%.30s\" => ERROR: ",
@@ -1351,10 +1349,13 @@ TclExecuteByteCode(interp, codePtr)
 	    ADJUST_PC(pcAdjustment);
 
 	case INST_APPEND_STK:
-	case INST_APPEND_SCALAR_STK:
 	case INST_APPEND_ARRAY_STK:
 	    valuePtr = POP_OBJECT(); /* value to append */
-	    if (*pc == INST_APPEND_ARRAY_STK) elemPtr = POP_OBJECT();
+	    if (*pc == INST_APPEND_ARRAY_STK) {
+		elemPtr = POP_OBJECT();
+	    } else {
+		elemPtr = NULL;
+	    }
 	    objPtr = POP_OBJECT(); /* scalar name */
 
 	    DECACHE_STACK_INFO();
@@ -1459,14 +1460,17 @@ TclExecuteByteCode(interp, codePtr)
 	    ADJUST_PC(pcAdjustment);
 
 	case INST_LAPPEND_STK:
-	case INST_LAPPEND_SCALAR_STK:
 	case INST_LAPPEND_ARRAY_STK:
 	{
 	    Tcl_Obj *newValuePtr;
 	    int createdNewObj = 0;
 
 	    value2Ptr = POP_OBJECT(); /* value to append */
-	    if (*pc == INST_LAPPEND_ARRAY_STK) elemPtr = POP_OBJECT();
+	    if (*pc == INST_LAPPEND_ARRAY_STK) {
+		elemPtr = POP_OBJECT();
+	    } else {
+		elemPtr = NULL;
+	    }
 	    objPtr = POP_OBJECT(); /* scalar name */
 
 	    DECACHE_STACK_INFO();
@@ -1905,12 +1909,12 @@ TclExecuteByteCode(interp, codePtr)
 		int iResult;
 		char *s;
 		Tcl_ObjType *t1Ptr, *t2Ptr;
-		
+
 		value2Ptr = POP_OBJECT();
 		valuePtr  = POP_OBJECT();
 		t1Ptr = valuePtr->typePtr;
 		t2Ptr = value2Ptr->typePtr;
-		
+
 		if ((t1Ptr == &tclIntType) || (t1Ptr == &tclBooleanType)) {
 		    i1 = (valuePtr->internalRep.longValue != 0);
 		} else if (t1Ptr == &tclDoubleType) {
@@ -1961,7 +1965,7 @@ TclExecuteByteCode(interp, codePtr)
 			goto checkForCatch;
 		    }
 		}
-		
+
 		/*
 		 * Reuse the valuePtr object already on stack if possible.
 		 */
diff --git a/generic/tclInt.decls b/generic/tclInt.decls
index dce2e0e..e664180 100644
--- a/generic/tclInt.decls
+++ b/generic/tclInt.decls
@@ -10,7 +10,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 # 
-# RCS: @(#) $Id: tclInt.decls,v 1.25 2001/04/27 22:11:51 kennykb Exp $
+# RCS: @(#) $Id: tclInt.decls,v 1.25.2.1 2001/05/15 20:07:38 hobbs Exp $
 
 library tcl
 
@@ -128,7 +128,7 @@ declare 28 generic {
 }
 declare 29 generic {
     Tcl_Obj * TclGetElementOfIndexedArray(Tcl_Interp *interp, \
-	    int localIndex, Tcl_Obj *elemPtr, int leaveErrorMsg)
+	    int localIndex, Tcl_Obj *elemPtr, int flags)
 }
 # Replaced by char * TclGetEnv(CONST char *name, Tcl_DString *valuePtr) in 8.1:
 #  declare 30 generic {
@@ -149,7 +149,7 @@ declare 34 generic {
 }
 declare 35 generic {
     Tcl_Obj * TclGetIndexedScalar(Tcl_Interp *interp, int localIndex, \
-	    int leaveErrorMsg)
+	    int flags)
 }
 declare 36 generic {
     int TclGetLong(Tcl_Interp *interp, char *str, long *longPtr)
@@ -374,11 +374,11 @@ declare 98 generic {
 }
 declare 99 generic {
     Tcl_Obj * TclSetElementOfIndexedArray(Tcl_Interp *interp, \
-	    int localIndex, Tcl_Obj *elemPtr, Tcl_Obj *objPtr, int leaveErrorMsg)
+	    int localIndex, Tcl_Obj *elemPtr, Tcl_Obj *objPtr, int flags)
 }
 declare 100 generic {
     Tcl_Obj * TclSetIndexedScalar(Tcl_Interp *interp, int localIndex, \
-	    Tcl_Obj *objPtr, int leaveErrorMsg)
+	    Tcl_Obj *objPtr, int flags)
 }
 declare 101 {unix win} {
     char * TclSetPreInitScript(char *string)
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 7ddd78e..9801e2c 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -11,7 +11,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclInt.h,v 1.52.2.1 2001/05/11 20:47:44 hobbs Exp $
+ * RCS: @(#) $Id: tclInt.h,v 1.52.2.2 2001/05/15 20:07:38 hobbs Exp $
  */
 
 #ifndef _TCLINT
@@ -1700,7 +1700,7 @@ EXTERN int		TclGetDate _ANSI_ARGS_((char *p,
 			    unsigned long *timePtr));
 EXTERN Tcl_Obj *	TclGetElementOfIndexedArray _ANSI_ARGS_((
 			    Tcl_Interp *interp, int localIndex,
-			    Tcl_Obj *elemPtr, int leaveErrorMsg));
+			    Tcl_Obj *elemPtr, int flags));
 EXTERN char *		TclGetExtension _ANSI_ARGS_((char *name));
 EXTERN int		TclGetFrame _ANSI_ARGS_((Tcl_Interp *interp,
 			    char *string, CallFrame **framePtrPtr));
@@ -1708,7 +1708,7 @@ EXTERN TclCmdProcType	TclGetInterpProc _ANSI_ARGS_((void));
 EXTERN int		TclGetIntForIndex _ANSI_ARGS_((Tcl_Interp *interp,
 			    Tcl_Obj *objPtr, int endValue, int *indexPtr));
 EXTERN Tcl_Obj *	TclGetIndexedScalar _ANSI_ARGS_((Tcl_Interp *interp,
-			    int localIndex, int leaveErrorMsg));
+			    int localIndex, int flags));
 EXTERN int		TclGetLong _ANSI_ARGS_((Tcl_Interp *interp,
 			    char *string, long *longPtr));
 EXTERN int		TclGetLoadedPackages _ANSI_ARGS_((
@@ -1876,11 +1876,9 @@ EXTERN void		TclResetShadowedCmdRefs _ANSI_ARGS_((
 EXTERN int		TclServiceIdle _ANSI_ARGS_((void));
 EXTERN Tcl_Obj *	TclSetElementOfIndexedArray _ANSI_ARGS_((
 			    Tcl_Interp *interp, int localIndex,
-			    Tcl_Obj *elemPtr, Tcl_Obj *objPtr,
-			    int leaveErrorMsg));
+			    Tcl_Obj *elemPtr, Tcl_Obj *objPtr, int flags));
 EXTERN Tcl_Obj *	TclSetIndexedScalar _ANSI_ARGS_((Tcl_Interp *interp,
-			    int localIndex, Tcl_Obj *objPtr,
-			    int leaveErrorMsg));
+			    int localIndex, Tcl_Obj *objPtr, int flags));
 EXTERN char *		TclSetPreInitScript _ANSI_ARGS_((char *string));
 EXTERN void		TclSetupEnv _ANSI_ARGS_((Tcl_Interp *interp));
 EXTERN VOID             TclSignalExitThread _ANSI_ARGS_((Tcl_ThreadId id,
diff --git a/generic/tclIntDecls.h b/generic/tclIntDecls.h
index 6e20425..1a2cbcd 100644
--- a/generic/tclIntDecls.h
+++ b/generic/tclIntDecls.h
@@ -11,7 +11,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclIntDecls.h,v 1.23 2001/04/27 22:11:51 kennykb Exp $
+ * RCS: @(#) $Id: tclIntDecls.h,v 1.23.2.1 2001/05/15 20:07:38 hobbs Exp $
  */
 
 #ifndef _TCLINTDECLS
@@ -133,7 +133,7 @@ EXTERN Tcl_Channel	TclpGetDefaultStdChannel _ANSI_ARGS_((int type));
 /* 29 */
 EXTERN Tcl_Obj *	TclGetElementOfIndexedArray _ANSI_ARGS_((
 				Tcl_Interp * interp, int localIndex, 
-				Tcl_Obj * elemPtr, int leaveErrorMsg));
+				Tcl_Obj * elemPtr, int flags));
 /* Slot 30 is reserved */
 /* 31 */
 EXTERN char *		TclGetExtension _ANSI_ARGS_((char * name));
@@ -148,7 +148,7 @@ EXTERN int		TclGetIntForIndex _ANSI_ARGS_((Tcl_Interp * interp,
 				int * indexPtr));
 /* 35 */
 EXTERN Tcl_Obj *	TclGetIndexedScalar _ANSI_ARGS_((Tcl_Interp * interp, 
-				int localIndex, int leaveErrorMsg));
+				int localIndex, int flags));
 /* 36 */
 EXTERN int		TclGetLong _ANSI_ARGS_((Tcl_Interp * interp, 
 				char * str, long * longPtr));
@@ -327,11 +327,10 @@ EXTERN int		TclServiceIdle _ANSI_ARGS_((void));
 EXTERN Tcl_Obj *	TclSetElementOfIndexedArray _ANSI_ARGS_((
 				Tcl_Interp * interp, int localIndex, 
 				Tcl_Obj * elemPtr, Tcl_Obj * objPtr, 
-				int leaveErrorMsg));
+				int flags));
 /* 100 */
 EXTERN Tcl_Obj *	TclSetIndexedScalar _ANSI_ARGS_((Tcl_Interp * interp, 
-				int localIndex, Tcl_Obj * objPtr, 
-				int leaveErrorMsg));
+				int localIndex, Tcl_Obj * objPtr, int flags));
 #if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
 /* 101 */
 EXTERN char *		TclSetPreInitScript _ANSI_ARGS_((char * string));
@@ -580,13 +579,13 @@ typedef struct TclIntStubs {
     void *reserved26;
     int (*tclGetDate) _ANSI_ARGS_((char * p, unsigned long now, long zone, unsigned long * timePtr)); /* 27 */
     Tcl_Channel (*tclpGetDefaultStdChannel) _ANSI_ARGS_((int type)); /* 28 */
-    Tcl_Obj * (*tclGetElementOfIndexedArray) _ANSI_ARGS_((Tcl_Interp * interp, int localIndex, Tcl_Obj * elemPtr, int leaveErrorMsg)); /* 29 */
+    Tcl_Obj * (*tclGetElementOfIndexedArray) _ANSI_ARGS_((Tcl_Interp * interp, int localIndex, Tcl_Obj * elemPtr, int flags)); /* 29 */
     void *reserved30;
     char * (*tclGetExtension) _ANSI_ARGS_((char * name)); /* 31 */
     int (*tclGetFrame) _ANSI_ARGS_((Tcl_Interp * interp, char * str, CallFrame ** framePtrPtr)); /* 32 */
     TclCmdProcType (*tclGetInterpProc) _ANSI_ARGS_((void)); /* 33 */
     int (*tclGetIntForIndex) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr, int endValue, int * indexPtr)); /* 34 */
-    Tcl_Obj * (*tclGetIndexedScalar) _ANSI_ARGS_((Tcl_Interp * interp, int localIndex, int leaveErrorMsg)); /* 35 */
+    Tcl_Obj * (*tclGetIndexedScalar) _ANSI_ARGS_((Tcl_Interp * interp, int localIndex, int flags)); /* 35 */
     int (*tclGetLong) _ANSI_ARGS_((Tcl_Interp * interp, char * str, long * longPtr)); /* 36 */
     int (*tclGetLoadedPackages) _ANSI_ARGS_((Tcl_Interp * interp, char * targetName)); /* 37 */
     int (*tclGetNamespaceForQualName) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * qualName, Namespace * cxtNsPtr, int flags, Namespace ** nsPtrPtr, Namespace ** altNsPtrPtr, Namespace ** actualCxtPtrPtr, CONST char ** simpleNamePtr)); /* 38 */
@@ -650,8 +649,8 @@ typedef struct TclIntStubs {
     int (*tclRenameCommand) _ANSI_ARGS_((Tcl_Interp * interp, char * oldName, char * newName)); /* 96 */
     void (*tclResetShadowedCmdRefs) _ANSI_ARGS_((Tcl_Interp * interp, Command * newCmdPtr)); /* 97 */
     int (*tclServiceIdle) _ANSI_ARGS_((void)); /* 98 */
-    Tcl_Obj * (*tclSetElementOfIndexedArray) _ANSI_ARGS_((Tcl_Interp * interp, int localIndex, Tcl_Obj * elemPtr, Tcl_Obj * objPtr, int leaveErrorMsg)); /* 99 */
-    Tcl_Obj * (*tclSetIndexedScalar) _ANSI_ARGS_((Tcl_Interp * interp, int localIndex, Tcl_Obj * objPtr, int leaveErrorMsg)); /* 100 */
+    Tcl_Obj * (*tclSetElementOfIndexedArray) _ANSI_ARGS_((Tcl_Interp * interp, int localIndex, Tcl_Obj * elemPtr, Tcl_Obj * objPtr, int flags)); /* 99 */
+    Tcl_Obj * (*tclSetIndexedScalar) _ANSI_ARGS_((Tcl_Interp * interp, int localIndex, Tcl_Obj * objPtr, int flags)); /* 100 */
 #if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
     char * (*tclSetPreInitScript) _ANSI_ARGS_((char * string)); /* 101 */
 #endif /* UNIX */
diff --git a/generic/tclObj.c b/generic/tclObj.c
index 61b5b1c..8a1274b 100644
--- a/generic/tclObj.c
+++ b/generic/tclObj.c
@@ -6,11 +6,12 @@
  *
  * Copyright (c) 1995-1997 Sun Microsystems, Inc.
  * Copyright (c) 1999 by Scriptics Corporation.
+ * Copyright (c) 2001 by ActiveState Corporation.
  *
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclObj.c,v 1.20.4.1 2001/05/11 20:47:44 hobbs Exp $
+ * RCS: @(#) $Id: tclObj.c,v 1.20.4.2 2001/05/15 20:07:38 hobbs Exp $
  */
 
 #include "tclInt.h"
@@ -201,6 +202,8 @@ TclInitObjSubsystem()
 void
 TclFinalizeCompExecEnv()
 {
+    Tcl_Obj *objPtr;
+
     Tcl_MutexLock(&tableMutex);
     if (typeTableInitialized) {
         Tcl_DeleteHashTable(&typeTable);
@@ -208,6 +211,15 @@ TclFinalizeCompExecEnv()
     }
     Tcl_MutexUnlock(&tableMutex);
     Tcl_MutexLock(&tclObjMutex);
+    /*
+     * Ensure that at least the last set of objects created with
+     * TclAllocateFreeObjects is freed.
+     */
+    objPtr = tclFreeObjList;
+    while (objPtr) {
+	objPtr = (Tcl_Obj *) objPtr->internalRep.otherValuePtr;
+    }
+    ckfree((char *) objPtr);
     tclFreeObjList = NULL;
     Tcl_MutexUnlock(&tclObjMutex);
 
@@ -556,10 +568,7 @@ Tcl_DbNewObj(file, line)
 void
 TclAllocateFreeObjects()
 {
-    Tcl_Obj tmp[2];
-    size_t objSizePlusPadding =	/* NB: this assumes byte addressing. */
-	((int)(&(tmp[1])) - (int)(&(tmp[0])));
-    size_t bytesToAlloc = (OBJS_TO_ALLOC_EACH_TIME * objSizePlusPadding);
+    size_t bytesToAlloc = (OBJS_TO_ALLOC_EACH_TIME * sizeof(Tcl_Obj));
     char *basePtr;
     register Tcl_Obj *prevPtr, *objPtr;
     register int i;
@@ -569,10 +578,10 @@ TclAllocateFreeObjects()
 
     prevPtr = NULL;
     objPtr = (Tcl_Obj *) basePtr;
-    for (i = 0;  i < OBJS_TO_ALLOC_EACH_TIME;  i++) {
+    for (i = 0; i < OBJS_TO_ALLOC_EACH_TIME; i++) {
 	objPtr->internalRep.otherValuePtr = (VOID *) prevPtr;
 	prevPtr = objPtr;
-	objPtr = (Tcl_Obj *) (((char *)objPtr) + objSizePlusPadding);
+	objPtr++;
     }
     tclFreeObjList = prevPtr;
 }
diff --git a/generic/tclVar.c b/generic/tclVar.c
index dc86684..1f4d630 100644
--- a/generic/tclVar.c
+++ b/generic/tclVar.c
@@ -14,7 +14,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclVar.c,v 1.31.2.2 2001/05/12 00:01:03 hobbs Exp $
+ * RCS: @(#) $Id: tclVar.c,v 1.31.2.3 2001/05/15 20:07:38 hobbs Exp $
  */
 
 #include "tclInt.h"
@@ -665,7 +665,7 @@ Tcl_GetVar2Ex(interp, part1, part2, flags)
  *	given by localIndex. If the specified variable doesn't exist, or
  *	there is a clash in array usage, or an error occurs while executing
  *	variable traces, then NULL is returned and a message will be left in
- *	the interpreter's result if leaveErrorMsg is 1.
+ *	the interpreter's result if TCL_LEAVE_ERR_MSG is set in flags.
  *
  * Side effects:
  *	The ref count for the returned object is _not_ incremented to
@@ -676,13 +676,13 @@ Tcl_GetVar2Ex(interp, part1, part2, flags)
  */
 
 Tcl_Obj *
-TclGetIndexedScalar(interp, localIndex, leaveErrorMsg)
+TclGetIndexedScalar(interp, localIndex, flags)
     Tcl_Interp *interp;		/* Command interpreter in which variable is
 				 * to be looked up. */
     register int localIndex;	/* Index of variable in procedure's array
 				 * of local variables. */
-    int leaveErrorMsg;		/* 1 if to leave an error message in
-				 * interpreter's result on an error.
+    int flags;			/* TCL_LEAVE_ERR_MSG if to leave an error
+				 * message in interpreter's result on an error.
 				 * Otherwise no error message is left. */
 {
     Interp *iPtr = (Interp *) interp;
@@ -736,7 +736,7 @@ TclGetIndexedScalar(interp, localIndex, leaveErrorMsg)
 	msg = CallTraces(iPtr, /*arrayPtr*/ NULL, varPtr, varName, NULL,
 		TCL_TRACE_READS);
 	if (msg != NULL) {
-	    if (leaveErrorMsg) {
+	    if (flags & TCL_LEAVE_ERR_MSG) {
 		VarErrMsg(interp, varName, NULL, "read", msg);
 	    }
 	    return NULL;
@@ -749,7 +749,7 @@ TclGetIndexedScalar(interp, localIndex, leaveErrorMsg)
      */
 
     if (!TclIsVarScalar(varPtr) || TclIsVarUndefined(varPtr)) {
-	if (leaveErrorMsg) {
+	if (flags & TCL_LEAVE_ERR_MSG) {
 	    if (TclIsVarArray(varPtr)) {
 		msg = isArray;
 	    } else {
@@ -778,7 +778,7 @@ TclGetIndexedScalar(interp, localIndex, leaveErrorMsg)
  *	element. If the specified array or element doesn't exist, or there
  *	is a clash in array usage, or an error occurs while executing
  *	variable traces, then NULL is returned and a message will be left in
- *	the interpreter's result if leaveErrorMsg is 1.
+ *	the interpreter's result if TCL_LEAVE_ERR_MSG is set in flags.
  *
  * Side effects:
  *	The ref count for the returned object is _not_ incremented to
@@ -789,15 +789,15 @@ TclGetIndexedScalar(interp, localIndex, leaveErrorMsg)
  */
 
 Tcl_Obj *
-TclGetElementOfIndexedArray(interp, localIndex, elemPtr, leaveErrorMsg)
+TclGetElementOfIndexedArray(interp, localIndex, elemPtr, flags)
     Tcl_Interp *interp;		/* Command interpreter in which variable is
 				 * to be looked up. */
     int localIndex;		/* Index of array variable in procedure's
 				 * array of local variables. */
     Tcl_Obj *elemPtr;		/* Points to an object holding the name of
 				 * an element to get in the array. */
-    int leaveErrorMsg;		/* 1 if to leave an error message in
-				 * the interpreter's result on an error.
+    int flags;			/* TCL_LEAVE_ERR_MSG if to leave an error
+				 * message in interpreter's result on an error.
 				 * Otherwise no error message is left. */
 {
     Interp *iPtr = (Interp *) interp;
@@ -856,7 +856,7 @@ TclGetElementOfIndexedArray(interp, localIndex, elemPtr, leaveErrorMsg)
      */
 
     if (!TclIsVarArray(arrayPtr) || TclIsVarUndefined(arrayPtr)) {
-	if (leaveErrorMsg) {
+	if (flags & TCL_LEAVE_ERR_MSG) {
 	    VarErrMsg(interp, arrayName, elem, "read", noSuchVar);
 	}
 	goto errorReturn;
@@ -894,7 +894,7 @@ TclGetElementOfIndexedArray(interp, localIndex, elemPtr, leaveErrorMsg)
 	msg = CallTraces(iPtr, arrayPtr, varPtr, arrayName, elem,
 	        TCL_TRACE_READS);
 	if (msg != NULL) {
-	    if (leaveErrorMsg) {
+	    if (flags & TCL_LEAVE_ERR_MSG) {
 		VarErrMsg(interp, arrayName, elem, "read", msg);
 	    }
 	    goto errorReturn;
@@ -909,7 +909,7 @@ TclGetElementOfIndexedArray(interp, localIndex, elemPtr, leaveErrorMsg)
 	return varPtr->value.objPtr;
     }
     
-    if (leaveErrorMsg) {
+    if (flags & TCL_LEAVE_ERR_MSG) {
 	if (TclIsVarArray(varPtr)) {
 	    msg = isArray;
 	} else {
@@ -1190,8 +1190,7 @@ Tcl_SetVar2Ex(interp, part1, part2, newValuePtr, flags)
     Var *arrayPtr;
     Tcl_Obj *oldValuePtr;
     Tcl_Obj *resultPtr = NULL;
-    char *bytes;
-    int length, result;
+    int result;
 
     varPtr = TclLookupVar(interp, part1, part2, flags, "set",
 	    /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr);
@@ -1272,10 +1271,9 @@ Tcl_SetVar2Ex(interp, part1, part2, newValuePtr, flags)
 	     * We append newValuePtr's bytes but don't change its ref count.
 	     */
 
-	    bytes = Tcl_GetStringFromObj(newValuePtr, &length);
 	    if (oldValuePtr == NULL) {
-		varPtr->value.objPtr = Tcl_NewStringObj(bytes, length);
-		Tcl_IncrRefCount(varPtr->value.objPtr);
+		varPtr->value.objPtr = newValuePtr;
+		Tcl_IncrRefCount(newValuePtr);
 	    } else {
 		if (Tcl_IsShared(oldValuePtr)) {   /* append to copy */
 		    varPtr->value.objPtr = Tcl_DuplicateObj(oldValuePtr);
@@ -1286,34 +1284,16 @@ Tcl_SetVar2Ex(interp, part1, part2, newValuePtr, flags)
 		Tcl_AppendObjToObj(oldValuePtr, newValuePtr);
 	    }
 	}
-    } else {
-	if (flags & TCL_LIST_ELEMENT) {	       /* set var to list element */
-	    int neededBytes, listFlags;
-
-	    /*
-	     * We set the variable to the result of converting newValuePtr's
-	     * string rep to a list element. We do not change newValuePtr's
-	     * ref count.
-	     */
+    } else if (newValuePtr != oldValuePtr) {
+	/*
+	 * In this case we are replacing the value, so we don't need to
+	 * do more than swap the objects.
+	 */
 
-	    if (oldValuePtr != NULL) {
-		Tcl_DecrRefCount(oldValuePtr); /* discard old value */
-	    }
-	    bytes = Tcl_GetStringFromObj(newValuePtr, &length);
-	    neededBytes = Tcl_ScanElement(bytes, &listFlags);
-	    oldValuePtr = Tcl_NewObj();
-	    oldValuePtr->bytes = (char *)
-		ckalloc((unsigned) (neededBytes + 1));
-	    oldValuePtr->length = Tcl_ConvertElement(bytes,
-		    oldValuePtr->bytes, listFlags);
-	    varPtr->value.objPtr = oldValuePtr;
-	    Tcl_IncrRefCount(varPtr->value.objPtr);
-	} else if (newValuePtr != oldValuePtr) {
-	    varPtr->value.objPtr = newValuePtr;
-	    Tcl_IncrRefCount(newValuePtr);      /* var is another ref */
-	    if (oldValuePtr != NULL) {
-		TclDecrRefCount(oldValuePtr);   /* discard old value */
-	    }
+	varPtr->value.objPtr = newValuePtr;
+	Tcl_IncrRefCount(newValuePtr);      /* var is another ref */
+	if (oldValuePtr != NULL) {
+	    TclDecrRefCount(oldValuePtr);   /* discard old value */
 	}
     }
     TclSetVarScalar(varPtr);
@@ -1381,8 +1361,8 @@ Tcl_SetVar2Ex(interp, part1, part2, newValuePtr, flags)
  *	variable given by localIndex. If the specified variable doesn't
  *	exist, or there is a clash in array usage, or an error occurs while
  *	executing variable traces, then NULL is returned and a message will
- *	be left in the interpreter's result if leaveErrorMsg is 1. Note
- *	that the returned object may not be the same one referenced by
+ *	be left in the interpreter's result if flags has TCL_LEAVE_ERR_MSG.
+ *	Note that the returned object may not be the same one referenced by
  *	newValuePtr; this is because variable traces may modify the
  *	variable's value.
  *
@@ -1407,9 +1387,9 @@ TclSetIndexedScalar(interp, localIndex, newValuePtr, flags)
     int localIndex;		/* Index of variable in procedure's array
 				 * of local variables. */
     Tcl_Obj *newValuePtr;	/* New value for variable. */
-    int flags;			/* 1 if to leave an error message in
-				 * the interpreter's result on an error.
-				 * Otherwise no error message is left. */
+    int flags;			/* Various flags that tell how to set value:
+				 * any of TCL_APPEND_VALUE,
+				 * TCL_LIST_ELEMENT or TCL_LEAVE_ERR_MSG. */
 {
     Interp *iPtr = (Interp *) interp;
     CallFrame *varFramePtr = iPtr->varFramePtr;
@@ -1421,7 +1401,6 @@ TclSetIndexedScalar(interp, localIndex, newValuePtr, flags)
     register Var *varPtr;	/* Points to the variable's in-frame Var
 				 * structure. */
     char *varName;		/* Name of the local variable. */
-    int leaveErrorMsg = (flags & TCL_LEAVE_ERR_MSG);
     Tcl_Obj *oldValuePtr;
     Tcl_Obj *resultPtr = NULL;
 
@@ -1466,7 +1445,7 @@ TclSetIndexedScalar(interp, localIndex, newValuePtr, flags)
      */
 
     if ((varPtr->flags & VAR_IN_HASHTABLE) && (varPtr->hPtr == NULL)) {
-	if (leaveErrorMsg) {
+	if (flags & TCL_LEAVE_ERR_MSG) {
 	    if (TclIsVarArrayElement(varPtr)) {
 		VarErrMsg(interp, varName, NULL, "set", danglingElement);
 	    } else {
@@ -1481,7 +1460,7 @@ TclSetIndexedScalar(interp, localIndex, newValuePtr, flags)
      */
 
     if (TclIsVarArray(varPtr) && !TclIsVarUndefined(varPtr)) {
-	if (leaveErrorMsg) {
+	if (flags & TCL_LEAVE_ERR_MSG) {
 	    VarErrMsg(interp, varName, NULL, "set", isArray);
 	}
 	return NULL;
@@ -1498,10 +1477,6 @@ TclSetIndexedScalar(interp, localIndex, newValuePtr, flags)
 	    varPtr->value.objPtr = NULL;
 	    oldValuePtr = NULL;
 	}
-
-	/*
-	 * We only handle TCL_LIST_ELEMENT in the TCL_APPEND_VALUE case
-	 */
 	if (flags & TCL_LIST_ELEMENT) {	/* append list element */
 	    if (oldValuePtr == NULL) {
 		TclNewObj(oldValuePtr);
@@ -1536,6 +1511,11 @@ TclSetIndexedScalar(interp, localIndex, newValuePtr, flags)
 	    }
 	}
     } else if (newValuePtr != oldValuePtr) {        /* set new value */
+	/*
+	 * In this case we are replacing the value, so we don't need to
+	 * do more than swap the objects.
+	 */
+
 	varPtr->value.objPtr = newValuePtr;
 	Tcl_IncrRefCount(newValuePtr);       /* var is another ref to obj */
 	if (oldValuePtr != NULL) {
@@ -1553,7 +1533,7 @@ TclSetIndexedScalar(interp, localIndex, newValuePtr, flags)
 	char *msg = CallTraces(iPtr, /*arrayPtr*/ NULL, varPtr,
 	        varName, (char *) NULL, TCL_TRACE_WRITES);
 	if (msg != NULL) {
-	    if (leaveErrorMsg) {
+	    if (flags & TCL_LEAVE_ERR_MSG) {
 		VarErrMsg(interp, varName, NULL, "set", msg);
 	    }
 	    goto cleanup;
@@ -1600,7 +1580,7 @@ TclSetIndexedScalar(interp, localIndex, newValuePtr, flags)
  *	element. If the specified array or element doesn't exist, or there
  *	is a clash in array usage, or an error occurs while executing
  *	variable traces, then NULL is returned and a message will be left in
- *	the interpreter's result if leaveErrorMsg is 1. Note that the
+ *	the interpreter's result if flags has TCL_LEAVE_ERR_MSG. Note that the
  *	returned object may not be the same one referenced by newValuePtr;
  *	this is because variable traces may modify the variable's value.
  *
@@ -1629,9 +1609,9 @@ TclSetElementOfIndexedArray(interp, localIndex, elemPtr, newValuePtr, flags)
     Tcl_Obj *elemPtr;		/* Points to an object holding the name of
 				 * an element to set in the array. */
     Tcl_Obj *newValuePtr;	/* New value for variable. */
-    int flags;			/* 1 if to leave an error message in
-				 * the interpreter's result on an error.
-				 * Otherwise no error message is left. */
+    int flags;			/* Various flags that tell how to set value:
+				 * any of TCL_APPEND_VALUE,
+				 * TCL_LIST_ELEMENT or TCL_LEAVE_ERR_MSG. */
 {
     Interp *iPtr = (Interp *) interp;
     CallFrame *varFramePtr = iPtr->varFramePtr;
@@ -1644,7 +1624,6 @@ TclSetElementOfIndexedArray(interp, localIndex, elemPtr, newValuePtr, flags)
 				 * structure. */
     char *arrayName;		/* Name of the local array. */
     char *elem;
-    int leaveErrorMsg = (flags & TCL_LEAVE_ERR_MSG);
     Tcl_HashEntry *hPtr;
     Var *varPtr = NULL;		/* Points to the element's Var structure
 				 * that we return. */
@@ -1694,7 +1673,7 @@ TclSetElementOfIndexedArray(interp, localIndex, elemPtr, newValuePtr, flags)
      */
 
     if ((arrayPtr->flags & VAR_IN_HASHTABLE) && (arrayPtr->hPtr == NULL)) {
-	if (leaveErrorMsg) {
+	if (flags & TCL_LEAVE_ERR_MSG) {
 	    if (TclIsVarArrayElement(arrayPtr)) {
 		VarErrMsg(interp, arrayName, elem, "set", danglingElement);
 	    } else {
@@ -1715,7 +1694,7 @@ TclSetElementOfIndexedArray(interp, localIndex, elemPtr, newValuePtr, flags)
 	Tcl_InitHashTable(arrayPtr->value.tablePtr, TCL_STRING_KEYS);
 	TclClearVarUndefined(arrayPtr);
     } else if (!TclIsVarArray(arrayPtr)) {
-	if (leaveErrorMsg) {
+	if (flags & TCL_LEAVE_ERR_MSG) {
 	    VarErrMsg(interp, arrayName, elem, "set", needArray);
 	}
 	goto errorReturn;
@@ -1743,7 +1722,7 @@ TclSetElementOfIndexedArray(interp, localIndex, elemPtr, newValuePtr, flags)
      */
 
     if (TclIsVarArray(varPtr)) {
-	if (leaveErrorMsg) {
+	if (flags & TCL_LEAVE_ERR_MSG) {
 	    VarErrMsg(interp, arrayName, elem, "set", isArray);
 	}
 	goto errorReturn;
@@ -1760,10 +1739,6 @@ TclSetElementOfIndexedArray(interp, localIndex, elemPtr, newValuePtr, flags)
 	    varPtr->value.objPtr = NULL;
 	    oldValuePtr = NULL;
 	}
-
-	/*
-	 * We only handle TCL_LIST_ELEMENT in the TCL_APPEND_VALUE case
-	 */
 	if (flags & TCL_LIST_ELEMENT) {	/* append list element */
 	    if (oldValuePtr == NULL) {
 		TclNewObj(oldValuePtr);
@@ -1798,6 +1773,11 @@ TclSetElementOfIndexedArray(interp, localIndex, elemPtr, newValuePtr, flags)
 	    }
 	}
     } else if (newValuePtr != oldValuePtr) {	/* set new value */
+	/*
+	 * In this case we are replacing the value, so we don't need to
+	 * do more than swap the objects.
+	 */
+
 	varPtr->value.objPtr = newValuePtr;
 	Tcl_IncrRefCount(newValuePtr);		/* var is another ref to obj */
 	if (oldValuePtr != NULL) {
@@ -1816,7 +1796,7 @@ TclSetElementOfIndexedArray(interp, localIndex, elemPtr, newValuePtr, flags)
 	char *msg = CallTraces(iPtr, arrayPtr, varPtr, arrayName, elem,
 		TCL_TRACE_WRITES);
 	if (msg != NULL) {
-	    if (leaveErrorMsg) {
+	    if (flags & TCL_LEAVE_ERR_MSG) {
 		VarErrMsg(interp, arrayName, elem, "set", msg);
 	    }
 	    goto errorReturn;
@@ -1979,8 +1959,7 @@ TclIncrIndexedScalar(interp, localIndex, incrAmount)
     long i;
     int result;
 
-    varValuePtr = TclGetIndexedScalar(interp, localIndex,
-	    /*leaveErrorMsg*/ 1);
+    varValuePtr = TclGetIndexedScalar(interp, localIndex, TCL_LEAVE_ERR_MSG);
     if (varValuePtr == NULL) {
 	Tcl_AddObjErrorInfo(interp,
 		"\n    (reading value of variable to increment)", -1);
@@ -2067,7 +2046,7 @@ TclIncrElementOfIndexedArray(interp, localIndex, elemPtr, incrAmount)
     int result;
 
     varValuePtr = TclGetElementOfIndexedArray(interp, localIndex, elemPtr,
-	    /*leaveErrorMsg*/ 1);
+	    TCL_LEAVE_ERR_MSG);
     if (varValuePtr == NULL) {
 	Tcl_AddObjErrorInfo(interp,
 		"\n    (reading value of variable to increment)", -1);
@@ -2101,8 +2080,7 @@ TclIncrElementOfIndexedArray(interp, localIndex, elemPtr, incrAmount)
      */
     
     resultPtr = TclSetElementOfIndexedArray(interp, localIndex, elemPtr,
-	    varValuePtr,
-	    /*leaveErrorMsg*/ 1);
+	    varValuePtr, TCL_LEAVE_ERR_MSG);
     if (resultPtr == NULL) {
 	return NULL;
     }