Added compilation of [array exists], [array set] and [array unset]. Fixed a whole bunch of issues with opcode issuing that were causing problems with stack depth calculations.merge_to_trunk

8 files changed, 451 insertions, 36 deletions

diff --git a/generic/tclAssembly.c b/generic/tclAssembly.c
index 3b02ca2..7833105 100644
--- a/generic/tclAssembly.c
+++ b/generic/tclAssembly.c
@@ -362,6 +362,10 @@ static const TalInstDesc TalInstructionTable[] = {
 					 | INST_APPEND_ARRAY4),	2,	1},
     {"appendArrayStk",	ASSEM_1BYTE,	INST_APPEND_ARRAY_STK,	3,	1},
     {"appendStk",	ASSEM_1BYTE,	INST_APPEND_STK,	2,	1},
+    {"arrayExistsImm",	ASSEM_LVT4,	INST_ARRAY_EXISTS_IMM,	0,	1},
+    {"arrayExistsStk",	ASSEM_1BYTE,	INST_ARRAY_EXISTS_STK,	1,	1},
+    {"arrayMakeImm",	ASSEM_LVT4,	INST_ARRAY_MAKE_IMM,	0,	0},
+    {"arrayMakeStk",	ASSEM_1BYTE,	INST_ARRAY_MAKE_STK,	1,	0},
     {"beginCatch",	ASSEM_BEGIN_CATCH,
 					INST_BEGIN_CATCH4,	0,	0},
     {"bitand",		ASSEM_1BYTE,	INST_BITAND,		2,	1},
diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index 463e82c..160fa3c 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -15,6 +15,7 @@
 
 #include "tclInt.h"
 #include "tclCompile.h"
