Work in progress auditing the stack usage estimates of the bytecode

compiler routines.  Much of this code is ugly and will never find a
place on the trunk, but the problems it pinpoints will be fixed there.

This is now at the point where the test suite of a --enable-symbols=all
build will usefully panic on those tests where stack estimates are
not correct (or where the auditing code itself is still faulty).

8 files changed, 128 insertions, 41 deletions

diff --git a/generic/tclAssembly.c b/generic/tclAssembly.c
index 0fe50b3a..2198d74 100644
--- a/generic/tclAssembly.c
+++ b/generic/tclAssembly.c
@@ -1345,7 +1345,7 @@ AssembleOneLine(
 		|| CheckStrictlyPositive(interp, opnd) != TCL_OK) {
 	    goto cleanup;
 	}
-	BBEmitInstInt4(assemEnvPtr, tblIdx, opnd, opnd+1);
+	BBEmitInstInt4(assemEnvPtr, tblIdx, opnd+1, opnd+1);
 	break;
 
     case ASSEM_DICT_SET:
@@ -1361,7 +1361,7 @@ AssembleOneLine(
 	if (localVar < 0) {
 	    goto cleanup;
 	}
-	BBEmitInstInt4(assemEnvPtr, tblIdx, opnd, opnd+1);
+	BBEmitInstInt4(assemEnvPtr, tblIdx, opnd+1, opnd+1);
 	TclEmitInt4(localVar, envPtr);
 	break;
 
diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index 7046e54..bc9ef81 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -302,9 +302,17 @@ TclCompileArraySetCmd(
 	} else {
 	    TclEmitOpcode(  INST_DUP,				envPtr);
 	    TclEmitOpcode(  INST_ARRAY_EXISTS_STK,		envPtr);
-	    TclEmitInstInt1(INST_JUMP_TRUE1, 5,			envPtr);
+	    TclEmitInstInt1(INST_JUMP_TRUE1, 5
+#ifdef TCL_COMPILE_DEBUG
++10
+#endif
+,			envPtr);
 	    TclEmitOpcode(  INST_ARRAY_MAKE_STK,		envPtr);
-	    TclEmitInstInt1(INST_JUMP1, 3,			envPtr);
+	    TclEmitInstInt1(INST_JUMP1, 3
+#ifdef TCL_COMPILE_DEBUG
++10
+#endif
+,			envPtr);
 	    /* Each branch decrements stack depth, but we only take one. */
 	    TclAdjustStackDepth(1, envPtr);
 	    TclEmitOpcode(  INST_POP,				envPtr);
@@ -382,7 +390,11 @@ TclCompileArraySetCmd(
     } else {
 	TclEmitOpcode(	INST_DUP,				envPtr);
 	TclEmitOpcode(	INST_ARRAY_EXISTS_STK,			envPtr);
-	TclEmitInstInt1(INST_JUMP_TRUE1, 4,			envPtr);
+	TclEmitInstInt1(INST_JUMP_TRUE1, 4
+#ifdef TCL_COMPILE_DEBUG
++15
+#endif
+,			envPtr);
 	TclEmitOpcode(	INST_DUP,				envPtr);
 	TclEmitOpcode(	INST_ARRAY_MAKE_STK,			envPtr);
 	TclEmitInstInt4(INST_FOREACH_START4, infoIndex,		envPtr);
@@ -442,9 +454,17 @@ TclCompileArrayUnsetCmd(
     } else {
 	TclEmitOpcode(	INST_DUP,				envPtr);
 	TclEmitOpcode(	INST_ARRAY_EXISTS_STK,			envPtr);
-	TclEmitInstInt1(INST_JUMP_FALSE1, 6,			envPtr);
+	TclEmitInstInt1(INST_JUMP_FALSE1, 6
+#ifdef TCL_COMPILE_DEBUG
++10
+#endif
+,			envPtr);
 	TclEmitInstInt1(INST_UNSET_STK, 1,			envPtr);
-	TclEmitInstInt1(INST_JUMP1, 3,				envPtr);
+	TclEmitInstInt1(INST_JUMP1, 3
+#ifdef TCL_COMPILE_DEBUG
++10
+#endif
+,				envPtr);
 	/* Each branch decrements stack depth, but we only take one. */
 	TclAdjustStackDepth(1, envPtr);
 	TclEmitOpcode(	INST_POP,				envPtr);
@@ -646,7 +666,11 @@ TclCompileCatchCmd(
 
 	TclEmitOpcode(		INST_POP,			envPtr);
 	PushStringLiteral(envPtr, "0");
-	TclEmitInstInt1(	INST_JUMP1, 3,			envPtr);
+	TclEmitInstInt1(	INST_JUMP1, 3
+#ifdef TCL_COMPILE_DEBUG
++5
+#endif
+,			envPtr);
 	envPtr->currStackDepth = savedStackDepth;
 	ExceptionRangeTarget(envPtr, range, catchOffset);
 	TclEmitOpcode(		INST_PUSH_RETURN_CODE,		envPtr);
@@ -803,7 +827,14 @@ TclCompileContinueCmd(
      */
 
     TclEmitOpcode(INST_CONTINUE, envPtr);
-    PushStringLiteral(envPtr, "");	/* Evil hack! */
+#ifdef TCL_COMPILE_DEBUG
+    /*
+     * Instructions that raise exceptions don't really have to follow
+     * the usual stack management rules.  But the checker wants them
+     * followed, so lie about stack usage to make it happy.
+     */
+    TclAdjustStackDepth(1, envPtr);
+#endif
     return TCL_OK;
 }
 
@@ -884,9 +915,8 @@ TclCompileDictSetCmd(
      * Now emit the instruction to do the dict manipulation.
      */
 
-    TclEmitInstInt4( INST_DICT_SET, numWords-2,		envPtr);
+    TclEmitInstInt4( INST_DICT_SET, numWords-1,		envPtr);
     TclEmitInt4(     dictVarIndex,			envPtr);
-    TclAdjustStackDepth(-1, envPtr);
     return TCL_OK;
 }
 
@@ -1003,8 +1033,7 @@ TclCompileDictGetCmd(
 	CompileWord(envPtr, tokenPtr, interp, i);
 	tokenPtr = TokenAfter(tokenPtr);
     }
-    TclEmitInstInt4(INST_DICT_GET, numWords-1, envPtr);
-    TclAdjustStackDepth(-1, envPtr);
+    TclEmitInstInt4(INST_DICT_GET, numWords, envPtr);
     return TCL_OK;
 }
 
@@ -1040,8 +1069,7 @@ TclCompileDictExistsCmd(
 	CompileWord(envPtr, tokenPtr, interp, i);
 	tokenPtr = TokenAfter(tokenPtr);
     }
-    TclEmitInstInt4(INST_DICT_EXISTS, numWords-1, envPtr);
-    TclAdjustStackDepth(-1, envPtr);
+    TclEmitInstInt4(INST_DICT_EXISTS, numWords, envPtr);
     return TCL_OK;
 }
 
@@ -1188,9 +1216,8 @@ TclCompileDictCreateCmd(
 	tokenPtr = TokenAfter(tokenPtr);
 	CompileWord(envPtr, tokenPtr, interp, i+1);
 	tokenPtr = TokenAfter(tokenPtr);
-	TclEmitInstInt4(	INST_DICT_SET, 1,		envPtr);
+	TclEmitInstInt4(	INST_DICT_SET, 2,		envPtr);
 	TclEmitInt4(			worker,			envPtr);
-	TclAdjustStackDepth(-1, envPtr);
 	TclEmitOpcode(		INST_POP,			envPtr);
     }
     Emit14Inst(			INST_LOAD_SCALAR, worker,	envPtr);
@@ -1270,9 +1297,8 @@ TclCompileDictMergeCmd(
 	TclEmitInstInt4(	INST_DICT_FIRST, infoIndex,	envPtr);
 	TclEmitInstInt1(	INST_JUMP_TRUE1, 24,		envPtr);
 	TclEmitInstInt4(	INST_REVERSE, 2,		envPtr);
-	TclEmitInstInt4(	INST_DICT_SET, 1,		envPtr);
+	TclEmitInstInt4(	INST_DICT_SET, 2,		envPtr);
 	TclEmitInt4(			workerIndex,		envPtr);
-	TclAdjustStackDepth(-1, envPtr);
 	TclEmitOpcode(		INST_POP,			envPtr);
 	TclEmitInstInt4(	INST_DICT_NEXT, infoIndex,	envPtr);
 	TclEmitInstInt1(	INST_JUMP_FALSE1, -20,		envPtr);
@@ -1499,9 +1525,8 @@ CompileDictEachCmd(
     if (collect == TCL_EACH_COLLECT) {
 	Emit14Inst(	INST_LOAD_SCALAR, keyVarIndex,		envPtr);
 	TclEmitInstInt4(INST_OVER, 1,				envPtr);
-	TclEmitInstInt4(INST_DICT_SET, 1,			envPtr);
+	TclEmitInstInt4(INST_DICT_SET, 2,			envPtr);
 	TclEmitInt4(		collectVar,			envPtr);
-	TclAdjustStackDepth(-1, envPtr);
 	TclEmitOpcode(	INST_POP,				envPtr);
     }
     TclEmitOpcode(	INST_POP,				envPtr);
diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c
index ed4d962..7014bc0 100644
--- a/generic/tclCompCmdsSZ.c
+++ b/generic/tclCompCmdsSZ.c
@@ -2309,7 +2309,12 @@ IssueTryInstructions(
     ExceptionRangeEnds(envPtr, range);
     PUSH(				"0");
     OP4(				REVERSE, 2);
-    OP1(				JUMP1, 4);
+    OP1(				JUMP1, 4
+#ifdef TCL_COMPILE_DEBUG
++10
+#endif
+);
+    TclAdjustStackDepth(-2, envPtr);
     ExceptionRangeTarget(envPtr, range, catchOffset);
     OP(					PUSH_RETURN_CODE);
     OP(					PUSH_RESULT);
@@ -2346,8 +2351,7 @@ IssueTryInstructions(
 
 	    LOAD(			optionsVar);
 	    PUSH(			"-errorcode");
-	    OP4(			DICT_GET, 1);
-	    TclAdjustStackDepth(-1, envPtr);
+	    OP4(			DICT_GET, 2);
 	    OP44(			LIST_RANGE_IMM, 0, len-1);
 	    p = Tcl_GetStringFromObj(matchClauses[i], &len);
 	    PushLiteral(envPtr, p, len);
@@ -2463,7 +2467,13 @@ IssueTryFinallyInstructions(
     ExceptionRangeEnds(envPtr, range);
     PUSH(				"0");
     OP4(				REVERSE, 2);
-    OP1(				JUMP1, 4);
+    OP1(				JUMP1, 4
+#ifdef TCL_COMPILE_DEBUG
++10
+#endif
+);
+//    TclAdjustStackDepth(-2, envPtr);
+    envPtr->currStackDepth = savedStackDepth;
     ExceptionRangeTarget(envPtr, range, catchOffset);
     OP(					PUSH_RETURN_CODE);
     OP(					PUSH_RESULT);
@@ -2473,7 +2483,7 @@ IssueTryFinallyInstructions(
     OP(					POP);
     STORE(				resultVar);
     OP(					POP);
-    envPtr->currStackDepth = savedStackDepth + 1;
+//    envPtr->currStackDepth = savedStackDepth + 1;
 
     /*
      * Now we handle all the registered 'on' and 'trap' handlers in order.
@@ -2503,8 +2513,7 @@ IssueTryFinallyInstructions(
 
 		LOAD(			optionsVar);
 		PUSH(			"-errorcode");
-		OP4(			DICT_GET, 1);
-		TclAdjustStackDepth(-1, envPtr);
+		OP4(			DICT_GET, 2);
 		OP44(			LIST_RANGE_IMM, 0, len-1);
 		p = Tcl_GetStringFromObj(matchClauses[i], &len);
 		PushLiteral(envPtr, p, len);
@@ -2578,7 +2587,7 @@ IssueTryFinallyInstructions(
 		}
 		OP4(			BEGIN_CATCH4, range);
 	    }
-	    envPtr->currStackDepth = savedStackDepth;
+//	    envPtr->currStackDepth = savedStackDepth + 1;
 	    BODY(			handlerTokens[i], 5+i*4);
 	    ExceptionRangeEnds(envPtr, range);
 	    OP(				PUSH_RETURN_OPTIONS);
@@ -2629,6 +2638,7 @@ IssueTryFinallyInstructions(
      * Drop the result code.
      */
 
+    envPtr->currStackDepth = savedStackDepth + 1;
     OP(					POP);
 
     /*
@@ -2639,7 +2649,6 @@ IssueTryFinallyInstructions(
      * next command (or some inter-command manipulation).
      */
 
-    envPtr->currStackDepth = savedStackDepth;
     BODY(				finallyToken, 3 + 4*numHandlers);
     OP(					POP);
     LOAD(				optionsVar);
diff --git a/generic/tclCompExpr.c b/generic/tclCompExpr.c
index 3597abe..efdc2b0 100644
--- a/generic/tclCompExpr.c
+++ b/generic/tclCompExpr.c
@@ -2401,6 +2401,7 @@ CompileExprTree(
 			(nodePtr->lexeme == AND) ? "1" : "0", 1), envPtr);
 		TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP,
 			&jumpPtr->next->next->jump);
+		TclAdjustStackDepth(-1, envPtr);
 		TclFixupForwardJumpToHere(envPtr, &jumpPtr->next->jump, 127);
 		if (TclFixupForwardJumpToHere(envPtr, &jumpPtr->jump, 127)) {
 		    jumpPtr->next->next->jump.codeOffset += 3;
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index 74e5313..3caa7c6 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -35,8 +35,8 @@ TCL_DECLARE_MUTEX(tableMutex)
  */
 
 #ifdef TCL_COMPILE_DEBUG
-int tclTraceCompile = 2;
-static int traceInitialized = 1;
+int tclTraceCompile = 0;
+static int traceInitialized = 0;
 #endif
 
 /*
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index 5952c41..cbfa6c7 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -1076,7 +1076,7 @@ MODULE_SCOPE Tcl_Obj	*TclNewInstNameObj(unsigned char inst);
  * void TclAdjustStackDepth(int delta, CompileEnv *envPtr);
  */
 
-#ifdef TCL_COMPILE_DEBUG
+#if defined(TCL_COMPILE_DEBUG) 
 #define VerifyStackDepth(envPtr) \
     do {							\
 	int i = (envPtr)->currStackDepth;			\
@@ -1166,6 +1166,23 @@ MODULE_SCOPE Tcl_Obj	*TclNewInstNameObj(unsigned char inst);
  * void TclEmitInt4(int i, CompileEnv *envPtr);
  */
 
+
+#if defined(TCL_COMPILE_DEBUG) 
+#define TclEmitInt1(i, envPtr) \
+    do {								\
+	if ((envPtr)->codeNext == (envPtr)->codeEnd) {			\
+	    TclExpandCodeArray(envPtr);					\
+	}								\
+	if ((envPtr)->codeNext[-5] == INST_VERIFY) {			\
+	    memmove((envPtr)->codeNext-4, (envPtr)->codeNext-5, 5);	\
+	    (envPtr)->codeNext[-5] =					\
+		(unsigned char) ((unsigned int) (i));			\
+	    (envPtr)->codeNext++;					\
+	    break;							\
+	}								\
+	*(envPtr)->codeNext++ = (unsigned char) ((unsigned int) (i));	\
+    } while (0)
+#else
 #define TclEmitInt1(i, envPtr) \
     do {								\
 	if ((envPtr)->codeNext == (envPtr)->codeEnd) {			\
@@ -1173,7 +1190,37 @@ MODULE_SCOPE Tcl_Obj	*TclNewInstNameObj(unsigned char inst);
 	}								\
 	*(envPtr)->codeNext++ = (unsigned char) ((unsigned int) (i));	\
     } while (0)
+#endif
 
+#if defined(TCL_COMPILE_DEBUG) 
+#define TclEmitInt4(i, envPtr) \
+    do {								\
+	if (((envPtr)->codeNext + 4) > (envPtr)->codeEnd) {		\
+	    TclExpandCodeArray(envPtr);					\
+	}								\
+	if ((envPtr)->codeNext[-5] == INST_VERIFY) {			\
+	    memmove((envPtr)->codeNext-1, (envPtr)->codeNext-5, 5);	\
+	    (envPtr)->codeNext[-5] =					\
+		(unsigned char) ((unsigned int) (i) >> 24);		\
+	    (envPtr)->codeNext[-4] =					\
+		(unsigned char) ((unsigned int) (i) >> 16);		\
+	    (envPtr)->codeNext[-3] =					\
+		(unsigned char) ((unsigned int) (i) >>  8);		\
+	    (envPtr)->codeNext[-2] =					\
+		(unsigned char) ((unsigned int) (i)      );		\
+	    (envPtr)->codeNext += 4;					\
+	    break;							\
+	}								\
+	*(envPtr)->codeNext++ =						\
+		(unsigned char) ((unsigned int) (i) >> 24);		\
+	*(envPtr)->codeNext++ =						\
+		(unsigned char) ((unsigned int) (i) >> 16);		\
+	*(envPtr)->codeNext++ =						\
+		(unsigned char) ((unsigned int) (i) >>  8);		\
+	*(envPtr)->codeNext++ =						\
+		(unsigned char) ((unsigned int) (i)      );		\
+    } while (0)
+#else
 #define TclEmitInt4(i, envPtr) \
     do {								\
 	if (((envPtr)->codeNext + 4) > (envPtr)->codeEnd) {		\
@@ -1188,6 +1235,7 @@ MODULE_SCOPE Tcl_Obj	*TclNewInstNameObj(unsigned char inst);
 	*(envPtr)->codeNext++ =						\
 		(unsigned char) ((unsigned int) (i)      );		\
     } while (0)
+#endif;
 
 /*
  * Macros to emit an instruction with signed or unsigned integer operands.
diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c
index 813e056..24e0f8b 100644
--- a/generic/tclEnsemble.c
+++ b/generic/tclEnsemble.c
@@ -3198,9 +3198,8 @@ CompileToInvokedCommand(
      * Do the replacing dispatch.
      */
 
-    TclEmitInstInt4(INST_INVOKE_REPLACE, parsePtr->numWords, envPtr);
+    TclEmitInstInt4(INST_INVOKE_REPLACE, parsePtr->numWords+1, envPtr);
     TclEmitInt1(numWords+1, envPtr);
-    TclAdjustStackDepth(-1, envPtr);	/* Correction to stack depth calcs. */
 }
 
 /*
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 14809cb..567ef76 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -67,7 +67,7 @@ static int cachedInExit = 0;
  * This variable is linked to the Tcl variable "tcl_traceExec".
  */
 
-int tclTraceExec = 3;
+int tclTraceExec = 0;
 #endif
 
 /*
@@ -2323,7 +2323,7 @@ TEBCresume(
 	goto instLoadScalar1;
     } else if (inst == INST_PUSH1) {
 	PUSH_OBJECT(codePtr->objArrayPtr[TclGetUInt1AtPtr(pc+1)]);
-	TRACE_WITH_OBJ(("%u => ", TclGetInt1AtPtr(pc+1)), OBJ_AT_TOS);
+	TRACE_WITH_OBJ(("%u => ", TclGetUInt1AtPtr(pc+1)), OBJ_AT_TOS);
 	inst = *(pc += 2);
 	goto peepholeStart;
     } else if (inst == INST_START_CMD) {
@@ -2997,7 +2997,7 @@ TEBCresume(
 #endif
 
     case INST_INVOKE_REPLACE:
-	objc = TclGetUInt4AtPtr(pc+1);
+	objc = TclGetUInt4AtPtr(pc+1) - 1;
 	opnd = TclGetUInt1AtPtr(pc+5);
 	objPtr = POP_OBJECT();
 	objv = &OBJ_AT_DEPTH(objc-1);
@@ -4249,7 +4249,7 @@ TEBCresume(
 	    } else {
 		TRACE(("%d => %.20s false, new pc %u\n", jmpOffset[0],
 			O2S(valuePtr),
-			(unsigned)(pc + jmpOffset[1] - codePtr->codeStart)));
+			(unsigned)(pc + jmpOffset[0] - codePtr->codeStart)));
 	    }
 	}
 #endif
@@ -6172,6 +6172,11 @@ TEBCresume(
 	 */
 
 	pc += 5;
+#ifdef TCL_COMPILE_DEBUG
+	if (*pc == INST_VERIFY) {
+	    pc +=5;
+	}
+#endif
 	if (*pc == INST_JUMP_FALSE1) {
 	    NEXT_INST_F((continueLoop? 2 : TclGetInt1AtPtr(pc+1)), 0, 0);
 	} else {
@@ -6268,7 +6273,7 @@ TEBCresume(
     case INST_DICT_EXISTS: {
 	register Tcl_Interp *interp2 = interp;
 
-	opnd = TclGetUInt4AtPtr(pc+1);
+	opnd = TclGetUInt4AtPtr(pc+1) - 1;
 	TRACE(("%u => ", opnd));
 	dictPtr = OBJ_AT_DEPTH(opnd);
 	if (*pc == INST_DICT_EXISTS) {
@@ -6324,7 +6329,7 @@ TEBCresume(
     case INST_DICT_SET:
     case INST_DICT_UNSET:
     case INST_DICT_INCR_IMM:
-	opnd = TclGetUInt4AtPtr(pc+1);
+	opnd = TclGetUInt4AtPtr(pc+1) - (*pc == INST_DICT_SET);
 	opnd2 = TclGetUInt4AtPtr(pc+5);
 
 	varPtr = LOCAL(opnd2);