summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorMiguel Sofer <miguel.sofer@gmail.com>2002-02-22 19:54:02 (GMT)
committerMiguel Sofer <miguel.sofer@gmail.com>2002-02-22 19:54:02 (GMT)
commit500f3725690b618dd3947378d069d463ddae2001 (patch)
treeb1f7245def953dd32520401502fbf16b8620d840
parent13515e3f357dbe28bc7a0d420aa4c89db2d23561 (diff)
downloadtcl-500f3725690b618dd3947378d069d463ddae2001.zip
tcl-500f3725690b618dd3947378d069d463ddae2001.tar.gz
tcl-500f3725690b618dd3947378d069d463ddae2001.tar.bz2
Optimising [if], [for] and [while] for constant conditions
-rw-r--r--ChangeLog7
-rw-r--r--generic/tclCompCmds.c466
2 files changed, 280 insertions, 193 deletions
diff --git a/ChangeLog b/ChangeLog
index e1cf9fa..3497e86 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,10 @@
+2002-02-22 Miguel Sofer <msofer@users.sourceforge.net>
+
+ * generic/tclCompCmds: [FR 465811]. Optimising [if], [for] and
+ [while] for constant conditions; in addition, [for] and [while]
+ are now compiled with the "loop rotation" optimisation (thanks to
+ Kevin Kenny).
+
2002-02-22 Donal K. Fellows <fellowsd@cs.man.ac.uk>
--- TIP#76 CHANGES ---
diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index 91ffe13..caed2cd 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.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: tclCompCmds.c,v 1.24 2002/02/07 01:04:00 hobbs Exp $
+ * RCS: @(#) $Id: tclCompCmds.c,v 1.25 2002/02/22 19:54:02 msofer Exp $
*/
#include "tclInt.h"
@@ -501,10 +501,9 @@ TclCompileForCmd(interp, parsePtr, envPtr)
CompileEnv *envPtr; /* Holds resulting instructions. */
{
Tcl_Token *startTokenPtr, *testTokenPtr, *nextTokenPtr, *bodyTokenPtr;
- JumpFixup jumpFalseFixup;
- int jumpBackDist, jumpBackOffset, testCodeOffset, jumpDist;
+ JumpFixup jumpEvalCondFixup;
+ int testCodeOffset, bodyCodeOffset, jumpDist;
int bodyRange, nextRange, code;
- unsigned char *jumpPc;
char buffer[32 + TCL_INTEGER_SPACE];
int savedStackDepth = envPtr->currStackDepth;
@@ -566,33 +565,31 @@ TclCompileForCmd(interp, parsePtr, envPtr)
goto done;
}
TclEmitOpcode(INST_POP, envPtr);
-
+
/*
- * Compile the test then emit the conditional jump that exits the for.
+ * Jump to the evaluation of the condition. This code uses the "loop
+ * rotation" optimisation (which eliminates one branch from the loop).
+ * "for start cond next body" produces then:
+ * start
+ * goto A
+ * B: body
+ * next
+ * A: cond -> result
+ * if (result) goto B
*/
- 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,
- "\n (\"for\" test expression)", -1);
- }
- goto done;
- }
- TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, &jumpFalseFixup);
+ TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &jumpEvalCondFixup);
/*
* Compile the loop body.
*/
- envPtr->currStackDepth = savedStackDepth;
- envPtr->exceptArrayPtr[bodyRange].codeOffset =
- (envPtr->codeNext - envPtr->codeStart);
+ bodyCodeOffset = (envPtr->codeNext - envPtr->codeStart);
+ envPtr->exceptArrayPtr[bodyRange].codeOffset = bodyCodeOffset;
+
code = TclCompileCmdWord(interp, bodyTokenPtr+1,
bodyTokenPtr->numComponents, envPtr);
+ envPtr->currStackDepth = savedStackDepth + 1;
if (code != TCL_OK) {
if (code == TCL_ERROR) {
sprintf(buffer, "\n (\"for\" body line %d)",
@@ -602,10 +599,10 @@ TclCompileForCmd(interp, parsePtr, envPtr)
goto done;
}
envPtr->exceptArrayPtr[bodyRange].numCodeBytes =
- (envPtr->codeNext - envPtr->codeStart)
- - envPtr->exceptArrayPtr[bodyRange].codeOffset;
+ (envPtr->codeNext - envPtr->codeStart) - bodyCodeOffset;
TclEmitOpcode(INST_POP, envPtr);
+
/*
* Compile the "next" subcommand.
*/
@@ -630,51 +627,34 @@ TclCompileForCmd(interp, parsePtr, envPtr)
- 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
- * if the distance to the test is > 120 bytes. This is conservative and
- * ensures that we won't have to replace this jump if we later need to
- * replace the ifFalse jump with a 4 byte jump.
- */
-
- jumpBackOffset = (envPtr->codeNext - envPtr->codeStart);
- jumpBackDist = (jumpBackOffset - testCodeOffset);
- if (jumpBackDist > 120) {
- TclEmitInstInt4(INST_JUMP4, -jumpBackDist, envPtr);
- } else {
- TclEmitInstInt1(INST_JUMP1, -jumpBackDist, envPtr);
- }
/*
- * Fix the target of the jumpFalse after the test.
+ * Compile the test expression then emit the conditional jump that
+ * terminates the for.
*/
- jumpDist = (envPtr->codeNext - envPtr->codeStart)
- - jumpFalseFixup.codeOffset;
- if (TclFixupForwardJump(envPtr, &jumpFalseFixup, jumpDist, 127)) {
- /*
- * Update the loop body and "next" command ExceptionRanges since
- * they moved down.
- */
-
- envPtr->exceptArrayPtr[bodyRange].codeOffset += 3;
- envPtr->exceptArrayPtr[bodyRange].continueOffset += 3;
- envPtr->exceptArrayPtr[nextRange].codeOffset += 3;
-
- /*
- * Update the jump back to the test at the top of the loop since it
- * also moved down 3 bytes.
- */
-
- jumpBackOffset += 3;
- jumpPc = (envPtr->codeStart + jumpBackOffset);
- jumpBackDist += 3;
- if (jumpBackDist > 120) {
- TclUpdateInstInt4AtPc(INST_JUMP4, -jumpBackDist, jumpPc);
- } else {
- TclUpdateInstInt1AtPc(INST_JUMP1, -jumpBackDist, jumpPc);
+ testCodeOffset = (envPtr->codeNext - envPtr->codeStart);
+ jumpDist = testCodeOffset - jumpEvalCondFixup.codeOffset;
+ if (TclFixupForwardJump(envPtr, &jumpEvalCondFixup, jumpDist, 127)) {
+ bodyCodeOffset += 3;
+ }
+
+ envPtr->currStackDepth = savedStackDepth;
+ code = TclCompileExprWords(interp, testTokenPtr, 1, envPtr);
+ if (code != TCL_OK) {
+ if (code == TCL_ERROR) {
+ Tcl_AddObjErrorInfo(interp,
+ "\n (\"for\" test expression)", -1);
}
+ goto done;
+ }
+ envPtr->currStackDepth = savedStackDepth + 1;
+
+ jumpDist = (envPtr->codeNext - envPtr->codeStart) - bodyCodeOffset;
+ if (jumpDist > 127) {
+ TclEmitInstInt4(INST_JUMP_TRUE4, -jumpDist, envPtr);
+ } else {
+ TclEmitInstInt1(INST_JUMP_TRUE1, -jumpDist, envPtr);
}
/*
@@ -689,6 +669,7 @@ TclCompileForCmd(interp, parsePtr, envPtr)
* The for command's result is an empty string.
*/
+ envPtr->currStackDepth = savedStackDepth;
TclEmitPush(TclRegisterLiteral(envPtr, "", 0, /*onHeap*/ 0), envPtr);
code = TCL_OK;
@@ -1167,7 +1148,8 @@ TclCompileIfCmd(interp, parsePtr, envPtr)
* body to the end of the "if" when that PC
* is determined. */
Tcl_Token *tokenPtr, *testTokenPtr;
- int jumpDist, jumpFalseDist, jumpIndex;
+ int jumpDist, jumpFalseDist;
+ int jumpIndex = 0; /* avoid compiler warning. */
int numWords, wordIdx, numBytes, j, code;
char *word;
char buffer[100];
@@ -1175,6 +1157,10 @@ TclCompileIfCmd(interp, parsePtr, envPtr)
/* 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. */
+ char *condStart, *savedPos, savedChar;
+ int realCond = 1; /* set to 0 for static conditions: "if 0 {..}" */
+ int boolVal; /* value of static condition */
+ int compileScripts = 1;
/*
* Only compile the "if" command if all arguments are simple
@@ -1209,9 +1195,6 @@ TclCompileIfCmd(interp, parsePtr, envPtr)
* Stop looping if the token isn't "if" or "elseif".
*/
- if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
- break;
- }
word = tokenPtr[1].start;
numBytes = tokenPtr[1].size;
if ((tokenPtr == parsePtr->tokenPtr)
@@ -1233,28 +1216,63 @@ TclCompileIfCmd(interp, parsePtr, envPtr)
/*
* Compile the test expression then emit the conditional jump
- * around the "then" part. If the expression word isn't simple,
- * we back off and compile the if command out-of-line.
+ * around the "then" part.
*/
envPtr->currStackDepth = savedStackDepth;
testTokenPtr = tokenPtr;
- code = TclCompileExprWords(interp, testTokenPtr, 1, envPtr);
- if (code != TCL_OK) {
- if (code == TCL_ERROR) {
- Tcl_AddObjErrorInfo(interp,
- "\n (\"if\" test expression)", -1);
+
+
+ if (realCond) {
+ /*
+ * Find out if the condition is a constant.
+ */
+
+ condStart = testTokenPtr[1].start;
+ savedPos = condStart + testTokenPtr[1].size - 1;
+
+ while (*condStart == ' ') {
+ condStart++;
+ }
+ while (*savedPos == ' ') {
+ savedPos--;
+ }
+ savedPos++;
+
+ savedChar = *savedPos;
+ *savedPos = '\0';
+
+ if (Tcl_GetBoolean(interp, condStart, &boolVal) != TCL_ERROR) {
+ /*
+ * A static condition
+ */
+ *savedPos = savedChar;
+ realCond = 0;
+ if (!boolVal) {
+ compileScripts = 0;
+ }
+ } else {
+ *savedPos = savedChar;
+ Tcl_ResetResult(interp);
+ code = TclCompileExprWords(interp, testTokenPtr, 1, envPtr);
+ if (code != TCL_OK) {
+ if (code == TCL_ERROR) {
+ Tcl_AddObjErrorInfo(interp,
+ "\n (\"if\" test expression)", -1);
+ }
+ goto done;
+ }
+ if (jumpFalseFixupArray.next >= jumpFalseFixupArray.end) {
+ TclExpandJumpFixupArray(&jumpFalseFixupArray);
+ }
+ jumpIndex = jumpFalseFixupArray.next;
+ jumpFalseFixupArray.next++;
+ TclEmitForwardJump(envPtr, TCL_FALSE_JUMP,
+ &(jumpFalseFixupArray.fixup[jumpIndex]));
}
- goto done;
- }
- if (jumpFalseFixupArray.next >= jumpFalseFixupArray.end) {
- TclExpandJumpFixupArray(&jumpFalseFixupArray);
}
- jumpIndex = jumpFalseFixupArray.next;
- jumpFalseFixupArray.next++;
- TclEmitForwardJump(envPtr, TCL_FALSE_JUMP,
- &(jumpFalseFixupArray.fixup[jumpIndex]));
-
+
+
/*
* Skip over the optional "then" before the then clause.
*/
@@ -1288,49 +1306,68 @@ TclCompileIfCmd(interp, parsePtr, envPtr)
* Compile the "then" command body.
*/
- envPtr->currStackDepth = savedStackDepth;
- code = TclCompileCmdWord(interp, tokenPtr+1,
- tokenPtr->numComponents, envPtr);
- if (code != TCL_OK) {
- if (code == TCL_ERROR) {
- sprintf(buffer, "\n (\"if\" then script line %d)",
- interp->errorLine);
- Tcl_AddObjErrorInfo(interp, buffer, -1);
- }
- goto done;
+ if (compileScripts) {
+ envPtr->currStackDepth = savedStackDepth;
+ code = TclCompileCmdWord(interp, tokenPtr+1,
+ tokenPtr->numComponents, envPtr);
+ if (code != TCL_OK) {
+ if (code == TCL_ERROR) {
+ sprintf(buffer, "\n (\"if\" then script line %d)",
+ interp->errorLine);
+ Tcl_AddObjErrorInfo(interp, buffer, -1);
+ }
+ goto done;
+ }
}
- /*
- * Jump to the end of the "if" command. Both jumpFalseFixupArray and
- * jumpEndFixupArray are indexed by "jumpIndex".
- */
+ if (realCond) {
+ /*
+ * Jump to the end of the "if" command. Both jumpFalseFixupArray and
+ * jumpEndFixupArray are indexed by "jumpIndex".
+ */
+
+ if (jumpEndFixupArray.next >= jumpEndFixupArray.end) {
+ TclExpandJumpFixupArray(&jumpEndFixupArray);
+ }
+ jumpEndFixupArray.next++;
+ TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP,
+ &(jumpEndFixupArray.fixup[jumpIndex]));
+
+ /*
+ * Fix the target of the jumpFalse after the test. Generate a 4 byte
+ * jump if the distance is > 120 bytes. This is conservative, and
+ * ensures that we won't have to replace this jump if we later also
+ * need to replace the proceeding jump to the end of the "if" with a
+ * 4 byte jump.
+ */
- if (jumpEndFixupArray.next >= jumpEndFixupArray.end) {
- TclExpandJumpFixupArray(&jumpEndFixupArray);
- }
- jumpEndFixupArray.next++;
- TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP,
- &(jumpEndFixupArray.fixup[jumpIndex]));
-
- /*
- * Fix the target of the jumpFalse after the test. Generate a 4 byte
- * jump if the distance is > 120 bytes. This is conservative, and
- * ensures that we won't have to replace this jump if we later also
- * need to replace the proceeding jump to the end of the "if" with a
- * 4 byte jump.
- */
+ jumpDist = (envPtr->codeNext - envPtr->codeStart)
+ - jumpFalseFixupArray.fixup[jumpIndex].codeOffset;
+ if (TclFixupForwardJump(envPtr,
+ &(jumpFalseFixupArray.fixup[jumpIndex]), jumpDist, 120)) {
+ /*
+ * Adjust the code offset for the proceeding jump to the end
+ * of the "if" command.
+ */
+
+ jumpEndFixupArray.fixup[jumpIndex].codeOffset += 3;
+ }
+ } else if (boolVal) {
+ /*
+ *We were processing an "if 1 {...}"; stop compiling
+ * scripts
+ */
- jumpDist = (envPtr->codeNext - envPtr->codeStart)
- - jumpFalseFixupArray.fixup[jumpIndex].codeOffset;
- if (TclFixupForwardJump(envPtr,
- &(jumpFalseFixupArray.fixup[jumpIndex]), jumpDist, 120)) {
- /*
- * Adjust the code offset for the proceeding jump to the end
- * of the "if" command.
+ compileScripts = 0;
+ } else {
+ /*
+ *We were processing an "if 0 {...}"; reset so that
+ * the rest (elseif, else) is compiled correctly
*/
- jumpEndFixupArray.fixup[jumpIndex].codeOffset += 3;
- }
+ realCond = 1;
+ compileScripts = 1;
+ }
tokenPtr += (tokenPtr->numComponents + 1);
wordIdx++;
@@ -1344,7 +1381,8 @@ TclCompileIfCmd(interp, parsePtr, envPtr)
envPtr->currStackDepth = savedStackDepth;
/*
- * Check for the optional else clause.
+ * Check for the optional else clause. Do not compile
+ * anything if this was an "if 1 {...}" case.
*/
if ((wordIdx < numWords)
@@ -1367,19 +1405,21 @@ TclCompileIfCmd(interp, parsePtr, envPtr)
}
}
- /*
- * Compile the else command body.
- */
-
- code = TclCompileCmdWord(interp, tokenPtr+1,
- tokenPtr->numComponents, envPtr);
- if (code != TCL_OK) {
- if (code == TCL_ERROR) {
- sprintf(buffer, "\n (\"if\" else script line %d)",
- interp->errorLine);
- Tcl_AddObjErrorInfo(interp, buffer, -1);
+ if (compileScripts) {
+ /*
+ * Compile the else command body.
+ */
+
+ code = TclCompileCmdWord(interp, tokenPtr+1,
+ tokenPtr->numComponents, envPtr);
+ if (code != TCL_OK) {
+ if (code == TCL_ERROR) {
+ sprintf(buffer, "\n (\"if\" else script line %d)",
+ interp->errorLine);
+ Tcl_AddObjErrorInfo(interp, buffer, -1);
+ }
+ goto done;
}
- goto done;
}
/*
@@ -1399,7 +1439,9 @@ TclCompileIfCmd(interp, parsePtr, envPtr)
* No else clause: the "if" command's result is an empty string.
*/
- TclEmitPush(TclRegisterLiteral(envPtr, "", 0,/*onHeap*/ 0), envPtr);
+ if (compileScripts) {
+ TclEmitPush(TclRegisterLiteral(envPtr, "", 0,/*onHeap*/ 0), envPtr);
+ }
}
/*
@@ -2834,12 +2876,16 @@ TclCompileWhileCmd(interp, parsePtr, envPtr)
CompileEnv *envPtr; /* Holds resulting instructions. */
{
Tcl_Token *testTokenPtr, *bodyTokenPtr;
- JumpFixup jumpFalseFixup;
- unsigned char *jumpPc;
- int testCodeOffset, jumpDist, jumpBackDist, jumpBackOffset;
+ JumpFixup jumpEvalCondFixup;
+ int testCodeOffset, bodyCodeOffset, jumpDist;
int range, code;
char buffer[32 + TCL_INTEGER_SPACE];
int savedStackDepth = envPtr->currStackDepth;
+ int loopMayEnd = 1; /* This is set to 0 if it is recognized as
+ * an infinite loop. */
+ int boolVal;
+ char *condStart;
+ char savedChar, *savedPos;
if (parsePtr->numWords != 3) {
Tcl_ResetResult(interp);
@@ -2866,6 +2912,45 @@ TclCompileWhileCmd(interp, parsePtr, envPtr)
}
/*
+ * Find out if the condition is a constant.
+ */
+
+ condStart = testTokenPtr[1].start;
+ savedPos = condStart + testTokenPtr[1].size - 1;
+
+ while (*condStart == ' ') {
+ condStart++;
+ }
+ while (*savedPos == ' ') {
+ savedPos--;
+ }
+ savedPos++;
+
+ savedChar = *savedPos;
+ *savedPos = '\0';
+
+ if (Tcl_GetBoolean(interp, condStart, &boolVal) != TCL_ERROR) {
+ if (boolVal) {
+ /*
+ * it is an infinite loop
+ */
+
+ loopMayEnd = 0;
+ } else {
+ /*
+ * This is an empty loop: "while 0 {...}" or such.
+ * Compile no bytecodes.
+ */
+
+ *savedPos = savedChar;
+ goto pushResult;
+ }
+ } else {
+ Tcl_ResetResult(interp);
+ }
+ *savedPos = savedChar;
+
+ /*
* Create a ExceptionRange record for the loop body. This is used to
* implement break and continue.
*/
@@ -2874,34 +2959,32 @@ TclCompileWhileCmd(interp, parsePtr, envPtr)
envPtr->maxExceptDepth =
TclMax(envPtr->exceptDepth, envPtr->maxExceptDepth);
range = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr);
- envPtr->exceptArrayPtr[range].continueOffset =
- (envPtr->codeNext - envPtr->codeStart);
/*
- * Compile the test expression then emit the conditional jump that
- * terminates the while. We already know it's a simple word.
+ * Jump to the evaluation of the condition. This code uses the "loop
+ * rotation" optimisation (which eliminates one branch from the loop).
+ * "while cond body" produces then:
+ * goto A
+ * B: body
+ * A: cond -> result
+ * if (result) goto B
*/
- testCodeOffset = (envPtr->codeNext - envPtr->codeStart);
- envPtr->exceptArrayPtr[range].continueOffset = testCodeOffset;
- code = TclCompileExprWords(interp, testTokenPtr, 1, envPtr);
- if (code != TCL_OK) {
- if (code == TCL_ERROR) {
- Tcl_AddObjErrorInfo(interp,
- "\n (\"while\" test expression)", -1);
- }
- goto error;
+ if (loopMayEnd) {
+ TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &jumpEvalCondFixup);
+ } else {
+ testCodeOffset = (envPtr->codeNext - envPtr->codeStart);
+ envPtr->exceptArrayPtr[range].continueOffset = testCodeOffset;
}
- 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);
+ bodyCodeOffset = (envPtr->codeNext - envPtr->codeStart);
+ envPtr->exceptArrayPtr[range].codeOffset = bodyCodeOffset;
+
code = TclCompileCmdWord(interp, bodyTokenPtr+1,
bodyTokenPtr->numComponents, envPtr);
envPtr->currStackDepth = savedStackDepth + 1;
@@ -2914,53 +2997,49 @@ TclCompileWhileCmd(interp, parsePtr, envPtr)
goto error;
}
envPtr->exceptArrayPtr[range].numCodeBytes =
- (envPtr->codeNext - envPtr->codeStart)
- - envPtr->exceptArrayPtr[range].codeOffset;
+ (envPtr->codeNext - envPtr->codeStart) - bodyCodeOffset;
TclEmitOpcode(INST_POP, envPtr);
-
- /*
- * Jump back to the test at the top of the loop. Generate a 4 byte jump
- * if the distance to the test is > 120 bytes. This is conservative and
- * ensures that we won't have to replace this jump if we later need to
- * replace the ifFalse jump with a 4 byte jump.
- */
-
- jumpBackOffset = (envPtr->codeNext - envPtr->codeStart);
- jumpBackDist = (jumpBackOffset - testCodeOffset);
- if (jumpBackDist > 120) {
- TclEmitInstInt4(INST_JUMP4, -jumpBackDist, envPtr);
- } else {
- TclEmitInstInt1(INST_JUMP1, -jumpBackDist, envPtr);
- }
/*
- * Fix the target of the jumpFalse after the test.
+ * Compile the test expression then emit the conditional jump that
+ * terminates the while. We already know it's a simple word.
*/
- jumpDist = (envPtr->codeNext - envPtr->codeStart)
- - jumpFalseFixup.codeOffset;
- if (TclFixupForwardJump(envPtr, &jumpFalseFixup, jumpDist, 127)) {
- /*
- * Update the loop body's starting PC offset since it moved down.
- */
-
- envPtr->exceptArrayPtr[range].codeOffset += 3;
-
- /*
- * Update the jump back to the test at the top of the loop since it
- * also moved down 3 bytes.
- */
-
- jumpBackOffset += 3;
- jumpPc = (envPtr->codeStart + jumpBackOffset);
- jumpBackDist += 3;
- if (jumpBackDist > 120) {
- TclUpdateInstInt4AtPc(INST_JUMP4, -jumpBackDist, jumpPc);
+ if (loopMayEnd) {
+ testCodeOffset = (envPtr->codeNext - envPtr->codeStart);
+ envPtr->exceptArrayPtr[range].continueOffset = testCodeOffset;
+ jumpDist = testCodeOffset - jumpEvalCondFixup.codeOffset;
+ if (TclFixupForwardJump(envPtr, &jumpEvalCondFixup, jumpDist, 127)) {
+ bodyCodeOffset += 3;
+ }
+
+ envPtr->currStackDepth = savedStackDepth;
+ code = TclCompileExprWords(interp, testTokenPtr, 1, envPtr);
+ if (code != TCL_OK) {
+ if (code == TCL_ERROR) {
+ Tcl_AddObjErrorInfo(interp,
+ "\n (\"while\" test expression)", -1);
+ }
+ goto error;
+ }
+ envPtr->currStackDepth = savedStackDepth + 1;
+
+ jumpDist = (envPtr->codeNext - envPtr->codeStart) - bodyCodeOffset;
+ if (jumpDist > 127) {
+ TclEmitInstInt4(INST_JUMP_TRUE4, -jumpDist, envPtr);
} else {
- TclUpdateInstInt1AtPc(INST_JUMP1, -jumpBackDist, jumpPc);
+ TclEmitInstInt1(INST_JUMP_TRUE1, -jumpDist, envPtr);
}
+ } else {
+ jumpDist = (envPtr->codeNext - envPtr->codeStart) - bodyCodeOffset;
+ if (jumpDist > 127) {
+ TclEmitInstInt4(INST_JUMP4, -jumpDist, envPtr);
+ } else {
+ TclEmitInstInt1(INST_JUMP1, -jumpDist, envPtr);
+ }
}
+
/*
* Set the loop's break target.
*/
@@ -2972,6 +3051,7 @@ TclCompileWhileCmd(interp, parsePtr, envPtr)
* The while command's result is an empty string.
*/
+ pushResult:
envPtr->currStackDepth = savedStackDepth;
TclEmitPush(TclRegisterLiteral(envPtr, "", 0, /*onHeap*/ 0), envPtr);
envPtr->exceptDepth--;