summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2013-06-11 21:40:51 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2013-06-11 21:40:51 (GMT)
commitb3c4e60c817c71a12c34fe76fe885d7da894f7bf (patch)
treeb5d9794484df9b70530db129748b9d7fd44041ee
parent6d413075c9b687f662acd3d1f4fcef7e34f386e7 (diff)
parent9ca9c6da3a55c6358a221f006c6cc846bd8d9922 (diff)
downloadtcl-b3c4e60c817c71a12c34fe76fe885d7da894f7bf.zip
tcl-b3c4e60c817c71a12c34fe76fe885d7da894f7bf.tar.gz
tcl-b3c4e60c817c71a12c34fe76fe885d7da894f7bf.tar.bz2
merge trunk
-rw-r--r--generic/tclCompCmds.c26
-rw-r--r--generic/tclCompCmdsGR.c15
-rw-r--r--generic/tclCompCmdsSZ.c141
-rw-r--r--generic/tclCompExpr.c1
-rw-r--r--generic/tclCompile.c19
-rw-r--r--generic/tclExecute.c17
-rw-r--r--tests/error.test6
7 files changed, 87 insertions, 138 deletions
diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index 25c4bac..fddf152 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -545,7 +545,6 @@ TclCompileCatchCmd(
Tcl_Token *cmdTokenPtr, *resultNameTokenPtr, *optsNameTokenPtr;
int resultIndex, optsIndex, range;
int initStackDepth = envPtr->currStackDepth;
- int savedStackDepth;
DefineLineInformation; /* TIP #280 */
/*
@@ -613,13 +612,11 @@ TclCompileCatchCmd(
SetLineInformation(1);
if (cmdTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
- savedStackDepth = envPtr->currStackDepth;
TclEmitInstInt4( INST_BEGIN_CATCH4, range, envPtr);
ExceptionRangeStarts(envPtr, range);
CompileBody(envPtr, cmdTokenPtr, interp);
} else {
CompileTokens(envPtr, cmdTokenPtr, interp);
- savedStackDepth = envPtr->currStackDepth;
TclEmitInstInt4( INST_BEGIN_CATCH4, range, envPtr);
ExceptionRangeStarts(envPtr, range);
TclEmitOpcode( INST_DUP, envPtr);
@@ -641,7 +638,7 @@ TclCompileCatchCmd(
TclEmitOpcode( INST_POP, envPtr);
PushStringLiteral(envPtr, "0");
TclEmitInstInt1( INST_JUMP1, 3, envPtr);
- envPtr->currStackDepth = savedStackDepth;
+ TclAdjustStackDepth(-1, envPtr);
ExceptionRangeTarget(envPtr, range, catchOffset);
TclEmitOpcode( INST_PUSH_RETURN_CODE, envPtr);
ExceptionRangeEnds(envPtr, range);
@@ -670,7 +667,7 @@ TclCompileCatchCmd(
* return code.
*/
- envPtr->currStackDepth = savedStackDepth;
+ TclAdjustStackDepth(-2, envPtr);
ExceptionRangeTarget(envPtr, range, catchOffset);
/* Stack at this point: ?script? */
TclEmitOpcode( INST_PUSH_RESULT, envPtr);
@@ -1286,6 +1283,7 @@ TclCompileDictMergeCmd(
* subsequent) dicts. This is strictly not necessary, but it is nice.
*/
+ TclAdjustStackDepth(-1, envPtr);
ExceptionRangeTarget(envPtr, outLoop, catchOffset);
TclEmitOpcode( INST_PUSH_RETURN_OPTIONS, envPtr);
TclEmitOpcode( INST_PUSH_RESULT, envPtr);
@@ -1295,7 +1293,6 @@ TclCompileDictMergeCmd(
TclEmitInstInt1( INST_UNSET_SCALAR, 0, envPtr);
TclEmitInt4( infoIndex, envPtr);
TclEmitOpcode( INST_RETURN_STK, envPtr);
- TclAdjustStackDepth(-1, envPtr);
return TCL_OK;
}
@@ -1345,9 +1342,6 @@ CompileDictEachCmd(
int numVars, endTargetOffset;
int collectVar = -1; /* Index of temp var holding the result
* dict. */
- int savedStackDepth = envPtr->currStackDepth;
- /* Needed because jumps confuse the stack
- * space calculator. */
const char **argv;
Tcl_DString buffer;
@@ -1510,6 +1504,7 @@ CompileDictEachCmd(
* and rethrows the error.
*/
+ TclAdjustStackDepth(-1, envPtr);
ExceptionRangeTarget(envPtr, catchRange, catchOffset);
TclEmitOpcode( INST_PUSH_RETURN_OPTIONS, envPtr);
TclEmitOpcode( INST_PUSH_RESULT, envPtr);
@@ -1528,7 +1523,6 @@ CompileDictEachCmd(
* easy!) Note that we skip the END_CATCH. [Bug 1382528]
*/
- envPtr->currStackDepth = savedStackDepth + 2;
jumpDisplacement = CurrentOffset(envPtr) - emptyTargetOffset;
TclUpdateInstInt4AtPc(INST_JUMP_TRUE4, jumpDisplacement,
envPtr->codeStart + emptyTargetOffset);
@@ -2240,7 +2234,6 @@ TclCompileForCmd(
JumpFixup jumpEvalCondFixup;
int testCodeOffset, bodyCodeOffset, nextCodeOffset, jumpDist;
int bodyRange, nextRange;
- int savedStackDepth = envPtr->currStackDepth;
DefineLineInformation; /* TIP #280 */
if (parsePtr->numWords != 5) {
@@ -2302,7 +2295,6 @@ TclCompileForCmd(
SetLineInformation(4);
CompileBody(envPtr, bodyTokenPtr, interp);
ExceptionRangeEnds(envPtr, bodyRange);
- envPtr->currStackDepth = savedStackDepth + 1;
TclEmitOpcode(INST_POP, envPtr);
/*
@@ -2313,14 +2305,11 @@ TclCompileForCmd(
nextRange = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr);
envPtr->exceptAuxArrayPtr[nextRange].supportsContinue = 0;
- envPtr->currStackDepth = savedStackDepth;
nextCodeOffset = ExceptionRangeStarts(envPtr, nextRange);
SetLineInformation(3);
CompileBody(envPtr, nextTokenPtr, interp);
ExceptionRangeEnds(envPtr, nextRange);
- envPtr->currStackDepth = savedStackDepth + 1;
TclEmitOpcode(INST_POP, envPtr);
- envPtr->currStackDepth = savedStackDepth;
/*
* Compile the test expression then emit the conditional jump that
@@ -2337,9 +2326,7 @@ TclCompileForCmd(
}
SetLineInformation(2);
- envPtr->currStackDepth = savedStackDepth;
TclCompileExprWords(interp, testTokenPtr, 1, envPtr);
- envPtr->currStackDepth = savedStackDepth + 1;
jumpDist = CurrentOffset(envPtr) - bodyCodeOffset;
if (jumpDist > 127) {
@@ -2367,7 +2354,6 @@ TclCompileForCmd(
* The for command's result is an empty string.
*/
- envPtr->currStackDepth = savedStackDepth;
PushStringLiteral(envPtr, "");
return TCL_OK;
@@ -2480,7 +2466,6 @@ CompileEachloopCmd(
JumpFixup jumpFalseFixup;
int jumpBackDist, jumpBackOffset, infoIndex, range, bodyIndex;
int numWords, numLists, numVars, loopIndex, tempVar, i, j, code;
- int savedStackDepth = envPtr->currStackDepth;
DefineLineInformation; /* TIP #280 */
/*
@@ -2703,7 +2688,6 @@ CompileEachloopCmd(
ExceptionRangeStarts(envPtr, range);
CompileBody(envPtr, bodyTokenPtr, interp);
ExceptionRangeEnds(envPtr, range);
- envPtr->currStackDepth = savedStackDepth + 1;
if (collect == TCL_EACH_COLLECT) {
Emit14Inst( INST_LAPPEND_SCALAR, collectVar,envPtr);
@@ -2763,7 +2747,6 @@ CompileEachloopCmd(
* list of results from evaluating the loop body.
*/
- envPtr->currStackDepth = savedStackDepth;
if (collect == TCL_EACH_COLLECT) {
Emit14Inst( INST_LOAD_SCALAR, collectVar, envPtr);
TclEmitInstInt1(INST_UNSET_SCALAR, 0, envPtr);
@@ -2771,7 +2754,6 @@ CompileEachloopCmd(
} else {
PushStringLiteral(envPtr, "");
}
- envPtr->currStackDepth = savedStackDepth + 1;
done:
for (loopIndex = 0; loopIndex < numLists; loopIndex++) {
diff --git a/generic/tclCompCmdsGR.c b/generic/tclCompCmdsGR.c
index 5e3d456..f7c15e6 100644
--- a/generic/tclCompCmdsGR.c
+++ b/generic/tclCompCmdsGR.c
@@ -142,10 +142,6 @@ TclCompileIfCmd(
int jumpIndex = 0; /* Avoid compiler warning. */
int jumpFalseDist, numWords, wordIdx, numBytes, j, code;
const char *word;
- int savedStackDepth = envPtr->currStackDepth;
- /* Saved stack depth at the start of the first
- * test; the envPtr current depth is restored
- * to this value at the start of each test. */
int realCond = 1; /* Set to 0 for static conditions:
* "if 0 {..}" */
int boolVal; /* Value of static condition. */
@@ -203,7 +199,6 @@ TclCompileIfCmd(
* the "then" part.
*/
- envPtr->currStackDepth = savedStackDepth;
testTokenPtr = tokenPtr;
if (realCond) {
@@ -270,7 +265,6 @@ TclCompileIfCmd(
if (compileScripts) {
SetLineInformation(wordIdx);
- envPtr->currStackDepth = savedStackDepth;
CompileBody(envPtr, tokenPtr, interp);
}
@@ -295,6 +289,7 @@ TclCompileIfCmd(
* with a 4 byte jump.
*/
+ TclAdjustStackDepth(-1, envPtr);
if (TclFixupForwardJumpToHere(envPtr,
jumpFalseFixupArray.fixup+jumpIndex, 120)) {
/*
@@ -325,13 +320,6 @@ TclCompileIfCmd(
}
/*
- * Restore the current stack depth in the environment; the "else" clause
- * (or its default) will add 1 to this.
- */
-
- envPtr->currStackDepth = savedStackDepth;
-
- /*
* Check for the optional else clause. Do not compile anything if this was
* an "if 1 {...}" case.
*/
@@ -416,7 +404,6 @@ TclCompileIfCmd(
*/
done:
- envPtr->currStackDepth = savedStackDepth + 1;
TclFreeJumpFixupArray(&jumpFalseFixupArray);
TclFreeJumpFixupArray(&jumpEndFixupArray);
return code;
diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c
index 5d67166..855dd8f 100644
--- a/generic/tclCompCmdsSZ.c
+++ b/generic/tclCompCmdsSZ.c
@@ -865,6 +865,7 @@ TclSubstCompile(
/* Substitution produced TCL_OK */
OP( END_CATCH);
TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &okFixup);
+ TclAdjustStackDepth(-1, envPtr);
/* Exceptional return codes processed here */
ExceptionRangeTarget(envPtr, catchRange, catchOffset);
@@ -890,6 +891,7 @@ TclSubstCompile(
/* OTHER */
TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &otherFixup);
+ TclAdjustStackDepth(1, envPtr);
/* BREAK destination */
if (TclFixupForwardJumpToHere(envPtr, &breakFixup, 127)) {
Tcl_Panic("TclCompileSubstCmd: bad break jump distance %d",
@@ -905,6 +907,7 @@ TclSubstCompile(
OP1(JUMP1, -breakJump);
}
+ TclAdjustStackDepth(2, envPtr);
/* CONTINUE destination */
if (TclFixupForwardJumpToHere(envPtr, &continueFixup, 127)) {
Tcl_Panic("TclCompileSubstCmd: bad continue jump distance %d",
@@ -914,6 +917,7 @@ TclSubstCompile(
OP( POP);
TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &endFixup);
+ TclAdjustStackDepth(2, envPtr);
/* RETURN + other destination */
if (TclFixupForwardJumpToHere(envPtr, &returnFixup, 127)) {
Tcl_Panic("TclCompileSubstCmd: bad return jump distance %d",
@@ -931,17 +935,6 @@ TclSubstCompile(
OP4( REVERSE, 2);
OP( POP);
- /*
- * We've emitted several POP instructions, and the automatic
- * computations for stack depth requirements have been decrementing
- * for every one. However, we know that every branch actually taken
- * only encounters some of those instructions. No branch passes
- * through them all. So, we now have a stack requirements estimate
- * that is too low. Here we manually fix that up.
- */
-
- TclAdjustStackDepth(4, envPtr);
-
/* OK destination */
if (TclFixupForwardJumpToHere(envPtr, &okFixup, 127)) {
Tcl_Panic("TclCompileSubstCmd: bad ok jump distance %d",
@@ -1353,7 +1346,6 @@ IssueSwitchChainedTests(
int **bodyContLines) /* Array of continuation line info. */
{
enum {Switch_Exact, Switch_Glob, Switch_Regexp};
- int savedStackDepth = envPtr->currStackDepth;
int foundDefault; /* Flag to indicate whether a "default" clause
* is present. */
JumpFixup *fixupArray; /* Array of forward-jump fixup records. */
@@ -1388,7 +1380,6 @@ IssueSwitchChainedTests(
foundDefault = 0;
for (i=0 ; i<numBodyTokens ; i+=2) {
nextArmFixupIndex = -1;
- envPtr->currStackDepth = savedStackDepth + 1;
if (i!=numBodyTokens-2 || bodyToken[numBodyTokens-2]->size != 7 ||
memcmp(bodyToken[numBodyTokens-2]->start, "default", 7)) {
/*
@@ -1525,7 +1516,6 @@ IssueSwitchChainedTests(
*/
OP( POP);
- envPtr->currStackDepth = savedStackDepth;
envPtr->line = bodyLines[i+1]; /* TIP #280 */
envPtr->clNext = bodyContLines[i+1]; /* TIP #280 */
TclCompileCmdWord(interp, bodyToken[i+1], 1, envPtr);
@@ -1583,8 +1573,6 @@ IssueSwitchChainedTests(
}
TclStackFree(interp, fixupTargetArray);
TclStackFree(interp, fixupArray);
-
- envPtr->currStackDepth = savedStackDepth + 1;
}
/*
@@ -1618,7 +1606,6 @@ IssueSwitchJumpTable(
int **bodyContLines) /* Array of continuation line info. */
{
JumptableInfo *jtPtr;
- int savedStackDepth = envPtr->currStackDepth;
int infoIndex, isNew, *finalFixups, numRealBodies = 0, jumpLocation;
int mustGenerate, foundDefault, jumpToDefault, i;
Tcl_DString buffer;
@@ -1731,7 +1718,6 @@ IssueSwitchJumpTable(
* Compile the body of the arm.
*/
- envPtr->currStackDepth = savedStackDepth;
envPtr->line = bodyLines[i+1]; /* TIP #280 */
envPtr->clNext = bodyContLines[i+1]; /* TIP #280 */
TclCompileCmdWord(interp, bodyToken[i+1], 1, envPtr);
@@ -1753,6 +1739,7 @@ IssueSwitchJumpTable(
*/
OP4( JUMP4, 0);
+ TclAdjustStackDepth(-1, envPtr);
}
}
@@ -1763,7 +1750,6 @@ IssueSwitchJumpTable(
*/
if (!foundDefault) {
- envPtr->currStackDepth = savedStackDepth;
TclStoreInt4AtPtr(CurrentOffset(envPtr)-jumpToDefault,
envPtr->codeStart+jumpToDefault+1);
PUSH("");
@@ -1784,7 +1770,6 @@ IssueSwitchJumpTable(
*/
TclStackFree(interp, finalFixups);
- envPtr->currStackDepth = savedStackDepth + 1;
}
/*
@@ -1942,9 +1927,9 @@ TclCompileThrowCmd(
{
DefineLineInformation; /* TIP #280 */
int numWords = parsePtr->numWords;
- int savedStackDepth = envPtr->currStackDepth;
Tcl_Token *codeToken, *msgToken;
Tcl_Obj *objPtr;
+ int codeKnown, codeIsList, codeIsValid, len;
if (numWords != 3) {
return TCL_ERROR;
@@ -1954,77 +1939,66 @@ TclCompileThrowCmd(
TclNewObj(objPtr);
Tcl_IncrRefCount(objPtr);
- if (TclWordKnownAtCompileTime(codeToken, objPtr)) {
- Tcl_Obj *errPtr, *dictPtr;
- const char *string;
- int len;
- /*
- * The code is known at compilation time. This allows us to issue a
- * very efficient sequence of instructions.
- */
+ codeKnown = TclWordKnownAtCompileTime(codeToken, objPtr);
- if (Tcl_ListObjLength(interp, objPtr, &len) != TCL_OK) {
- /*
- * Must still do this; might generate an error when getting this
- * "ignored" value prepared as an argument.
- */
+ /*
+ * First we must emit the code to substitute the arguments. This
+ * must come first in case substitution raises errors.
+ */
+ if (!codeKnown) {
+ CompileWord(envPtr, codeToken, interp, 1);
+ PUSH( "-errorcode");
+ }
+ CompileWord(envPtr, msgToken, interp, 2);
- CompileWord(envPtr, msgToken, interp, 2);
- TclCompileSyntaxError(interp, envPtr);
- Tcl_DecrRefCount(objPtr);
- envPtr->currStackDepth = savedStackDepth + 1;
- return TCL_OK;
- }
- if (len == 0) {
- /*
- * Must still do this; might generate an error when getting this
- * "ignored" value prepared as an argument.
- */
+ codeIsList = codeKnown && (TCL_OK ==
+ Tcl_ListObjLength(interp, objPtr, &len));
+ codeIsValid = codeIsList && (len != 0);
+
+ if (codeIsValid) {
+ Tcl_Obj *errPtr, *dictPtr;
- CompileWord(envPtr, msgToken, interp, 2);
- goto issueErrorForEmptyCode;
- }
TclNewLiteralStringObj(errPtr, "-errorcode");
TclNewObj(dictPtr);
Tcl_DictObjPut(NULL, dictPtr, errPtr, objPtr);
- Tcl_IncrRefCount(dictPtr);
- string = Tcl_GetStringFromObj(dictPtr, &len);
- CompileWord(envPtr, msgToken, interp, 2);
- PushLiteral(envPtr, string, len);
- TclDecrRefCount(dictPtr);
- OP44( RETURN_IMM, 1, 0);
- envPtr->currStackDepth = savedStackDepth + 1;
- } else {
- /*
- * When the code token is not known at compilation time, we need to do
- * a little bit more work. The main tricky bit here is that the error
- * code has to be a list (a [throw] restriction) so we must emit extra
- * instructions to enforce that condition.
- */
+ TclEmitPush(TclAddLiteralObj(envPtr, dictPtr, NULL), envPtr);
+ }
+ TclDecrRefCount(objPtr);
- CompileWord(envPtr, codeToken, interp, 1);
- PUSH( "-errorcode");
- CompileWord(envPtr, msgToken, interp, 2);
- OP4( REVERSE, 3);
- OP( DUP);
- OP( LIST_LENGTH);
- OP1( JUMP_FALSE1, 16);
- OP4( LIST, 2);
- OP44( RETURN_IMM, 1, 0);
+ /*
+ * Simpler bytecodes when we detect invalid arguments at compile time.
+ */
+ if (codeKnown && !codeIsValid) {
+ OP( POP);
+ if (codeIsList) {
+ /* Must be an empty list */
+ goto issueErrorForEmptyCode;
+ }
+ TclCompileSyntaxError(interp, envPtr);
+ return TCL_OK;
+ }
+ if (!codeKnown) {
/*
- * Generate an error for being an empty list. Can't leverage anything
- * else to do this for us.
+ * Argument validity checking has to be done by bytecode at
+ * run time.
*/
-
+ OP4( REVERSE, 3);
+ OP( DUP);
+ OP( LIST_LENGTH);
+ OP1( JUMP_FALSE1, 16);
+ OP4( LIST, 2);
+ OP44( RETURN_IMM, 1, 0);
+ TclAdjustStackDepth(2, envPtr);
+ OP( POP);
+ OP( POP);
+ OP( POP);
issueErrorForEmptyCode:
- PUSH( "type must be non-empty list");
- PUSH( "");
- OP44( RETURN_IMM, 1, 0);
+ PUSH( "type must be non-empty list");
+ PUSH( "-errorcode {TCL OPERATION THROW BADEXCEPTION}");
}
- envPtr->currStackDepth = savedStackDepth + 1;
- TclDecrRefCount(objPtr);
+ OP44( RETURN_IMM, 1, 0);
return TCL_OK;
}
@@ -2703,15 +2677,13 @@ IssueTryClausesFinallyInstructions(
/* Skip POP at end; can clean up with subsequent POP */
if (i+1 < numHandlers) {
OP( POP);
- } else {
- TclAdjustStackDepth(-1, envPtr);
}
endOfThisArm:
if (i+1 < numHandlers) {
JUMP4( JUMP, addrsToFix[i]);
+ TclAdjustStackDepth(1, envPtr);
}
- TclAdjustStackDepth(1, envPtr);
if (matchClauses[i]) {
FIXJUMP4( notECJumpSource);
}
@@ -2965,7 +2937,6 @@ TclCompileWhileCmd(
Tcl_Token *testTokenPtr, *bodyTokenPtr;
JumpFixup jumpEvalCondFixup;
int testCodeOffset, bodyCodeOffset, jumpDist, range, code, boolVal;
- int savedStackDepth = envPtr->currStackDepth;
int loopMayEnd = 1; /* This is set to 0 if it is recognized as an
* infinite loop. */
Tcl_Obj *boolObj;
@@ -3065,7 +3036,6 @@ TclCompileWhileCmd(
}
CompileBody(envPtr, bodyTokenPtr, interp);
ExceptionRangeEnds(envPtr, range);
- envPtr->currStackDepth = savedStackDepth + 1;
OP( POP);
/*
@@ -3080,10 +3050,8 @@ TclCompileWhileCmd(
bodyCodeOffset += 3;
testCodeOffset += 3;
}
- envPtr->currStackDepth = savedStackDepth;
SetLineInformation(1);
TclCompileExprWords(interp, testTokenPtr, 1, envPtr);
- envPtr->currStackDepth = savedStackDepth + 1;
jumpDist = CurrentOffset(envPtr) - bodyCodeOffset;
if (jumpDist > 127) {
@@ -3114,7 +3082,6 @@ TclCompileWhileCmd(
*/
pushResult:
- envPtr->currStackDepth = savedStackDepth;
PUSH("");
return TCL_OK;
}
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 f93bbad..da0e63e 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -1214,7 +1214,12 @@ CompileSubstObj(
codePtr->localCachePtr = iPtr->varFramePtr->localCachePtr;
codePtr->localCachePtr->refCount++;
}
- /* TODO: Debug printing? */
+#ifdef TCL_COMPILE_DEBUG
+ if (tclTraceCompile >= 2) {
+ TclPrintByteCodeObj(interp, objPtr);
+ fflush(stdout);
+ }
+#endif /* TCL_COMPILE_DEBUG */
}
return codePtr;
}
@@ -1986,8 +1991,7 @@ TclCompileScript(
#ifdef TCL_COMPILE_DEBUG
int diff = envPtr->currStackDepth-startStackDepth;
- if (diff != 1 && (diff != 0 ||
- *(envPtr->codeNext-1) != INST_DONE)) {
+ if (diff != 1) {
Tcl_Panic("bad stack adjustment when compiling"
" %.*s (was %d instead of 1)",
parsePtr->tokenPtr->size,
@@ -2605,12 +2609,10 @@ TclCompileNoOp(
{
Tcl_Token *tokenPtr;
int i;
- int savedStackDepth = envPtr->currStackDepth;
tokenPtr = parsePtr->tokenPtr;
for (i = 1; i < parsePtr->numWords; i++) {
tokenPtr = tokenPtr + tokenPtr->numComponents + 1;
- envPtr->currStackDepth = savedStackDepth;
if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
TclCompileTokens(interp, tokenPtr+1, tokenPtr->numComponents,
@@ -2618,7 +2620,6 @@ TclCompileNoOp(
TclEmitOpcode(INST_POP, envPtr);
}
}
- envPtr->currStackDepth = savedStackDepth;
TclEmitPush(TclRegisterNewLiteral(envPtr, "", 0), envPtr);
return TCL_OK;
}
@@ -3416,6 +3417,7 @@ TclCleanupStackForBreakContinue(
CompileEnv *envPtr,
ExceptionAux *auxPtr)
{
+ int savedStackDepth = envPtr->currStackDepth;
int toPop = envPtr->expandCount - auxPtr->expandTarget;
if (toPop > 0) {
@@ -3423,20 +3425,21 @@ TclCleanupStackForBreakContinue(
TclEmitOpcode(INST_EXPAND_DROP, envPtr);
toPop--;
}
+ TclAdjustStackDepth(auxPtr->expandTargetDepth - envPtr->currStackDepth,
+ envPtr);
toPop = auxPtr->expandTargetDepth - auxPtr->stackDepth;
while (toPop > 0) {
TclEmitOpcode(INST_POP, envPtr);
- TclAdjustStackDepth(1, envPtr);
toPop--;
}
} else {
toPop = envPtr->currStackDepth - auxPtr->stackDepth;
while (toPop > 0) {
TclEmitOpcode(INST_POP, envPtr);
- TclAdjustStackDepth(1, envPtr);
toPop--;
}
}
+ envPtr->currStackDepth = savedStackDepth;
}
/*
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 443fb85..f5737b5 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -2320,7 +2320,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) {
@@ -2362,7 +2362,7 @@ TEBCresume(
TRACE(("%u %u => ", code, level));
result = TclProcessReturn(interp, code, level, OBJ_AT_TOS);
if (result == TCL_OK) {
- TRACE_APPEND(("continuing to next instruction (result=\"%.30s\")",
+ TRACE_APPEND(("continuing to next instruction (result=\"%.30s\")\n",
O2S(objResultPtr)));
NEXT_INST_F(9, 1, 0);
}
@@ -2371,6 +2371,7 @@ TEBCresume(
iPtr->flags &= ~ERR_ALREADY_LOGGED;
}
cleanup = 2;
+ TRACE_APPEND(("\n"));
goto processExceptionReturn;
}
@@ -2381,7 +2382,7 @@ TEBCresume(
if (result == TCL_OK) {
Tcl_DecrRefCount(OBJ_AT_TOS);
OBJ_AT_TOS = objResultPtr;
- TRACE_APPEND(("continuing to next instruction (result=\"%.30s\")",
+ TRACE_APPEND(("continuing to next instruction (result=\"%.30s\")\n",
O2S(objResultPtr)));
NEXT_INST_F(1, 0, 0);
} else if (result == TCL_ERROR) {
@@ -2401,6 +2402,7 @@ TEBCresume(
Tcl_SetObjResult(interp, objResultPtr);
}
cleanup = 1;
+ TRACE_APPEND(("\n"));
goto processExceptionReturn;
case INST_YIELD: {
@@ -3662,7 +3664,7 @@ TEBCresume(
arrayPtr = NULL;
part1Ptr = part2Ptr = NULL;
cleanup = 0;
- TRACE(("%u %ld => ", opnd, increment));
+ TRACE(("%u %s => ", opnd, Tcl_GetString(incrPtr)));
doIncrVar:
if (TclIsVarDirectModifyable2(varPtr, arrayPtr)) {
@@ -4227,7 +4229,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
@@ -6610,7 +6612,7 @@ TEBCresume(
}
#endif
- TRACE_APPEND(("\"%.30s\" \"%.30s\" %d",
+ TRACE_APPEND(("\"%.30s\" \"%.30s\" %d\n",
O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), done));
objResultPtr = TCONST(done);
/* TODO: consider opt like INST_FOREACH_STEP4 */
@@ -6624,7 +6626,7 @@ TEBCresume(
while (TclIsVarLink(varPtr)) {
varPtr = varPtr->value.linkPtr;
}
- TRACE(("%u => ", opnd));
+ TRACE(("%u => \n", opnd));
if (TclIsVarDirectReadable(varPtr)) {
dictPtr = varPtr->value.objPtr;
} else {
@@ -6753,6 +6755,7 @@ TEBCresume(
O2S(dictPtr), O2S(listPtr)), Tcl_GetObjResult(interp));
goto gotError;
}
+ TRACE((" => "));
TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
NEXT_INST_F(1, 2, 1);
diff --git a/tests/error.test b/tests/error.test
index 273577a..06f8eca 100644
--- a/tests/error.test
+++ b/tests/error.test
@@ -317,6 +317,12 @@ test error-8.8 {throw syntax checks} -returnCodes error -body {
test error-8.9 {throw syntax checks} -returnCodes error -body {
throw {} foo
} -result {type must be non-empty list}
+test error-8.10 {Bug 33b7abb8a2: throw stack usage} -returnCodes error -body {
+ apply {code {throw $code foo}} {}
+} -result {type must be non-empty list}
+test error-8.11 {Bug 7174354ecb: throw error message} -returnCodes error -body {
+ throw {not {}a list} x[]y
+} -result {list element in braces followed by "a" instead of space}
# simple try tests: body completes with code ok