* generic/tclCompile.h:

	* generic/tclCompile.c:
	* generic/tclExecute.c: changed implementation of {expand}, last
	chance while in alpha as ...

	***POTENTIAL INCOMPATIBILITY***
	Scripts precompiled with ProComp under previous tcl8.5a versions
	may malfunction due to changed instruction numbers for
	INST_LIST_INDEX_IMM, INST_LIST_RANGE_IMM and INST_START_CMD.

4 files changed, 166 insertions, 198 deletions

diff --git a/ChangeLog b/ChangeLog
index 66885c4..47c4e11 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,15 @@
+2004-05-16  Miguel Sofer <msofer@users.sf.net>
+
+	* generic/tclCompile.h:
+	* generic/tclCompile.c:
+	* generic/tclExecute.c: changed implementation of {expand}, last
+	chance while in alpha as ...
+
+	***POTENTIAL INCOMPATIBILITY***
+	Scripts precompiled with ProComp under previous tcl8.5a versions
+	may malfunction due to changed instruction numbers for
+	INST_LIST_INDEX_IMM, INST_LIST_RANGE_IMM and INST_START_CMD. 
+	
 2004-05-14  Kevin B. Kenny  <kennykb@acm.org>
 
 	* generic/tclInt.decls:      Promoted TclpLocaltime and TclpGmtime
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index c918c5d..0f1e615 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.65 2004/05/12 17:43:54 msofer Exp $
+ * RCS: @(#) $Id: tclCompile.c,v 1.66 2004/05/16 17:25:48 msofer Exp $
  */
 
 #include "tclInt.h"
@@ -274,10 +274,20 @@ InstructionDesc tclInstructionTable[] = {
 	 * are on the stack. */
     {"expon",		  1,   -1,	   0,	{OPERAND_NONE}},
 	/* Binary exponentiation operator: push (stknext ** stktop) */
-    {"listverify",	  1,    0,	   0,   {OPERAND_NONE}},
-	/* Test that top of stack is a valid list; error if not */
-    {"invokeExp",   INT_MIN,   INT_MIN,    2, {OPERAND_UINT4, OPERAND_ULIST1}},
-	/* Invoke with expansion: <objc,objv> = expanded <op1,top op1> */
+     /* 
+      * NOTE: the stack effects of expandStkTop and invokeExpanded
+      * are wrong - but it cannot be done right at compile time, the stack
+      * effect is only known at run time. The value for invokeExpanded
+      * is estimated better at compile time.
+      * See the comments further down in this file, where INST_INVOKE_EXPANDED 
+      * is emitted.
+      */
+     {"expandStart",       1,    0,          0,   {OPERAND_NONE}},
+         /* Start of command with {expand}ed arguments */
+     {"expandStkTop",      5,    0,          1,   {OPERAND_INT4}},
+         /* Expand the list at stacktop: push its elements on the stack */
+     {"invokeExpanded",    1,    0,          0,   {OPERAND_NONE}},
+         /* Invoke the command marked by the last 'expandStart' */
     {"listIndexImm",	  5,	0,	   1,	{OPERAND_IDX4}},
 	/* List Index:	push (lindex stktop op4) */
     {"listRangeImm",	  9,	0,	   2,	{OPERAND_IDX4, OPERAND_IDX4}},
@@ -941,8 +951,6 @@ TclCompileScript(interp, script, numBytes, envPtr)
 	gotParse = 1;
 	if (parse.numWords > 0) {
 	    int expand = 0;
-	    unsigned char delta = 1;
-	    Tcl_DString deltaList;
 
 	    /*
 	     * If not the first command, pop the previous command's result
@@ -995,7 +1003,7 @@ TclCompileScript(interp, script, numBytes, envPtr)
 		    wordIdx++, tokenPtr += (tokenPtr->numComponents + 1)) {
 		if (tokenPtr->type == TCL_TOKEN_EXPAND_WORD) {
 		    expand = 1;
-		    Tcl_DStringInit(&deltaList);
+		    TclEmitOpcode(INST_EXPAND_START, envPtr);		    
 		    break;
 		}
 	    }
@@ -1013,21 +1021,9 @@ TclCompileScript(interp, script, numBytes, envPtr)
 	     */
 	    
 	    for (wordIdx = 0, tokenPtr = parse.tokenPtr;
-		    wordIdx < parse.numWords; delta++, wordIdx++,
+		    wordIdx < parse.numWords; wordIdx++,
 		    tokenPtr += (tokenPtr->numComponents + 1)) {
 
-		if (expand && (delta == 255)
-			&& (tokenPtr->type != TCL_TOKEN_EXPAND_WORD)) {
-		    /*
-		     * Push an empty list for expansion so our delta
-		     * between expanded words doesn't overflow a byte
-		     */
-		    objIndex = TclRegisterNewLiteral(envPtr, "", 0);
-		    TclEmitPush(objIndex, envPtr);
-		    Tcl_DStringAppend(&deltaList, (CONST char *)&delta, 1);
-		    delta = 1;
-		}
-
 		if (tokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
 		    /*
 		     * If this is the first word and the command has a
@@ -1138,35 +1134,8 @@ TclCompileScript(interp, script, numBytes, envPtr)
 		    }
 		}
 		if (tokenPtr->type == TCL_TOKEN_EXPAND_WORD) {
-
-		    if ((tokenPtr->numComponents == 1)
-			    && (tokenPtr[1].type == TCL_TOKEN_TEXT)) {
-			/*
-			 * The value to be expanded is fully known
-			 * now at compile time.  We can check list
-			 * validity, so we do not have to do so at
-			 * runtime
-			 */
-			int length;
-			Tcl_Obj *testObj = Tcl_NewStringObj(tokenPtr[1].start,
-				tokenPtr[1].size);
-			if (TCL_OK !=
-				Tcl_ListObjLength(NULL, testObj, &length)) {
-			    /*
-			     * Not a valid list, so emit instructions to
-			     * test list validity (and fail) at runtime
-			     */
-			    TclEmitOpcode(INST_LIST_VERIFY, envPtr);
-			}
-		    } else {
-			/* 
-			 * Value to expand unknown until runtime, so
-			 * include a runtime check for valid list
-			 */
-			TclEmitOpcode(INST_LIST_VERIFY, envPtr);
-		    }
-		    Tcl_DStringAppend(&deltaList, (char *)&delta, 1);
-		    delta = 0;
+		    TclEmitInstInt4(INST_EXPAND_STKTOP, 
+		            envPtr->currStackDepth, envPtr);
 		}
 	    }
 
@@ -1176,9 +1145,24 @@ TclCompileScript(interp, script, numBytes, envPtr)
 	     */
 
 	    if (expand) {
-		TclEmitInstInt4(INST_INVOKE_EXP, wordIdx, envPtr);
-		TclEmitImmDeltaList1(&deltaList, envPtr);
-		Tcl_DStringFree(&deltaList);
+		/*
+		 * The stack depth during argument expansion can only be
+		 * managed at runtime, as the number of elements in the
+		 * expanded lists is not known at compile time.
+		 * We adjust here the stack depth estimate so that it is
+		 * correct after the command with expanded arguments
+		 * returns.
+		 * The end effect of this command's invocation is that 
+		 * all the words of the command are popped from the stack, 
+		 * and the result is pushed: the stack top changes by
+		 * (1-wordIdx).
+		 * Note that the estimates are not correct while the 
+		 * command is being prepared and run, INST_EXPAND_STKTOP 
+		 * is not stack-neutral in general. 
+		 */
+
+		TclEmitOpcode(INST_INVOKE_EXPANDED, envPtr);
+		TclAdjustStackDepth((1-wordIdx), envPtr);
 	    } else if (wordIdx > 0) {
 		if (wordIdx <= 255) {
 		    TclEmitInstInt1(INST_INVOKE_STK1, wordIdx, envPtr);
@@ -3415,16 +3399,6 @@ TclPrintInstruction(codePtr, pc)
 	    }
 	    break;
 
-	case OPERAND_ULIST1:
-	    opnd = TclGetUInt1AtPtr(pc+numBytes); numBytes++;
-	    fprintf(stdout, "{");
-	    while (opnd) {
-		fprintf(stdout, "%u ", opnd);
-	        opnd = TclGetUInt1AtPtr(pc+numBytes); numBytes++;
-	    }
-	    fprintf(stdout, "0}");
-	    break;
-
 	case OPERAND_IDX4:
 	    opnd = TclGetInt4AtPtr(pc+numBytes); numBytes += 4;
 	    if (opnd >= -1) {
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index 088218f..adfaeef 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -8,7 +8,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclCompile.h,v 1.45 2004/05/14 19:15:35 msofer Exp $
+ * RCS: @(#) $Id: tclCompile.h,v 1.46 2004/05/16 17:25:49 msofer Exp $
  */
 
 #ifndef _TCLCOMPILATION
@@ -530,21 +530,22 @@ typedef struct ByteCode {
 
 /* TIP #157 - {expand}... language syntax support. */
 
-#define INST_LIST_VERIFY		100
-#define INST_INVOKE_EXP			101
+#define INST_EXPAND_START             100
+#define INST_EXPAND_STKTOP            101
+#define INST_INVOKE_EXPANDED          102
 
 /*
  * TIP #57 - 'lassign' command.  Code generation requires immediate
  *	     LINDEX and LRANGE operators.
  */
 
-#define INST_LIST_INDEX_IMM		102
-#define INST_LIST_RANGE_IMM		103
+#define INST_LIST_INDEX_IMM		103
+#define INST_LIST_RANGE_IMM		104
 
-#define INST_START_CMD                  104
+#define INST_START_CMD                  105
 
 /* The last opcode */
-#define LAST_INST_OPCODE		104
+#define LAST_INST_OPCODE		105
 
 /*
  * Table describing the Tcl bytecode instructions: their name (for
@@ -563,7 +564,6 @@ typedef enum InstOperandType {
     OPERAND_INT4,		/* Four byte signed integer. */
     OPERAND_UINT1,		/* One byte unsigned integer. */
     OPERAND_UINT4,		/* Four byte unsigned integer. */
-    OPERAND_ULIST1,		/* List of one byte unsigned integers. */
     OPERAND_IDX4		/* Four byte signed index (actually an
 				 * integer, but displayed differently.) */
 } InstOperandType;
@@ -865,6 +865,21 @@ EXTERN int		TclWordKnownAtCompileTime _ANSI_ARGS_((
 	TclRegisterLiteral(envPtr, (char *)(bytes), length, /*onHeap*/ 0)
 
 /*
+ * Macro used to manually adjust the stack requirements; used
+ * in cases where the stack effect cannot be computed from
+ * the opcode and its operands, but is still known at
+ * compile time.
+ */
+
+#define TclAdjustStackDepth(delta, envPtr) \
+    if ((delta) < 0) {\
+	if((envPtr)->maxStackDepth < (envPtr)->currStackDepth) {\
+	    (envPtr)->maxStackDepth = (envPtr)->currStackDepth;\
+	}\
+    }\
+    (envPtr)->currStackDepth += (delta)
+
+/*
  * Macro used to update the stack requirements.
  * It is called by the macros TclEmitOpCode, TclEmitInst1 and
  * TclEmitInst4.
@@ -877,16 +892,11 @@ EXTERN int		TclWordKnownAtCompileTime _ANSI_ARGS_((
     {\
 	int delta = tclInstructionTable[(op)].stackEffect;\
 	if (delta) {\
-	    if (delta < 0) {\
-		if((envPtr)->maxStackDepth < (envPtr)->currStackDepth) {\
-		    (envPtr)->maxStackDepth = (envPtr)->currStackDepth;\
-		}\
-		if (delta == INT_MIN) {\
-		    delta = 1 - (i);\
-		}\
+	    if (delta == INT_MIN) {\
+		delta = 1 - (i);\
 	    }\
-	    (envPtr)->currStackDepth += delta;\
-	}\
+            TclAdjustStackDepth(delta, envPtr);\
+        }\
     }
 
 /*
@@ -966,25 +976,6 @@ EXTERN int		TclWordKnownAtCompileTime _ANSI_ARGS_((
     TclUpdateStackReqs(op, i, envPtr)
 
 /*
- * Macro to emit an immediate list of index deltas in the code stream. 
- * The ANSI C "prototypes" for this macro is:
- *
- * EXTERN void	TclEmitImmList1 _ANSI_ARGS_((Tcl_Obj *listPtr,
- *		    CompileEnv *envPtr));
- */
-
-#define TclEmitImmDeltaList1(listPtr, envPtr)				\
-    {									\
-	int numBytes = Tcl_DStringLength(listPtr) + 1;			\
-	while (((envPtr)->codeNext + numBytes) > (envPtr)->codeEnd) {	\
-	    TclExpandCodeArray(envPtr);					\
-	}								\
-	memcpy((VOID *) (envPtr)->codeNext,				\
-		(VOID *)Tcl_DStringValue(listPtr), (size_t) numBytes);	\
-	(envPtr)->codeNext += numBytes;					\
-    }
-
-/*
  * Macro to push a Tcl object onto the Tcl evaluation stack. It emits the
  * object's one or four byte array index into the CompileEnv's code
  * array. These support, respectively, a maximum of 256 (2**8) and 2**32
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index c7cb66e..6c29150 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.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: tclExecute.c,v 1.127 2004/05/14 19:15:35 msofer Exp $
+ * RCS: @(#) $Id: tclExecute.c,v 1.128 2004/05/16 17:25:49 msofer Exp $
  */
 
 #include "tclInt.h"
@@ -387,7 +387,8 @@ static void		PrintByteCodeInfo _ANSI_ARGS_((ByteCode *codePtr));
 static char *		StringForResultCode _ANSI_ARGS_((int result));
 static void		ValidatePcAndStackTop _ANSI_ARGS_((
 			    ByteCode *codePtr, unsigned char *pc,
-			    int stackTop, int stackLowerBound));
+			    int stackTop, int stackLowerBound, 
+			    int checkStack));
 #endif /* TCL_COMPILE_DEBUG */
 static int		VerifyExprObjType _ANSI_ARGS_((Tcl_Interp *interp,
 			    Tcl_Obj *objPtr));
@@ -1100,9 +1101,7 @@ TclExecuteByteCode(interp, codePtr)
     Tcl_WideInt w;
     int isWide;
     register int cleanup;
-    int objc = 0;
     Tcl_Obj *objResultPtr;
-    Tcl_Obj **objv = NULL, **stackObjArray = NULL;
     char *part1, *part2;
     Var *varPtr, *arrayPtr;
     CallFrame *varFramePtr = iPtr->varFramePtr;
@@ -1117,6 +1116,8 @@ TclExecuteByteCode(interp, codePtr)
     int codeNsEpoch = codePtr->nsEpoch;
     int codePrecompiled = (codePtr->flags & TCL_BYTECODE_PRECOMPILED);
     
+    Tcl_Obj *expandNestList = NULL;
+
     /*
      * The execution uses a unified stack: first the catch stack, immediately
      * above it the execution stack.
@@ -1223,8 +1224,12 @@ TclExecuteByteCode(interp, codePtr)
     cleanup0:
     
 #ifdef TCL_COMPILE_DEBUG
+    /*
+     * Skip the stack depth check if an expansion is in progress
+     */
+
     ValidatePcAndStackTop(codePtr, pc, (tosPtr - eePtr->stackPtr),
-            initStackTop);
+            initStackTop, /*checkStack*/ (expandNestList == NULL));
     if (traceInstructions) {
 	fprintf(stdout, "%2d: %2d ", iPtr->numLevels, (tosPtr - eePtr->stackPtr));
 	TclPrintInstruction(codePtr, pc);
@@ -1410,120 +1415,109 @@ TclExecuteByteCode(interp, codePtr)
 	    NEXT_INST_V(2, opnd, 1);
 	}
 
-    case INST_LIST_VERIFY:
+    case INST_EXPAND_START:
+	/*
+	 * Push an element to the expandNestList. This records
+	 * the current tosPtr - i.e., the point in the stack
+	 * where the expanded command starts.
+	 *
+	 * Use a Tcl_Obj as linked list element; slight mem waste,
+	 * but faster allocation than ckalloc. This also abuses
+	 * the Tcl_Obj structure, as we do not define a special
+	 * tclObjType for it. It is not dangerous as the obj is
+	 * never passed anywhere, so that all manipulations are
+	 * performed here and in INST_INVOKE_EXPANDED (in case of
+	 * an expansion error, also in INST_EXPAND_STKTOP).
+	 */
+
+	TclNewObj(objPtr);
+	objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) (tosPtr - eePtr->stackPtr);
+	objPtr->internalRep.twoPtrValue.ptr2 = (VOID *) expandNestList;
+	expandNestList = objPtr;
+	NEXT_INST_F(1, 0, 0);
+
+    case INST_EXPAND_STKTOP:
 	{  
-	    int numElements = 0;
-	    valuePtr = *tosPtr;
+	    int objc;
+	    Tcl_Obj **objv;
+
+	    /*
+	     * Make sure that the element at stackTop is a list; if not,
+	     * remove the element from the expand link list and leave.
+	     */
+	    
 
-	    result = Tcl_ListObjLength(interp, valuePtr, &numElements);
+	    valuePtr = *tosPtr;
+	    result = Tcl_ListObjGetElements(interp, valuePtr, &objc, &objv);
 	    if (result != TCL_OK) {
 		TRACE_WITH_OBJ(("%.30s => ERROR: ", O2S(valuePtr)),
 	        	Tcl_GetObjResult(interp));
+		objPtr = expandNestList;
+		expandNestList = (Tcl_Obj *) objPtr->internalRep.twoPtrValue.ptr2;
+		TclDecrRefCount(objPtr);
 		goto checkForCatch;
 	    }
-	    NEXT_INST_F(1, 0, 0);
-	}
-
-    case INST_INVOKE_EXP:
-	{
-	    int numWords = TclGetUInt4AtPtr(pc+1);
-	    int spaceAvailable = eePtr->endPtr - tosPtr;
-	    unsigned char *deltaPtr, *deltaPtrStart = pc+5;
-	    Tcl_Obj **wordv = tosPtr - (numWords - 1);
-	    int objIdx, wordIdx, wordToExpand = -1;
-
-	    /* 
-	     * Compute number of objects needed to store the 
-	     * command after expansion is complete.
-	     */
+	    tosPtr--;
 
-	    opnd = objc = numWords;
-	    for (deltaPtr = deltaPtrStart; *deltaPtr; deltaPtr++) {
-		int numElements;
-		wordToExpand += TclGetUInt1AtPtr(deltaPtr);
-		Tcl_ListObjLength(NULL, wordv[wordToExpand], &numElements);
-		objc += numElements - 1;
+	    /*
+	     * Make sure there is enough room in the stack to expand
+	     * this list *and* process the rest of the command (at least
+	     * up to the next argument expansion or command end).
+	     * The operand is the current stack depth, as seen by the 
+	     * compiler.
+	     */ 
+
+	    length = objc + codePtr->maxStackDepth - TclGetInt4AtPtr( pc+1 );
+	    while ((tosPtr + length) > eePtr->endPtr) {
+		DECACHE_STACK_INFO();
+		GrowEvaluationStack(eePtr); 
+		CACHE_STACK_INFO();
 	    }
-
+	    
 	    /*
-	     * We'll store the expanded command in the stack expansion
-	     * space just above tosPtr, assuming there is room.  Otherwise,
-	     * allocate enough heap storage to store the expanded command.
+	     * Expand the list at stacktop onto the stack; free the list.
 	     */
 
-	    objv = stackObjArray = tosPtr + 1;
-	    if (objc > spaceAvailable) {
-		objv = (Tcl_Obj **) ckalloc((unsigned)
-			(objc * sizeof(Tcl_Obj *)));
-	    } else {
-		tosPtr += objc;
+	    for (i = 0; i < objc; i++) {
+		PUSH_OBJECT(objv[i]);
 	    }
+	    TclDecrRefCount(valuePtr);
+	    NEXT_INST_F(5, 0, 0);
+	}
 
-	    objIdx = 0;
-	    deltaPtr = deltaPtrStart;
-	    wordToExpand = TclGetUInt1AtPtr(deltaPtr) - 1;
-	    for (wordIdx = 0; wordIdx < numWords; wordIdx++) {
-
-		/* 
-		 * Copy words (expanding some) from wordv to objv.
-		 * Note that we do not increment refCounts.  We
-		 * rely on the references in wordv (on the execution
-		 * stack) to be sufficient to keep the values around
-		 * as long as we need them.
-		 */
-
-		if (wordIdx == wordToExpand) {
-		    int i, numElements;
-		    Tcl_Obj **elements, *temp = wordv[wordIdx];
-
-		    /*
-		     * Make sure the list we expand is unshared.
-		     * If it is not shared, then the stack holds the
-		     * only reference to it, and there is no danger
-		     * the list will shimmer to another type (and
-		     * possibly free the elements of the list) before
-		     * we are done with the command evaluation.
-		     */
+    case INST_INVOKE_EXPANDED:
+        objPtr = expandNestList;
+	expandNestList = (Tcl_Obj *) objPtr->internalRep.twoPtrValue.ptr2;
+	opnd = tosPtr - eePtr->stackPtr 
+		- (int) objPtr->internalRep.twoPtrValue.ptr1;
+	TclDecrRefCount(objPtr);
+	
+	if (opnd == 0) {
+	    /* 
+	     * Nothing was expanded, return {}.
+	     */
 
-		    if (Tcl_IsShared(temp)) {
-			Tcl_DecrRefCount(temp);
-			temp = Tcl_DuplicateObj(temp);
-			Tcl_IncrRefCount(temp);
-			wordv[wordIdx] = temp;
-		    }
-		    Tcl_ListObjGetElements(NULL, temp, &numElements, &elements);
-		    for (i=0; i<numElements; i++) {
-			objv[objIdx++] = elements[i];
-		    }
-		    ++deltaPtr;
-		    if (*deltaPtr) {
-			wordToExpand += TclGetUInt1AtPtr(deltaPtr);
-		    } else {
-			wordToExpand = -1;
-		    }
-		} else {
-		    objv[objIdx++] = wordv[wordIdx];
-		}
-	    }
-	    pcAdjustment = (deltaPtr - pc) + 1;
-	    goto doInvocation;
+	    TclNewObj(objResultPtr);
+	    NEXT_INST_F(1, 0, 1);
 	}
 
+	pcAdjustment = 1;
+	goto doInvocation;
+
     case INST_INVOKE_STK4:
 	opnd = TclGetUInt4AtPtr(pc+1);
-	objc = opnd;
-	objv = stackObjArray = (tosPtr - (objc-1));
 	pcAdjustment = 5;
 	goto doInvocation;
 
     case INST_INVOKE_STK1:
 	opnd = TclGetUInt1AtPtr(pc+1);
-	objc = opnd;
-	objv = stackObjArray = (tosPtr - (objc-1));
 	pcAdjustment = 2;
 	    
     doInvocation:
 	{
+	    int objc = opnd;
+	    Tcl_Obj **objv = (tosPtr - (objc-1));
+
 	    /*
 	     * We keep the stack reference count as a (char *), as that
 	     * works nicely as a portable pointer-sized counter.
@@ -1623,12 +1617,6 @@ TclExecuteByteCode(interp, codePtr)
 		ckfree((VOID *) preservedStackRefCountPtr);
 	    }	    
 
-	    if (objv != stackObjArray) {
-		ckfree((char *) objv);
-	    } else if (*pc == INST_INVOKE_EXP) {
-		tosPtr -= objc;
-	    }
-
 	    if (result == TCL_OK) {
 		/*
 		 * Push the call's object result and continue execution
@@ -4756,7 +4744,7 @@ PrintByteCodeInfo(codePtr)
 
 #ifdef TCL_COMPILE_DEBUG
 static void
-ValidatePcAndStackTop(codePtr, pc, stackTop, stackLowerBound)
+ValidatePcAndStackTop(codePtr, pc, stackTop, stackLowerBound, checkStack)
     register ByteCode *codePtr; /* The bytecode whose summary is printed
 				 * to stdout. */
     unsigned char *pc;		/* Points to first byte of a bytecode
@@ -4765,6 +4753,8 @@ ValidatePcAndStackTop(codePtr, pc, stackTop, stackLowerBound)
 				 * stackLowerBound and stackUpperBound
 				 * (inclusive). */
     int stackLowerBound;	/* Smallest legal value for stackTop. */
+    int checkStack;             /* 0 if the stack depth check should be
+				 * skipped. */
 {
     int stackUpperBound = stackLowerBound +  codePtr->maxStackDepth;	
                                 /* Greatest legal value for stackTop. */
@@ -4784,7 +4774,8 @@ ValidatePcAndStackTop(codePtr, pc, stackTop, stackLowerBound)
 		(unsigned int) opCode, relativePc);
         Tcl_Panic("TclExecuteByteCode execution failure: bad opcode");
     }
-    if ((stackTop < stackLowerBound) || (stackTop > stackUpperBound)) {
+    if (checkStack && 
+            ((stackTop < stackLowerBound) || (stackTop > stackUpperBound))) {
 	int numChars;
 	char *cmd = GetSrcInfoForPc(pc, codePtr, &numChars);