Make the [unset] command be bytecode compiled.

8 files changed, 724 insertions, 401 deletions

diff --git a/ChangeLog b/ChangeLog
index c4656c5..0f7713d 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,30 +1,40 @@
+2010-01-30  Donal K. Fellows  <dkf@users.sf.net>
+
+	* generic/tclCompile.c (tclInstructionTable):	Bytecode instructions
+	* generic/tclCompCmds.c (TclCompileUnsetCmd):	to allow the [unset]
+	* generic/tclExecute.c (TclExecuteByteCode):	command to be compiled
+	with the compiler being a complete compilation for all compile-time
+	decidable uses.
+
+	* generic/tclVar.c (TclPtrUnsetVar): Var reference version of the code
+	to unset a variable. Required for INST_UNSET bytecodes.
+
 2010-01-29  Jan Nijtmans  <nijtmans@users.sf.net>
 
-	* generic/tcl.h         Reverted Tcl_ThreadDataKey type change,
-	                        see Bug #2942081
-	                        Changed some Tcl_CallFrame fields from "char *"
-	                        to "void *". This saves unnecessary space on
-	                        Cray's (and it's simply more correct).
-
-	* tools/genStubs.tcl:   No longer generate a space after "*" and
-	                        immediately after a function name, so the
-	                        format of function definitions in tcl*Decls.h 
-	                        match all other tcl*.h header files.
-	* doc/ParseArgs.3:      Change Tcl_ArgvFuncProc, Tcl_ArgvGenFuncProc
-	* generic/tcl.h         and GetFrameInfoValueProc to be function
-	* generic/tclInt.h      definitions, not pointers, for consistency
-	* generic/tclOOInt.h    with all other Tcl function definitions.
-	* generic/tclIndexObj.c
-	* generic/regguts.h:    CONST -> const
-	* generic/tcl.decls     Formatting
-	* generic/tclTomMath.decls Formatting
-	* generic/tclDecls.h    (regenerated)
-	* generic/tclIntDecls.h
-	* generic/tclIntPlatDecls.h
-	* generic/tclOODecls.h
-	* generic/tclOOIntDecls.h
-	* generic/tclPlatDecls.h
-	* generic/tclTomMathDecls.h
+	* generic/tcl.h: [Bug 2942081]: Reverted Tcl_ThreadDataKey type change
+				Changed some Tcl_CallFrame fields from "char *"
+				to "void *". This saves unnecessary space on
+				Cray's (and it's simply more correct).
+
+	* tools/genStubs.tcl:	No longer generate a space after "*" and
+				immediately after a function name, so the
+				format of function definitions in tcl*Decls.h 
+				match all other tcl*.h header files.
+	* doc/ParseArgs.3:	Change Tcl_ArgvFuncProc, Tcl_ArgvGenFuncProc
+	* generic/tcl.h:	and GetFrameInfoValueProc to be function
+	* generic/tclInt.h:	definitions, not pointers, for consistency
+	* generic/tclOOInt.h:	with all other Tcl function definitions.
+	* generic/tclIndexObj.c:
+	* generic/regguts.h:	CONST -> const
+	* generic/tcl.decls:	Formatting
+	* generic/tclTomMath.decls: Formatting
+	* generic/tclDecls.h:	(regenerated)
+	* generic/tclIntDecls.h:
+	* generic/tclIntPlatDecls.h:
+	* generic/tclOODecls.h:
+	* generic/tclOOIntDecls.h:
+	* generic/tclPlatDecls.h:
+	* generic/tclTomMathDecls.h:
 
 2010-01-28  Donal K. Fellows  <dkf@users.sf.net>
 
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 254760d..2612aef 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -16,7 +16,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclBasic.c,v 1.438 2010/01/03 20:29:11 msofer Exp $
+ * RCS: @(#) $Id: tclBasic.c,v 1.439 2010/01/30 16:33:25 dkf Exp $
  */
 
 #include "tclInt.h"
@@ -242,7 +242,7 @@ static const CmdInfo builtInCmds[] = {
     {"throw",		Tcl_ThrowObjCmd,	NULL,			NULL,	1},
     {"trace",		Tcl_TraceObjCmd,	NULL,			NULL,	1},
     {"try",		Tcl_TryObjCmd,		NULL,			TclNRTryObjCmd,	1},
-    {"unset",		Tcl_UnsetObjCmd,	NULL,			NULL,	1},
+    {"unset",		Tcl_UnsetObjCmd,	TclCompileUnsetCmd,	NULL,	1},
     {"uplevel",		Tcl_UplevelObjCmd,	NULL,			TclNRUplevelObjCmd,	1},
     {"upvar",		Tcl_UpvarObjCmd,	TclCompileUpvarCmd,	NULL,	1},
     {"variable",	Tcl_VariableObjCmd,	TclCompileVariableCmd,	NULL,	1},
diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index 6ec2265..5455e5d 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -12,7 +12,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclCompCmds.c,v 1.157 2009/09/11 20:13:27 dgp Exp $
+ * RCS: @(#) $Id: tclCompCmds.c,v 1.158 2010/01/30 16:33:25 dkf Exp $
  */
 
 #include "tclInt.h"
@@ -27,14 +27,14 @@
  */
 
 #define CompileWord(envPtr, tokenPtr, interp, word) \
-    if ((tokenPtr)->type == TCL_TOKEN_SIMPLE_WORD) { \
+    if ((tokenPtr)->type == TCL_TOKEN_SIMPLE_WORD) {			\
 	TclEmitPush(TclRegisterNewLiteral((envPtr), (tokenPtr)[1].start, \
-		(tokenPtr)[1].size), (envPtr)); \
-    } else { \
-	envPtr->line = mapPtr->loc[eclIndex].line[word]; \
-	envPtr->clNext = mapPtr->loc[eclIndex].next[word]; \
+		(tokenPtr)[1].size), (envPtr));				\
+    } else {								\
+	envPtr->line = mapPtr->loc[eclIndex].line[word];		\
+	envPtr->clNext = mapPtr->loc[eclIndex].next[word];		\
 	TclCompileTokens((interp), (tokenPtr)+1, (tokenPtr)->numComponents, \
-		(envPtr)); \
+		(envPtr));						\
     }
 
 /*
@@ -124,13 +124,13 @@
 #define DeclareExceptionRange(envPtr, type) \
     (TclCreateExceptRange((type), (envPtr)))
 #define ExceptionRangeStarts(envPtr, index) \
-    (((envPtr)->exceptDepth++), \
-    ((envPtr)->maxExceptDepth = \
-	    TclMax((envPtr)->exceptDepth, (envPtr)->maxExceptDepth)), \
+    (((envPtr)->exceptDepth++),						\
+    ((envPtr)->maxExceptDepth =						\
+	    TclMax((envPtr)->exceptDepth, (envPtr)->maxExceptDepth)),	\
     ((envPtr)->exceptArrayPtr[(index)].codeOffset = CurrentOffset(envPtr)))
 #define ExceptionRangeEnds(envPtr, index) \
-    (((envPtr)->exceptDepth--), \
-    ((envPtr)->exceptArrayPtr[(index)].numCodeBytes = \
+    (((envPtr)->exceptDepth--),						\
+    ((envPtr)->exceptArrayPtr[(index)].numCodeBytes =			\
 	CurrentOffset(envPtr) - (envPtr)->exceptArrayPtr[(index)].codeOffset))
 #define ExceptionRangeTarget(envPtr, index, targetType) \
     ((envPtr)->exceptArrayPtr[(index)].targetType = CurrentOffset(envPtr))
@@ -184,9 +184,9 @@ static void		CompileReturnInternal(CompileEnv *envPtr,
 			    Tcl_Obj *returnOpts);
 
 #define PushVarNameWord(i,v,e,f,l,s,sc,word) \
-    PushVarName (i,v,e,f,l,s,sc,                       \
-                    mapPtr->loc [eclIndex].line [(word)], \
-	            mapPtr->loc [eclIndex].next [(word)])
+    PushVarName(i,v,e,f,l,s,sc,						\
+	    mapPtr->loc[eclIndex].line[(word)],				\
+	    mapPtr->loc[eclIndex].next[(word)])
 
 /*
  * Flags bits used by PushVarName.
@@ -5019,6 +5019,104 @@ PrintJumptableInfo(
 /*
  *----------------------------------------------------------------------
  *
+ * TclCompileUnsetCmd --
+ *
+ *	Procedure called to compile the "unset" command.
+ *
+ * Results:
+ * 	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
+ * 	evaluation to runtime.
+ *
+ * Side effects:
+ *	Instructions are added to envPtr to execute the "unset" command at
+ *	runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompileUnsetCmd(
+    Tcl_Interp *interp,		/* Used for error reporting. */
+    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. */
+{
+    Tcl_Token *varTokenPtr;
+    int isScalar, simpleVarName, localIndex, numWords, flags, i;
+    Tcl_Obj *leadingWord;
+    DefineLineInformation;	/* TIP #280 */
+
+    numWords = parsePtr->numWords-1;
+    flags = 1;
+    varTokenPtr = TokenAfter(parsePtr->tokenPtr);
+    leadingWord = Tcl_NewObj();
+    if (TclWordKnownAtCompileTime(varTokenPtr, leadingWord)) {
+	int len;
+	const char *bytes = Tcl_GetStringFromObj(leadingWord, &len);
+
+	if (len == 11 && !strncmp("-nocomplain", bytes, 11)) {
+	    flags = 0;
+	    varTokenPtr = TokenAfter(varTokenPtr);
+	    numWords--;
+	} else if (len == 2 && !strncmp("--", bytes, 2)) {
+	    varTokenPtr = TokenAfter(varTokenPtr);
+	    numWords--;
+	}
+    } else {
+	/*
+	 * Cannot guarantee that the first word is not '-nocomplain' at
+	 * evaluation with reasonable effort, so spill to interpreted version.
+	 */
+
+	return TCL_ERROR;
+    }
+    TclDecrRefCount(leadingWord);
+
+    for (i=0 ; i<numWords ; i++) {
+	/*
+	 * 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.
+	 */
+
+	PushVarNameWord(interp, varTokenPtr, envPtr, 0,
+		&localIndex, &simpleVarName, &isScalar, 1);
+
+	/*
+	 * Emit instructions to unset the variable.
+	 */
+
+	if (!simpleVarName) {
+	    TclEmitInstInt1(	INST_UNSET_STK, flags,		envPtr);
+	} else if (isScalar) {
+	    if (localIndex < 0) {
+		TclEmitInstInt1(INST_UNSET_STK, flags,		envPtr);
+	    } else {
+		TclEmitInstInt1(INST_UNSET_SCALAR, flags,	envPtr);
+		TclEmitInt4(			   localIndex,	envPtr);
+	    }
+	} else {
+	    if (localIndex < 0) {
+		TclEmitInstInt1(INST_UNSET_ARRAY_STK, flags,	envPtr);
+	    } else {
+		TclEmitInstInt1(INST_UNSET_ARRAY, flags,	envPtr);
+		TclEmitInt4(			  localIndex,	envPtr);
+	    }
+	}
+
+	varTokenPtr = TokenAfter(varTokenPtr);
+    }
+    PushLiteral(envPtr, "", 0);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * TclCompileWhileCmd --
  *
  *	Procedure called to compile the "while" command.
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index 57e3a9d..726aefb 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -11,7 +11,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclCompile.c,v 1.179 2009/11/18 21:59:50 nijtmans Exp $
+ * RCS: @(#) $Id: tclCompile.c,v 1.180 2010/01/30 16:33:25 dkf Exp $
  */
 
 #include "tclInt.h"
@@ -399,6 +399,7 @@ InstructionDesc const tclInstructionTable[] = {
 	 * stknext */
     {"existStk",	 1,    0,         0,	{OPERAND_NONE}},
 	/* Test if general variable exists; unparsed variable name is stktop*/
+
     {"nop",		 1,    0,         0,	{OPERAND_NONE}},
 	/* Do nothing */
     {"returnCodeBranch", 1,   -1,	  0,	{OPERAND_NONE}},
@@ -406,9 +407,23 @@ InstructionDesc const tclInstructionTable[] = {
 	 * ERROR: +1;	RETURN: +3;	BREAK: +5;	CONTINUE: +7;
 	 * Other non-OK: +9
 	 */
+
+    {"unsetScalar",	 6,    0,         2,	{OPERAND_UINT1, OPERAND_LVT4}},
+	/* Make scalar variable at index op2 in call frame cease to exist;
+	 * op1 is 1 for errors on problems, 0 otherwise */
+    {"unsetArray",	 6,    -1,        2,	{OPERAND_UINT1, OPERAND_LVT4}},
+	/* Make array element cease to exist; array at slot op2, element is
+	 * stktop; op1 is 1 for errors on problems, 0 otherwise */
+    {"unsetArrayStk",	 2,    -2,        1,	{OPERAND_UINT1}},
+	/* Make array element cease to exist; element is stktop, array name is
+	 * stknext; op1 is 1 for errors on problems, 0 otherwise */
+    {"unsetStk",	 2,    -1,        1,	{OPERAND_UINT1}},
+	/* Make general variable cease to exist; unparsed variable name is
+	 * stktop; op1 is 1 for errors on problems, 0 otherwise */
+
     {NULL, 0, 0, 0, {OPERAND_NONE}}
 };
-
+
 /*
  * Prototypes for procedures defined later in this file:
  */
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index 3c514d0..18dad76 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -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: tclCompile.h,v 1.121 2010/01/21 17:23:49 msofer Exp $
+ * RCS: @(#) $Id: tclCompile.h,v 1.122 2010/01/30 16:33:25 dkf Exp $
  */
 
 #ifndef _TCLCOMPILATION
@@ -672,8 +672,14 @@ typedef struct ByteCode {
 #define INST_NOP			132
 #define INST_RETURN_CODE_BRANCH		133
 
+/* For [unset] compilation */
+#define INST_UNSET_SCALAR		134
+#define INST_UNSET_ARRAY		135
+#define INST_UNSET_ARRAY_STK		136
+#define INST_UNSET_STK			137
+
 /* The last opcode */
-#define LAST_INST_OPCODE		133
+#define LAST_INST_OPCODE		137
 
 /*
  * Table describing the Tcl bytecode instructions: their name (for displaying
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 812e68b..cbf59c9 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.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: tclExecute.c,v 1.470 2010/01/22 10:22:51 dkf Exp $
+ * RCS: @(#) $Id: tclExecute.c,v 1.471 2010/01/30 16:33:25 dkf Exp $
  */
 
 #include "tclInt.h"
@@ -1879,6 +1879,7 @@ TclExecuteByteCode(
 
 #define ReadTraced(varPtr) ((varPtr)->flags & VAR_TRACED_READ)
 #define WriteTraced(varPtr) ((varPtr)->flags & VAR_TRACED_WRITE)
+#define UnsetTraced(varPtr) ((varPtr)->flags & VAR_TRACED_UNSET)
 
     /*
      * Bottom of allocated stack holds the NR data
@@ -2041,6 +2042,7 @@ TclExecuteByteCode(
 
     if (iPtr->execEnvPtr->corPtr) {
 	CoroutineData *corPtr = iPtr->execEnvPtr->corPtr;
+
 	if (!corPtr->base.cmdFramePtr) {
 	    /*
 	     * First coroutine run, incomplete init:
@@ -2167,10 +2169,6 @@ TclExecuteByteCode(
      */
 
     if ((TAUX.instructionCount++ & ASYNC_CHECK_COUNT_MASK) == 0) {
-	/*
-	 * Check for asynchronous handlers [Bug 746722]; we do the check every
-	 * ASYNC_CHECK_COUNT_MASK instruction, of the form (2**n-<1).
-	 */
 	int localResult;
 
 	if (TclAsyncReady(iPtr)) {
@@ -2383,19 +2381,17 @@ TclExecuteByteCode(
 	NEXT_INST_F(1, 0, 1);
 
     case INST_OVER: {
-	int opnd;
+	int opnd = TclGetUInt4AtPtr(pc+1);
 
-	opnd = TclGetUInt4AtPtr(pc+1);
 	objResultPtr = OBJ_AT_DEPTH(opnd);
 	TRACE_WITH_OBJ(("=> "), objResultPtr);
 	NEXT_INST_F(5, 0, 1);
     }
 
     case INST_REVERSE: {
-	int opnd;
 	Tcl_Obj **a, **b;
+	int opnd = TclGetUInt4AtPtr(pc+1);
 
-	opnd = TclGetUInt4AtPtr(pc+1);
 	a = tosPtr-(opnd-1);
 	b = tosPtr;
 	while (a<b) {
@@ -2659,11 +2655,11 @@ TclExecuteByteCode(
 	goto nonRecursiveCallStart;
     }
 
-    {
 	/*
 	 * INVOCATION BLOCK
 	 */
 
+    {
 	int objc, pcAdjustment;
 	Tcl_Obj **objv;
 
@@ -2703,7 +2699,7 @@ TclExecuteByteCode(
 		     */
 
 		    iPtr->numLevels++;
-		    Tcl_NRAddCallback(interp, NRCommand, NULL, NULL, NULL, NULL);
+		    Tcl_NRAddCallback(interp, NRCommand, NULL,NULL,NULL,NULL);
 		    goto doInvocationFromEval;
 		}
 	    }
@@ -2737,15 +2733,15 @@ TclExecuteByteCode(
 	if (objc) {
 	    pcAdjustment = 1;
 	    goto doInvocation;
-	} else {
-	    /*
-	     * Nothing was expanded, return {}.
-	     */
-
-	    TclNewObj(objResultPtr);
-	    NEXT_INST_F(1, 0, 1);
 	}
 
+	/*
+	 * Nothing was expanded, return {}.
+	 */
+
+	TclNewObj(objResultPtr);
+	NEXT_INST_F(1, 0, 1);
+
     case INST_INVOKE_STK4:
 	objc = TclGetUInt4AtPtr(pc+1);
 	pcAdjustment = 5;
@@ -2756,230 +2752,226 @@ TclExecuteByteCode(
 	pcAdjustment = 2;
 
     doInvocation:
-	{
-	    objv = &OBJ_AT_DEPTH(objc-1);
-	    cleanup = objc;
+	objv = &OBJ_AT_DEPTH(objc-1);
+	cleanup = objc;
     doInvocationFromEval:
 
 #ifdef TCL_COMPILE_DEBUG
-	    if (tclTraceExec >= 2) {
-		int i;
+	if (tclTraceExec >= 2) {
+	    int i;
 
-		if (traceInstructions) {
-		    strncpy(cmdNameBuf, TclGetString(objv[0]), 20);
-		    TRACE(("%u => call ", objc));
-		} else {
-		    fprintf(stdout, "%d: (%u) invoking ", iPtr->numLevels,
-			    (unsigned)(pc - codePtr->codeStart));
-		}
-		for (i = 0;  i < objc;  i++) {
-		    TclPrintObject(stdout, objv[i], 15);
-		    fprintf(stdout, " ");
-		}
-		fprintf(stdout, "\n");
-		fflush(stdout);
+	    if (traceInstructions) {
+		strncpy(cmdNameBuf, TclGetString(objv[0]), 20);
+		TRACE(("%u => call ", objc));
+	    } else {
+		fprintf(stdout, "%d: (%u) invoking ", iPtr->numLevels,
+			(unsigned)(pc - codePtr->codeStart));
 	    }
+	    for (i = 0;  i < objc;  i++) {
+		TclPrintObject(stdout, objv[i], 15);
+		fprintf(stdout, " ");
+	    }
+	    fprintf(stdout, "\n");
+	    fflush(stdout);
+	}
 #endif /*TCL_COMPILE_DEBUG*/
 
-	    /*
-	     * Finally, let TclEvalObjv handle the command.
-	     *
-	     * TIP #280: Record the last piece of info needed by
-	     * 'TclGetSrcInfoForPc', and push the frame.
-	     */
+	/*
+	 * Finally, let TclEvalObjv handle the command.
+	 *
+	 * TIP #280: Record the last piece of info needed by
+	 * 'TclGetSrcInfoForPc', and push the frame.
+	 */
 
-	    bcFramePtr->data.tebc.pc = (char *) pc;
-	    iPtr->cmdFramePtr = bcFramePtr;
+	bcFramePtr->data.tebc.pc = (char *) pc;
+	iPtr->cmdFramePtr = bcFramePtr;
 
-	    /*
-	     * Reset the instructionCount variable, since we're about to check
-	     * for async stuff anyway while processing TclEvalObjv
-	     */
+	/*
+	 * Reset the instructionCount variable, since we're about to check for
+	 * async stuff anyway while processing TclEvalObjv
+	 */
 
-	    TAUX.instructionCount = 1;
+	TAUX.instructionCount = 1;
 
-	    TclArgumentBCEnter((Tcl_Interp *) iPtr, objv, objc,
-		    codePtr, bcFramePtr, pc - codePtr->codeStart);
+	TclArgumentBCEnter((Tcl_Interp *) iPtr, objv, objc,
+		codePtr, bcFramePtr, pc - codePtr->codeStart);
 
-	    DECACHE_STACK_INFO();
+	DECACHE_STACK_INFO();
 
-	    TRESULT = TclNREvalObjv(interp, objc, objv,
-		    (*pc == INST_EVAL_STK) ? 0 : TCL_EVAL_NOERR, NULL);
-	    TRESULT = TclNRRunCallbacks(interp, TRESULT, BP->rootPtr, 1);
-	    CACHE_STACK_INFO();
+	TRESULT = TclNREvalObjv(interp, objc, objv,
+		(*pc == INST_EVAL_STK) ? 0 : TCL_EVAL_NOERR, NULL);
+	TRESULT = TclNRRunCallbacks(interp, TRESULT, BP->rootPtr, 1);
+	CACHE_STACK_INFO();
 
-	    if (TOP_CB(interp) != BP->rootPtr) {
-		NRE_ASSERT(TRESULT == TCL_OK);
-		pc += pcAdjustment;
+	if (TOP_CB(interp) != BP->rootPtr) {
+	    NRE_ASSERT(TRESULT == TCL_OK);
+	    pc += pcAdjustment;
 
-		nonRecursiveCallSetup: {
-		    TEOV_callback *callbackPtr = TOP_CB(interp);
-		    int type = PTR2INT(callbackPtr->data[0]);
-		    ClientData param = callbackPtr->data[1];
+	nonRecursiveCallSetup:
+	    {
+		TEOV_callback *callbackPtr = TOP_CB(interp);
+		int type = PTR2INT(callbackPtr->data[0]);
+		ClientData param = callbackPtr->data[1];
 
-		    pcAdjustment = 0; /* silence warning */
+		pcAdjustment = 0; /* silence warning */
 
-		    NRE_ASSERT(callbackPtr != BP->rootPtr);
-		    NRE_ASSERT(callbackPtr->procPtr == NRCallTEBC);
+		NRE_ASSERT(callbackPtr != BP->rootPtr);
+		NRE_ASSERT(callbackPtr->procPtr == NRCallTEBC);
 
-		    TOP_CB(interp) = callbackPtr->nextPtr;
-		    TCLNR_FREE(interp, callbackPtr);
+		TOP_CB(interp) = callbackPtr->nextPtr;
+		TCLNR_FREE(interp, callbackPtr);
 
-		    NR_DATA_BURY();
-		    switch (type) {
-		    case TCL_NR_BC_TYPE:
-			if (param) {
-			    codePtr = param;
-			    goto nonRecursiveCallStart;
-			} else {
-			    OBP = BP;
-			    goto resumeCoroutine;
-			}
-			break;
-		    case TCL_NR_TAILCALL_TYPE:
-			/*
-			 * A request to perform a tailcall: just drop this
-			 * bytecode. */
+		NR_DATA_BURY();
+		switch (type) {
+		case TCL_NR_BC_TYPE:
+		    if (param) {
+			codePtr = param;
+			goto nonRecursiveCallStart;
+		    } else {
+			OBP = BP;
+			goto resumeCoroutine;
+		    }
+		    break;
+		case TCL_NR_TAILCALL_TYPE:
+		    /*
+		     * A request to perform a tailcall: just drop this
+		     * bytecode.
+		     */
 #ifdef TCL_COMPILE_DEBUG
-			if (traceInstructions) {
-			    fprintf(stdout, "   Tailcall request received\n");
-			}
+		    if (traceInstructions) {
+			fprintf(stdout, "   Tailcall request received\n");
+		    }
 #endif /* TCL_COMPILE_DEBUG */
-			iPtr->cmdFramePtr = bcFramePtr->nextPtr;
-			TclArgumentBCRelease((Tcl_Interp *) iPtr, bcFramePtr);
-
-			if (catchTop != initCatchTop) {
-			    TclClearTailcall(interp, param);
-			    iPtr->varFramePtr->tailcallPtr = NULL;
-			    TRESULT = TCL_ERROR;
-			    Tcl_SetResult(interp,
-				    "tailcall called from within a catch environment",
-				    TCL_STATIC);
-			    Tcl_SetErrorCode(interp, "TCL", "TAILCALL",
-				    "ILLEGAL", NULL);
-			    pc--;
-			    goto checkForCatch;
-			}
-			iPtr->varFramePtr->tailcallPtr = param;
-			TclSpliceTailcall(interp, param);
-			goto abnormalReturn;
-		    case TCL_NR_YIELD_TYPE: {	/* [yield] */
-			CoroutineData *corPtr = iPtr->execEnvPtr->corPtr;
-
-			if (!corPtr) {
-			    Tcl_SetResult(interp,
-				    "yield can only be called in a coroutine",
-				    TCL_STATIC);
-			    Tcl_SetErrorCode(interp, "TCL", "COROUTINE",
-				    "ILLEGAL_YIELD", NULL);
-			    TRESULT = TCL_ERROR;
-			    pc--;
-			    goto checkForCatch;
-			}
-
-			NRE_ASSERT(iPtr->execEnvPtr == corPtr->eePtr);
-			NRE_ASSERT(corPtr->stackLevel != NULL);
-			NRE_ASSERT(BP == corPtr->eePtr->bottomPtr);
-			if (corPtr->stackLevel != &TAUX) {
-			    Tcl_SetResult(interp, "cannot yield: C stack busy",
-				    TCL_STATIC);
-			    Tcl_SetErrorCode(interp, "TCL", "COROUTINE",
-				    "CANT_YIELD", NULL);
-			    TRESULT = TCL_ERROR;
-			    pc--;
-			    goto checkForCatch;
-			}
-
-			/*
-			 * Mark suspended, save our state and return
-			 */
-
-			corPtr->stackLevel = NULL;
-			iPtr->execEnvPtr = corPtr->callerEEPtr;
-			OBP = *corPtr->callerBPPtr;
-			goto returnToCaller;
+		    iPtr->cmdFramePtr = bcFramePtr->nextPtr;
+		    TclArgumentBCRelease((Tcl_Interp *) iPtr, bcFramePtr);
+
+		    if (catchTop != initCatchTop) {
+			TclClearTailcall(interp, param);
+			iPtr->varFramePtr->tailcallPtr = NULL;
+			TRESULT = TCL_ERROR;
+			Tcl_SetResult(interp,
+				"tailcall called from within a catch environment",
+				TCL_STATIC);
+			Tcl_SetErrorCode(interp, "TCL", "TAILCALL", "ILLEGAL",
+				NULL);
+			pc--;
+			goto checkForCatch;
 		    }
-		    default:
-			Tcl_Panic("TEBC: TRCB sent us a callback we cannot handle!");
+		    iPtr->varFramePtr->tailcallPtr = param;
+		    TclSpliceTailcall(interp, param);
+		    goto abnormalReturn;
+		case TCL_NR_YIELD_TYPE: {	/* [yield] */
+		    CoroutineData *corPtr = iPtr->execEnvPtr->corPtr;
+
+		    if (!corPtr) {
+			Tcl_SetResult(interp,
+				"yield can only be called in a coroutine",
+				TCL_STATIC);
+			Tcl_SetErrorCode(interp, "TCL", "COROUTINE",
+				"ILLEGAL_YIELD", NULL);
+			TRESULT = TCL_ERROR;
+			pc--;
+			goto checkForCatch;
 		    }
-		}
-	    }
 
-	    pc += pcAdjustment;
+		    NRE_ASSERT(iPtr->execEnvPtr == corPtr->eePtr);
+		    NRE_ASSERT(corPtr->stackLevel != NULL);
+		    NRE_ASSERT(BP == corPtr->eePtr->bottomPtr);
+		    if (corPtr->stackLevel != &TAUX) {
+			Tcl_SetResult(interp, "cannot yield: C stack busy",
+				TCL_STATIC);
+			Tcl_SetErrorCode(interp, "TCL", "COROUTINE",
+				"CANT_YIELD", NULL);
+			TRESULT = TCL_ERROR;
+			pc--;
+			goto checkForCatch;
+		    }
 
-	nonRecursiveCallReturn:
+		    /*
+		     * Mark suspended, save our state and return
+		     */
 
-	    if (codePtr->flags & TCL_BYTECODE_RECOMPILE) {
-		iPtr->flags |= ERR_ALREADY_LOGGED;
-		codePtr->flags &= ~TCL_BYTECODE_RECOMPILE;
+		    corPtr->stackLevel = NULL;
+		    iPtr->execEnvPtr = corPtr->callerEEPtr;
+		    OBP = *corPtr->callerBPPtr;
+		    goto returnToCaller;
+		}
+		default:
+		    Tcl_Panic("TEBC: TRCB sent us a callback we cannot handle!");
+		}
 	    }
-	    NRE_ASSERT(iPtr->cmdFramePtr == bcFramePtr);
-	    iPtr->cmdFramePtr = bcFramePtr->nextPtr;
-	    TclArgumentBCRelease((Tcl_Interp *) iPtr, bcFramePtr);
+	}
 
-	    /*
-	     * If the CallFrame is marked as tailcalling, keep tailcalling
-	     */
+	pc += pcAdjustment;
 
-	    if (iPtr->varFramePtr->tailcallPtr) {
-		if (catchTop != initCatchTop) {
-		    TclClearTailcall(interp, iPtr->varFramePtr->tailcallPtr);
-		    iPtr->varFramePtr->tailcallPtr = NULL;
-		    TRESULT = TCL_ERROR;
-		    Tcl_SetResult(interp,
-			    "tailcall called from within a catch environment",
-			    TCL_STATIC);
-		    Tcl_SetErrorCode(interp, "TCL", "TAILCALL", "ILLEGAL",
-			    NULL);
-		    pc--;
-		    goto checkForCatch;
-		}
-		goto abnormalReturn;
-	    }
+    nonRecursiveCallReturn:
+	if (codePtr->flags & TCL_BYTECODE_RECOMPILE) {
+	    iPtr->flags |= ERR_ALREADY_LOGGED;
+	    codePtr->flags &= ~TCL_BYTECODE_RECOMPILE;
+	}
+	NRE_ASSERT(iPtr->cmdFramePtr == bcFramePtr);
+	iPtr->cmdFramePtr = bcFramePtr->nextPtr;
+	TclArgumentBCRelease((Tcl_Interp *) iPtr, bcFramePtr);
+
+	/*
+	 * If the CallFrame is marked as tailcalling, keep tailcalling
+	 */
 
-	    if (iPtr->execEnvPtr->rewind) {
+	if (iPtr->varFramePtr->tailcallPtr) {
+	    if (catchTop != initCatchTop) {
+		TclClearTailcall(interp, iPtr->varFramePtr->tailcallPtr);
+		iPtr->varFramePtr->tailcallPtr = NULL;
 		TRESULT = TCL_ERROR;
-		goto abnormalReturn;
+		Tcl_SetResult(interp,
+			"tailcall called from within a catch environment",
+			TCL_STATIC);
+		Tcl_SetErrorCode(interp, "TCL", "TAILCALL", "ILLEGAL", NULL);
+		pc--;
+		goto checkForCatch;
 	    }
+	    goto abnormalReturn;
+	}
 
-	    if (TRESULT == TCL_OK) {
-		Tcl_Obj *objPtr;
+	if (iPtr->execEnvPtr->rewind) {
+	    TRESULT = TCL_ERROR;
+	    goto abnormalReturn;
+	}
+
+	if (TRESULT == TCL_OK) {
+	    Tcl_Obj *objPtr;
 #ifndef TCL_COMPILE_DEBUG
-		if (*pc == INST_POP) {
-		    NEXT_INST_V(1, cleanup, 0);
-		}
+	    if (*pc == INST_POP) {
+		NEXT_INST_V(1, cleanup, 0);
+	    }
 #endif
-		/*
-		 * Push the call's object result and continue execution with
-		 * the next instruction.
-		 */
+	    /*
+	     * Push the call's object result and continue execution with the
+	     * next instruction.
+	     */
 
-		TRACE_WITH_OBJ(("%u => ... after \"%.20s\": TCL_OK, result=",
-			objc, cmdNameBuf), Tcl_GetObjResult(interp));
+	    TRACE_WITH_OBJ(("%u => ... after \"%.20s\": TCL_OK, result=",
+		    objc, cmdNameBuf), Tcl_GetObjResult(interp));
 
-		objResultPtr = Tcl_GetObjResult(interp);
+	    objResultPtr = Tcl_GetObjResult(interp);
 
-		/*
-		 * Reset the interp's result to avoid possible duplications of
-		 * large objects [Bug 781585]. We do not call Tcl_ResetResult
-		 * to avoid any side effects caused by the resetting of
-		 * errorInfo and errorCode [Bug 804681], which are not needed
-		 * here. We chose instead to manipulate the interp's object
-		 * result directly.
-		 *
-		 * Note that the result object is now in objResultPtr, it
-		 * keeps the refCount it had in its role of
-		 * iPtr->objResultPtr.
-		 */
+	    /*
+	     * Reset the interp's result to avoid possible duplications of
+	     * large objects [Bug 781585]. We do not call Tcl_ResetResult to
+	     * avoid any side effects caused by the resetting of errorInfo and
+	     * errorCode [Bug 804681], which are not needed here. We chose
+	     * instead to manipulate the interp's object result directly.
+	     *
+	     * Note that the result object is now in objResultPtr, it keeps
+	     * the refCount it had in its role of iPtr->objResultPtr.
+	     */
 
-		TclNewObj(objPtr);
-		Tcl_IncrRefCount(objPtr);
-		iPtr->objResultPtr = objPtr;
-		NEXT_INST_V(0, cleanup, -1);
-	    } else {
-		pc--;
-		goto processExceptionReturn;
-	    }
+	    TclNewObj(objPtr);
+	    Tcl_IncrRefCount(objPtr);
+	    iPtr->objResultPtr = objPtr;
+	    NEXT_INST_V(0, cleanup, -1);
+	} else {
+	    pc--;
+	    goto processExceptionReturn;
 	}
 
 #if TCL_SUPPORT_84_BYTECODE
@@ -2992,7 +2984,7 @@ TclExecuteByteCode(
 	 */
 
 	int opnd, numArgs;
-	Tcl_Obj *objPtr;
+	Tcl_Obj *objPtr, *tmpPtr1, *tmpPtr2;
 
 	opnd = TclGetUInt1AtPtr(pc+1);
 	if ((opnd < 0) || (opnd > LAST_BUILTIN_FUNC)) {
@@ -3011,12 +3003,11 @@ TclExecuteByteCode(
 	if (numArgs == 0) {
 	    PUSH_OBJECT(objPtr);
 	} else if (numArgs == 1) {
-	    Tcl_Obj *tmpPtr1 = POP_OBJECT();
+	    tmpPtr1 = POP_OBJECT();
 	    PUSH_OBJECT(objPtr);
 	    PUSH_OBJECT(tmpPtr1);
 	    Tcl_DecrRefCount(tmpPtr1);
 	} else {
-	    Tcl_Obj *tmpPtr1, *tmpPtr2;
 	    tmpPtr2 = POP_OBJECT();
 	    tmpPtr1 = POP_OBJECT();
 	    PUSH_OBJECT(objPtr);
@@ -3077,7 +3068,7 @@ TclExecuteByteCode(
     }
 
     /*
-     * ---------------------------------------------------------
+     * -----------------------------------------------------------------
      *	   Start of INST_LOAD instructions.
      *
      * WARNING: more 'goto' here than your doctor recommended! The different
@@ -3086,9 +3077,8 @@ TclExecuteByteCode(
      */
     {
 	int opnd, pcAdjustment;
-	Tcl_Obj *part1Ptr, *part2Ptr;
+	Tcl_Obj *objPtr, *part1Ptr, *part2Ptr;
 	Var *varPtr, *arrayPtr;
-	Tcl_Obj *objPtr;
 
     case INST_LOAD_SCALAR1:
     instLoadScalar1:
@@ -3235,11 +3225,7 @@ TclExecuteByteCode(
 
     /*
      *	   End of INST_LOAD instructions.
-     * ---------------------------------------------------------
-     */
-
-    /*
-     * ---------------------------------------------------------
+     * -----------------------------------------------------------------
      *	   Start of INST_STORE and related instructions.
      *
      * WARNING: more 'goto' here than your doctor recommended! The different
@@ -3249,9 +3235,8 @@ TclExecuteByteCode(
 
     {
 	int opnd, pcAdjustment, storeFlags;
-	Tcl_Obj *part1Ptr, *part2Ptr;
+	Tcl_Obj *part1Ptr, *part2Ptr, *objPtr, *valuePtr;
 	Var *varPtr, *arrayPtr;
-	Tcl_Obj *objPtr, *valuePtr;
 
     case INST_STORE_ARRAY4:
 	opnd = TclGetUInt4AtPtr(pc+1);
@@ -3500,11 +3485,7 @@ TclExecuteByteCode(
 
     /*
      *	   End of INST_STORE and related instructions.
-     * ---------------------------------------------------------
-     */
-
-    /*
-     * ---------------------------------------------------------
+     * -----------------------------------------------------------------
      *	   Start of INST_INCR instructions.
      *
      * WARNING: more 'goto' here than your doctor recommended! The different
@@ -3515,13 +3496,12 @@ TclExecuteByteCode(
 /*TODO: Consider more untangling here; merge with LOAD and STORE ? */
 
     {
-	Tcl_Obj *objPtr, *incrPtr;
+	Tcl_Obj *objPtr, *incrPtr, *part1Ptr, *part2Ptr;
 	int opnd, pcAdjustment;
 #ifndef NO_WIDE_TYPE
 	Tcl_WideInt w;
 #endif
 	long i;
-	Tcl_Obj *part1Ptr, *part2Ptr;
 	Var *varPtr, *arrayPtr;
 
     case INST_INCR_SCALAR1:
@@ -3646,34 +3626,32 @@ TclExecuteByteCode(
 			goto doneIncr;
 		    }
 #ifndef NO_WIDE_TYPE
-		    {
-			w = (Tcl_WideInt)augend;
+		    w = (Tcl_WideInt)augend;
 
-			TRACE(("%u %ld => ", opnd, i));
-			if (Tcl_IsShared(objPtr)) {
-			    objPtr->refCount--;	/* We know it's shared. */
-			    objResultPtr = Tcl_NewWideIntObj(w+i);
-			    Tcl_IncrRefCount(objResultPtr);
-			    varPtr->value.objPtr = objResultPtr;
-			} else {
-			    objResultPtr = objPtr;
+		    TRACE(("%u %ld => ", opnd, i));
+		    if (Tcl_IsShared(objPtr)) {
+			objPtr->refCount--;	/* We know it's shared. */
+			objResultPtr = Tcl_NewWideIntObj(w+i);
+			Tcl_IncrRefCount(objResultPtr);
+			varPtr->value.objPtr = objResultPtr;
+		    } else {
+			objResultPtr = objPtr;
 
-			    /*
-			     * We know the sum value is outside the long
-			     * range; use macro form that doesn't range test
-			     * again.
-			     */
+			/*
+			 * We know the sum value is outside the long range;
+			 * use macro form that doesn't range test again.
+			 */
 
-			    TclSetWideIntObj(objPtr, w+i);
-			}
-			goto doneIncr;
+			TclSetWideIntObj(objPtr, w+i);
 		    }
+		    goto doneIncr;
 #endif
 		}	/* end if (type == TCL_NUMBER_LONG) */
 #ifndef NO_WIDE_TYPE
 		if (type == TCL_NUMBER_WIDE) {
 		    Tcl_WideInt sum;
-		    w = *((const Tcl_WideInt *)ptr);
+
+		    w = *((const Tcl_WideInt *) ptr);
 		    sum = w + i;
 
 		    /*
@@ -3785,20 +3763,17 @@ TclExecuteByteCode(
 
     /*
      *	   End of INST_INCR instructions.
-     * ---------------------------------------------------------
-     */
-
-    /*
-     * ---------------------------------------------------------
+     * -----------------------------------------------------------------
      *	   Start of INST_EXIST instructions.
      */
+
     {
 	Tcl_Obj *part1Ptr, *part2Ptr;
 	Var *varPtr, *arrayPtr;
+	int opnd;
 
-    case INST_EXIST_SCALAR: {
-	int opnd = TclGetUInt4AtPtr(pc+1);
-
+    case INST_EXIST_SCALAR:
+	opnd = TclGetUInt4AtPtr(pc+1);
 	varPtr = LOCAL(opnd);
 	while (TclIsVarLink(varPtr)) {
 	    varPtr = varPtr->value.linkPtr;
@@ -3822,11 +3797,9 @@ TclExecuteByteCode(
 	objResultPtr = TCONST(!varPtr || TclIsVarUndefined(varPtr) ? 0 : 1);
 	TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
 	NEXT_INST_F(5, 0, 1);
-    }
-
-    case INST_EXIST_ARRAY: {
-	int opnd = TclGetUInt4AtPtr(pc+1);
 
+    case INST_EXIST_ARRAY:
+	opnd = TclGetUInt4AtPtr(pc+1);
 	part2Ptr = OBJ_AT_TOS;
 	arrayPtr = LOCAL(opnd);
 	while (TclIsVarLink(arrayPtr)) {
@@ -3857,7 +3830,6 @@ TclExecuteByteCode(
 	objResultPtr = TCONST(!varPtr || TclIsVarUndefined(varPtr) ? 0 : 1);
 	TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
 	NEXT_INST_F(5, 1, 1);
-    }
 
     case INST_EXIST_ARRAY_STK:
 	cleanup = 2;
@@ -3894,82 +3866,201 @@ TclExecuteByteCode(
 
     /*
      *	   End of INST_EXIST instructions.
-     * ---------------------------------------------------------
+     * -----------------------------------------------------------------
+     *	   Start of INST_UNSET instructions.
      */
 
-    case INST_UPVAR: {
-	int opnd;
-	Var *varPtr, *otherPtr;
+    {
+	Tcl_Obj *part1Ptr, *part2Ptr;
+	Var *varPtr, *arrayPtr;
+	int opnd, flags, localResult;
 
-	TRACE_WITH_OBJ(("upvar "), OBJ_UNDER_TOS);
+    case INST_UNSET_SCALAR:
+	flags = TclGetUInt1AtPtr(pc+1) ? TCL_LEAVE_ERR_MSG : 0;
+	opnd = TclGetUInt4AtPtr(pc+2);
+	varPtr = LOCAL(opnd);
+	while (TclIsVarLink(varPtr)) {
+	    varPtr = varPtr->value.linkPtr;
+	}
+	TRACE(("%s %u\n", (flags?"normal":"noerr"), opnd));
+	if (TclIsVarDirectUnsettable(varPtr) && !TclIsVarInHash(varPtr)) {
+	    /*
+	     * No errors, no traces, no searches: just make the variable cease
+	     * to exist.
+	     */
 
-	{
-	    CallFrame *framePtr, *savedFramePtr;
+	    if (!TclIsVarUndefined(varPtr)) {
+		Tcl_DecrRefCount(varPtr->value.objPtr);
+	    } else if (flags & TCL_LEAVE_ERR_MSG) {
+		goto slowUnsetScalar;
+	    }
+	    varPtr->value.objPtr = NULL;
+	    NEXT_INST_F(6, 0, 0);
+	}
+    slowUnsetScalar:
+	DECACHE_STACK_INFO();
+	localResult = TclPtrUnsetVar(interp, varPtr, NULL, NULL, NULL, flags,
+		opnd);
+	CACHE_STACK_INFO();
+	if (localResult != TCL_OK && flags) {
+	    goto errorInUnset;
+	}
+	NEXT_INST_F(6, 0, 0);
 
-	    TRESULT = TclObjGetFrame(interp, OBJ_UNDER_TOS, &framePtr);
-	    if (TRESULT != -1) {
+    case INST_UNSET_ARRAY:
+	flags = TclGetUInt1AtPtr(pc+1) ? TCL_LEAVE_ERR_MSG : 0;
+	opnd = TclGetUInt4AtPtr(pc+2);
+	part2Ptr = OBJ_AT_TOS;
+	arrayPtr = LOCAL(opnd);
+	while (TclIsVarLink(arrayPtr)) {
+	    arrayPtr = arrayPtr->value.linkPtr;
+	}
+	TRACE(("%s %u \"%.30s\"\n", (flags?"normal":"noerr"), opnd, O2S(part2Ptr)));
+	if (TclIsVarArray(arrayPtr) && !UnsetTraced(arrayPtr)) {
+	    varPtr = VarHashFindVar(arrayPtr->value.tablePtr, part2Ptr);
+	    if (varPtr && TclIsVarDirectUnsettable(varPtr)) {
 		/*
-		 * Locate the other variable.
+		 * No nasty traces and element exists, so we can proceed to
+		 * unset it. Might still not exist though...
 		 */
 
-		savedFramePtr = iPtr->varFramePtr;
-		iPtr->varFramePtr = framePtr;
-		otherPtr = TclObjLookupVarEx(interp, OBJ_AT_TOS, NULL,
-			(TCL_LEAVE_ERR_MSG), "access",
-			/*createPart1*/ 1, /*createPart2*/ 1, &varPtr);
-		iPtr->varFramePtr = savedFramePtr;
-		if (otherPtr) {
-		    TRESULT = TCL_OK;
-		    goto doLinkVars;
+		if (!TclIsVarUndefined(varPtr)) {
+		    Tcl_DecrRefCount(varPtr->value.objPtr);
+		} else if (flags & TCL_LEAVE_ERR_MSG) {
+		    goto slowUnsetArray;
 		}
+		varPtr->value.objPtr = NULL;
+		NEXT_INST_F(6, 1, 0);
 	    }
-	    TRESULT = TCL_ERROR;
-	    goto checkForCatch;
 	}
+    slowUnsetArray:
+	DECACHE_STACK_INFO();
+	varPtr = TclLookupArrayElement(interp, NULL, part2Ptr, flags, "unset",
+		0, 0, arrayPtr, opnd);
+	if (!varPtr && (flags & TCL_LEAVE_ERR_MSG)) {
+	    CACHE_STACK_INFO();
+	    goto errorInUnset;
+	}
+	if (varPtr) {
+	    localResult = TclPtrUnsetVar(interp, varPtr, arrayPtr, NULL,
+		    part2Ptr, flags, opnd);
+	} else {
+	    localResult = TCL_OK;
+	}
+	CACHE_STACK_INFO();
+	if (localResult != TCL_OK && (flags & TCL_LEAVE_ERR_MSG)) {
+	    goto errorInUnset;
+	}
+	NEXT_INST_F(6, 1, 0);
 
-    case INST_VARIABLE:
-	TRACE(("variable "));
-	otherPtr = TclObjLookupVarEx(interp, OBJ_AT_TOS, NULL,
-		(TCL_NAMESPACE_ONLY | TCL_LEAVE_ERR_MSG), "access",
-		/*createPart1*/ 1, /*createPart2*/ 1, &varPtr);
-	if (otherPtr) {
+    case INST_UNSET_ARRAY_STK:
+	flags = TclGetUInt1AtPtr(pc+1) ? TCL_LEAVE_ERR_MSG : 0;
+	cleanup = 2;
+	part2Ptr = OBJ_AT_TOS;		/* element name */
+	part1Ptr = OBJ_UNDER_TOS;	/* array name */
+	TRACE(("%s \"%.30s(%.30s)\"\n", (flags?"normal":"noerr"),
+		O2S(part1Ptr), O2S(part2Ptr)));
+	goto doUnsetStk;
+
+    case INST_UNSET_STK:
+	flags = TclGetUInt1AtPtr(pc+1) ? TCL_LEAVE_ERR_MSG : 0;
+	cleanup = 1;
+	part2Ptr = NULL;
+	part1Ptr = OBJ_AT_TOS;		/* variable name */
+	TRACE(("%s \"%.30s\"\n", (flags?"normal":"noerr"), O2S(part1Ptr)));
+
+    doUnsetStk:
+	DECACHE_STACK_INFO();
+	localResult = TclObjUnsetVar2(interp, part1Ptr, part2Ptr, flags);
+	CACHE_STACK_INFO();
+	if (localResult != TCL_OK && (flags & TCL_LEAVE_ERR_MSG)) {
+	    goto errorInUnset;
+	}
+	NEXT_INST_V(2, cleanup, 0);
+
+    errorInUnset:
+	TRESULT = TCL_ERROR;
+	TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
+	goto checkForCatch;
+    }
+
+    /*
+     *	   End of INST_UNSET instructions.
+     * -----------------------------------------------------------------
+     *	   Start of variable linking instructions.
+     */
+
+    {
+	int opnd;
+	Var *varPtr, *otherPtr;
+
+    case INST_UPVAR: {
+	CallFrame *framePtr, *savedFramePtr;
+
+	TRACE_WITH_OBJ(("upvar "), OBJ_UNDER_TOS);
+
+	TRESULT = TclObjGetFrame(interp, OBJ_UNDER_TOS, &framePtr);
+	if (TRESULT == -1) {
 	    /*
-	     * Do the [variable] magic.
+	     * Locate the other variable.
 	     */
 
-	    TclSetVarNamespaceVar(otherPtr);
-	    TRESULT = TCL_OK;
-	    goto doLinkVars;
+	    savedFramePtr = iPtr->varFramePtr;
+	    iPtr->varFramePtr = framePtr;
+	    otherPtr = TclObjLookupVarEx(interp, OBJ_AT_TOS, NULL,
+		    TCL_LEAVE_ERR_MSG, "access", /*createPart1*/ 1,
+		    /*createPart2*/ 1, &varPtr);
+	    iPtr->varFramePtr = savedFramePtr;
+	    if (otherPtr) {
+		TRESULT = TCL_OK;
+		goto doLinkVars;
+	    }
 	}
 	TRESULT = TCL_ERROR;
 	goto checkForCatch;
+    }
 
-    case INST_NSUPVAR:
-	TRACE_WITH_OBJ(("nsupvar "), OBJ_UNDER_TOS);
+    case INST_NSUPVAR: {
+	Tcl_Namespace *nsPtr, *savedNsPtr;
 
-	{
-	    Tcl_Namespace *nsPtr, *savedNsPtr;
-
-	    TRESULT = TclGetNamespaceFromObj(interp, OBJ_UNDER_TOS, &nsPtr);
-	    if (TRESULT == TCL_OK) {
-		/*
-		 * Locate the other variable.
-		 */
+	TRACE_WITH_OBJ(("nsupvar "), OBJ_UNDER_TOS);
+	TRESULT = TclGetNamespaceFromObj(interp, OBJ_UNDER_TOS, &nsPtr);
+	if (TRESULT == TCL_OK) {
+	    /*
+	     * Locate the other variable.
+	     */
 
-		savedNsPtr = (Tcl_Namespace *) iPtr->varFramePtr->nsPtr;
-		iPtr->varFramePtr->nsPtr = (Namespace *) nsPtr;
-		otherPtr = TclObjLookupVarEx(interp, OBJ_AT_TOS, NULL,
-			(TCL_NAMESPACE_ONLY | TCL_LEAVE_ERR_MSG), "access",
-			/*createPart1*/ 1, /*createPart2*/ 1, &varPtr);
-		iPtr->varFramePtr->nsPtr = (Namespace *) savedNsPtr;
-		if (otherPtr) {
-		    goto doLinkVars;
-		}
+	    savedNsPtr = (Tcl_Namespace *) iPtr->varFramePtr->nsPtr;
+	    iPtr->varFramePtr->nsPtr = (Namespace *) nsPtr;
+	    otherPtr = TclObjLookupVarEx(interp, OBJ_AT_TOS, NULL,
+		    (TCL_NAMESPACE_ONLY | TCL_LEAVE_ERR_MSG), "access",
+		    /*createPart1*/ 1, /*createPart2*/ 1, &varPtr);
+	    iPtr->varFramePtr->nsPtr = (Namespace *) savedNsPtr;
+	    if (otherPtr) {
+		goto doLinkVars;
 	    }
+	}
+	TRESULT = TCL_ERROR;
+	goto checkForCatch;
+    }
+
+    case INST_VARIABLE:
+	TRACE(("variable "));
+	otherPtr = TclObjLookupVarEx(interp, OBJ_AT_TOS, NULL,
+		(TCL_NAMESPACE_ONLY | TCL_LEAVE_ERR_MSG), "access",
+		/*createPart1*/ 1, /*createPart2*/ 1, &varPtr);
+	if (!otherPtr) {
 	    TRESULT = TCL_ERROR;
 	    goto checkForCatch;
 	}
 
+	/*
+	 * Do the [variable] magic.
+	 */
+
+	TclSetVarNamespaceVar(otherPtr);
+	TRESULT = TCL_OK;
+
     doLinkVars:
 
 	/*
@@ -4020,6 +4111,11 @@ TclExecuteByteCode(
 	NEXT_INST_F(5, 1, 0);
     }
 
+    /*
+     *	   End of variable linking instructions.
+     * -----------------------------------------------------------------
+     */
+
     case INST_JUMP1: {
 	int opnd = TclGetInt1AtPtr(pc+1);
 
@@ -4165,7 +4261,7 @@ TclExecuteByteCode(
     }
 
     /*
-     * ---------------------------------------------------------
+     * -----------------------------------------------------------------
      *	   Start of INST_LIST and related instructions.
      */
 
@@ -4587,7 +4683,8 @@ TclExecuteByteCode(
 
     /*
      *	   End of INST_LIST and related instructions.
-     * ---------------------------------------------------------
+     * -----------------------------------------------------------------
+     *	   Start of string-related instructions.
      */
 
     case INST_STR_EQ:
@@ -4791,6 +4888,7 @@ TclExecuteByteCode(
 	/*
 	 * Get char length to calulate what 'end' means.
 	 */
+
 	length = Tcl_GetCharLength(valuePtr);
 	TRESULT = TclGetIntForIndexM(interp, value2Ptr, length - 1, &index);
 	if (TRESULT != TCL_OK) {
@@ -4865,12 +4963,29 @@ TclExecuteByteCode(
 	/*
 	 * Reuse value2Ptr object already on stack if possible. Adjustment is
 	 * 2 due to the nocase byte
-	 * TODO: consider peephole opt.
 	 */
 
 	TRACE(("%.20s %.20s => %d\n", O2S(valuePtr), O2S(value2Ptr), match));
+
+	/*
+	 * Peep-hole optimisation: if you're about to jump, do jump from here.
+	 */
+
+	pc += 2;
+#ifndef TCL_COMPILE_DEBUG
+	switch (*pc) {
+	case INST_JUMP_FALSE1:
+	    NEXT_INST_F((match? 2 : TclGetInt1AtPtr(pc+1)), 2, 0);
+	case INST_JUMP_TRUE1:
+	    NEXT_INST_F((match? TclGetInt1AtPtr(pc+1) : 2), 2, 0);
+	case INST_JUMP_FALSE4:
+	    NEXT_INST_F((match? 5 : TclGetInt4AtPtr(pc+1)), 2, 0);
+	case INST_JUMP_TRUE4:
+	    NEXT_INST_F((match? TclGetInt4AtPtr(pc+1) : 5), 2, 0);
+	}
+#endif
 	objResultPtr = TCONST(match);
-	NEXT_INST_F(2, 2, 1);
+	NEXT_INST_F(0, 2, 1);
     }
 
     case INST_REGEXP: {
@@ -4899,14 +5014,37 @@ TclExecuteByteCode(
 		    O2S(valuePtr), O2S(value2Ptr)), objResultPtr);
 	    TRESULT = TCL_ERROR;
 	    goto checkForCatch;
-	} else {
-	    TRACE(("%.20s %.20s => %d\n",
-		    O2S(valuePtr), O2S(value2Ptr), match));
-	    objResultPtr = TCONST(match);
-	    NEXT_INST_F(2, 2, 1);
 	}
+
+	TRACE(("%.20s %.20s => %d\n", O2S(valuePtr), O2S(value2Ptr), match));
+
+	/*
+	 * Peep-hole optimisation: if you're about to jump, do jump from here.
+	 */
+
+	pc += 2;
+#ifndef TCL_COMPILE_DEBUG
+	switch (*pc) {
+	case INST_JUMP_FALSE1:
+	    NEXT_INST_F((match? 2 : TclGetInt1AtPtr(pc+1)), 2, 0);
+	case INST_JUMP_TRUE1:
+	    NEXT_INST_F((match? TclGetInt1AtPtr(pc+1) : 2), 2, 0);
+	case INST_JUMP_FALSE4:
+	    NEXT_INST_F((match? 5 : TclGetInt4AtPtr(pc+1)), 2, 0);
+	case INST_JUMP_TRUE4:
+	    NEXT_INST_F((match? TclGetInt4AtPtr(pc+1) : 5), 2, 0);
+	}
+#endif
+	objResultPtr = TCONST(match);
+	NEXT_INST_F(0, 2, 1);
     }
 
+    /*
+     *	   End of string-related instructions.
+     * -----------------------------------------------------------------
+     *	   Start of numeric operator instructions.
+     */
+
     case INST_EQ:
     case INST_NEQ:
     case INST_LT:
@@ -6933,6 +7071,11 @@ TclExecuteByteCode(
 	NEXT_INST_F(1, 0, 0);
     }
 
+    /*
+     *	   End of numeric operator instructions.
+     * -----------------------------------------------------------------
+     */
+
     case INST_BREAK:
 	/*
 	DECACHE_STACK_INFO();
@@ -7185,10 +7328,18 @@ TclExecuteByteCode(
 	NEXT_INST_F(2*code -1, 1, 0);
     }
 
+    /*
+     * -----------------------------------------------------------------
+     *	   Start of dictionary-related instructions.
+     */
+
     {
-	int opnd, opnd2, allocateDict;
-	Tcl_Obj *dictPtr, *valuePtr, *val2Ptr;
+	int opnd, opnd2, allocateDict, done, i, length, allocdict;
+	Tcl_Obj *dictPtr, *valuePtr, *val2Ptr, *statePtr, *keyPtr;
+	Tcl_Obj *emptyPtr, **keyPtrPtr;
 	Var *varPtr;
+	Tcl_DictSearch *searchPtr;
+	DictUpdateInfo *duiPtr;
 
     case INST_DICT_GET:
 	opnd = TclGetUInt4AtPtr(pc+1);
@@ -7390,26 +7541,24 @@ TclExecuteByteCode(
 
 	    if (valuePtr == NULL) {
 		valuePtr = Tcl_NewListObj(1, &OBJ_AT_TOS);
-	    } else if (Tcl_IsShared(valuePtr)) {
+		break;
+	    }
+	    if (Tcl_IsShared(valuePtr)) {
 		valuePtr = Tcl_DuplicateObj(valuePtr);
 		TRESULT = Tcl_ListObjAppendElement(interp, valuePtr,
 			OBJ_AT_TOS);
 		if (TRESULT != TCL_OK) {
 		    TclDecrRefCount(valuePtr);
-		    if (allocateDict) {
-			TclDecrRefCount(dictPtr);
-		    }
-		    goto checkForCatch;
 		}
 	    } else {
 		TRESULT = Tcl_ListObjAppendElement(interp, valuePtr,
 			OBJ_AT_TOS);
-		if (TRESULT != TCL_OK) {
-		    if (allocateDict) {
-			TclDecrRefCount(dictPtr);
-		    }
-		    goto checkForCatch;
+	    }
+	    if (TRESULT != TCL_OK) {
+		if (allocateDict) {
+		    TclDecrRefCount(dictPtr);
 		}
+		goto checkForCatch;
 	    }
 	    break;
 	default:
@@ -7449,13 +7598,6 @@ TclExecuteByteCode(
 #endif
 	TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
 	NEXT_INST_F(5, 2, 1);
-    }
-
-    {
-	int opnd, done;
-	Tcl_Obj *statePtr, *dictPtr, *keyPtr, *valuePtr, *emptyPtr;
-	Var *varPtr;
-	Tcl_DictSearch *searchPtr;
 
     case INST_DICT_FIRST:
 	opnd = TclGetUInt4AtPtr(pc+1);
@@ -7540,13 +7682,6 @@ TclExecuteByteCode(
 	    Tcl_IncrRefCount(emptyPtr);
 	}
 	NEXT_INST_F(5, 0, 0);
-    }
-
-    {
-	int opnd, opnd2, i, length, allocdict;
-	Tcl_Obj **keyPtrPtr, *dictPtr, *valuePtr;
-	DictUpdateInfo *duiPtr;
-	Var *varPtr;
 
     case INST_DICT_UPDATE_START:
 	opnd = TclGetUInt4AtPtr(pc+1);
@@ -7674,6 +7809,11 @@ TclExecuteByteCode(
 	NEXT_INST_F(9, 1, 0);
     }
 
+    /*
+     *	   End of dictionary-related instructions.
+     * -----------------------------------------------------------------
+     */
+
     default:
 	Tcl_Panic("TclExecuteByteCode: unrecognized opCode %u", *pc);
     } /* end of switch on opCode */
diff --git a/generic/tclInt.h b/generic/tclInt.h
index c1da3d4..97a5e44 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -15,7 +15,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.455 2010/01/29 16:17:20 nijtmans Exp $
+ * RCS: @(#) $Id: tclInt.h,v 1.456 2010/01/30 16:33:25 dkf Exp $
  */
 
 #ifndef _TCLINT
@@ -808,6 +808,9 @@ typedef struct VarInHash {
 #define TclIsVarDirectWritable(varPtr) \
     !((varPtr)->flags & (VAR_ARRAY|VAR_LINK|VAR_TRACED_WRITE|VAR_DEAD_HASH))
 
+#define TclIsVarDirectUnsettable(varPtr) \
+    !((varPtr)->flags & (VAR_ARRAY|VAR_LINK|VAR_TRACED_UNSET|VAR_DEAD_HASH))
+
 #define TclIsVarDirectModifyable(varPtr) \
     (   !((varPtr)->flags & (VAR_ARRAY|VAR_LINK|VAR_TRACED_READ|VAR_TRACED_WRITE)) \
     &&  (varPtr)->value.objPtr)
@@ -3392,6 +3395,9 @@ MODULE_SCOPE int	TclCompileSubstCmd(Tcl_Interp *interp,
 MODULE_SCOPE int	TclCompileSwitchCmd(Tcl_Interp *interp,
 			    Tcl_Parse *parsePtr, Command *cmdPtr,
 			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclCompileUnsetCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr);
 MODULE_SCOPE int	TclCompileUpvarCmd(Tcl_Interp *interp,
 			    Tcl_Parse *parsePtr, Command *cmdPtr,
 			    struct CompileEnv *envPtr);
@@ -3569,6 +3575,10 @@ MODULE_SCOPE Tcl_Obj *	TclPtrIncrObjVar(Tcl_Interp *interp,
 			    const int flags, int index);
 MODULE_SCOPE int	TclPtrObjMakeUpvar(Tcl_Interp *interp, Var *otherPtr,
 			    Tcl_Obj *myNamePtr, int myFlags, int index);
+MODULE_SCOPE int	TclPtrUnsetVar(Tcl_Interp *interp, Var *varPtr,
+			    Var *arrayPtr, Tcl_Obj *part1Ptr,
+			    Tcl_Obj *part2Ptr, const int flags,
+			    int index);
 MODULE_SCOPE void	TclInvalidateNsPath(Namespace *nsPtr);
 
 /*
diff --git a/generic/tclVar.c b/generic/tclVar.c
index 54699ce..c2aea55 100644
--- a/generic/tclVar.c
+++ b/generic/tclVar.c
@@ -16,7 +16,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclVar.c,v 1.184 2009/11/20 00:19:46 dgp Exp $
+ * RCS: @(#) $Id: tclVar.c,v 1.185 2010/01/30 16:33:25 dkf Exp $
  */
 
 #include "tclInt.h"
@@ -158,7 +158,7 @@ static ArraySearch *	ParseSearchId(Tcl_Interp *interp, const Var *varPtr,
 			    Tcl_Obj *varNamePtr, Tcl_Obj *handleObj);
 static void		UnsetVarStruct(Var *varPtr, Var *arrayPtr,
 			    Interp *iPtr, Tcl_Obj *part1Ptr,
-			    Tcl_Obj *part2Ptr, int flags);
+			    Tcl_Obj *part2Ptr, int flags, int index);
 static int		SetArraySearchObj(Tcl_Interp *interp,
 			    Tcl_Obj *objPtr);
 
@@ -2204,10 +2204,7 @@ TclObjUnsetVar2(
 				 * TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY,
 				 * TCL_LEAVE_ERR_MSG. */
 {
-    Var *varPtr;
-    Interp *iPtr = (Interp *) interp;
-    Var *arrayPtr;
-    int result;
+    Var *varPtr, *arrayPtr;
 
     varPtr = TclObjLookupVarEx(interp, part1Ptr, part2Ptr, flags, "unset",
 	    /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr);
@@ -2215,7 +2212,52 @@ TclObjUnsetVar2(
 	return TCL_ERROR;
     }
 
-    result = (TclIsVarUndefined(varPtr)? TCL_ERROR : TCL_OK);
+    return TclPtrUnsetVar(interp, varPtr, arrayPtr, part1Ptr, part2Ptr, flags,
+	    -1);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclPtrUnsetVar --
+ *
+ *	Delete a variable, given the pointers to the variable's (and possibly
+ *	containing array's) VAR structure.
+ *
+ * Results:
+ *	Returns TCL_OK if the variable was successfully deleted, TCL_ERROR if
+ *	the variable can't be unset. In the event of an error, if the
+ *	TCL_LEAVE_ERR_MSG flag is set then an error message is left in the
+ *	interp's result.
+ *
+ * Side effects:
+ *	If varPtr and arrayPtr indicate a local or global variable in interp,
+ *	it is deleted. If varPtr is an array reference and part2Ptr is NULL,
+ *	then the whole array is deleted.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclPtrUnsetVar(
+    Tcl_Interp *interp,		/* Command interpreter in which varName is to
+				 * be looked up. */
+    register Var *varPtr,	/* The variable to be unset. */
+    Var *arrayPtr,		/* NULL for scalar variables, pointer to the
+				 * containing array otherwise. */
+    Tcl_Obj *part1Ptr,		/* Name of an array (if part2 is non-NULL) or
+				 * the name of a variable. */
+    Tcl_Obj *part2Ptr,		/* If non-NULL, gives the name of an element
+				 * in the array part1. */
+    const int flags,		/* OR-ed combination of any of
+				 * TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY,
+				 * TCL_LEAVE_ERR_MSG. */
+    int index)			/* Index into the local variable table of the
+				 * variable, or -1. Only used when part1Ptr is
+				 * NULL. */
+{
+    Interp *iPtr = (Interp *) interp;
+    int result = (TclIsVarUndefined(varPtr)? TCL_ERROR : TCL_OK);
 
     /*
      * Keep the variable alive until we're done with it. We used to
@@ -2228,7 +2270,7 @@ TclObjUnsetVar2(
 	VarHashRefCount(varPtr)++;
     }
 
-    UnsetVarStruct(varPtr, arrayPtr, iPtr, part1Ptr, part2Ptr, flags);
+    UnsetVarStruct(varPtr, arrayPtr, iPtr, part1Ptr, part2Ptr, flags, index);
 
     /*
      * It's an error to unset an undefined variable.
@@ -2237,7 +2279,7 @@ TclObjUnsetVar2(
     if (result != TCL_OK) {
 	if (flags & TCL_LEAVE_ERR_MSG) {
 	    TclObjVarErrMsg(interp, part1Ptr, part2Ptr, "unset",
-		    ((arrayPtr == NULL) ? noSuchVar : noSuchElement), -1);
+		    ((arrayPtr == NULL) ? noSuchVar : noSuchElement), index);
 	    Tcl_SetErrorCode(interp, "TCL", "UNSET", "VARNAME", NULL);
 	}
     }
@@ -2294,7 +2336,8 @@ UnsetVarStruct(
     Interp *iPtr,
     Tcl_Obj *part1Ptr,
     Tcl_Obj *part2Ptr,
-    int flags)
+    int flags,
+    int index)
 {
     Var dummyVar;
     int traced = TclIsVarTraced(varPtr)
@@ -2364,7 +2407,7 @@ UnsetVarStruct(
 	    TclObjCallVarTraces(iPtr, arrayPtr, &dummyVar, part1Ptr, part2Ptr,
 		    (flags & (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY))
 			    | TCL_TRACE_UNSETS,
-		    /* leaveErrMsg */ 0, -1);
+		    /* leaveErrMsg */ 0, index);
 
 	    /*
 	     * The traces that we just called may have triggered a change in
@@ -4418,7 +4461,7 @@ TclDeleteNamespaceVars(
 					 * hash. */
 	Tcl_GetVariableFullName(interp, (Tcl_Var) varPtr, objPtr);
 	UnsetVarStruct(varPtr, NULL, iPtr, /* part1 */ objPtr,
-		NULL, flags);
+		NULL, flags, -1);
 	Tcl_DecrRefCount(objPtr); /* free no longer needed obj */
 
 
@@ -4506,7 +4549,8 @@ TclDeleteVars(
 	 */
 
 	VarHashInvalidateEntry(varPtr);
-	UnsetVarStruct(varPtr, NULL, iPtr, VarHashGetKey(varPtr), NULL, flags);
+	UnsetVarStruct(varPtr, NULL, iPtr, VarHashGetKey(varPtr), NULL, flags,
+		-1);
     }
     VarHashDeleteTable(tablePtr);
 }
@@ -4548,7 +4592,7 @@ TclDeleteCompiledLocalVars(
     namePtrPtr = &localName(framePtr, 0);
     for (i=0 ; i<numLocals ; i++, namePtrPtr++, varPtr++) {
 	UnsetVarStruct(varPtr, NULL, iPtr, *namePtrPtr, NULL,
-		TCL_TRACE_UNSETS);
+		TCL_TRACE_UNSETS, i);
     }
     framePtr->numCompiledLocals = 0;
 }