+#include <assert.h>
 
 /*
  * Prototypes for procedures defined later in this file:
@@ -225,6 +226,245 @@ TclCompileAppendCmd(
 /*
  *----------------------------------------------------------------------
  *
+ * TclCompileArray*Cmd --
+ *
+ *	Functions called to compile "array" sucommands.
+ *
+ * Results:
+ *	All return TCL_OK for a successful compile, and TCL_ERROR to defer
+ *	evaluation to runtime.
+ *
+ * Side effects:
+ *	Instructions are added to envPtr to execute the "array" subcommand at
+ *	runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompileArrayExistsCmd(
+    Tcl_Interp *interp,		/* Used for looking up stuff. */
+    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
+				 * created by Tcl_ParseCommand. */
+    Command *cmdPtr,		/* Points to defintion of command being
+				 * compiled. */
+    CompileEnv *envPtr)		/* Holds resulting instructions. */
+{
+    DefineLineInformation;	/* TIP #280 */
+    Tcl_Token *tokenPtr;
+    int simpleVarName, isScalar, localIndex;
+
+    if (parsePtr->numWords != 2) {
+	return TCL_ERROR;
+    }
+
+    tokenPtr = TokenAfter(parsePtr->tokenPtr);
+    PushVarNameWord(interp, tokenPtr, envPtr, 0,
+	    &localIndex, &simpleVarName, &isScalar, 1);
+    if (!isScalar) {
+	return TCL_ERROR;
+    }
+
+    if (localIndex >= 0) {
+	TclEmitInstInt4(INST_ARRAY_EXISTS_IMM, localIndex,	envPtr);
+    } else {
+	TclEmitOpcode(	INST_ARRAY_EXISTS_STK,			envPtr);
+    }
+    return TCL_OK;
+}
+
+int
+TclCompileArraySetCmd(
+    Tcl_Interp *interp,		/* Used for looking up stuff. */
+    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
+				 * created by Tcl_ParseCommand. */
+    Command *cmdPtr,		/* Points to defintion of command being
+				 * compiled. */
+    CompileEnv *envPtr)		/* Holds resulting instructions. */
+{
+    DefineLineInformation;	/* TIP #280 */
+    Tcl_Token *tokenPtr;
+    int simpleVarName, isScalar, localIndex;
+    int dataVar, iterVar, keyVar, valVar, infoIndex;
+    int back, fwd, offsetBack, offsetFwd, savedStackDepth;
+    ForeachInfo *infoPtr;
+
+    if (parsePtr->numWords != 3) {
+	return TCL_ERROR;
+    }
+
+    tokenPtr = TokenAfter(parsePtr->tokenPtr);
+    PushVarNameWord(interp, tokenPtr, envPtr, 0,
+	    &localIndex, &simpleVarName, &isScalar, 1);
+    if (!isScalar) {
+	return TCL_ERROR;
+    }
+    tokenPtr = TokenAfter(tokenPtr);
+
+    /*
+     * Special case: literal empty value argument is just an "ensure array"
+     * operation.
+     */
+
+    if (tokenPtr->type == TCL_TOKEN_SIMPLE_WORD && tokenPtr[1].size == 0) {
+	if (localIndex >= 0) {
+	    TclEmitInstInt4(INST_ARRAY_EXISTS_IMM, localIndex,	envPtr);
+	    TclEmitInstInt1(INST_JUMP_TRUE1, 7,			envPtr);
+	    TclEmitInstInt4(INST_ARRAY_MAKE_IMM, localIndex,	envPtr);
+	} else {
+	    TclEmitOpcode(  INST_DUP,				envPtr);
+	    TclEmitOpcode(  INST_ARRAY_EXISTS_STK,		envPtr);
+	    TclEmitInstInt1(INST_JUMP_TRUE1, 5,			envPtr);
+	    savedStackDepth = envPtr->currStackDepth;
+	    TclEmitOpcode(  INST_ARRAY_MAKE_STK,		envPtr);
+	    TclEmitInstInt1(INST_JUMP1, 3,			envPtr);
+	    envPtr->currStackDepth = savedStackDepth;
+	    TclEmitOpcode(  INST_POP,				envPtr);
+	}
+	PushLiteral(envPtr, "", 0);
+	return TCL_OK;
+    }
+
+    /*
+     * Prepare for the internal foreach.
+     */
+
+    if (envPtr->procPtr == NULL) {
+	return TCL_ERROR;
+    }
+    dataVar = TclFindCompiledLocal(NULL, 0, 1, envPtr);
+    iterVar = TclFindCompiledLocal(NULL, 0, 1, envPtr);
+    keyVar = TclFindCompiledLocal(NULL, 0, 1, envPtr);
+    valVar = TclFindCompiledLocal(NULL, 0, 1, envPtr);
+
+    infoPtr = ckalloc(sizeof(ForeachInfo) + sizeof(ForeachVarList *));
+    infoPtr->numLists = 1;
+    infoPtr->firstValueTemp = dataVar;
+    infoPtr->loopCtTemp = iterVar;
+    infoPtr->varLists[0] = ckalloc(sizeof(ForeachVarList) * 2*sizeof(int));
+    infoPtr->varLists[0]->numVars = 2;
+    infoPtr->varLists[0]->varIndexes[0] = keyVar;
+    infoPtr->varLists[0]->varIndexes[1] = valVar;
+    infoIndex = TclCreateAuxData(infoPtr, &tclForeachInfoType, envPtr);
+
+    /*
+     * Start issuing instructions to write to the array.
+     */
+
+    CompileWord(envPtr, tokenPtr, interp, 2);
+    TclEmitOpcode(	INST_DUP,				envPtr);
+    TclEmitOpcode(	INST_LIST_LENGTH,			envPtr);
+    PushLiteral(envPtr, "1", 1);
+    TclEmitOpcode(	INST_BITAND,				envPtr);
+    offsetFwd = CurrentOffset(envPtr);
+    TclEmitInstInt1(	INST_JUMP_FALSE1, 0,			envPtr);
+    savedStackDepth = envPtr->currStackDepth;
+    PushLiteral(envPtr, "list must have an even number of elements",
+	    strlen("list must have an even number of elements"));
+    PushLiteral(envPtr, "-errorCode {TCL ARGUMENT FORMAT}",
+	    strlen("-errorCode {TCL ARGUMENT FORMAT}"));
+    TclEmitInstInt4(	INST_RETURN_IMM, 1,			envPtr);
+    TclEmitInt4(		0,				envPtr);
+    envPtr->currStackDepth = savedStackDepth;
+    fwd = CurrentOffset(envPtr) - offsetFwd;
+    TclStoreInt1AtPtr(fwd, envPtr->codeStart+offsetFwd+1);
+    Emit14Inst(		INST_STORE_SCALAR, dataVar,		envPtr);
+    TclEmitOpcode(	INST_POP,				envPtr);
+
+    if (localIndex >= 0) {
+	TclEmitInstInt4(INST_ARRAY_EXISTS_IMM, localIndex,	envPtr);
+	TclEmitInstInt1(INST_JUMP_TRUE1, 7,			envPtr);
+	TclEmitInstInt4(INST_ARRAY_MAKE_IMM, localIndex,	envPtr);
+	TclEmitInstInt4(INST_FOREACH_START4, infoIndex,		envPtr);
+	offsetBack = CurrentOffset(envPtr);
+	TclEmitInstInt4(INST_FOREACH_STEP4, infoIndex,		envPtr);
+	offsetFwd = CurrentOffset(envPtr);
+	TclEmitInstInt1(INST_JUMP_FALSE1, 0,			envPtr);
+	savedStackDepth = envPtr->currStackDepth;
+	Emit14Inst(	INST_LOAD_SCALAR, keyVar,		envPtr);
+	Emit14Inst(	INST_LOAD_SCALAR, valVar,		envPtr);
+	Emit14Inst(	INST_STORE_ARRAY, localIndex,		envPtr);
+	TclEmitOpcode(	INST_POP,				envPtr);
+	back = offsetBack - CurrentOffset(envPtr);
+	TclEmitInstInt1(INST_JUMP1, back,			envPtr);
+	fwd = CurrentOffset(envPtr) - offsetFwd;
+	TclStoreInt1AtPtr(fwd, envPtr->codeStart+offsetFwd+1);
+	envPtr->currStackDepth = savedStackDepth;
+    } else {
+	TclEmitOpcode(	INST_DUP,				envPtr);
+	TclEmitOpcode(	INST_ARRAY_EXISTS_STK,			envPtr);
+	TclEmitInstInt1(INST_JUMP_TRUE1, 4,			envPtr);
+	TclEmitOpcode(	INST_DUP,				envPtr);
+	TclEmitOpcode(	INST_ARRAY_MAKE_STK,			envPtr);
+	TclEmitInstInt4(INST_FOREACH_START4, infoIndex,		envPtr);
+	offsetBack = CurrentOffset(envPtr);
+	TclEmitInstInt4(INST_FOREACH_STEP4, infoIndex,		envPtr);
+	offsetFwd = CurrentOffset(envPtr);
+	TclEmitInstInt1(INST_JUMP_FALSE1, 0,			envPtr);
+	savedStackDepth = envPtr->currStackDepth;
+	TclEmitOpcode(	INST_DUP,				envPtr);
+	Emit14Inst(	INST_LOAD_SCALAR, keyVar,		envPtr);
+	Emit14Inst(	INST_LOAD_SCALAR, valVar,		envPtr);
+	TclEmitOpcode(	INST_STORE_ARRAY_STK,			envPtr);
+	TclEmitOpcode(	INST_POP,				envPtr);
+	back = offsetBack - CurrentOffset(envPtr);
+	TclEmitInstInt1(INST_JUMP1, back,			envPtr);
+	fwd = CurrentOffset(envPtr) - offsetFwd;
+	TclStoreInt1AtPtr(fwd, envPtr->codeStart+offsetFwd+1);
+	envPtr->currStackDepth = savedStackDepth;
+	TclEmitOpcode(	INST_POP,				envPtr);
+    }
+    TclEmitInstInt1(	INST_UNSET_SCALAR, 0,			envPtr);
+    TclEmitInt4(		dataVar,			envPtr);
+    PushLiteral(envPtr,	"", 0);
+    return TCL_OK;
+}
+
+int
+TclCompileArrayUnsetCmd(
+    Tcl_Interp *interp,		/* Used for looking up stuff. */
+    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
+				 * created by Tcl_ParseCommand. */
+    Command *cmdPtr,		/* Points to defintion of command being
+				 * compiled. */
+    CompileEnv *envPtr)		/* Holds resulting instructions. */
+{
+    DefineLineInformation;	/* TIP #280 */
+    Tcl_Token *tokenPtr = TokenAfter(parsePtr->tokenPtr);
+    int simpleVarName, isScalar, localIndex, savedStackDepth;
+
+    if (parsePtr->numWords != 2) {
+	return TCL_ERROR;
+    }
+
+    PushVarNameWord(interp, tokenPtr, envPtr, 0,
+	    &localIndex, &simpleVarName, &isScalar, 1);
+    if (!isScalar) {
+	return TCL_ERROR;
+    }
+
+    if (localIndex >= 0) {
+	TclEmitInstInt4(INST_ARRAY_EXISTS_IMM, localIndex,	envPtr);
+	TclEmitInstInt1(INST_JUMP_FALSE1, 8,			envPtr);
+	TclEmitInstInt1(INST_UNSET_SCALAR, 1,			envPtr);
+	TclEmitInt4(		localIndex,			envPtr);
+    } else {
+	TclEmitOpcode(	INST_DUP,				envPtr);
+	TclEmitOpcode(	INST_ARRAY_EXISTS_STK,			envPtr);
+	TclEmitInstInt1(INST_JUMP_FALSE1, 6,			envPtr);
+	savedStackDepth = envPtr->currStackDepth;
+	TclEmitInstInt1(INST_UNSET_STK, 1,			envPtr);
+	TclEmitInstInt1(INST_JUMP1, 3,				envPtr);
+	envPtr->currStackDepth = savedStackDepth;
+	TclEmitOpcode(	INST_POP,				envPtr);
+    }
+    PushLiteral(envPtr,	"", 0);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * TclCompileBreakCmd --
  *
  *	Procedure called to compile the "break" command.
@@ -258,6 +498,7 @@ TclCompileBreakCmd(
      */
 
     TclEmitOpcode(INST_BREAK, envPtr);
+    PushLiteral(envPtr, "", 0);	/* Evil hack! */
     return TCL_OK;
 }
 
@@ -564,6 +805,7 @@ TclCompileContinueCmd(
      */
 
     TclEmitOpcode(INST_CONTINUE, envPtr);
+    PushLiteral(envPtr, "", 0);	/* Evil hack! */
     return TCL_OK;
 }
 
@@ -582,26 +824,6 @@ TclCompileContinueCmd(
  *	Instructions are added to envPtr to execute the "dict" subcommand at
  *	runtime.
  *
- * Notes:
- *	The following commands are in fairly common use and are possibly worth
- *	bytecoding:
- *		dict append
- *		dict create	[*]
- *		dict exists	[*]
- *		dict for
- *		dict get	[*]
- *		dict incr
- *		dict keys	[*]
- *		dict lappend
- *		dict map
- *		dict set
- *		dict unset
- *
- *	In practice, those that are pure-value operators (marked with [*]) can
- *	probably be left alone (except perhaps [dict get] which is very very
- *	common) and [dict update] should be considered instead (really big
- *	win!)
- *
  *----------------------------------------------------------------------
  */
 
@@ -666,6 +888,7 @@ TclCompileDictSetCmd(
 
     TclEmitInstInt4( INST_DICT_SET, numWords-2,		envPtr);
     TclEmitInt4(     dictVarIndex,			envPtr);
+    TclAdjustStackDepth(-1, envPtr);
     return TCL_OK;
 }
 
@@ -783,6 +1006,7 @@ TclCompileDictGetCmd(
 	tokenPtr = TokenAfter(tokenPtr);
     }
     TclEmitInstInt4(INST_DICT_GET, numWords-1, envPtr);
+    TclAdjustStackDepth(-1, envPtr);
     return TCL_OK;
 }
 
@@ -819,6 +1043,7 @@ TclCompileDictExistsCmd(
 	tokenPtr = TokenAfter(tokenPtr);
     }
     TclEmitInstInt4(INST_DICT_EXISTS, numWords-1, envPtr);
+    TclAdjustStackDepth(-1, envPtr);
     return TCL_OK;
 }
 
