Optimising [if], [for] and [while] for constant conditions

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--;