diff options
Diffstat (limited to 'generic')
| -rw-r--r-- | generic/tclCompile.c | 7 | ||||
| -rw-r--r-- | generic/tclCompile.h | 25 | ||||
| -rw-r--r-- | generic/tclExecute.c | 19 |
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; |