@@ -879,7 +1104,7 @@ TclCompileDictUnsetCmd(
      */
 
     TclEmitInstInt4( INST_DICT_UNSET, parsePtr->numWords-2,	envPtr);
-    TclEmitInt4(     dictVarIndex,				envPtr);
+    TclEmitInt4(	dictVarIndex,				envPtr);
     return TCL_OK;
 }
 
@@ -967,6 +1192,7 @@ TclCompileDictCreateCmd(
 	tokenPtr = TokenAfter(tokenPtr);
 	TclEmitInstInt4(	INST_DICT_SET, 1,		envPtr);
 	TclEmitInt4(			worker,			envPtr);
+	TclAdjustStackDepth(-1, envPtr);
 	TclEmitOpcode(		INST_POP,			envPtr);
     }
     Emit14Inst(			INST_LOAD_SCALAR, worker,	envPtr);
@@ -1048,6 +1274,7 @@ TclCompileDictMergeCmd(
 	TclEmitInstInt4(	INST_REVERSE, 2,		envPtr);
 	TclEmitInstInt4(	INST_DICT_SET, 1,		envPtr);
 	TclEmitInt4(			workerIndex,		envPtr);
+	TclAdjustStackDepth(-1, envPtr);
 	TclEmitOpcode(		INST_POP,			envPtr);
 	TclEmitInstInt4(	INST_DICT_NEXT, infoIndex,	envPtr);
 	TclEmitInstInt1(	INST_JUMP_FALSE1, -20,		envPtr);
@@ -1275,6 +1502,7 @@ CompileDictEachCmd(
 	TclEmitInstInt4(INST_OVER, 1,				envPtr);
 	TclEmitInstInt4(INST_DICT_SET, 1,			envPtr);
 	TclEmitInt4(		collectVar,			envPtr);
+	TclAdjustStackDepth(-1, envPtr);
 	TclEmitOpcode(	INST_POP,				envPtr);
     }
     TclEmitOpcode(	INST_POP,				envPtr);
@@ -1337,7 +1565,7 @@ CompileDictEachCmd(
      * easy!) Note that we skip the END_CATCH. [Bug 1382528]
      */
 
-    envPtr->currStackDepth = savedStackDepth+2;
+    envPtr->currStackDepth = savedStackDepth + 2;
     jumpDisplacement = CurrentOffset(envPtr) - emptyTargetOffset;
     TclUpdateInstInt4AtPc(INST_JUMP_TRUE4, jumpDisplacement,
 	    envPtr->codeStart + emptyTargetOffset);
@@ -1533,6 +1761,7 @@ TclCompileDictUpdateCmd(
 		(int) (CurrentOffset(envPtr) - jumpFixup.codeOffset));
     }
     TclStackFree(interp, keyTokenPtrs);
