diff options
Diffstat (limited to 'generic/tclCompile.c')
| -rw-r--r-- | generic/tclCompile.c | 62 |
1 files changed, 59 insertions, 3 deletions
diff --git a/generic/tclCompile.c b/generic/tclCompile.c index c390971..e7462e6 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.c @@ -372,13 +372,13 @@ InstructionDesc const tclInstructionTable[] = { * Stack: ... value => ... * Note that the jump table contains offsets relative to the PC when * it points to this instruction; the code is relocatable. */ - {"upvar", 5, 0, 1, {OPERAND_LVT4}}, + {"upvar", 5, -1, 1, {OPERAND_LVT4}}, /* finds level and otherName in stack, links to local variable at * index op1. Leaves the level on stack. */ - {"nsupvar", 5, 0, 1, {OPERAND_LVT4}}, + {"nsupvar", 5, -1, 1, {OPERAND_LVT4}}, /* finds namespace and otherName in stack, links to local variable at * index op1. Leaves the namespace on stack. */ - {"variable", 5, 0, 1, {OPERAND_LVT4}}, + {"variable", 5, -1, 1, {OPERAND_LVT4}}, /* finds namespace and otherName in stack, links to local variable at * index op1. Leaves the namespace on stack. */ {"syntax", 9, -1, 2, {OPERAND_INT4, OPERAND_UINT4}}, @@ -453,8 +453,15 @@ InstructionDesc const tclInstructionTable[] = { /* Find the first index of a needle string in a haystack string, * producing the index (integer) or -1 if nothing found. * Stack: ... needle haystack => ... index */ + {"strrfind", 1, -1, 0, {OPERAND_NONE}}, + /* Find the last index of a needle string in a haystack string, + * producing the index (integer) or -1 if nothing found. + * Stack: ... needle haystack => ... index */ {"strrangeImm", 9, 0, 2, {OPERAND_IDX4, OPERAND_IDX4}}, /* String Range: push (string range stktop op4 op4) */ + {"strrange", 1, -2, 0, {OPERAND_NONE}}, + /* String Range with non-constant arguments. + * Stack: ... string idxA idxB => ... substring */ {"yield", 1, 0, 0, {OPERAND_NONE}}, /* Makes the current coroutine yield the value at the top of the @@ -496,6 +503,33 @@ InstructionDesc const tclInstructionTable[] = { /* Push the namespace of the TclOO object named at the top of the * stack onto the stack. * Stack: ... object => ... namespace */ + {"tclooIsObject", 1, 0, 0, {OPERAND_NONE}}, + /* Push whether the value named at the top of the stack is a TclOO + * object (i.e., a boolean). Can corrupt the interpreter result + * despite not throwing, so not safe for use in a post-exception + * context. + * Stack: ... value => ... boolean */ + + {"arrayExistsStk", 1, 0, 0, {OPERAND_NONE}}, + /* Looks up the element on the top of the stack and tests whether it + * is an array. Pushes a boolean describing whether this is the + * case. Also runs the whole-array trace on the named variable, so can + * throw anything. + * Stack: ... varName => ... boolean */ + {"arrayExistsImm", 5, +1, 1, {OPERAND_UINT4}}, + /* Looks up the variable indexed by opnd and tests whether it is an + * array. Pushes a boolean describing whether this is the case. Also + * runs the whole-array trace on the named variable, so can throw + * anything. + * Stack: ... => ... boolean */ + {"arrayMakeStk", 1, -1, 0, {OPERAND_NONE}}, + /* Forces the element on the top of the stack to be the name of an + * array. + * Stack: ... varName => ... */ + {"arrayMakeImm", 5, 0, 1, {OPERAND_UINT4}}, + /* Forces the variable indexed by opnd to be an array. Does not touch + * the stack. */ + {"tclooNext", 2, INT_MIN, 1, {OPERAND_UINT1}}, /* Push the identity of the current TclOO object (i.e., the name of * its current public access command) on the stack. */ @@ -1742,6 +1776,9 @@ TclCompileScript( unsigned savedCodeNext = envPtr->codeNext - envPtr->codeStart; int update = 0; +#ifdef TCL_COMPILE_DEBUG + int startStackDepth = envPtr->currStackDepth; +#endif /* * Mark the start of the command; the proper bytecode @@ -1785,6 +1822,25 @@ TclCompileScript( envPtr); if (code == TCL_OK) { + /* + * Confirm that the command compiler generated a + * single value on the stack as its result. This + * is only done in debugging mode, as it *should* + * be correct and normal users have no reasonable + * way to fix it anyway. + */ + +#ifdef TCL_COMPILE_DEBUG + int diff = envPtr->currStackDepth-startStackDepth; + + if (diff != 1 && (diff != 0 || + *(envPtr->codeNext-1) != INST_DONE)) { + Tcl_Panic("bad stack adjustment when compiling" + " %.*s (was %d instead of 1)", + parsePtr->tokenPtr->size, + parsePtr->tokenPtr->start, diff); + } +#endif if (update) { /* * Fix the bytecode length. |