Experimental super-stack-estimate checker.

3 files changed, 47 insertions, 4 deletions

diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index 039a694..74e5313 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -35,8 +35,8 @@ TCL_DECLARE_MUTEX(tableMutex)
  */
 
 #ifdef TCL_COMPILE_DEBUG
-int tclTraceCompile = 0;
-static int traceInitialized = 0;
+int tclTraceCompile = 2;
+static int traceInitialized = 1;
 #endif
 
 /*
@@ -539,6 +539,9 @@ InstructionDesc const tclInstructionTable[] = {
 	/* Concatenates the two lists at the top of the stack into a single
 	 * list and pushes that resulting list onto the stack.
 	 * Stack: ... list1 list2 => ... [lconcat list1 list2] */
+    {"verify",		 5,	 0,	  1,	{OPERAND_UINT4}},
+	/* Verify the predicted stack depth (operand) is true during
+	 * bytecode execution. */
 
     {NULL, 0, 0, 0, {OPERAND_NONE}}
 };
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index 0be5d1d..5952c41 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -716,9 +716,10 @@ typedef struct ByteCode {
 #define INST_INVOKE_REPLACE		163
 
 #define INST_LIST_CONCAT		164
+#define INST_VERIFY			165
 
 /* The last opcode */
-#define LAST_INST_OPCODE		164
+#define LAST_INST_OPCODE		165
 
 /*
  * Table describing the Tcl bytecode instructions: their name (for displaying
@@ -1075,6 +1076,27 @@ MODULE_SCOPE Tcl_Obj	*TclNewInstNameObj(unsigned char inst);
  * void TclAdjustStackDepth(int delta, CompileEnv *envPtr);
  */
 
+#ifdef TCL_COMPILE_DEBUG
+#define VerifyStackDepth(envPtr) \
+    do {							\
+	int i = (envPtr)->currStackDepth;			\
+	if (((envPtr)->codeNext + 5) > (envPtr)->codeEnd) {	\
+	    TclExpandCodeArray(envPtr);				\
+	}							\
+	*(envPtr)->codeNext++ = (unsigned char) INST_VERIFY;	\
+	*(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 VerifyStackDepth(envPtr)
+#endif
+
 #define TclAdjustStackDepth(delta, envPtr) \
     do {								\
 	if ((delta) < 0) {						\
@@ -1083,6 +1105,7 @@ MODULE_SCOPE Tcl_Obj	*TclNewInstNameObj(unsigned char inst);
 	    }								\
 	}								\
 	(envPtr)->currStackDepth += (delta);				\
+	VerifyStackDepth(envPtr);					\
     } while (0)
 
 /*
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 6486206..14809cb 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 = 0;
+int tclTraceExec = 3;
 #endif
 
 /*
@@ -2722,6 +2722,23 @@ TEBCresume(
 	PUSH_TAUX_OBJ(objPtr);
 	NEXT_INST_F(1, 0, 0);
 
+    case INST_VERIFY : {
+#ifdef TCL_COMPILE_DEBUG
+	/*
+	 * This is how deep the compiler thought the stack would be,
+	 * assuming no expansion.
+	 */
+	int estimate = TclGetUInt4AtPtr(pc+1);
+
+	if (CURR_DEPTH != estimate + (auxObjList ? auxObjList->length : 0)) {
+	    Tcl_Panic("Bad stack estimate = %d; truth = %ld", estimate,
+		    CURR_DEPTH - (auxObjList ? auxObjList->length : 0));
+	}
+#endif
+	NEXT_INST_F(5, 0, 0);
+    }
+
+
     case INST_EXPAND_STKTOP: {
 	int i;
 	ptrdiff_t moved;