+    envPtr->currStackDepth = savedStackDepth + 1;
     return TCL_OK;
 }
 
@@ -1781,6 +2010,7 @@ TclCompileDictWithCmd(
 		PushLiteral(envPtr, "", 0);
 	    }
 	}
+	envPtr->currStackDepth = savedStackDepth + 1;
 	return TCL_OK;
     }
 
@@ -1899,6 +2129,7 @@ TclCompileDictWithCmd(
      * Prepare for the start of the next command.
      */
 
+    envPtr->currStackDepth = savedStackDepth + 1;
     if (TclFixupForwardJumpToHere(envPtr, &jumpFixup, 127)) {
 	Tcl_Panic("TclCompileDictCmd(update): bad jump distance %d",
 		(int) (CurrentOffset(envPtr) - jumpFixup.codeOffset));
@@ -1998,6 +2229,7 @@ TclCompileErrorCmd(
      * However, we only deal with the case where there is just a message.
      */
     Tcl_Token *messageTokenPtr;
+    int savedStackDepth = envPtr->currStackDepth;
     DefineLineInformation;	/* TIP #280 */
 
     if (parsePtr->numWords != 2) {
@@ -2008,6 +2240,7 @@ TclCompileErrorCmd(
     PushLiteral(envPtr, "-code error -level 0", 20);
     CompileWord(envPtr, messageTokenPtr, interp, 1);
     TclEmitOpcode(INST_RETURN_STK, envPtr);
+    envPtr->currStackDepth = savedStackDepth + 1;
     return TCL_OK;
 }
 
@@ -5238,6 +5471,7 @@ TclCompileReturnCmd(
     int numWords = parsePtr->numWords;
     int explicitResult = (0 == (numWords % 2));
     int numOptionWords = numWords - 1 - explicitResult;
+    int savedStackDepth = envPtr->currStackDepth;
     Tcl_Obj *returnOpts, **objv;
     Tcl_Token *wordTokenPtr = TokenAfter(parsePtr->tokenPtr);
     DefineLineInformation;	/* TIP #280 */
@@ -5260,6 +5494,7 @@ TclCompileReturnCmd(
 	CompileWord(envPtr, optsTokenPtr, interp, 2);
 	CompileWord(envPtr, msgTokenPtr,  interp, 3);
 	TclEmitOpcode(INST_RETURN_STK, envPtr);
+	envPtr->currStackDepth = savedStackDepth + 1;
 	return TCL_OK;
     }
 
diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c
index 090f996..be63e0e 100644
--- a/generic/tclCompCmdsSZ.c
+++ b/generic/tclCompCmdsSZ.c
@@ -995,6 +995,7 @@ TclSubstCompile(
     if (state != NULL) {
 	Tcl_RestoreInterpState(interp, state);
 	TclCompileSyntaxError(interp, envPtr);
+	TclAdjustStackDepth(-1, envPtr);
     }
 
     /* Final target of the multi-jump from all BREAKs */
@@ -1639,6 +1640,7 @@ IssueSwitchJumpTable(
     int **bodyContLines)	/* Array of continuation line info. */
 {
     JumptableInfo *jtPtr;
+    int savedStackDepth = envPtr->currStackDepth;
     int infoIndex, isNew, *finalFixups, numRealBodies = 0, jumpLocation;
     int mustGenerate, foundDefault, jumpToDefault, i;
     Tcl_DString buffer;
@@ -1751,6 +1753,7 @@ IssueSwitchJumpTable(
 	 * Compile the body of the arm.
 	 */
 
+	envPtr->currStackDepth = savedStackDepth;
 	envPtr->line = bodyLines[i+1];		/* TIP #280 */
 	envPtr->clNext = bodyContLines[i+1];	/* TIP #280 */
 	TclCompileCmdWord(interp, bodyToken[i+1], 1, envPtr);
@@ -1782,6 +1785,7 @@ IssueSwitchJumpTable(
      */
 
     if (!foundDefault) {
+	envPtr->currStackDepth = savedStackDepth;
 	TclStoreInt4AtPtr(CurrentOffset(envPtr)-jumpToDefault,
 		envPtr->codeStart+jumpToDefault+1);
 	PushLiteral(envPtr, "", 0);
@@ -1802,6 +1806,7 @@ IssueSwitchJumpTable(
      */
 
     TclStackFree(interp, finalFixups);
+    envPtr->currStackDepth = savedStackDepth + 1;
 }
 
 /*
@@ -1957,6 +1962,7 @@ TclCompileThrowCmd(
 {
     DefineLineInformation;	/* TIP #280 */
     int numWords = parsePtr->numWords;
+    int savedStackDepth = envPtr->currStackDepth;
     Tcl_Token *codeToken, *msgToken;
     Tcl_Obj *objPtr;
 
@@ -1987,6 +1993,7 @@ TclCompileThrowCmd(
 	    CompileWord(envPtr, msgToken, interp, 2);
 	    TclCompileSyntaxError(interp, envPtr);
 	    Tcl_DecrRefCount(objPtr);
+	    envPtr->currStackDepth = savedStackDepth + 1;
 	    return TCL_OK;
 	}
 	if (len == 0) {
@@ -2007,6 +2014,7 @@ TclCompileThrowCmd(
 	PushLiteral(envPtr, string, len);
 	TclDecrRefCount(dictPtr);
 	OP44(				RETURN_IMM, 1, 0);
+	envPtr->currStackDepth = savedStackDepth + 1;
     } else {
 	/*
 	 * When the code token is not known at compilation time, we need to do
@@ -2035,6 +2043,7 @@ TclCompileThrowCmd(
 	PUSH(				"");
 	OP44(				RETURN_IMM, 1, 0);
     }
+    envPtr->currStackDepth = savedStackDepth + 1;
     TclDecrRefCount(objPtr);
     return TCL_OK;
 }
@@ -2302,6 +2311,7 @@ IssueTryInstructions(
 {
     DefineLineInformation;	/* TIP #280 */
     int range, resultVar, optionsVar;
+    int savedStackDepth = envPtr->currStackDepth;
     int i, j, len, forwardsNeedFixing = 0;
     int *addrsToFix, *forwardsToFix, notCodeJumpSource, notECJumpSource;
     char buf[TCL_INTEGER_SPACE];
@@ -2363,6 +2373,7 @@ IssueTryInstructions(
 	    LOAD(			optionsVar);
 	    PUSH(			"-errorcode");
 	    OP4(			DICT_GET, 1);
+	    TclAdjustStackDepth(-1, envPtr);
 	    OP44(			LIST_RANGE_IMM, 0, len-1);
 	    PUSH(			TclGetString(matchClauses[i]));
 	    OP(				STR_EQ);
@@ -2403,6 +2414,7 @@ IssueTryInstructions(
 		    forwardsToFix[j] = -1;
 		}
 	    }
+	    envPtr->currStackDepth = savedStackDepth;
 	    BODY(			handlerTokens[i], 5+i*4);
 	}
 
@@ -2434,6 +2446,7 @@ IssueTryInstructions(
     }
     TclStackFree(interp, forwardsToFix);
     TclStackFree(interp, addrsToFix);
+    envPtr->currStackDepth = savedStackDepth + 1;
     return TCL_OK;
 }
 
@@ -2470,6 +2483,7 @@ IssueTryFinallyInstructions(
     range = DeclareExceptionRange(envPtr, CATCH_EXCEPTION_RANGE);
     OP4(				BEGIN_CATCH4, range);
     ExceptionRangeStarts(envPtr, range);
+    envPtr->currStackDepth = savedStackDepth;
     BODY(				bodyToken, 1);
     ExceptionRangeEnds(envPtr, range);
     PUSH(				"0");
@@ -2514,6 +2528,7 @@ IssueTryFinallyInstructions(
 		LOAD(			optionsVar);
 		PUSH(			"-errorcode");
 		OP4(			DICT_GET, 1);
+		TclAdjustStackDepth(-1, envPtr);
 		OP44(			LIST_RANGE_IMM, 0, len-1);
 		PUSH(			TclGetString(matchClauses[i]));
 		OP(			STR_EQ);
@@ -2586,6 +2601,7 @@ IssueTryFinallyInstructions(
 		}
 		OP4(			BEGIN_CATCH4, range);
 	    }
+	    envPtr->currStackDepth = savedStackDepth;
 	    BODY(			handlerTokens[i], 5+i*4);
 	    ExceptionRangeEnds(envPtr, range);
 	    OP(				PUSH_RETURN_OPTIONS);
@@ -2637,7 +2653,6 @@ IssueTryFinallyInstructions(
      */
 
     OP(					POP);
-    envPtr->currStackDepth = savedStackDepth;
 
     /*
      * Process the finally clause (at last!) Note that we do not wrap this in
@@ -2647,11 +2662,13 @@ IssueTryFinallyInstructions(
      * next command (or some inter-command manipulation).
      */
 
+    envPtr->currStackDepth = savedStackDepth;
     BODY(				finallyToken, 3 + 4*numHandlers);
     OP(					POP);
     LOAD(				optionsVar);
     LOAD(				resultVar);
     OP(					RETURN_STK);
+    envPtr->currStackDepth = savedStackDepth + 1;
 
     return TCL_OK;
 }
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index 2c87b34..309682d 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -372,13 +372,13 @@ InstructionDesc const tclInstructionTable[] = {
 	 * Stack:  ... value => ...
 	 * Note that the jump table contains offsets relative to the PC when
 	 * it points to this instruction; the code is relocatable. */
-    {"upvar",            5,     0,        1,   {OPERAND_LVT4}},
+    {"upvar",            5,    -1,        1,   {OPERAND_LVT4}},
 	/* finds level and otherName in stack, links to local variable at
 	 * index op1. Leaves the level on stack. */
-    {"nsupvar",          5,     0,        1,   {OPERAND_LVT4}},
+    {"nsupvar",          5,    -1,        1,   {OPERAND_LVT4}},
 	/* finds namespace and otherName in stack, links to local variable at
 	 * index op1. Leaves the namespace on stack. */
-    {"variable",         5,     0,        1,   {OPERAND_LVT4}},
+    {"variable",         5,    -1,        1,   {OPERAND_LVT4}},
 	/* finds namespace and otherName in stack, links to local variable at
 	 * index op1. Leaves the namespace on stack. */
     {"syntax",		 9,   -1,         2,	{OPERAND_INT4, OPERAND_UINT4}},
@@ -509,6 +509,26 @@ InstructionDesc const tclInstructionTable[] = {
 	 * context.
 	 * Stack:  ... value => ... boolean */
 
+    {"arrayExistsStk",	 1,	0,	  0,	{OPERAND_NONE}},
+	/* Looks up the element on the top of the stack and tests whether it
+	 * is an array. Pushes a boolean describing whether this is the
+	 * case. Also runs the whole-array trace on the named variable, so can
+	 * throw anything.
+	 * Stack:  ... varName => ... boolean */
+    {"arrayExistsImm",	 5,	+1,	  1,	{OPERAND_UINT4}},
+	/* Looks up the variable indexed by opnd and tests whether it is an
+	 * array. Pushes a boolean describing whether this is the case. Also
+	 * runs the whole-array trace on the named variable, so can throw
+	 * anything.
+	 * Stack:  ... => ... boolean */
+    {"arrayMakeStk",	 1,	-1,	  0,	{OPERAND_NONE}},
+	/* Forces the element on the top of the stack to be the name of an
+	 * array.
+	 * Stack:  ... varName => ... */
+    {"arrayMakeImm",	 5,	0,	  1,	{OPERAND_UINT4}},
+	/* Forces the variable indexed by opnd to be an array. Does not touch
+	 * the stack. */
+
     {NULL, 0, 0, 0, {OPERAND_NONE}}
 };
 
@@ -1751,6 +1771,9 @@ TclCompileScript(
 			unsigned savedCodeNext =
 				envPtr->codeNext - envPtr->codeStart;
 			int update = 0;
+#ifdef TCL_COMPILE_DEBUG
+			int startStackDepth = envPtr->currStackDepth;
+#endif
 
 			/*
 			 * Mark the start of the command; the proper bytecode
@@ -1794,6 +1817,25 @@ TclCompileScript(
 				envPtr);
 
 			if (code == TCL_OK) {
+			    /*
+			     * Confirm that the command compiler generated a
+			     * single value on the stack as its result. This
+			     * is only done in debugging mode, as it *should*
+			     * be correct and normal users have no reasonable
+			     * way to fix it anyway.
+			     */
+
+#ifdef TCL_COMPILE_DEBUG
+			    int diff = envPtr->currStackDepth-startStackDepth;
+
+			    if (diff != 1 && (diff != 0 ||
+				   *(envPtr->codeNext-1) != INST_DONE)) {
+				Tcl_Panic("bad stack adjustment when compiling"
+					" %.*s (was %d instead of 1)",
+					parsePtr->tokenPtr->size,
+					parsePtr->tokenPtr->start, diff);
+			    }
+#endif
 			    if (update) {
 				/*
 				 * Fix the bytecode length.
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index b080d33..3302f9b 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -705,8 +705,14 @@ typedef struct ByteCode {
 #define INST_TCLOO_NS			157
 #define INST_TCLOO_IS_OBJECT		158
 
+/* For compilation of [array] subcommands */
+#define INST_ARRAY_EXISTS_STK		159
+#define INST_ARRAY_EXISTS_IMM		160
+#define INST_ARRAY_MAKE_STK		161
+#define INST_ARRAY_MAKE_IMM		162
+
 /* The last opcode */
-#define LAST_INST_OPCODE		158
+#define LAST_INST_OPCODE		162
 
 /*
  * Table describing the Tcl bytecode instructions: their name (for displaying
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 2b29d5c..caf35ba 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -2389,14 +2389,18 @@ TEBCresume(
 	}
 
 #ifdef TCL_COMPILE_DEBUG
-	TRACE(("%d [", opnd));
-	for (i=opnd-1 ; i>=0 ; i++) {
-	    TRACE_APPEND(("\"%.30s\"", O2S(OBJ_AT_DEPTH(i))));
-	    if (i > 0) {
-		TRACE_APPEND((" "));
+	{
+	    register int i;
+
+	    TRACE(("%d [", opnd));
+	    for (i=opnd-1 ; i>=0 ; i++) {
+		TRACE_APPEND(("\"%.30s\"", O2S(OBJ_AT_DEPTH(i))));
+		if (i > 0) {
+		    TRACE_APPEND((" "));
+		}
 	    }
+	    TRACE_APPEND(("] => RETURN..."));
 	}
-	TRACE_APPEND(("] => RETURN..."));
 #endif
 
 	/*
@@ -3877,6 +3881,104 @@ TEBCresume(
     /*
      *	   End of INST_UNSET instructions.
      * -----------------------------------------------------------------
+     *	   Start of INST_ARRAY instructions.
+     */
+
+    case INST_ARRAY_EXISTS_IMM:
+	opnd = TclGetUInt4AtPtr(pc+1);
+	pcAdjustment = 5;
+	cleanup = 0;
+	part1Ptr = NULL;
+	arrayPtr = NULL;
+	TRACE(("%u => ", opnd));
+	varPtr = LOCAL(opnd);
+	while (TclIsVarLink(varPtr)) {
+	    varPtr = varPtr->value.linkPtr;
+	}
+	goto doArrayExists;
+    case INST_ARRAY_EXISTS_STK:
+	opnd = -1;
+	pcAdjustment = 1;
+	cleanup = 1;
+	part1Ptr = OBJ_AT_TOS;
+	TRACE(("\"%.30s\" => ", O2S(part1Ptr)));
+	varPtr = TclObjLookupVarEx(interp, part1Ptr, NULL, 0, NULL,
+		/*createPart1*/0, /*createPart2*/0, &arrayPtr);
+    doArrayExists:
+	if (varPtr && (varPtr->flags & VAR_TRACED_ARRAY)
+		&& (TclIsVarArray(varPtr) || TclIsVarUndefined(varPtr))) {
+	    DECACHE_STACK_INFO();
+	    result = TclObjCallVarTraces(iPtr, arrayPtr, varPtr, part1Ptr,
+		    NULL, (TCL_LEAVE_ERR_MSG|TCL_NAMESPACE_ONLY|
+		    TCL_GLOBAL_ONLY|TCL_TRACE_ARRAY), 1, opnd);
+	    CACHE_STACK_INFO();
+	    if (result == TCL_ERROR) {
+		TRACE_APPEND(("ERROR: %.30s\n",
+			O2S(Tcl_GetObjResult(interp))));
+		goto gotError;
+	    }
+	}
+	if (varPtr && TclIsVarArray(varPtr) && !TclIsVarUndefined(varPtr)) {
+	    objResultPtr = TCONST(1);
+	} else {
+	    objResultPtr = TCONST(0);
+	}
+	TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
+	NEXT_INST_V(pcAdjustment, cleanup, 1);
+
+    case INST_ARRAY_MAKE_IMM:
+	opnd = TclGetUInt4AtPtr(pc+1);
+	pcAdjustment = 5;
+	cleanup = 0;
+	part1Ptr = NULL;
+	arrayPtr = NULL;
+	TRACE(("%u => ", opnd));
+	varPtr = LOCAL(opnd);
+	while (TclIsVarLink(varPtr)) {
+	    varPtr = varPtr->value.linkPtr;
+	}
+	goto doArrayMake;
+    case INST_ARRAY_MAKE_STK:
+	opnd = -1;
+	pcAdjustment = 1;
+	cleanup = 1;
+	part1Ptr = OBJ_AT_TOS;
+	TRACE(("\"%.30s\" => ", O2S(part1Ptr)));
+	varPtr = TclObjLookupVarEx(interp, part1Ptr, NULL, TCL_LEAVE_ERR_MSG,
+		"set", /*createPart1*/1, /*createPart2*/0, &arrayPtr);
+	if (varPtr == NULL) {
+	    TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
+	    goto gotError;
+	}
+    doArrayMake:
+	if (varPtr && !TclIsVarArray(varPtr)) {
+	    if (TclIsVarArrayElement(varPtr) || !TclIsVarUndefined(varPtr)) {
+		/*
+		 * Either an array element, or a scalar: lose!
+		 */
+
+		TclObjVarErrMsg(interp, part1Ptr, NULL, "array set",
+			"variable isn't array", opnd);
+		Tcl_SetErrorCode(interp, "TCL", "WRITE", "ARRAY", NULL);
+		TRACE_APPEND(("ERROR: bad array ref: %.30s\n",
+			O2S(Tcl_GetObjResult(interp))));
+		goto gotError;
+	    }
+	    TclSetVarArray(varPtr);
+	    varPtr->value.tablePtr = ckalloc(sizeof(TclVarHashTable));
+	    TclInitVarHashTable(varPtr->value.tablePtr,
+		    TclGetVarNsPtr(varPtr));
+#ifdef TCL_COMPILE_DEBUG
+	    TRACE_APPEND(("done\n"));
+	} else {
+	    TRACE_APPEND(("nothing to do\n"));
+#endif
+	}
+	NEXT_INST_V(pcAdjustment, cleanup, 0);
+
+    /*
+     *	   End of INST_ARRAY instructions.
+     * -----------------------------------------------------------------
      *	   Start of variable linking instructions.
      */
 
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 7dc21c1..1d04c82 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -3491,6 +3491,15 @@ MODULE_SCOPE int	Tcl_WhileObjCmd(ClientData clientData,
 MODULE_SCOPE int	TclCompileAppendCmd(Tcl_Interp *interp,
 			    Tcl_Parse *parsePtr, Command *cmdPtr,
 			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclCompileArrayExistsCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclCompileArraySetCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclCompileArrayUnsetCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr);
 MODULE_SCOPE int	TclCompileBreakCmd(Tcl_Interp *interp,
 			    Tcl_Parse *parsePtr, Command *cmdPtr,
 			    struct CompileEnv *envPtr);
diff --git a/generic/tclVar.c b/generic/tclVar.c
index e31e9cf..1c01e41 100644
--- a/generic/tclVar.c
+++ b/generic/tclVar.c
@@ -4224,15 +4224,15 @@ TclInitArrayCmd(
     static const EnsembleImplMap arrayImplMap[] = {
 	{"anymore",	ArrayAnyMoreCmd,	NULL, NULL, NULL, 0},
 	{"donesearch",	ArrayDoneSearchCmd,	NULL, NULL, NULL, 0},
-	{"exists",	ArrayExistsCmd,		NULL, NULL, NULL, 0},
+	{"exists",	ArrayExistsCmd,		TclCompileArrayExistsCmd, NULL, NULL, 0},
 	{"get",		ArrayGetCmd,		NULL, NULL, NULL, 0},
 	{"names",	ArrayNamesCmd,		NULL, NULL, NULL, 0},
 	{"nextelement",	ArrayNextElementCmd,	NULL, NULL, NULL, 0},
-	{"set",		ArraySetCmd,		NULL, NULL, NULL, 0},
+	{"set",		ArraySetCmd,		TclCompileArraySetCmd, NULL, NULL, 0},
 	{"size",	ArraySizeCmd,		NULL, NULL, NULL, 0},
 	{"startsearch",	ArrayStartSearchCmd,	NULL, NULL, NULL, 0},
 	{"statistics",	ArrayStatsCmd,		NULL, NULL, NULL, 0},
-	{"unset",	ArrayUnsetCmd,		NULL, NULL, NULL, 0},
+	{"unset",	ArrayUnsetCmd,		TclCompileArrayUnsetCmd, NULL, NULL, 0},
 	{NULL, NULL, NULL, NULL, NULL, 0}
     };