summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorMiguel Sofer <miguel.sofer@gmail.com>2001-12-10 15:44:34 (GMT)
committerMiguel Sofer <miguel.sofer@gmail.com>2001-12-10 15:44:34 (GMT)
commit22f99d42b260461aacb728ca3326315bd4eb2041 (patch)
tree3537073577782a6683cee13a0a237de6e91a0e33
parent2cbac63a7dc061dc68347e297b82609c9802bb95 (diff)
downloadtcl-22f99d42b260461aacb728ca3326315bd4eb2041.zip
tcl-22f99d42b260461aacb728ca3326315bd4eb2041.tar.gz
tcl-22f99d42b260461aacb728ca3326315bd4eb2041.tar.bz2
fixed the calculation of the maximal stack depth required by bytecodes [Bug 483611].
Diffstat
-rw-r--r--ChangeLog11
-rw-r--r--generic/tclCompCmds.c287
-rw-r--r--generic/tclCompExpr.c66
-rw-r--r--generic/tclCompile.c249
-rw-r--r--generic/tclCompile.h49
-rw-r--r--generic/tclExecute.c20
-rw-r--r--generic/tclProc.c10
7 files changed, 239 insertions, 453 deletions
diff --git a/ChangeLog b/ChangeLog
index 2ae86b4..94bc3c1 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,16 @@
2001-12-07 Miguel Sofer <msofer@users.sourceforge.net>
+ * generic/tclCompCmds.c:
+ * generic/tclCompExpr.c:
+ * generic/tclCompile.c:
+ * generic/tclCompile.h:
+ * generic/tclExecute.c:
+ * generic/tclProc.c: fixed the calculation of the maximal stack
+ depth required by bytecodes [Bug 483611].
+
+
+2001-12-07 Miguel Sofer <msofer@users.sourceforge.net>
+
* generic/tclVar.c:
* tests/trace.test: restored consistency in refCount accounting by
array traces [Bug #4484339], submitted by Don Porter.
diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index 14a82f4..c94aeff 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -10,7 +10,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclCompCmds.c,v 1.16 2001/11/19 12:25:08 msofer Exp $
+ * RCS: @(#) $Id: tclCompCmds.c,v 1.17 2001/12/10 15:44:34 msofer Exp $
*/
#include "tclInt.h"
@@ -24,8 +24,7 @@ static ClientData DupForeachInfo _ANSI_ARGS_((ClientData clientData));
static void FreeForeachInfo _ANSI_ARGS_((ClientData clientData));
static int TclPushVarName _ANSI_ARGS_((Tcl_Interp *interp,
Tcl_Token *varTokenPtr, CompileEnv *envPtr, int flags,
- int *localIndexPtr, int *maxDepthPtr, int *simpleVarNamePtr,
- int *isScalarPtr));
+ int *localIndexPtr, int *simpleVarNamePtr, int *isScalarPtr));
/*
* Flags bits used by TclPushVarName.
@@ -60,9 +59,6 @@ AuxDataType tclForeachInfoType = {
* command should be compiled "out of line" by emitting code to
* invoke its command procedure (Tcl_AppendObjCmd) at runtime.
*
- * envPtr->maxStackDepth is updated with the maximum number of stack
- * elements needed to execute the incr command.
- *
* Side effects:
* Instructions are added to envPtr to execute the "append" command
* at runtime.
@@ -79,10 +75,8 @@ TclCompileAppendCmd(interp, parsePtr, envPtr)
{
Tcl_Token *varTokenPtr, *valueTokenPtr;
int simpleVarName, isScalar, localIndex, numWords;
- int maxDepth = 0;
int code = TCL_OK;
- envPtr->maxStackDepth = 0;
numWords = parsePtr->numWords;
if (numWords == 1) {
Tcl_ResetResult(interp);
@@ -115,7 +109,7 @@ TclCompileAppendCmd(interp, parsePtr, envPtr)
code = TclPushVarName(interp, varTokenPtr, envPtr,
((numWords > 2) ? TCL_CREATE_VAR : 0),
- &localIndex, &maxDepth, &simpleVarName, &isScalar);
+ &localIndex, &simpleVarName, &isScalar);
if (code != TCL_OK) {
goto done;
}
@@ -131,14 +125,12 @@ TclCompileAppendCmd(interp, parsePtr, envPtr)
if (valueTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
TclEmitPush(TclRegisterLiteral(envPtr, valueTokenPtr[1].start,
valueTokenPtr[1].size, /*onHeap*/ 0), envPtr);
- maxDepth += 1;
} else {
code = TclCompileTokens(interp, valueTokenPtr+1,
valueTokenPtr->numComponents, envPtr);
if (code != TCL_OK) {
goto done;
}
- maxDepth += envPtr->maxStackDepth;
}
}
@@ -173,7 +165,6 @@ TclCompileAppendCmd(interp, parsePtr, envPtr)
}
done:
- envPtr->maxStackDepth = maxDepth;
return code;
}
@@ -189,9 +180,6 @@ TclCompileAppendCmd(interp, parsePtr, envPtr)
* there was an error during compilation. If an error occurs then
* the interpreter's result contains a standard error message.
*
- * envPtr->maxStackDepth is updated with the maximum number of stack
- * elements needed to execute the command.
- *
* Side effects:
* Instructions are added to envPtr to execute the "break" command
* at runtime.
@@ -210,7 +198,6 @@ TclCompileBreakCmd(interp, parsePtr, envPtr)
Tcl_ResetResult(interp);
Tcl_AppendToObj(Tcl_GetObjResult(interp),
"wrong # args: should be \"break\"", -1);
- envPtr->maxStackDepth = 0;
return TCL_ERROR;
}
@@ -219,7 +206,6 @@ TclCompileBreakCmd(interp, parsePtr, envPtr)
*/
TclEmitOpcode(INST_BREAK, envPtr);
- envPtr->maxStackDepth = 0;
return TCL_OK;
}
@@ -239,9 +225,6 @@ TclCompileBreakCmd(interp, parsePtr, envPtr)
* should be compiled "out of line" by emitting code to invoke its
* command procedure at runtime.
*
- * envPtr->maxStackDepth is updated with the maximum number of stack
- * elements needed to execute the command.
- *
* Side effects:
* Instructions are added to envPtr to execute the "catch" command
* at runtime.
@@ -259,11 +242,11 @@ TclCompileCatchCmd(interp, parsePtr, envPtr)
JumpFixup jumpFixup;
Tcl_Token *cmdTokenPtr, *nameTokenPtr;
char *name;
- int localIndex, nameChars, range, maxDepth, startOffset, jumpDist;
+ int localIndex, nameChars, range, startOffset, jumpDist;
int code;
char buffer[32 + TCL_INTEGER_SPACE];
+ int savedStackDepth = envPtr->currStackDepth;
- envPtr->maxStackDepth = 0;
if ((parsePtr->numWords != 2) && (parsePtr->numWords != 3)) {
Tcl_ResetResult(interp);
Tcl_AppendToObj(Tcl_GetObjResult(interp),
@@ -309,8 +292,6 @@ TclCompileCatchCmd(interp, parsePtr, envPtr)
* We will compile the catch command. Emit a beginCatch instruction at
* the start of the catch body: the subcommand it controls.
*/
-
- maxDepth = 0;
envPtr->exceptDepth++;
envPtr->maxExceptDepth =
@@ -347,7 +328,6 @@ TclCompileCatchCmd(interp, parsePtr, envPtr)
}
goto done;
}
- maxDepth = envPtr->maxStackDepth;
envPtr->exceptArrayPtr[range].numCodeBytes =
(envPtr->codeNext - envPtr->codeStart) - startOffset;
@@ -367,9 +347,6 @@ TclCompileCatchCmd(interp, parsePtr, envPtr)
TclEmitOpcode(INST_POP, envPtr);
TclEmitPush(TclRegisterLiteral(envPtr, "0", 1, /*onHeap*/ 0),
envPtr);
- if (maxDepth == 0) {
- maxDepth = 1;
- }
TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &jumpFixup);
/*
@@ -378,6 +355,7 @@ TclCompileCatchCmd(interp, parsePtr, envPtr)
* the catch's error target.
*/
+ envPtr->currStackDepth = savedStackDepth;
envPtr->exceptArrayPtr[range].catchOffset =
(envPtr->codeNext - envPtr->codeStart);
if (localIndex != -1) {
@@ -391,6 +369,7 @@ TclCompileCatchCmd(interp, parsePtr, envPtr)
}
TclEmitOpcode(INST_PUSH_RETURN_CODE, envPtr);
+
/*
* Update the target of the jump after the "no errors" code, then emit
* an endCatch instruction at the end of the catch command.
@@ -404,8 +383,8 @@ TclCompileCatchCmd(interp, parsePtr, envPtr)
TclEmitOpcode(INST_END_CATCH, envPtr);
done:
+ envPtr->currStackDepth = savedStackDepth + 1;
envPtr->exceptDepth--;
- envPtr->maxStackDepth = maxDepth;
return code;
}
@@ -421,9 +400,6 @@ TclCompileCatchCmd(interp, parsePtr, envPtr)
* there was an error while parsing string. If an error occurs then
* the interpreter's result contains a standard error message.
*
- * envPtr->maxStackDepth is updated with the maximum number of stack
- * elements needed to execute the command.
- *
* Side effects:
* Instructions are added to envPtr to execute the "continue" command
* at runtime.
@@ -446,7 +422,6 @@ TclCompileContinueCmd(interp, parsePtr, envPtr)
Tcl_ResetResult(interp);
Tcl_AppendToObj(Tcl_GetObjResult(interp),
"wrong # args: should be \"continue\"", -1);
- envPtr->maxStackDepth = 0;
return TCL_ERROR;
}
@@ -455,7 +430,6 @@ TclCompileContinueCmd(interp, parsePtr, envPtr)
*/
TclEmitOpcode(INST_CONTINUE, envPtr);
- envPtr->maxStackDepth = 0;
return TCL_OK;
}
@@ -471,9 +445,6 @@ TclCompileContinueCmd(interp, parsePtr, envPtr)
* unless there was an error while parsing string. If an error occurs
* then the interpreter's result contains a standard error message.
*
- * envPtr->maxStackDepth is updated with the maximum number of stack
- * elements needed to execute the "expr" command.
- *
* Side effects:
* Instructions are added to envPtr to execute the "expr" command
* at runtime.
@@ -490,7 +461,6 @@ TclCompileExprCmd(interp, parsePtr, envPtr)
{
Tcl_Token *firstWordPtr;
- envPtr->maxStackDepth = 0;
if (parsePtr->numWords == 1) {
Tcl_ResetResult(interp);
Tcl_AppendToObj(Tcl_GetObjResult(interp),
@@ -516,9 +486,6 @@ TclCompileExprCmd(interp, parsePtr, envPtr)
* there was an error while parsing string. If an error occurs then
* the interpreter's result contains a standard error message.
*
- * envPtr->maxStackDepth is updated with the maximum number of stack
- * elements needed to execute the command.
- *
* Side effects:
* Instructions are added to envPtr to execute the "for" command
* at runtime.
@@ -535,12 +502,12 @@ TclCompileForCmd(interp, parsePtr, envPtr)
{
Tcl_Token *startTokenPtr, *testTokenPtr, *nextTokenPtr, *bodyTokenPtr;
JumpFixup jumpFalseFixup;
- int maxDepth, jumpBackDist, jumpBackOffset, testCodeOffset, jumpDist;
+ int jumpBackDist, jumpBackOffset, testCodeOffset, jumpDist;
int bodyRange, nextRange, code;
unsigned char *jumpPc;
char buffer[32 + TCL_INTEGER_SPACE];
+ int savedStackDepth = envPtr->currStackDepth;
- envPtr->maxStackDepth = 0;
if (parsePtr->numWords != 5) {
Tcl_ResetResult(interp);
Tcl_AppendToObj(Tcl_GetObjResult(interp),
@@ -589,7 +556,6 @@ TclCompileForCmd(interp, parsePtr, envPtr)
* Inline compile the initial command.
*/
- maxDepth = 0;
code = TclCompileCmdWord(interp, startTokenPtr+1,
startTokenPtr->numComponents, envPtr);
if (code != TCL_OK) {
@@ -599,15 +565,16 @@ TclCompileForCmd(interp, parsePtr, envPtr)
}
goto done;
}
- maxDepth = envPtr->maxStackDepth;
TclEmitOpcode(INST_POP, envPtr);
/*
* Compile the test then emit the conditional jump that exits the for.
*/
+ envPtr->currStackDepth = savedStackDepth;
testCodeOffset = (envPtr->codeNext - envPtr->codeStart);
code = TclCompileExprWords(interp, testTokenPtr, 1, envPtr);
+ envPtr->currStackDepth = savedStackDepth + 1;
if (code != TCL_OK) {
if (code == TCL_ERROR) {
Tcl_AddObjErrorInfo(interp,
@@ -615,13 +582,13 @@ TclCompileForCmd(interp, parsePtr, envPtr)
}
goto done;
}
- maxDepth = TclMax(envPtr->maxStackDepth, maxDepth);
TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, &jumpFalseFixup);
/*
* Compile the loop body.
*/
+ envPtr->currStackDepth = savedStackDepth;
envPtr->exceptArrayPtr[bodyRange].codeOffset =
(envPtr->codeNext - envPtr->codeStart);
code = TclCompileCmdWord(interp, bodyTokenPtr+1,
@@ -634,7 +601,6 @@ TclCompileForCmd(interp, parsePtr, envPtr)
}
goto done;
}
- maxDepth = TclMax(envPtr->maxStackDepth, maxDepth);
envPtr->exceptArrayPtr[bodyRange].numCodeBytes =
(envPtr->codeNext - envPtr->codeStart)
- envPtr->exceptArrayPtr[bodyRange].codeOffset;
@@ -644,12 +610,14 @@ TclCompileForCmd(interp, parsePtr, envPtr)
* Compile the "next" subcommand.
*/
+ envPtr->currStackDepth = savedStackDepth;
envPtr->exceptArrayPtr[bodyRange].continueOffset =
(envPtr->codeNext - envPtr->codeStart);
envPtr->exceptArrayPtr[nextRange].codeOffset =
(envPtr->codeNext - envPtr->codeStart);
code = TclCompileCmdWord(interp, nextTokenPtr+1,
nextTokenPtr->numComponents, envPtr);
+ envPtr->currStackDepth = savedStackDepth + 1;
if (code != TCL_OK) {
if (code == TCL_ERROR) {
Tcl_AddObjErrorInfo(interp,
@@ -657,11 +625,11 @@ TclCompileForCmd(interp, parsePtr, envPtr)
}
goto done;
}
- maxDepth = TclMax(envPtr->maxStackDepth, maxDepth);
envPtr->exceptArrayPtr[nextRange].numCodeBytes =
(envPtr->codeNext - envPtr->codeStart)
- envPtr->exceptArrayPtr[nextRange].codeOffset;
TclEmitOpcode(INST_POP, envPtr);
+ envPtr->currStackDepth = savedStackDepth;
/*
* Jump back to the test at the top of the loop. Generate a 4 byte jump
@@ -722,13 +690,9 @@ TclCompileForCmd(interp, parsePtr, envPtr)
*/
TclEmitPush(TclRegisterLiteral(envPtr, "", 0, /*onHeap*/ 0), envPtr);
- if (maxDepth == 0) {
- maxDepth = 1;
- }
code = TCL_OK;
done:
- envPtr->maxStackDepth = maxDepth;
envPtr->exceptDepth--;
return code;
}
@@ -749,9 +713,6 @@ TclCompileForCmd(interp, parsePtr, envPtr)
* should be compiled "out of line" by emitting code to invoke its
* command procedure at runtime.
*
- * envPtr->maxStackDepth is updated with the maximum number of stack
- * elements needed to execute the "while" command.
- *
* Side effects:
* Instructions are added to envPtr to execute the "foreach" command
* at runtime.
@@ -778,10 +739,12 @@ TclCompileForeachCmd(interp, parsePtr, envPtr)
char *varList;
unsigned char *jumpPc;
JumpFixup jumpFalseFixup;
- int jumpDist, jumpBackDist, jumpBackOffset, maxDepth, infoIndex, range;
+ int jumpDist, jumpBackDist, jumpBackOffset, infoIndex, range;
int numWords, numLists, numVars, loopIndex, tempVar, i, j, code;
char savedChar;
char buffer[32 + TCL_INTEGER_SPACE];
+ int savedStackDepth = envPtr->currStackDepth;
+
/*
* We parse the variable list argument words and create two arrays:
@@ -800,13 +763,10 @@ TclCompileForeachCmd(interp, parsePtr, envPtr)
* the payoff is too small.
*/
- envPtr->maxStackDepth = 0;
if (procPtr == NULL) {
return TCL_OUT_LINE_COMPILE;
}
- maxDepth = 0;
-
numWords = parsePtr->numWords;
if ((numWords < 4) || (numWords%2 != 0)) {
Tcl_ResetResult(interp);
@@ -958,7 +918,6 @@ TclCompileForeachCmd(interp, parsePtr, envPtr)
if (code != TCL_OK) {
goto done;
}
- maxDepth = TclMax(envPtr->maxStackDepth, maxDepth);
tempVar = (firstValueTemp + loopIndex);
if (tempVar <= 255) {
@@ -995,6 +954,7 @@ TclCompileForeachCmd(interp, parsePtr, envPtr)
(envPtr->codeNext - envPtr->codeStart);
code = TclCompileCmdWord(interp, bodyTokenPtr+1,
bodyTokenPtr->numComponents, envPtr);
+ envPtr->currStackDepth = savedStackDepth + 1;
if (code != TCL_OK) {
if (code == TCL_ERROR) {
sprintf(buffer, "\n (\"foreach\" body line %d)",
@@ -1003,7 +963,6 @@ TclCompileForeachCmd(interp, parsePtr, envPtr)
}
goto done;
}
- maxDepth = TclMax(envPtr->maxStackDepth, maxDepth);
envPtr->exceptArrayPtr[range].numCodeBytes =
(envPtr->codeNext - envPtr->codeStart)
- envPtr->exceptArrayPtr[range].codeOffset;
@@ -1064,10 +1023,9 @@ TclCompileForeachCmd(interp, parsePtr, envPtr)
* The foreach command's result is an empty string.
*/
+ envPtr->currStackDepth = savedStackDepth;
TclEmitPush(TclRegisterLiteral(envPtr, "", 0, /*onHeap*/ 0), envPtr);
- if (maxDepth == 0) {
- maxDepth = 1;
- }
+ envPtr->currStackDepth = savedStackDepth + 1;
done:
for (loopIndex = 0; loopIndex < numLists; loopIndex++) {
@@ -1079,7 +1037,6 @@ TclCompileForeachCmd(interp, parsePtr, envPtr)
ckfree((char *) varcList);
ckfree((char *) varvList);
}
- envPtr->maxStackDepth = maxDepth;
envPtr->exceptDepth--;
return code;
}
@@ -1188,9 +1145,6 @@ FreeForeachInfo(clientData)
* should be compiled "out of line" by emitting code to invoke its
* command procedure at runtime.
*
- * envPtr->maxStackDepth is updated with the maximum number of stack
- * elements needed to execute the command.
- *
* Side effects:
* Instructions are added to envPtr to execute the "if" command
* at runtime.
@@ -1214,9 +1168,13 @@ TclCompileIfCmd(interp, parsePtr, envPtr)
* is determined. */
Tcl_Token *tokenPtr, *testTokenPtr;
int jumpDist, jumpFalseDist, jumpIndex;
- int numWords, wordIdx, numBytes, maxDepth, j, code;
+ int numWords, wordIdx, numBytes, j, code;
char *word;
char buffer[100];
+ 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. */
/*
* Only compile the "if" command if all arguments are simple
@@ -1237,7 +1195,6 @@ TclCompileIfCmd(interp, parsePtr, envPtr)
TclInitJumpFixupArray(&jumpFalseFixupArray);
TclInitJumpFixupArray(&jumpEndFixupArray);
- maxDepth = 0;
code = TCL_OK;
/*
@@ -1280,6 +1237,7 @@ TclCompileIfCmd(interp, parsePtr, envPtr)
* we back off and compile the if command out-of-line.
*/
+ envPtr->currStackDepth = savedStackDepth;
testTokenPtr = tokenPtr;
code = TclCompileExprWords(interp, testTokenPtr, 1, envPtr);
if (code != TCL_OK) {
@@ -1289,7 +1247,6 @@ TclCompileIfCmd(interp, parsePtr, envPtr)
}
goto done;
}
- maxDepth = TclMax(envPtr->maxStackDepth, maxDepth);
if (jumpFalseFixupArray.next >= jumpFalseFixupArray.end) {
TclExpandJumpFixupArray(&jumpFalseFixupArray);
}
@@ -1331,6 +1288,7 @@ TclCompileIfCmd(interp, parsePtr, envPtr)
* Compile the "then" command body.
*/
+ envPtr->currStackDepth = savedStackDepth;
code = TclCompileCmdWord(interp, tokenPtr+1,
tokenPtr->numComponents, envPtr);
if (code != TCL_OK) {
@@ -1341,7 +1299,6 @@ TclCompileIfCmd(interp, parsePtr, envPtr)
}
goto done;
}
- maxDepth = TclMax(envPtr->maxStackDepth, maxDepth);
/*
* Jump to the end of the "if" command. Both jumpFalseFixupArray and
@@ -1380,6 +1337,13 @@ TclCompileIfCmd(interp, parsePtr, envPtr)
}
/*
+ * 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.
*/
@@ -1388,7 +1352,7 @@ TclCompileIfCmd(interp, parsePtr, envPtr)
/*
* There is an else clause. Skip over the optional "else" word.
*/
-
+
word = tokenPtr[1].start;
numBytes = tokenPtr[1].size;
if ((numBytes == 4) && (strncmp(word, "else", 4) == 0)) {
@@ -1417,7 +1381,6 @@ TclCompileIfCmd(interp, parsePtr, envPtr)
}
goto done;
}
- maxDepth = TclMax(envPtr->maxStackDepth, maxDepth);
/*
* Make sure there are no words after the else clause.
@@ -1437,7 +1400,6 @@ TclCompileIfCmd(interp, parsePtr, envPtr)
*/
TclEmitPush(TclRegisterLiteral(envPtr, "", 0,/*onHeap*/ 0), envPtr);
- maxDepth = TclMax(1, maxDepth);
}
/*
@@ -1477,9 +1439,9 @@ TclCompileIfCmd(interp, parsePtr, envPtr)
*/
done:
+ envPtr->currStackDepth = savedStackDepth + 1;
TclFreeJumpFixupArray(&jumpFalseFixupArray);
TclFreeJumpFixupArray(&jumpEndFixupArray);
- envPtr->maxStackDepth = maxDepth;
return code;
}
@@ -1499,9 +1461,6 @@ TclCompileIfCmd(interp, parsePtr, envPtr)
* should be compiled "out of line" by emitting code to invoke its
* command procedure at runtime.
*
- * envPtr->maxStackDepth is updated with the maximum number of stack
- * elements needed to execute the "incr" command.
- *
* Side effects:
* Instructions are added to envPtr to execute the "incr" command
* at runtime.
@@ -1518,10 +1477,8 @@ TclCompileIncrCmd(interp, parsePtr, envPtr)
{
Tcl_Token *varTokenPtr, *incrTokenPtr;
int simpleVarName, isScalar, localIndex, haveImmValue, immValue;
- int maxDepth = 0;
int code = TCL_OK;
- envPtr->maxStackDepth = 0;
if ((parsePtr->numWords != 2) && (parsePtr->numWords != 3)) {
Tcl_ResetResult(interp);
Tcl_AppendToObj(Tcl_GetObjResult(interp),
@@ -1533,7 +1490,7 @@ TclCompileIncrCmd(interp, parsePtr, envPtr)
+ (parsePtr->tokenPtr->numComponents + 1);
code = TclPushVarName(interp, varTokenPtr, envPtr, TCL_NO_LARGE_INDEX,
- &localIndex, &maxDepth, &simpleVarName, &isScalar);
+ &localIndex, &simpleVarName, &isScalar);
if (code != TCL_OK) {
goto done;
}
@@ -1572,7 +1529,6 @@ TclCompileIncrCmd(interp, parsePtr, envPtr)
if (!haveImmValue) {
TclEmitPush(TclRegisterLiteral(envPtr, word, numBytes,
/*onHeap*/ 0), envPtr);
- maxDepth += 1;
}
} else {
code = TclCompileTokens(interp, incrTokenPtr+1,
@@ -1584,7 +1540,6 @@ TclCompileIncrCmd(interp, parsePtr, envPtr)
}
goto done;
}
- maxDepth += envPtr->maxStackDepth;
}
} else { /* no incr amount given so use 1 */
haveImmValue = 1;
@@ -1636,7 +1591,6 @@ TclCompileIncrCmd(interp, parsePtr, envPtr)
}
done:
- envPtr->maxStackDepth = maxDepth;
return code;
}
@@ -1656,9 +1610,6 @@ TclCompileIncrCmd(interp, parsePtr, envPtr)
* command should be compiled "out of line" by emitting code to
* invoke its command procedure (Tcl_LappendObjCmd) at runtime.
*
- * envPtr->maxStackDepth is updated with the maximum number of stack
- * elements needed to execute the incr command.
- *
* Side effects:
* Instructions are added to envPtr to execute the "lappend" command
* at runtime.
@@ -1675,7 +1626,6 @@ TclCompileLappendCmd(interp, parsePtr, envPtr)
{
Tcl_Token *varTokenPtr, *valueTokenPtr;
int numValues, simpleVarName, isScalar, localIndex, numWords;
- int maxDepth = 0;
int code = TCL_OK;
/*
@@ -1685,7 +1635,6 @@ TclCompileLappendCmd(interp, parsePtr, envPtr)
return TCL_OUT_LINE_COMPILE;
}
- envPtr->maxStackDepth = 0;
numWords = parsePtr->numWords;
if (numWords == 1) {
Tcl_ResetResult(interp);
@@ -1713,7 +1662,7 @@ TclCompileLappendCmd(interp, parsePtr, envPtr)
+ (parsePtr->tokenPtr->numComponents + 1);
code = TclPushVarName(interp, varTokenPtr, envPtr, TCL_CREATE_VAR,
- &localIndex, &maxDepth, &simpleVarName, &isScalar);
+ &localIndex, &simpleVarName, &isScalar);
if (code != TCL_OK) {
goto done;
}
@@ -1728,14 +1677,12 @@ TclCompileLappendCmd(interp, parsePtr, envPtr)
if (valueTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
TclEmitPush(TclRegisterLiteral(envPtr, valueTokenPtr[1].start,
valueTokenPtr[1].size, /*onHeap*/ 0), envPtr);
- maxDepth += 1;
} else {
code = TclCompileTokens(interp, valueTokenPtr+1,
valueTokenPtr->numComponents, envPtr);
if (code != TCL_OK) {
goto done;
}
- maxDepth += envPtr->maxStackDepth;
}
#if 0
} else {
@@ -1745,7 +1692,6 @@ TclCompileLappendCmd(interp, parsePtr, envPtr)
*/
TclEmitPush(TclRegisterLiteral(envPtr, "", 0, /*onHeap*/ 0), envPtr);
- maxDepth += 1;
numValues = 1;
#endif
}
@@ -1785,7 +1731,6 @@ TclCompileLappendCmd(interp, parsePtr, envPtr)
}
done:
- envPtr->maxStackDepth = maxDepth;
return code;
}
@@ -1803,9 +1748,6 @@ TclCompileLappendCmd(interp, parsePtr, envPtr)
* interpreter's result contains an error message, and TCL_ERROR is
* returned.
*
- * envPtr->maxStackDepth is updated with the maximum number of stack
- * elements needed to execute the command.
- *
* Side effects:
* Instructions are added to envPtr to execute the "lindex" command
* at runtime.
@@ -1821,7 +1763,7 @@ TclCompileLindexCmd(interp, parsePtr, envPtr)
CompileEnv *envPtr; /* Holds resulting instructions. */
{
Tcl_Token *varTokenPtr;
- int code, depth, i;
+ int code, i;
int numWords;
numWords = parsePtr->numWords;
@@ -1837,8 +1779,6 @@ TclCompileLindexCmd(interp, parsePtr, envPtr)
varTokenPtr = parsePtr->tokenPtr
+ (parsePtr->tokenPtr->numComponents + 1);
- depth = 0;
-
/*
* Push the operands onto the stack.
*/
@@ -1850,15 +1790,12 @@ TclCompileLindexCmd(interp, parsePtr, envPtr)
varTokenPtr[1].size,
0),
envPtr);
- depth++;
} else {
code = TclCompileTokens(interp, varTokenPtr+1,
varTokenPtr->numComponents, envPtr);
if (code != TCL_OK) {
- envPtr->maxStackDepth = depth;
return code;
}
- depth += envPtr->maxStackDepth;
}
varTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1);
}
@@ -1868,7 +1805,6 @@ TclCompileLindexCmd(interp, parsePtr, envPtr)
* if there are multiple index args.
*/
- envPtr->maxStackDepth = depth;
if ( numWords == 3 ) {
TclEmitOpcode( INST_LIST_INDEX, envPtr );
} else {
@@ -1895,9 +1831,6 @@ TclCompileLindexCmd(interp, parsePtr, envPtr)
* command should be compiled "out of line" by emitting code to
* invoke its command procedure (Tcl_ListObjCmd) at runtime.
*
- * envPtr->maxStackDepth is updated with the maximum number of stack
- * elements needed to execute the incr command.
- *
* Side effects:
* Instructions are added to envPtr to execute the "list" command
* at runtime.
@@ -1919,20 +1852,18 @@ TclCompileListCmd(interp, parsePtr, envPtr)
return TCL_OUT_LINE_COMPILE;
}
- envPtr->maxStackDepth = 0;
if (parsePtr->numWords == 1) {
/*
* Empty args case
*/
TclEmitPush(TclRegisterLiteral(envPtr, "", 0, 0), envPtr);
- envPtr->maxStackDepth = 1;
} else {
/*
* Push the all values onto the stack.
*/
Tcl_Token *valueTokenPtr;
- int i, code, numWords, depth = 0;
+ int i, code, numWords;
numWords = parsePtr->numWords;
@@ -1943,19 +1874,15 @@ TclCompileListCmd(interp, parsePtr, envPtr)
TclEmitPush(TclRegisterLiteral(envPtr,
valueTokenPtr[1].start, valueTokenPtr[1].size,
/*onHeap*/ 0), envPtr);
- depth++;
} else {
code = TclCompileTokens(interp, valueTokenPtr+1,
valueTokenPtr->numComponents, envPtr);
if (code != TCL_OK) {
- envPtr->maxStackDepth = depth;
return code;
}
- depth += envPtr->maxStackDepth;
}
valueTokenPtr = valueTokenPtr + (valueTokenPtr->numComponents + 1);
}
- envPtr->maxStackDepth = depth;
TclEmitInstInt4(INST_LIST, numWords - 1, envPtr);
}
@@ -1976,9 +1903,6 @@ TclCompileListCmd(interp, parsePtr, envPtr)
* interpreter's result contains an error message, and TCL_ERROR is
* returned.
*
- * envPtr->maxStackDepth is updated with the maximum number of stack
- * elements needed to execute the command.
- *
* Side effects:
* Instructions are added to envPtr to execute the "llength" command
* at runtime.
@@ -2011,7 +1935,6 @@ TclCompileLlengthCmd(interp, parsePtr, envPtr)
*/
TclEmitPush(TclRegisterLiteral(envPtr, varTokenPtr[1].start,
varTokenPtr[1].size, 0), envPtr);
- envPtr->maxStackDepth = 1;
} else {
code = TclCompileTokens(interp, varTokenPtr+1,
varTokenPtr->numComponents, envPtr);
@@ -2038,9 +1961,6 @@ TclCompileLlengthCmd(interp, parsePtr, envPtr)
* (that is, not byte-compiled). If an error occurs, TCL_ERROR is
* returned, and the interpreter result contains an error message.
*
- * envPtr->maxStackDepth is updated with a conservative estimate
- * of the number of stack elements needed to execute the command.
- *
* Side effects:
* Instructions are added to envPtr to execute the "lset" command
* at runtime.
@@ -2078,12 +1998,8 @@ TclCompileLsetCmd( interp, parsePtr, envPtr )
CompileEnv* envPtr; /* Holds the resulting instructions */
{
- int depth = 0; /* Current depth of stack */
int tempDepth; /* Depth used for emitting one part
* of the code burst. */
- int maxDepth = 0; /* Max depth used anywhere in the
- * code burst */
-
Tcl_Token* varTokenPtr; /* Pointer to the Tcl_Token representing
* the parse of the variable name */
@@ -2112,32 +2028,12 @@ TclCompileLsetCmd( interp, parsePtr, envPtr )
varTokenPtr = parsePtr->tokenPtr
+ (parsePtr->tokenPtr->numComponents + 1);
- tempDepth = 0;
result = TclPushVarName( interp, varTokenPtr, envPtr, 0,
- &localIndex, &tempDepth,
- &simpleVarName, &isScalar );
- if ( tempDepth > maxDepth ) {
- maxDepth = tempDepth;
- }
+ &localIndex, &simpleVarName, &isScalar );
if (result != TCL_OK) {
- envPtr->maxStackDepth = maxDepth;
return result;
}
- /* Figure out how much is now on stack. */
-
- depth = 0;
- if ( simpleVarName ) {
- if ( localIndex < 0 ) {
- ++depth; /* We have pushed a variable name. */
- }
- if ( !isScalar ) {
- ++depth; /* We have pushed an array element */
- }
- } else {
- ++depth; /* Variable is complex; it's pushed to stack */
- }
-
/* Push the "index" args and the new element value. */
for ( i = 2; i < parsePtr->numWords; ++i ) {
@@ -2154,20 +2050,10 @@ TclCompileLsetCmd( interp, parsePtr, envPtr )
varTokenPtr[1].size,
0),
envPtr);
- ++depth;
- if ( depth > maxDepth ) {
- maxDepth = depth;
- }
} else {
- envPtr->maxStackDepth = depth;
result = TclCompileTokens(interp, varTokenPtr+1,
varTokenPtr->numComponents, envPtr);
- ++depth;
- if ( envPtr->maxStackDepth > maxDepth ) {
- maxDepth = envPtr->maxStackDepth;
- }
if ( result != TCL_OK ) {
- envPtr->maxStackDepth = maxDepth;
return result;
}
}
@@ -2184,10 +2070,6 @@ TclCompileLsetCmd( interp, parsePtr, envPtr )
tempDepth = parsePtr->numWords - 1;
}
TclEmitInstInt4( INST_OVER, tempDepth, envPtr );
- ++depth;
- if ( depth > maxDepth ) {
- maxDepth = depth;
- }
}
/*
@@ -2201,10 +2083,6 @@ TclCompileLsetCmd( interp, parsePtr, envPtr )
tempDepth = parsePtr->numWords - 2;
}
TclEmitInstInt4( INST_OVER, tempDepth, envPtr );
- ++depth;
- if ( depth > maxDepth ) {
- maxDepth = depth;
- }
}
/*
@@ -2232,17 +2110,6 @@ TclCompileLsetCmd( interp, parsePtr, envPtr )
}
/*
- * Stack has now reached the maximum depth it will attain
- * during this code burst.
- */
-
- ++depth;
- if ( depth > maxDepth ) {
- maxDepth = depth;
- }
- envPtr->maxStackDepth = maxDepth;
-
- /*
* Emit the correct variety of 'lset' instruction
*/
@@ -2296,9 +2163,6 @@ TclCompileLsetCmd( interp, parsePtr, envPtr )
* If an error occurs then the interpreter's result contains a standard
* error message.
*
- * envPtr->maxStackDepth is updated with the maximum number of stack
- * elements needed to execute the command.
- *
* Side effects:
* Instructions are added to envPtr to execute the "return" command
* at runtime.
@@ -2331,7 +2195,6 @@ TclCompileReturnCmd(interp, parsePtr, envPtr)
* Just push the literal string "".
*/
TclEmitPush(TclRegisterLiteral(envPtr, "", 0, 0), envPtr);
- envPtr->maxStackDepth = 1;
break;
}
case 2: {
@@ -2350,7 +2213,6 @@ TclCompileReturnCmd(interp, parsePtr, envPtr)
*/
TclEmitPush(TclRegisterLiteral(envPtr, varTokenPtr[1].start,
varTokenPtr[1].size, /*onHeap*/ 0), envPtr);
- envPtr->maxStackDepth = 1;
} else {
/*
* Parse token is more complex, so compile it; this handles the
@@ -2401,9 +2263,6 @@ TclCompileReturnCmd(interp, parsePtr, envPtr)
* set command should be compiled "out of line" by emitting code to
* invoke its command procedure (Tcl_SetCmd) at runtime.
*
- * envPtr->maxStackDepth is updated with the maximum number of stack
- * elements needed to execute the incr command.
- *
* Side effects:
* Instructions are added to envPtr to execute the "set" command
* at runtime.
@@ -2420,10 +2279,8 @@ TclCompileSetCmd(interp, parsePtr, envPtr)
{
Tcl_Token *varTokenPtr, *valueTokenPtr;
int isAssignment, isScalar, simpleVarName, localIndex, numWords;
- int maxDepth = 0;
int code = TCL_OK;
- envPtr->maxStackDepth = 0;
numWords = parsePtr->numWords;
if ((numWords != 2) && (numWords != 3)) {
Tcl_ResetResult(interp);
@@ -2446,7 +2303,7 @@ TclCompileSetCmd(interp, parsePtr, envPtr)
code = TclPushVarName(interp, varTokenPtr, envPtr,
(isAssignment ? TCL_CREATE_VAR : 0),
- &localIndex, &maxDepth, &simpleVarName, &isScalar);
+ &localIndex, &simpleVarName, &isScalar);
if (code != TCL_OK) {
goto done;
}
@@ -2460,14 +2317,12 @@ TclCompileSetCmd(interp, parsePtr, envPtr)
if (valueTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
TclEmitPush(TclRegisterLiteral(envPtr, valueTokenPtr[1].start,
valueTokenPtr[1].size, /*onHeap*/ 0), envPtr);
- maxDepth += 1;
} else {
code = TclCompileTokens(interp, valueTokenPtr+1,
valueTokenPtr->numComponents, envPtr);
if (code != TCL_OK) {
goto done;
}
- maxDepth += envPtr->maxStackDepth;
}
}
@@ -2512,7 +2367,6 @@ TclCompileSetCmd(interp, parsePtr, envPtr)
}
done:
- envPtr->maxStackDepth = maxDepth;
return code;
}
@@ -2530,9 +2384,6 @@ TclCompileSetCmd(interp, parsePtr, envPtr)
* interpreter's result contains an error message, and TCL_ERROR is
* returned.
*
- * envPtr->maxStackDepth is updated with the maximum number of stack
- * elements needed to execute the command.
- *
* Side effects:
* Instructions are added to envPtr to execute the "string" command
* at runtime.
@@ -2612,7 +2463,7 @@ TclCompileStringCmd(interp, parsePtr, envPtr)
case STR_COMPARE:
case STR_EQUAL: {
- int i, depth;
+ int i;
/*
* If there are any flags to the command, we can't byte compile it
* because the INST_STR_EQ bytecode doesn't support flags.
@@ -2622,8 +2473,6 @@ TclCompileStringCmd(interp, parsePtr, envPtr)
return TCL_OUT_LINE_COMPILE;
}
- depth = 0;
-
/*
* Push the two operands onto the stack.
*/
@@ -2633,25 +2482,22 @@ TclCompileStringCmd(interp, parsePtr, envPtr)
TclEmitPush(TclRegisterLiteral(envPtr,
varTokenPtr[1].start, varTokenPtr[1].size,
0), envPtr);
- depth++;
} else {
code = TclCompileTokens(interp, varTokenPtr+1,
varTokenPtr->numComponents, envPtr);
if (code != TCL_OK) {
return code;
}
- depth += envPtr->maxStackDepth;
}
varTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1);
}
- envPtr->maxStackDepth = depth;
TclEmitOpcode(((((enum options) index) == STR_COMPARE) ?
INST_STR_CMP : INST_STR_EQ), envPtr);
return TCL_OK;
}
case STR_INDEX: {
- int i, depth;
+ int i;
if (parsePtr->numWords != 4) {
Tcl_SetResult(interp, "wrong # args: should be "
@@ -2659,8 +2505,6 @@ TclCompileStringCmd(interp, parsePtr, envPtr)
return TCL_ERROR;
}
- depth = 0;
-
/*
* Push the two operands onto the stack.
*/
@@ -2670,19 +2514,16 @@ TclCompileStringCmd(interp, parsePtr, envPtr)
TclEmitPush(TclRegisterLiteral(envPtr,
varTokenPtr[1].start, varTokenPtr[1].size,
0), envPtr);
- depth++;
} else {
code = TclCompileTokens(interp, varTokenPtr+1,
varTokenPtr->numComponents, envPtr);
if (code != TCL_OK) {
return code;
}
- depth += envPtr->maxStackDepth;
}
varTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1);
}
- envPtr->maxStackDepth = depth;
TclEmitOpcode(INST_STR_INDEX, envPtr);
return TCL_OK;
}
@@ -2715,7 +2556,7 @@ TclCompileStringCmd(interp, parsePtr, envPtr)
return TCL_OK;
}
case STR_MATCH: {
- int i, length, exactMatch = 0, nocase = 0, depth = 0;
+ int i, length, exactMatch = 0, nocase = 0;
char c, *str;
if (parsePtr->numWords < 4 || parsePtr->numWords > 5) {
@@ -2767,14 +2608,12 @@ TclCompileStringCmd(interp, parsePtr, envPtr)
}
TclEmitPush(TclRegisterLiteral(envPtr, str, length,
0), envPtr);
- depth++;
} else {
code = TclCompileTokens(interp, varTokenPtr+1,
varTokenPtr->numComponents, envPtr);
if (code != TCL_OK) {
return code;
}
- depth += envPtr->maxStackDepth;
}
varTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1);
}
@@ -2784,7 +2623,6 @@ TclCompileStringCmd(interp, parsePtr, envPtr)
} else {
TclEmitInstInt1(INST_STR_MATCH, nocase, envPtr);
}
- envPtr->maxStackDepth = depth;
return TCL_OK;
}
}
@@ -2808,9 +2646,6 @@ TclCompileStringCmd(interp, parsePtr, envPtr)
* indicating that the while command should be compiled "out of line"
* by emitting code to invoke its command procedure at runtime.
*
- * envPtr->maxStackDepth is updated with the maximum number of stack
- * elements needed to execute the "while" command.
- *
* Side effects:
* Instructions are added to envPtr to execute the "while" command
* at runtime.
@@ -2829,11 +2664,10 @@ TclCompileWhileCmd(interp, parsePtr, envPtr)
JumpFixup jumpFalseFixup;
unsigned char *jumpPc;
int testCodeOffset, jumpDist, jumpBackDist, jumpBackOffset;
- int range, maxDepth, code;
+ int range, code;
char buffer[32 + TCL_INTEGER_SPACE];
+ int savedStackDepth = envPtr->currStackDepth;
- envPtr->maxStackDepth = 0;
- maxDepth = 0;
if (parsePtr->numWords != 3) {
Tcl_ResetResult(interp);
Tcl_AppendToObj(Tcl_GetObjResult(interp),
@@ -2885,18 +2719,19 @@ TclCompileWhileCmd(interp, parsePtr, envPtr)
}
goto error;
}
- maxDepth = envPtr->maxStackDepth;
TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, &jumpFalseFixup);
/*
* Compile the loop body.
*/
+ envPtr->currStackDepth = savedStackDepth;
bodyTokenPtr = testTokenPtr + (testTokenPtr->numComponents + 1);
envPtr->exceptArrayPtr[range].codeOffset =
(envPtr->codeNext - envPtr->codeStart);
code = TclCompileCmdWord(interp, bodyTokenPtr+1,
bodyTokenPtr->numComponents, envPtr);
+ envPtr->currStackDepth = savedStackDepth + 1;
if (code != TCL_OK) {
if (code == TCL_ERROR) {
sprintf(buffer, "\n (\"while\" body line %d)",
@@ -2905,7 +2740,6 @@ TclCompileWhileCmd(interp, parsePtr, envPtr)
}
goto error;
}
- maxDepth = TclMax(envPtr->maxStackDepth, maxDepth);
envPtr->exceptArrayPtr[range].numCodeBytes =
(envPtr->codeNext - envPtr->codeStart)
- envPtr->exceptArrayPtr[range].codeOffset;
@@ -2965,16 +2799,12 @@ TclCompileWhileCmd(interp, parsePtr, envPtr)
* The while command's result is an empty string.
*/
+ envPtr->currStackDepth = savedStackDepth;
TclEmitPush(TclRegisterLiteral(envPtr, "", 0, /*onHeap*/ 0), envPtr);
- if (maxDepth == 0) {
- maxDepth = 1;
- }
- envPtr->maxStackDepth = maxDepth;
envPtr->exceptDepth--;
return TCL_OK;
error:
- envPtr->maxStackDepth = maxDepth;
envPtr->exceptDepth--;
return code;
}
@@ -2992,9 +2822,6 @@ TclCompileWhileCmd(interp, parsePtr, envPtr)
* unless there was an error while parsing string. If an error occurs
* then the interpreter's result contains a standard error message.
*
- * envPtr->maxStackDepth is updated with the maximum number of stack
- * elements needed to execute the incr command.
- *
* Side effects:
* Instructions are added to envPtr to execute the "set" command
* at runtime.
@@ -3004,15 +2831,13 @@ TclCompileWhileCmd(interp, parsePtr, envPtr)
static int
TclPushVarName(interp, varTokenPtr, envPtr, flags, localIndexPtr,
- maxDepthPtr, simpleVarNamePtr, isScalarPtr)
+ simpleVarNamePtr, isScalarPtr)
Tcl_Interp *interp; /* Used for error reporting. */
Tcl_Token *varTokenPtr; /* Points to a variable token. */
CompileEnv *envPtr; /* Holds resulting instructions. */
int flags; /* takes TCL_CREATE_VAR or
* TCL_LARGE_INDEX_OK */
int *localIndexPtr; /* must not be NULL */
- int *maxDepthPtr; /* must not be NULL, should already have a
- * value set in the parent. */
int *simpleVarNamePtr; /* must not be NULL */
int *isScalarPtr; /* must not be NULL */
{
@@ -3022,7 +2847,6 @@ TclPushVarName(interp, varTokenPtr, envPtr, flags, localIndexPtr,
char *name, *elName;
register int i, n;
int nameChars, elNameChars, simpleVarName, localIndex;
- int maxDepth = 0;
int code = TCL_OK;
/*
@@ -3149,7 +2973,6 @@ TclPushVarName(interp, varTokenPtr, envPtr, flags, localIndexPtr,
if (localIndex < 0) {
TclEmitPush(TclRegisterLiteral(envPtr, name, nameChars,
/*onHeap*/ 0), envPtr);
- maxDepth = 1;
}
/*
@@ -3181,11 +3004,9 @@ TclPushVarName(interp, varTokenPtr, envPtr, flags, localIndexPtr,
if (code != TCL_OK) {
goto done;
}
- maxDepth += envPtr->maxStackDepth;
} else {
TclEmitPush(TclRegisterLiteral(envPtr, "", 0,
/*alreadyAlloced*/ 0), envPtr);
- maxDepth += 1;
}
}
} else {
@@ -3198,7 +3019,6 @@ TclPushVarName(interp, varTokenPtr, envPtr, flags, localIndexPtr,
if (code != TCL_OK) {
goto done;
}
- maxDepth += envPtr->maxStackDepth;
}
done:
@@ -3206,7 +3026,6 @@ TclPushVarName(interp, varTokenPtr, envPtr, flags, localIndexPtr,
Tcl_FreeParse(&elemParse);
}
*localIndexPtr = localIndex;
- *maxDepthPtr += maxDepth;
*simpleVarNamePtr = simpleVarName;
*isScalarPtr = (elName == NULL);
return code;
diff --git a/generic/tclCompExpr.c b/generic/tclCompExpr.c
index b619e2c..bae0a90 100644
--- a/generic/tclCompExpr.c
+++ b/generic/tclCompExpr.c
@@ -9,7 +9,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclCompExpr.c,v 1.6 2000/05/26 08:53:40 hobbs Exp $
+ * RCS: @(#) $Id: tclCompExpr.c,v 1.7 2001/12/10 15:44:34 msofer Exp $
*/
#include "tclInt.h"
@@ -206,9 +206,6 @@ static void LogSyntaxError _ANSI_ARGS_((ExprInfo *infoPtr));
* on failure. If TCL_ERROR is returned, then the interpreter's result
* contains an error message.
*
- * envPtr->maxStackDepth is updated with the maximum number of stack
- * elements needed to execute the expression.
- *
* envPtr->exprIsJustVarRef is set 1 if the expression consisted of
* a single variable reference as in the expression of "if $b then...".
* Otherwise it is set 0. This is used to implement Tcl's two level
@@ -237,7 +234,7 @@ TclCompileExpr(interp, script, numBytes, envPtr)
ExprInfo info;
Tcl_Parse parse;
Tcl_HashEntry *hPtr;
- int maxDepth, new, i, code;
+ int new, i, code;
/*
* If this is the first time we've been called, initialize the table
@@ -280,7 +277,6 @@ TclCompileExpr(interp, script, numBytes, envPtr)
* Parse the expression then compile it.
*/
- maxDepth = 0;
code = Tcl_ParseExpr(interp, script, numBytes, &parse);
if (code != TCL_OK) {
goto done;
@@ -291,7 +287,6 @@ TclCompileExpr(interp, script, numBytes, envPtr)
Tcl_FreeParse(&parse);
goto done;
}
- maxDepth = envPtr->maxStackDepth;
if (!info.hasOperators) {
/*
@@ -306,7 +301,6 @@ TclCompileExpr(interp, script, numBytes, envPtr)
Tcl_FreeParse(&parse);
done:
- envPtr->maxStackDepth = maxDepth;
envPtr->exprIsJustVarRef = info.exprIsJustVarRef;
envPtr->exprIsComparison = info.exprIsComparison;
return code;
@@ -357,9 +351,6 @@ TclFinalizeCompilation()
* on failure. If TCL_ERROR is returned, then the interpreter's result
* contains an error message.
*
- * envPtr->maxStackDepth is updated with the maximum number of stack
- * elements needed to execute the subexpression.
- *
* envPtr->exprIsJustVarRef is set 1 if the subexpression consisted of
* a single variable reference as in the expression of "if $b then...".
* Otherwise it is set 0. This is used to implement Tcl's two level
@@ -390,14 +381,13 @@ CompileSubExpr(exprTokenPtr, infoPtr, envPtr)
Tcl_HashEntry *hPtr;
char *operator;
char savedChar;
- int maxDepth, objIndex, opIndex, length, code;
+ int objIndex, opIndex, length, code;
char buffer[TCL_UTF_MAX];
if (exprTokenPtr->type != TCL_TOKEN_SUB_EXPR) {
panic("CompileSubExpr: token type %d not TCL_TOKEN_SUB_EXPR\n",
exprTokenPtr->type);
}
- maxDepth = 0;
code = TCL_OK;
/*
@@ -416,7 +406,6 @@ CompileSubExpr(exprTokenPtr, infoPtr, envPtr)
if (code != TCL_OK) {
goto done;
}
- maxDepth = envPtr->maxStackDepth;
tokenPtr += (tokenPtr->numComponents + 1);
infoPtr->exprIsJustVarRef = 0;
break;
@@ -429,7 +418,6 @@ CompileSubExpr(exprTokenPtr, infoPtr, envPtr)
objIndex = TclRegisterLiteral(envPtr, "", 0, /*onHeap*/ 0);
}
TclEmitPush(objIndex, envPtr);
- maxDepth = 1;
tokenPtr += 1;
infoPtr->exprIsJustVarRef = 0;
break;
@@ -444,7 +432,6 @@ CompileSubExpr(exprTokenPtr, infoPtr, envPtr)
objIndex = TclRegisterLiteral(envPtr, "", 0, /*onHeap*/ 0);
}
TclEmitPush(objIndex, envPtr);
- maxDepth = 1;
tokenPtr += 1;
infoPtr->exprIsJustVarRef = 0;
break;
@@ -455,7 +442,6 @@ CompileSubExpr(exprTokenPtr, infoPtr, envPtr)
if (code != TCL_OK) {
goto done;
}
- maxDepth = envPtr->maxStackDepth;
tokenPtr += 1;
infoPtr->exprIsJustVarRef = 0;
break;
@@ -465,7 +451,6 @@ CompileSubExpr(exprTokenPtr, infoPtr, envPtr)
if (code != TCL_OK) {
goto done;
}
- maxDepth = envPtr->maxStackDepth;
tokenPtr += (tokenPtr->numComponents + 1);
break;
@@ -475,7 +460,6 @@ CompileSubExpr(exprTokenPtr, infoPtr, envPtr)
if (code != TCL_OK) {
goto done;
}
- maxDepth = envPtr->maxStackDepth;
tokenPtr += (tokenPtr->numComponents + 1);
break;
@@ -504,7 +488,6 @@ CompileSubExpr(exprTokenPtr, infoPtr, envPtr)
if (code != TCL_OK) {
goto done;
}
- maxDepth = envPtr->maxStackDepth;
tokenPtr = endPtr;
infoPtr->exprIsJustVarRef = 0;
infoPtr->exprIsComparison = 0;
@@ -525,7 +508,6 @@ CompileSubExpr(exprTokenPtr, infoPtr, envPtr)
if (code != TCL_OK) {
goto done;
}
- maxDepth = envPtr->maxStackDepth;
tokenPtr += (tokenPtr->numComponents + 1);
if (opDescPtr->numOperands == 2) {
@@ -533,8 +515,6 @@ CompileSubExpr(exprTokenPtr, infoPtr, envPtr)
if (code != TCL_OK) {
goto done;
}
- maxDepth = TclMax((envPtr->maxStackDepth + 1),
- maxDepth);
tokenPtr += (tokenPtr->numComponents + 1);
}
TclEmitOpcode(opDescPtr->instruction, envPtr);
@@ -559,7 +539,6 @@ CompileSubExpr(exprTokenPtr, infoPtr, envPtr)
if (code != TCL_OK) {
goto done;
}
- maxDepth = envPtr->maxStackDepth;
tokenPtr += (tokenPtr->numComponents + 1);
/*
@@ -583,8 +562,6 @@ CompileSubExpr(exprTokenPtr, infoPtr, envPtr)
if (code != TCL_OK) {
goto done;
}
- maxDepth = TclMax((envPtr->maxStackDepth + 1),
- maxDepth);
tokenPtr += (tokenPtr->numComponents + 1);
TclEmitOpcode(((opIndex==OP_PLUS)? INST_ADD : INST_SUB),
envPtr);
@@ -597,7 +574,6 @@ CompileSubExpr(exprTokenPtr, infoPtr, envPtr)
if (code != TCL_OK) {
goto done;
}
- maxDepth = envPtr->maxStackDepth;
tokenPtr = endPtr;
break;
@@ -607,7 +583,6 @@ CompileSubExpr(exprTokenPtr, infoPtr, envPtr)
if (code != TCL_OK) {
goto done;
}
- maxDepth = envPtr->maxStackDepth;
tokenPtr = endPtr;
break;
@@ -638,7 +613,6 @@ CompileSubExpr(exprTokenPtr, infoPtr, envPtr)
}
done:
- envPtr->maxStackDepth = maxDepth;
return code;
}
@@ -657,9 +631,6 @@ CompileSubExpr(exprTokenPtr, infoPtr, envPtr)
* endPtrPtr. If TCL_ERROR is returned, then the interpreter's result
* contains an error message.
*
- * envPtr->maxStackDepth is updated with the maximum number of stack
- * elements needed to execute the expression.
- *
* Side effects:
* Adds instructions to envPtr to evaluate the expression at runtime.
*
@@ -685,19 +656,18 @@ CompileLandOrLorExpr(exprTokenPtr, opIndex, infoPtr, envPtr, endPtrPtr)
/* Used to fix up jumps used to convert the
* first operand to 0 or 1. */
Tcl_Token *tokenPtr;
- int dist, maxDepth, code;
+ int dist, code;
+ int savedStackDepth = envPtr->currStackDepth;
/*
* Emit code for the first operand.
*/
- maxDepth = 0;
tokenPtr = exprTokenPtr+2;
code = CompileSubExpr(tokenPtr, infoPtr, envPtr);
if (code != TCL_OK) {
goto done;
}
- maxDepth = envPtr->maxStackDepth;
tokenPtr += (tokenPtr->numComponents + 1);
/*
@@ -713,6 +683,7 @@ CompileLandOrLorExpr(exprTokenPtr, opIndex, infoPtr, envPtr, endPtrPtr)
badDist:
panic("CompileLandOrLorExpr: bad jump distance %d\n", dist);
}
+ envPtr->currStackDepth = savedStackDepth;
TclEmitPush(TclRegisterLiteral(envPtr, "1", 1, /*onHeap*/ 0), envPtr);
dist = (envPtr->codeNext - envPtr->codeStart) - lhsEndFixup.codeOffset;
if (TclFixupForwardJump(envPtr, &lhsEndFixup, dist, 127)) {
@@ -738,7 +709,6 @@ CompileLandOrLorExpr(exprTokenPtr, opIndex, infoPtr, envPtr, endPtrPtr)
if (code != TCL_OK) {
goto done;
}
- maxDepth = TclMax((envPtr->maxStackDepth + 1), maxDepth);
tokenPtr += (tokenPtr->numComponents + 1);
/*
@@ -760,7 +730,7 @@ CompileLandOrLorExpr(exprTokenPtr, opIndex, infoPtr, envPtr, endPtrPtr)
*endPtrPtr = tokenPtr;
done:
- envPtr->maxStackDepth = maxDepth;
+ envPtr->currStackDepth = savedStackDepth + 1;
return code;
}
@@ -779,9 +749,6 @@ CompileLandOrLorExpr(exprTokenPtr, opIndex, infoPtr, envPtr, endPtrPtr)
* endPtrPtr. If TCL_ERROR is returned, then the interpreter's result
* contains an error message.
*
- * envPtr->maxStackDepth is updated with the maximum number of stack
- * elements needed to execute the expression.
- *
* Side effects:
* Adds instructions to envPtr to evaluate the expression at runtime.
*
@@ -804,19 +771,18 @@ CompileCondExpr(exprTokenPtr, infoPtr, envPtr, endPtrPtr)
* around the then and else expressions when
* their target PCs are determined. */
Tcl_Token *tokenPtr;
- int elseCodeOffset, dist, maxDepth, code;
+ int elseCodeOffset, dist, code;
+ int savedStackDepth = envPtr->currStackDepth;
/*
* Emit code for the test.
*/
- maxDepth = 0;
tokenPtr = exprTokenPtr+2;
code = CompileSubExpr(tokenPtr, infoPtr, envPtr);
if (code != TCL_OK) {
goto done;
}
- maxDepth = envPtr->maxStackDepth;
tokenPtr += (tokenPtr->numComponents + 1);
/*
@@ -837,7 +803,6 @@ CompileCondExpr(exprTokenPtr, infoPtr, envPtr, endPtrPtr)
if (code != TCL_OK) {
goto done;
}
- maxDepth = TclMax(envPtr->maxStackDepth, maxDepth);
tokenPtr += (tokenPtr->numComponents + 1);
if (!infoPtr->hasOperators) {
TclEmitOpcode(INST_TRY_CVT_TO_NUMERIC, envPtr);
@@ -854,13 +819,13 @@ CompileCondExpr(exprTokenPtr, infoPtr, envPtr, endPtrPtr)
* Compile the "else" expression.
*/
+ envPtr->currStackDepth = savedStackDepth;
elseCodeOffset = (envPtr->codeNext - envPtr->codeStart);
infoPtr->hasOperators = 0;
code = CompileSubExpr(tokenPtr, infoPtr, envPtr);
if (code != TCL_OK) {
goto done;
}
- maxDepth = TclMax(envPtr->maxStackDepth, maxDepth);
tokenPtr += (tokenPtr->numComponents + 1);
if (!infoPtr->hasOperators) {
TclEmitOpcode(INST_TRY_CVT_TO_NUMERIC, envPtr);
@@ -890,7 +855,7 @@ CompileCondExpr(exprTokenPtr, infoPtr, envPtr, endPtrPtr)
*endPtrPtr = tokenPtr;
done:
- envPtr->maxStackDepth = maxDepth;
+ envPtr->currStackDepth = savedStackDepth + 1;
return code;
}
@@ -909,9 +874,6 @@ CompileCondExpr(exprTokenPtr, infoPtr, envPtr, endPtrPtr)
* endPtrPtr. If TCL_ERROR is returned, then the interpreter's result
* contains an error message.
*
- * envPtr->maxStackDepth is updated with the maximum number of stack
- * elements needed to execute the function.
- *
* Side effects:
* Adds instructions to envPtr to evaluate the math function at
* runtime.
@@ -936,14 +898,13 @@ CompileMathFuncCall(exprTokenPtr, funcName, infoPtr, envPtr, endPtrPtr)
MathFunc *mathFuncPtr;
Tcl_HashEntry *hPtr;
Tcl_Token *tokenPtr, *afterSubexprPtr;
- int maxDepth, code, i;
+ int code, i;
/*
* Look up the MathFunc record for the function.
*/
code = TCL_OK;
- maxDepth = 0;
hPtr = Tcl_FindHashEntry(&iPtr->mathFuncTable, funcName);
if (hPtr == NULL) {
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
@@ -960,7 +921,6 @@ CompileMathFuncCall(exprTokenPtr, funcName, infoPtr, envPtr, endPtrPtr)
if (mathFuncPtr->builtinFuncIndex < 0) {
TclEmitPush(TclRegisterLiteral(envPtr, funcName, -1, /*onHeap*/ 0),
envPtr);
- maxDepth = 1;
}
/*
@@ -984,7 +944,6 @@ CompileMathFuncCall(exprTokenPtr, funcName, infoPtr, envPtr, endPtrPtr)
goto done;
}
tokenPtr += (tokenPtr->numComponents + 1);
- maxDepth++;
}
if (tokenPtr != afterSubexprPtr) {
Tcl_ResetResult(interp);
@@ -1016,7 +975,6 @@ CompileMathFuncCall(exprTokenPtr, funcName, infoPtr, envPtr, endPtrPtr)
*endPtrPtr = afterSubexprPtr;
done:
- envPtr->maxStackDepth = maxDepth;
return code;
}
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index c5f9767..0d223d7 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -11,7 +11,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclCompile.c,v 1.28 2001/11/21 02:36:20 hobbs Exp $
+ * RCS: @(#) $Id: tclCompile.c,v 1.29 2001/12/10 15:44:34 msofer Exp $
*/
#include "tclInt.h"
@@ -53,218 +53,218 @@ static int traceInitialized = 0;
*/
InstructionDesc instructionTable[] = {
- /* Name Bytes #Opnds Operand types Stack top, next */
- {"done", 1, 0, {OPERAND_NONE}},
+ /* Name Bytes stackEffect #Opnds Operand types Stack top, next */
+ {"done", 1, -1, 0, {OPERAND_NONE}},
/* Finish ByteCode execution and return stktop (top stack item) */
- {"push1", 2, 1, {OPERAND_UINT1}},
+ {"push1", 2, +1, 1, {OPERAND_UINT1}},
/* Push object at ByteCode objArray[op1] */
- {"push4", 5, 1, {OPERAND_UINT4}},
+ {"push4", 5, +1, 1, {OPERAND_UINT4}},
/* Push object at ByteCode objArray[op4] */
- {"pop", 1, 0, {OPERAND_NONE}},
+ {"pop", 1, -1, 0, {OPERAND_NONE}},
/* Pop the topmost stack object */
- {"dup", 1, 0, {OPERAND_NONE}},
+ {"dup", 1, +1, 0, {OPERAND_NONE}},
/* Duplicate the topmost stack object and push the result */
- {"concat1", 2, 1, {OPERAND_UINT1}},
+ {"concat1", 2, INT_MIN, 1, {OPERAND_UINT1}},
/* Concatenate the top op1 items and push result */
- {"invokeStk1", 2, 1, {OPERAND_UINT1}},
+ {"invokeStk1", 2, INT_MIN, 1, {OPERAND_UINT1}},
/* Invoke command named objv[0]; <objc,objv> = <op1,top op1> */
- {"invokeStk4", 5, 1, {OPERAND_UINT4}},
+ {"invokeStk4", 5, INT_MIN, 1, {OPERAND_UINT4}},
/* Invoke command named objv[0]; <objc,objv> = <op4,top op4> */
- {"evalStk", 1, 0, {OPERAND_NONE}},
+ {"evalStk", 1, 0, 0, {OPERAND_NONE}},
/* Evaluate command in stktop using Tcl_EvalObj. */
- {"exprStk", 1, 0, {OPERAND_NONE}},
+ {"exprStk", 1, 0, 0, {OPERAND_NONE}},
/* Execute expression in stktop using Tcl_ExprStringObj. */
- {"loadScalar1", 2, 1, {OPERAND_UINT1}},
+ {"loadScalar1", 2, 1, 1, {OPERAND_UINT1}},
/* Load scalar variable at index op1 <= 255 in call frame */
- {"loadScalar4", 5, 1, {OPERAND_UINT4}},
+ {"loadScalar4", 5, 1, 1, {OPERAND_UINT4}},
/* Load scalar variable at index op1 >= 256 in call frame */
- {"loadScalarStk", 1, 0, {OPERAND_NONE}},
+ {"loadScalarStk", 1, 0, 0, {OPERAND_NONE}},
/* Load scalar variable; scalar's name is stktop */
- {"loadArray1", 2, 1, {OPERAND_UINT1}},
+ {"loadArray1", 2, 0, 1, {OPERAND_UINT1}},
/* Load array element; array at slot op1<=255, element is stktop */
- {"loadArray4", 5, 1, {OPERAND_UINT4}},
+ {"loadArray4", 5, 0, 1, {OPERAND_UINT4}},
/* Load array element; array at slot op1 > 255, element is stktop */
- {"loadArrayStk", 1, 0, {OPERAND_NONE}},
+ {"loadArrayStk", 1, -1, 0, {OPERAND_NONE}},
/* Load array element; element is stktop, array name is stknext */
- {"loadStk", 1, 0, {OPERAND_NONE}},
+ {"loadStk", 1, 0, 0, {OPERAND_NONE}},
/* Load general variable; unparsed variable name is stktop */
- {"storeScalar1", 2, 1, {OPERAND_UINT1}},
+ {"storeScalar1", 2, 0, 1, {OPERAND_UINT1}},
/* Store scalar variable at op1<=255 in frame; value is stktop */
- {"storeScalar4", 5, 1, {OPERAND_UINT4}},
+ {"storeScalar4", 5, 0, 1, {OPERAND_UINT4}},
/* Store scalar variable at op1 > 255 in frame; value is stktop */
- {"storeScalarStk", 1, 0, {OPERAND_NONE}},
+ {"storeScalarStk", 1, -1, 0, {OPERAND_NONE}},
/* Store scalar; value is stktop, scalar name is stknext */
- {"storeArray1", 2, 1, {OPERAND_UINT1}},
+ {"storeArray1", 2, -1, 1, {OPERAND_UINT1}},
/* Store array element; array at op1<=255, value is top then elem */
- {"storeArray4", 5, 1, {OPERAND_UINT4}},
+ {"storeArray4", 5, -1, 1, {OPERAND_UINT4}},
/* Store array element; array at op1>=256, value is top then elem */
- {"storeArrayStk", 1, 0, {OPERAND_NONE}},
+ {"storeArrayStk", 1, -2, 0, {OPERAND_NONE}},
/* Store array element; value is stktop, then elem, array names */
- {"storeStk", 1, 0, {OPERAND_NONE}},
+ {"storeStk", 1, -1, 0, {OPERAND_NONE}},
/* Store general variable; value is stktop, then unparsed name */
- {"incrScalar1", 2, 1, {OPERAND_UINT1}},
+ {"incrScalar1", 2, 0, 1, {OPERAND_UINT1}},
/* Incr scalar at index op1<=255 in frame; incr amount is stktop */
- {"incrScalarStk", 1, 0, {OPERAND_NONE}},
+ {"incrScalarStk", 1, -1, 0, {OPERAND_NONE}},
/* Incr scalar; incr amount is stktop, scalar's name is stknext */
- {"incrArray1", 2, 1, {OPERAND_UINT1}},
+ {"incrArray1", 2, -1, 1, {OPERAND_UINT1}},
/* Incr array elem; arr at slot op1<=255, amount is top then elem */
- {"incrArrayStk", 1, 0, {OPERAND_NONE}},
+ {"incrArrayStk", 1, -2, 0, {OPERAND_NONE}},
/* Incr array element; amount is top then elem then array names */
- {"incrStk", 1, 0, {OPERAND_NONE}},
+ {"incrStk", 1, -1, 0, {OPERAND_NONE}},
/* Incr general variable; amount is stktop then unparsed var name */
- {"incrScalar1Imm", 3, 2, {OPERAND_UINT1, OPERAND_INT1}},
+ {"incrScalar1Imm", 3, +1, 2, {OPERAND_UINT1, OPERAND_INT1}},
/* Incr scalar at slot op1 <= 255; amount is 2nd operand byte */
- {"incrScalarStkImm", 2, 1, {OPERAND_INT1}},
+ {"incrScalarStkImm", 2, 0, 1, {OPERAND_INT1}},
/* Incr scalar; scalar name is stktop; incr amount is op1 */
- {"incrArray1Imm", 3, 2, {OPERAND_UINT1, OPERAND_INT1}},
+ {"incrArray1Imm", 3, 0, 2, {OPERAND_UINT1, OPERAND_INT1}},
/* Incr array elem; array at slot op1 <= 255, elem is stktop,
* amount is 2nd operand byte */
- {"incrArrayStkImm", 2, 1, {OPERAND_INT1}},
+ {"incrArrayStkImm", 2, -1, 1, {OPERAND_INT1}},
/* Incr array element; elem is top then array name, amount is op1 */
- {"incrStkImm", 2, 1, {OPERAND_INT1}},
+ {"incrStkImm", 2, 0, 1, {OPERAND_INT1}},
/* Incr general variable; unparsed name is top, amount is op1 */
- {"jump1", 2, 1, {OPERAND_INT1}},
+ {"jump1", 2, 0, 1, {OPERAND_INT1}},
/* Jump relative to (pc + op1) */
- {"jump4", 5, 1, {OPERAND_INT4}},
+ {"jump4", 5, 0, 1, {OPERAND_INT4}},
/* Jump relative to (pc + op4) */
- {"jumpTrue1", 2, 1, {OPERAND_INT1}},
+ {"jumpTrue1", 2, -1, 1, {OPERAND_INT1}},
/* Jump relative to (pc + op1) if stktop expr object is true */
- {"jumpTrue4", 5, 1, {OPERAND_INT4}},
+ {"jumpTrue4", 5, -1, 1, {OPERAND_INT4}},
/* Jump relative to (pc + op4) if stktop expr object is true */
- {"jumpFalse1", 2, 1, {OPERAND_INT1}},
+ {"jumpFalse1", 2, -1, 1, {OPERAND_INT1}},
/* Jump relative to (pc + op1) if stktop expr object is false */
- {"jumpFalse4", 5, 1, {OPERAND_INT4}},
+ {"jumpFalse4", 5, -1, 1, {OPERAND_INT4}},
/* Jump relative to (pc + op4) if stktop expr object is false */
- {"lor", 1, 0, {OPERAND_NONE}},
+ {"lor", 1, -1, 0, {OPERAND_NONE}},
/* Logical or: push (stknext || stktop) */
- {"land", 1, 0, {OPERAND_NONE}},
+ {"land", 1, -1, 0, {OPERAND_NONE}},
/* Logical and: push (stknext && stktop) */
- {"bitor", 1, 0, {OPERAND_NONE}},
+ {"bitor", 1, -1, 0, {OPERAND_NONE}},
/* Bitwise or: push (stknext | stktop) */
- {"bitxor", 1, 0, {OPERAND_NONE}},
+ {"bitxor", 1, -1, 0, {OPERAND_NONE}},
/* Bitwise xor push (stknext ^ stktop) */
- {"bitand", 1, 0, {OPERAND_NONE}},
+ {"bitand", 1, -1, 0, {OPERAND_NONE}},
/* Bitwise and: push (stknext & stktop) */
- {"eq", 1, 0, {OPERAND_NONE}},
+ {"eq", 1, -1, 0, {OPERAND_NONE}},
/* Equal: push (stknext == stktop) */
- {"neq", 1, 0, {OPERAND_NONE}},
+ {"neq", 1, -1, 0, {OPERAND_NONE}},
/* Not equal: push (stknext != stktop) */
- {"lt", 1, 0, {OPERAND_NONE}},
+ {"lt", 1, -1, 0, {OPERAND_NONE}},
/* Less: push (stknext < stktop) */
- {"gt", 1, 0, {OPERAND_NONE}},
+ {"gt", 1, -1, 0, {OPERAND_NONE}},
/* Greater: push (stknext || stktop) */
- {"le", 1, 0, {OPERAND_NONE}},
+ {"le", 1, -1, 0, {OPERAND_NONE}},
/* Logical or: push (stknext || stktop) */
- {"ge", 1, 0, {OPERAND_NONE}},
+ {"ge", 1, -1, 0, {OPERAND_NONE}},
/* Logical or: push (stknext || stktop) */
- {"lshift", 1, 0, {OPERAND_NONE}},
+ {"lshift", 1, -1, 0, {OPERAND_NONE}},
/* Left shift: push (stknext << stktop) */
- {"rshift", 1, 0, {OPERAND_NONE}},
+ {"rshift", 1, -1, 0, {OPERAND_NONE}},
/* Right shift: push (stknext >> stktop) */
- {"add", 1, 0, {OPERAND_NONE}},
+ {"add", 1, -1, 0, {OPERAND_NONE}},
/* Add: push (stknext + stktop) */
- {"sub", 1, 0, {OPERAND_NONE}},
+ {"sub", 1, -1, 0, {OPERAND_NONE}},
/* Sub: push (stkext - stktop) */
- {"mult", 1, 0, {OPERAND_NONE}},
+ {"mult", 1, -1, 0, {OPERAND_NONE}},
/* Multiply: push (stknext * stktop) */
- {"div", 1, 0, {OPERAND_NONE}},
+ {"div", 1, -1, 0, {OPERAND_NONE}},
/* Divide: push (stknext / stktop) */
- {"mod", 1, 0, {OPERAND_NONE}},
+ {"mod", 1, -1, 0, {OPERAND_NONE}},
/* Mod: push (stknext % stktop) */
- {"uplus", 1, 0, {OPERAND_NONE}},
+ {"uplus", 1, 0, 0, {OPERAND_NONE}},
/* Unary plus: push +stktop */
- {"uminus", 1, 0, {OPERAND_NONE}},
+ {"uminus", 1, 0, 0, {OPERAND_NONE}},
/* Unary minus: push -stktop */
- {"bitnot", 1, 0, {OPERAND_NONE}},
+ {"bitnot", 1, 0, 0, {OPERAND_NONE}},
/* Bitwise not: push ~stktop */
- {"not", 1, 0, {OPERAND_NONE}},
+ {"not", 1, 0, 0, {OPERAND_NONE}},
/* Logical not: push !stktop */
- {"callBuiltinFunc1", 2, 1, {OPERAND_UINT1}},
+ {"callBuiltinFunc1", 2, 1, 1, {OPERAND_UINT1}},
/* Call builtin math function with index op1; any args are on stk */
- {"callFunc1", 2, 1, {OPERAND_UINT1}},
+ {"callFunc1", 2, INT_MIN, 1, {OPERAND_UINT1}},
/* Call non-builtin func objv[0]; <objc,objv>=<op1,top op1> */
- {"tryCvtToNumeric", 1, 0, {OPERAND_NONE}},
+ {"tryCvtToNumeric", 1, 0, 0, {OPERAND_NONE}},
/* Try converting stktop to first int then double if possible. */
- {"break", 1, 0, {OPERAND_NONE}},
+ {"break", 1, 0, 0, {OPERAND_NONE}},
/* Abort closest enclosing loop; if none, return TCL_BREAK code. */
- {"continue", 1, 0, {OPERAND_NONE}},
+ {"continue", 1, 0, 0, {OPERAND_NONE}},
/* Skip to next iteration of closest enclosing loop; if none,
* return TCL_CONTINUE code. */
- {"foreach_start4", 5, 1, {OPERAND_UINT4}},
+ {"foreach_start4", 5, 0, 1, {OPERAND_UINT4}},
/* Initialize execution of a foreach loop. Operand is aux data index
* of the ForeachInfo structure for the foreach command. */
- {"foreach_step4", 5, 1, {OPERAND_UINT4}},
+ {"foreach_step4", 5, +1, 1, {OPERAND_UINT4}},
/* "Step" or begin next iteration of foreach loop. Push 0 if to
* terminate loop, else push 1. */
- {"beginCatch4", 5, 1, {OPERAND_UINT4}},
+ {"beginCatch4", 5, 0, 1, {OPERAND_UINT4}},
/* Record start of catch with the operand's exception index.
* Push the current stack depth onto a special catch stack. */
- {"endCatch", 1, 0, {OPERAND_NONE}},
+ {"endCatch", 1, 0, 0, {OPERAND_NONE}},
/* End of last catch. Pop the bytecode interpreter's catch stack. */
- {"pushResult", 1, 0, {OPERAND_NONE}},
+ {"pushResult", 1, +1, 0, {OPERAND_NONE}},
/* Push the interpreter's object result onto the stack. */
- {"pushReturnCode", 1, 0, {OPERAND_NONE}},
+ {"pushReturnCode", 1, +1, 0, {OPERAND_NONE}},
/* Push interpreter's return code (e.g. TCL_OK or TCL_ERROR) as
* a new object onto the stack. */
- {"streq", 1, 0, {OPERAND_NONE}},
+ {"streq", 1, -1, 0, {OPERAND_NONE}},
/* Str Equal: push (stknext eq stktop) */
- {"strneq", 1, 0, {OPERAND_NONE}},
+ {"strneq", 1, -1, 0, {OPERAND_NONE}},
/* Str !Equal: push (stknext neq stktop) */
- {"strcmp", 1, 0, {OPERAND_NONE}},
+ {"strcmp", 1, -1, 0, {OPERAND_NONE}},
/* Str Compare: push (stknext cmp stktop) */
- {"strlen", 1, 0, {OPERAND_NONE}},
+ {"strlen", 1, 0, 0, {OPERAND_NONE}},
/* Str Length: push (strlen stktop) */
- {"strindex", 1, 0, {OPERAND_NONE}},
+ {"strindex", 1, -1, 0, {OPERAND_NONE}},
/* Str Index: push (strindex stknext stktop) */
- {"strmatch", 2, 1, {OPERAND_INT1}},
+ {"strmatch", 2, -1, 1, {OPERAND_INT1}},
/* Str Match: push (strmatch stknext stktop) opnd == nocase */
- {"list", 5, 1, {OPERAND_UINT4}},
+ {"list", 5, INT_MIN, 1, {OPERAND_UINT4}},
/* List: push (stk1 stk2 ... stktop) */
- {"listindex", 1, 0, {OPERAND_NONE}},
+ {"listindex", 1, -1, 0, {OPERAND_NONE}},
/* List Index: push (listindex stknext stktop) */
- {"listlength", 1, 0, {OPERAND_NONE}},
+ {"listlength", 1, 0, 0, {OPERAND_NONE}},
/* List Len: push (listlength stktop) */
- {"appendScalar1", 2, 1, {OPERAND_UINT1}},
+ {"appendScalar1", 2, 0, 1, {OPERAND_UINT1}},
/* Append scalar variable at op1<=255 in frame; value is stktop */
- {"appendScalar4", 5, 1, {OPERAND_UINT4}},
+ {"appendScalar4", 5, 0, 1, {OPERAND_UINT4}},
/* Append scalar variable at op1 > 255 in frame; value is stktop */
- {"appendArray1", 2, 1, {OPERAND_UINT1}},
+ {"appendArray1", 2, -1, 1, {OPERAND_UINT1}},
/* Append array element; array at op1<=255, value is top then elem */
- {"appendArray4", 5, 1, {OPERAND_UINT4}},
+ {"appendArray4", 5, -1, 1, {OPERAND_UINT4}},
/* Append array element; array at op1>=256, value is top then elem */
- {"appendArrayStk", 1, 0, {OPERAND_NONE}},
+ {"appendArrayStk", 1, -2, 0, {OPERAND_NONE}},
/* Append array element; value is stktop, then elem, array names */
- {"appendStk", 1, 0, {OPERAND_NONE}},
+ {"appendStk", 1, -1, 0, {OPERAND_NONE}},
/* Append general variable; value is stktop, then unparsed name */
- {"lappendScalar1", 2, 1, {OPERAND_UINT1}},
+ {"lappendScalar1", 2, 0, 1, {OPERAND_UINT1}},
/* Lappend scalar variable at op1<=255 in frame; value is stktop */
- {"lappendScalar4", 5, 1, {OPERAND_UINT4}},
+ {"lappendScalar4", 5, 0, 1, {OPERAND_UINT4}},
/* Lappend scalar variable at op1 > 255 in frame; value is stktop */
- {"lappendArray1", 2, 1, {OPERAND_UINT1}},
+ {"lappendArray1", 2, -1, 1, {OPERAND_UINT1}},
/* Lappend array element; array at op1<=255, value is top then elem */
- {"lappendArray4", 5, 1, {OPERAND_UINT4}},
+ {"lappendArray4", 5, -1, 1, {OPERAND_UINT4}},
/* Lappend array element; array at op1>=256, value is top then elem */
- {"lappendArrayStk", 1, 0, {OPERAND_NONE}},
+ {"lappendArrayStk", 1, -2, 0, {OPERAND_NONE}},
/* Lappend array element; value is stktop, then elem, array names */
- {"lappendStk", 1, 0, {OPERAND_NONE}},
+ {"lappendStk", 1, -1, 0, {OPERAND_NONE}},
/* Lappend general variable; value is stktop, then unparsed name */
- {"lindexMulti", 5, 1, {OPERAND_UINT4}},
+ {"lindexMulti", 5, INT_MIN, 1, {OPERAND_UINT4}},
/* Lindex with generalized args, operand is number of indices.
* (operand) entries from stktop are the indices; then list to
* process. */
- {"over", 5, 1, {OPERAND_UINT4}},
+ {"over", 5, +1, 1, {OPERAND_UINT4}},
/* Duplicate the arg-th element from top of stack (TOS=0) */
- {"lsetList", 1, 0, {OPERAND_NONE}},
+ {"lsetList", 1, -2, 0, {OPERAND_NONE}},
/* Four-arg version of 'lset'. stktop is old value; next is
* new element value, next is the index list; pushes new value */
- {"lsetFlat", 5, 1, {OPERAND_UINT4}},
+ {"lsetFlat", 5, INT_MIN, 1, {OPERAND_UINT4}},
/* Three- or >=5-arg version of 'lset'. stktop is old value,
* next is new element value; next come objc-2 indices; pushes
* the new value.
@@ -702,6 +702,7 @@ TclInitCompileEnv(interp, envPtr, string, numBytes)
envPtr->exceptDepth = 0;
envPtr->maxExceptDepth = 0;
envPtr->maxStackDepth = 0;
+ envPtr->currStackDepth = 0;
TclInitLiteralTable(&(envPtr->localLitTable));
envPtr->exprIsJustVarRef = 0;
envPtr->exprIsComparison = 0;
@@ -789,8 +790,6 @@ TclFreeCompileEnv(envPtr)
* interp->termOffset is set to the offset of the character in the
* script just after the last one successfully processed; this will be
* the offset of the ']' if (flags & TCL_BRACKET_TERM).
- * envPtr->maxStackDepth is set to the maximum number of stack elements
- * needed to execute the script's commands.
*
* Side effects:
* Adds instructions to envPtr to evaluate the script at runtime.
@@ -813,8 +812,6 @@ TclCompileScript(interp, script, numBytes, nested, envPtr)
{
Interp *iPtr = (Interp *) interp;
Tcl_Parse parse;
- int maxDepth = 0; /* Maximum number of stack elements needed
- * to execute all cmds. */
int lastTopLevelCmdIndex = -1;
/* Index of most recent toplevel command in
* the command location table. Initialized
@@ -955,8 +952,6 @@ TclCompileScript(interp, script, numBytes, nested, envPtr)
code = (*(cmdPtr->compileProc))(interp, &parse,
envPtr);
if (code == TCL_OK) {
- maxDepth = TclMax(envPtr->maxStackDepth,
- maxDepth);
goto finishCommand;
} else if (code == TCL_OUT_LINE_COMPILE) {
/* do nothing */
@@ -992,7 +987,6 @@ TclCompileScript(interp, script, numBytes, nested, envPtr)
/*onHeap*/ 0);
}
TclEmitPush(objIndex, envPtr);
- maxDepth = TclMax((wordIdx + 1), maxDepth);
} else {
/*
* The word is not a simple string of characters.
@@ -1003,8 +997,6 @@ TclCompileScript(interp, script, numBytes, nested, envPtr)
if (code != TCL_OK) {
goto error;
}
- maxDepth = TclMax((wordIdx + envPtr->maxStackDepth),
- maxDepth);
}
}
@@ -1060,7 +1052,6 @@ TclCompileScript(interp, script, numBytes, nested, envPtr)
if (envPtr->codeNext == entryCodeNext) {
TclEmitPush(TclRegisterLiteral(envPtr, "", 0, /*onHeap*/ 0),
envPtr);
- maxDepth = 1;
}
if ((nested != 0) && (p > script) && (p[-1] == ']')) {
@@ -1068,7 +1059,6 @@ TclCompileScript(interp, script, numBytes, nested, envPtr)
} else {
iPtr->termOffset = (p - script);
}
- envPtr->maxStackDepth = maxDepth;
Tcl_DStringFree(&ds);
return TCL_OK;
@@ -1101,7 +1091,6 @@ TclCompileScript(interp, script, numBytes, nested, envPtr)
Tcl_FreeParse(&parse);
}
iPtr->termOffset = (p - script);
- envPtr->maxStackDepth = maxDepth;
Tcl_DStringFree(&ds);
return code;
}
@@ -1120,9 +1109,6 @@ TclCompileScript(interp, script, numBytes, nested, envPtr)
* The return value is a standard Tcl result. If an error occurs, an
* error message is left in the interpreter's result.
*
- * envPtr->maxStackDepth is updated with the maximum number of stack
- * elements needed to evaluate the tokens.
- *
* Side effects:
* Instructions are added to envPtr to push and evaluate the tokens
* at runtime.
@@ -1144,11 +1130,10 @@ TclCompileTokens(interp, tokenPtr, count, envPtr)
char buffer[TCL_UTF_MAX];
char *name, *p;
int numObjsToConcat, nameBytes, hasNsQualifiers, localVar;
- int length, maxDepth, depthForVar, i, code;
+ int length, i, code;
unsigned char *entryCodeNext = envPtr->codeNext;
Tcl_DStringInit(&textBuffer);
- maxDepth = 0;
numObjsToConcat = 0;
for ( ; count > 0; count--, tokenPtr++) {
switch (tokenPtr->type) {
@@ -1176,7 +1161,6 @@ TclCompileTokens(interp, tokenPtr, count, envPtr)
Tcl_DStringLength(&textBuffer), /*onHeap*/ 0);
TclEmitPush(literal, envPtr);
numObjsToConcat++;
- maxDepth = TclMax(numObjsToConcat, maxDepth);
Tcl_DStringFree(&textBuffer);
}
@@ -1185,8 +1169,6 @@ TclCompileTokens(interp, tokenPtr, count, envPtr)
if (code != TCL_OK) {
goto error;
}
- maxDepth = TclMax((numObjsToConcat + envPtr->maxStackDepth),
- maxDepth);
numObjsToConcat++;
break;
@@ -1203,7 +1185,6 @@ TclCompileTokens(interp, tokenPtr, count, envPtr)
Tcl_DStringLength(&textBuffer), /*onHeap*/ 0);
TclEmitPush(literal, envPtr);
numObjsToConcat++;
- maxDepth = TclMax(numObjsToConcat, maxDepth);
Tcl_DStringFree(&textBuffer);
}
@@ -1227,19 +1208,16 @@ TclCompileTokens(interp, tokenPtr, count, envPtr)
* the array of local variables in a procedure frame.
*/
- depthForVar = 0;
if ((envPtr->procPtr == NULL) || hasNsQualifiers) {
localVar = -1;
TclEmitPush(TclRegisterLiteral(envPtr, name, nameBytes,
/*onHeap*/ 0), envPtr);
- depthForVar = 1;
} else {
localVar = TclFindCompiledLocal(name, nameBytes,
/*create*/ 0, /*flags*/ 0, envPtr->procPtr);
if (localVar < 0) {
TclEmitPush(TclRegisterLiteral(envPtr, name,
nameBytes, /*onHeap*/ 0), envPtr);
- depthForVar = 1;
}
}
@@ -1267,7 +1245,6 @@ TclCompileTokens(interp, tokenPtr, count, envPtr)
Tcl_AddObjErrorInfo(interp, buffer, -1);
goto error;
}
- depthForVar += envPtr->maxStackDepth;
if (localVar < 0) {
TclEmitOpcode(INST_LOAD_ARRAY_STK, envPtr);
} else if (localVar <= 255) {
@@ -1278,7 +1255,6 @@ TclCompileTokens(interp, tokenPtr, count, envPtr)
envPtr);
}
}
- maxDepth = TclMax(numObjsToConcat + depthForVar, maxDepth);
numObjsToConcat++;
count -= tokenPtr->numComponents;
tokenPtr += tokenPtr->numComponents;
@@ -1300,7 +1276,6 @@ TclCompileTokens(interp, tokenPtr, count, envPtr)
Tcl_DStringLength(&textBuffer), /*onHeap*/ 0);
TclEmitPush(literal, envPtr);
numObjsToConcat++;
- maxDepth = TclMax(numObjsToConcat, maxDepth);
}
/*
@@ -1322,15 +1297,12 @@ TclCompileTokens(interp, tokenPtr, count, envPtr)
if (envPtr->codeNext == entryCodeNext) {
TclEmitPush(TclRegisterLiteral(envPtr, "", 0, /*onHeap*/ 0),
envPtr);
- maxDepth = 1;
}
Tcl_DStringFree(&textBuffer);
- envPtr->maxStackDepth = maxDepth;
return TCL_OK;
error:
Tcl_DStringFree(&textBuffer);
- envPtr->maxStackDepth = maxDepth;
return code;
}
@@ -1349,9 +1321,6 @@ TclCompileTokens(interp, tokenPtr, count, envPtr)
* The return value is a standard Tcl result. If an error occurs, an
* error message is left in the interpreter's result.
*
- * envPtr->maxStackDepth is updated with the maximum number of stack
- * elements needed to execute the tokens.
- *
* Side effects:
* Instructions are added to envPtr to execute the tokens at runtime.
*
@@ -1374,7 +1343,6 @@ TclCompileCmdWord(interp, tokenPtr, count, envPtr)
* into an inline sequence of instructions.
*/
- envPtr->maxStackDepth = 0;
if ((count == 1) && (tokenPtr->type == TCL_TOKEN_TEXT)) {
code = TclCompileScript(interp, tokenPtr->start, tokenPtr->size,
/*nested*/ 0, envPtr);
@@ -1410,9 +1378,6 @@ TclCompileCmdWord(interp, tokenPtr, count, envPtr)
* The return value is a standard Tcl result. If an error occurs, an
* error message is left in the interpreter's result.
*
- * envPtr->maxStackDepth is updated with the maximum number of stack
- * elements needed to execute the expression.
- *
* Side effects:
* Instructions are added to envPtr to execute the expression.
*
@@ -1431,13 +1396,11 @@ TclCompileExprWords(interp, tokenPtr, numWords, envPtr)
CompileEnv *envPtr; /* Holds the resulting instructions. */
{
Tcl_Token *wordPtr;
- int maxDepth, range, numBytes, i, code;
+ int range, numBytes, i, code;
char *script;
int saveExprIsJustVarRef = envPtr->exprIsJustVarRef;
int saveExprIsComparison = envPtr->exprIsComparison;
- envPtr->maxStackDepth = 0;
- maxDepth = 0;
range = -1;
code = TCL_OK;
@@ -1473,9 +1436,6 @@ TclCompileExprWords(interp, tokenPtr, numWords, envPtr)
if (i < (numWords - 1)) {
TclEmitPush(TclRegisterLiteral(envPtr, " ", 1, /*onHeap*/ 0),
envPtr);
- maxDepth = TclMax((envPtr->maxStackDepth + 1), maxDepth);
- } else {
- maxDepth = TclMax(envPtr->maxStackDepth, maxDepth);
}
wordPtr += (wordPtr->numComponents + 1);
}
@@ -1493,7 +1453,6 @@ TclCompileExprWords(interp, tokenPtr, numWords, envPtr)
envPtr->exprIsJustVarRef = saveExprIsJustVarRef;
envPtr->exprIsComparison = saveExprIsComparison;
- envPtr->maxStackDepth = maxDepth;
return code;
}
@@ -1585,7 +1544,7 @@ TclInitByteCodeObj(objPtr, envPtr)
codePtr->numCmdLocBytes = cmdLocBytes;
codePtr->maxExceptDepth = envPtr->maxExceptDepth;
codePtr->maxStackDepth = envPtr->maxStackDepth;
-
+
p += sizeof(ByteCode);
codePtr->codeStart = p;
memcpy((VOID *) p, (VOID *) envPtr->codeStart, (size_t) codeBytes);
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index 533f521..f2e478e 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -8,7 +8,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclCompile.h,v 1.22 2001/11/20 22:47:58 msofer Exp $
+ * RCS: @(#) $Id: tclCompile.h,v 1.23 2001/12/10 15:44:34 msofer Exp $
*/
#ifndef _TCLCOMPILATION
@@ -217,6 +217,7 @@ typedef struct CompileEnv {
int maxStackDepth; /* Maximum number of stack elements needed
* to execute the code. Set by compilation
* procedures before returning. */
+ int currStackDepth; /* Current stack depth. */
LiteralTable localLitTable; /* Contains LiteralEntry's describing
* all Tcl objects referenced by this
* compiled code. Indexed by the string
@@ -564,6 +565,12 @@ typedef enum InstOperandType {
typedef struct InstructionDesc {
char *name; /* Name of instruction. */
int numBytes; /* Total number of bytes for instruction. */
+ int stackEffect; /* The worst-case balance stack effect of the
+ * instruction, used for stack requirements
+ * computations. The value INT_MIN signals
+ * that the instruction's worst case effect
+ * is (1-opnd1).
+ */
int numOperands; /* Number of operands. */
InstOperandType opTypes[MAX_INSTRUCTION_OPERANDS];
/* The type of each operand. */
@@ -838,6 +845,31 @@ EXTERN void TclVerifyLocalLiteralTable _ANSI_ARGS_((
*/
/*
+ * Macro used to update the stack requirements.
+ * It is called by the macros TclEmitOpCode, TclEmitInst1 and
+ * TclEmitInst4.
+ * Remark that the very last instruction of a bytecode always
+ * reduces the stack level: INST_DONE or INST_POP, so that the
+ * maxStackdepth is always updated.
+ */
+
+#define TclUpdateStackReqs(op, i, envPtr) \
+ {\
+ int delta = instructionTable[(op)].stackEffect;\
+ if (delta) {\
+ if (delta < 0) {\
+ if((envPtr)->maxStackDepth < (envPtr)->currStackDepth) {\
+ (envPtr)->maxStackDepth = (envPtr)->currStackDepth;\
+ }\
+ if (delta == INT_MIN) {\
+ delta = 1 - (i);\
+ }\
+ }\
+ (envPtr)->currStackDepth += delta;\
+ }\
+ }
+
+/*
* Macro to emit an opcode byte into a CompileEnv's code array.
* The ANSI C "prototype" for this macro is:
*
@@ -848,7 +880,8 @@ EXTERN void TclVerifyLocalLiteralTable _ANSI_ARGS_((
#define TclEmitOpcode(op, envPtr) \
if ((envPtr)->codeNext == (envPtr)->codeEnd) \
TclExpandCodeArray(envPtr); \
- *(envPtr)->codeNext++ = (unsigned char) (op)
+ *(envPtr)->codeNext++ = (unsigned char) (op);\
+ TclUpdateStackReqs(op, 0, envPtr)
/*
* Macro to emit an integer operand.
@@ -874,12 +907,14 @@ EXTERN void TclVerifyLocalLiteralTable _ANSI_ARGS_((
* CompileEnv *envPtr));
*/
+
#define TclEmitInstInt1(op, i, envPtr) \
if (((envPtr)->codeNext + 2) > (envPtr)->codeEnd) { \
TclExpandCodeArray(envPtr); \
} \
*(envPtr)->codeNext++ = (unsigned char) (op); \
- *(envPtr)->codeNext++ = (unsigned char) ((unsigned int) (i))
+ *(envPtr)->codeNext++ = (unsigned char) ((unsigned int) (i));\
+ TclUpdateStackReqs(op, i, envPtr)
#define TclEmitInstInt4(op, i, envPtr) \
if (((envPtr)->codeNext + 5) > (envPtr)->codeEnd) { \
@@ -893,7 +928,8 @@ EXTERN void TclVerifyLocalLiteralTable _ANSI_ARGS_((
*(envPtr)->codeNext++ = \
(unsigned char) ((unsigned int) (i) >> 8); \
*(envPtr)->codeNext++ = \
- (unsigned char) ((unsigned int) (i) )
+ (unsigned char) ((unsigned int) (i) );\
+ TclUpdateStackReqs(op, i, envPtr)
/*
* Macro to push a Tcl object onto the Tcl evaluation stack. It emits the
@@ -1006,3 +1042,8 @@ EXTERN void TclVerifyLocalLiteralTable _ANSI_ARGS_((
# define TCL_STORAGE_CLASS DLLIMPORT
#endif /* _TCLCOMPILATION */
+
+
+
+
+
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index fa05bab..b99a594 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -11,7 +11,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclExecute.c,v 1.42 2001/11/20 22:47:58 msofer Exp $
+ * RCS: @(#) $Id: tclExecute.c,v 1.43 2001/12/10 15:44:34 msofer Exp $
*/
#include "tclInt.h"
@@ -268,8 +268,7 @@ static void RecordTracebackInfo _ANSI_ARGS_((
static char * StringForResultCode _ANSI_ARGS_((int result));
static void ValidatePcAndStackTop _ANSI_ARGS_((
ByteCode *codePtr, unsigned char *pc,
- int stackTop, int stackLowerBound,
- int stackUpperBound));
+ int stackTop, int stackLowerBound));
#endif
static int VerifyExprObjType _ANSI_ARGS_((Tcl_Interp *interp,
Tcl_Obj *objPtr));
@@ -1049,8 +1048,7 @@ TclExecuteByteCode(interp, codePtr)
for (;;) {
#ifdef TCL_COMPILE_DEBUG
- ValidatePcAndStackTop(codePtr, pc, stackTop, initStackTop,
- eePtr->stackEnd);
+ ValidatePcAndStackTop(codePtr, pc, stackTop, initStackTop);
if (traceInstructions) {
fprintf(stdout, "%2d: %2d ", iPtr->numLevels, stackTop);
TclPrintInstruction(codePtr, pc);
@@ -4090,8 +4088,7 @@ PrintByteCodeInfo(codePtr)
#ifdef TCL_COMPILE_DEBUG
static void
-ValidatePcAndStackTop(codePtr, pc, stackTop, stackLowerBound,
- stackUpperBound)
+ValidatePcAndStackTop(codePtr, pc, stackTop, stackLowerBound)
register ByteCode *codePtr; /* The bytecode whose summary is printed
* to stdout. */
unsigned char *pc; /* Points to first byte of a bytecode
@@ -4100,8 +4097,9 @@ ValidatePcAndStackTop(codePtr, pc, stackTop, stackLowerBound,
* stackLowerBound and stackUpperBound
* (inclusive). */
int stackLowerBound; /* Smallest legal value for stackTop. */
- int stackUpperBound; /* Greatest legal value for stackTop. */
{
+ int stackUpperBound = stackLowerBound + codePtr->maxStackDepth;
+ /* Greatest legal value for stackTop. */
unsigned int relativePc = (unsigned int) (pc - codePtr->codeStart);
unsigned int codeStart = (unsigned int) codePtr->codeStart;
unsigned int codeEnd = (unsigned int)
@@ -4116,15 +4114,15 @@ ValidatePcAndStackTop(codePtr, pc, stackTop, stackLowerBound,
if ((unsigned int) opCode > LAST_INST_OPCODE) {
fprintf(stderr, "\nBad opcode %d at pc %u in TclExecuteByteCode\n",
(unsigned int) opCode, relativePc);
- panic("TclExecuteByteCode execution failure: bad opcode");
+ panic("TclExecuteByteCode execution failure: bad opcode");
}
if ((stackTop < stackLowerBound) || (stackTop > stackUpperBound)) {
int numChars;
char *cmd = GetSrcInfoForPc(pc, codePtr, &numChars);
char *ellipsis = "";
- fprintf(stderr, "\nBad stack top %d at pc %u in TclExecuteByteCode",
- stackTop, relativePc);
+ fprintf(stderr, "\nBad stack top %d at pc %u in TclExecuteByteCode (min %i, max %i)",
+ stackTop, relativePc, stackLowerBound, stackUpperBound);
if (cmd != NULL) {
if (numChars > 100) {
numChars = 100;
diff --git a/generic/tclProc.c b/generic/tclProc.c
index 21cba70..f73f8a7 100644
--- a/generic/tclProc.c
+++ b/generic/tclProc.c
@@ -10,7 +10,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclProc.c,v 1.34 2001/11/27 13:47:29 dkf Exp $
+ * RCS: @(#) $Id: tclProc.c,v 1.35 2001/12/10 15:44:34 msofer Exp $
*/
#include "tclInt.h"
@@ -1656,9 +1656,6 @@ ProcBodyUpdateString(objPtr)
* Results:
* The return value is TCL_OK, indicating successful compilation.
*
- * envPtr->maxStackDepth is updated with the maximum number of stack
- * elements needed to execute the command.
- *
* Side effects:
* Instructions are added to envPtr to execute a noOp at runtime.
*
@@ -1674,11 +1671,13 @@ TclCompileNoOp(interp, parsePtr, envPtr)
{
Tcl_Token *tokenPtr;
int i, code;
+ int savedStackDepth = envPtr->currStackDepth;
- envPtr->maxStackDepth = 1;
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) {
code = TclCompileTokens(interp, tokenPtr+1,
tokenPtr->numComponents, envPtr);
@@ -1688,6 +1687,7 @@ TclCompileNoOp(interp, parsePtr, envPtr)
TclEmitOpcode(INST_POP, envPtr);
}
}
+ envPtr->currStackDepth = savedStackDepth;
TclEmitPush(TclRegisterLiteral(envPtr, "", 0, /*onHeap*/ 0), envPtr);
return TCL_OK;
}
generated by cgit v0.12 at 2024-07-21 03:46:34 (GMT)