Index: ChangeLog
===================================================================
RCS file: /cvsroot/tcl/tcl/ChangeLog,v
retrieving revision 1.1001
diff -u -r1.1001 ChangeLog
--- ChangeLog	30 May 2002 03:27:40 -0000	1.1001
+++ ChangeLog	30 May 2002 11:05:35 -0000
@@ -1,3 +1,30 @@
+2002-05-30  Donal K. Fellows  <fellowsd@cs.man.ac.uk>
+
+	* generic/tclCompile.c (TclCompileScript): Added extra meaning to
+	nested argument.  This is fairly gross as it currently only lets
+	nested scripts have this extra compilation, and probably needs to
+	be revisited in the future.  Note that the OPTIMIZE_LOOP_TEST flag
+	is reset for any commands other than the last in a script.
+	(TclCompileExprWords): Added flag to let callers specify that
+	their expressions are going to be loop tests.
+	* generic/tclCompExpr.c (ExprInfo.exprIsLoopTest): New member to
+	support optimized compilation as described below.
+	(TclCompileExpr): Added handling of ExprInfo.exprIsLoopTest. Note
+	that the result is currently extremely simplistic; this is just
+	peephole optimization, not something more general.
+	(CompileSubExpr): Map from ExprInfo.exprIsLoopTest to our optimize
+	flag.
+	* generic/tclCompCmds.c (TclCompileStringCmd): Added optimization
+	so that when compiling to a boolean test for a loop or an [if],
+	[string compare] gets transformed into INST_STR_EQ;INST_LNOT.
+	(TclCompileForCmd,TclCompileIfCmd,TclCompileWhileCmd): Marked
+	these commands' expressions as being ones used for boolean
+	testing.
+	* generic/tclInt.h (OPTIMIZE_LOOP_TEST): Added flag to indicate
+	that we are doing stronger optimizations.
+	(CompileProc): Added optimizeFlags argument, with many minor
+	knock-on changes.
+
 2002-05-29  Jeff Hobbs  <jeffh@ActiveState.com>
 
 	* unix/configure: regen'ed
Index: generic/tclCompCmds.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclCompCmds.c,v
retrieving revision 1.28
diff -u -r1.28 tclCompCmds.c
--- generic/tclCompCmds.c	29 May 2002 09:09:12 -0000	1.28
+++ generic/tclCompCmds.c	30 May 2002 11:05:36 -0000
@@ -68,11 +68,12 @@
  */
 
 int
-TclCompileAppendCmd(interp, parsePtr, envPtr)
+TclCompileAppendCmd(interp, parsePtr, envPtr, optFlags)
     Tcl_Interp *interp;		/* Used for error reporting. */
     Tcl_Parse *parsePtr;	/* Points to a parse structure for the
 				 * command created by Tcl_ParseCommand. */
     CompileEnv *envPtr;		/* Holds resulting instructions. */
+    int optFlags;		/* What optimizations are possible. */
 {
     Tcl_Token *varTokenPtr, *valueTokenPtr;
     int simpleVarName, isScalar, localIndex, numWords;
@@ -89,7 +90,7 @@
 	/*
 	 * append varName === set varName
 	 */
-        return TclCompileSetCmd(interp, parsePtr, envPtr);
+        return TclCompileSetCmd(interp, parsePtr, envPtr, optFlags);
     } else if (numWords > 3) {
 	/*
 	 * APPEND instructions currently only handle one value
@@ -188,11 +189,12 @@
  */
 
 int
-TclCompileBreakCmd(interp, parsePtr, envPtr)
+TclCompileBreakCmd(interp, parsePtr, envPtr, optFlags)
     Tcl_Interp *interp;		/* Used for error reporting. */
     Tcl_Parse *parsePtr;	/* Points to a parse structure for the
 				 * command created by Tcl_ParseCommand. */
     CompileEnv *envPtr;		/* Holds resulting instructions. */
+    int optFlags;		/* What optimizations are possible. */
 {
     if (parsePtr->numWords != 1) {
 	Tcl_ResetResult(interp);
@@ -233,11 +235,12 @@
  */
 
 int
-TclCompileCatchCmd(interp, parsePtr, envPtr)
+TclCompileCatchCmd(interp, parsePtr, envPtr, optFlags)
     Tcl_Interp *interp;		/* Used for error reporting. */
     Tcl_Parse *parsePtr;	/* Points to a parse structure for the
 				 * command created by Tcl_ParseCommand. */
     CompileEnv *envPtr;		/* Holds resulting instructions. */
+    int optFlags;		/* What optimizations are possible. */
 {
     JumpFixup jumpFixup;
     Tcl_Token *cmdTokenPtr, *nameTokenPtr;
@@ -408,11 +411,12 @@
  */
 
 int
-TclCompileContinueCmd(interp, parsePtr, envPtr)
+TclCompileContinueCmd(interp, parsePtr, envPtr, optFlags)
     Tcl_Interp *interp;		/* Used for error reporting. */
     Tcl_Parse *parsePtr;	/* Points to a parse structure for the
 				 * command created by Tcl_ParseCommand. */
     CompileEnv *envPtr;		/* Holds resulting instructions. */
+    int optFlags;		/* What optimizations are possible. */
 {
     /*
      * There should be no argument after the "continue".
@@ -453,11 +457,12 @@
  */
 
 int
-TclCompileExprCmd(interp, parsePtr, envPtr)
+TclCompileExprCmd(interp, parsePtr, envPtr, optFlags)
     Tcl_Interp *interp;		/* Used for error reporting. */
     Tcl_Parse *parsePtr;	/* Points to a parse structure for the
 				 * command created by Tcl_ParseCommand. */
     CompileEnv *envPtr;		/* Holds resulting instructions. */
+    int optFlags;		/* What optimizations are possible. */
 {
     Tcl_Token *firstWordPtr;
 
@@ -471,7 +476,7 @@
     firstWordPtr = parsePtr->tokenPtr
 	    + (parsePtr->tokenPtr->numComponents + 1);
     return TclCompileExprWords(interp, firstWordPtr, (parsePtr->numWords-1),
-	    envPtr);
+	    envPtr, 0);
 }
 
 /*
@@ -493,11 +498,12 @@
  *----------------------------------------------------------------------
  */
 int
-TclCompileForCmd(interp, parsePtr, envPtr)
+TclCompileForCmd(interp, parsePtr, envPtr, optFlags)
     Tcl_Interp *interp;		/* Used for error reporting. */
     Tcl_Parse *parsePtr;	/* Points to a parse structure for the
 				 * command created by Tcl_ParseCommand. */
     CompileEnv *envPtr;		/* Holds resulting instructions. */
+    int optFlags;		/* What optimizations are possible. */
 {
     Tcl_Token *startTokenPtr, *testTokenPtr, *nextTokenPtr, *bodyTokenPtr;
     JumpFixup jumpEvalCondFixup;
@@ -639,7 +645,7 @@
     }
     
     envPtr->currStackDepth = savedStackDepth;
-    code = TclCompileExprWords(interp, testTokenPtr, 1, envPtr);
+    code = TclCompileExprWords(interp, testTokenPtr, 1, envPtr, 1);
     if (code != TCL_OK) {
 	if (code == TCL_ERROR) {
 	    Tcl_AddObjErrorInfo(interp,
@@ -706,11 +712,12 @@
  */
 
 int
-TclCompileForeachCmd(interp, parsePtr, envPtr)
+TclCompileForeachCmd(interp, parsePtr, envPtr, optFlags)
     Tcl_Interp *interp;		/* Used for error reporting. */
     Tcl_Parse *parsePtr;	/* Points to a parse structure for the
 				 * command created by Tcl_ParseCommand. */
     CompileEnv *envPtr;		/* Holds resulting instructions. */
+    int optFlags;		/* What optimizations are possible. */
 {
     Proc *procPtr = envPtr->procPtr;
     ForeachInfo *infoPtr;	/* Points to the structure describing this
@@ -1137,11 +1144,12 @@
  *----------------------------------------------------------------------
  */
 int
-TclCompileIfCmd(interp, parsePtr, envPtr)
+TclCompileIfCmd(interp, parsePtr, envPtr, optFlags)
     Tcl_Interp *interp;		/* Used for error reporting. */
     Tcl_Parse *parsePtr;	/* Points to a parse structure for the
 				 * command created by Tcl_ParseCommand. */
     CompileEnv *envPtr;		/* Holds resulting instructions. */
+    int optFlags;		/* What optimizations are possible. */
 {
     JumpFixupArray jumpFalseFixupArray;
     				/* Used to fix the ifFalse jump after each
@@ -1257,7 +1265,7 @@
 	    } else {
 		*savedPos = savedChar;
 		Tcl_ResetResult(interp);
-		code = TclCompileExprWords(interp, testTokenPtr, 1, envPtr);
+		code = TclCompileExprWords(interp, testTokenPtr,1, envPtr, 1);
 		if (code != TCL_OK) {
 		    if (code == TCL_ERROR) {
 			Tcl_AddObjErrorInfo(interp,
@@ -1514,11 +1522,12 @@
  */
 
 int
-TclCompileIncrCmd(interp, parsePtr, envPtr)
+TclCompileIncrCmd(interp, parsePtr, envPtr, optFlags)
     Tcl_Interp *interp;		/* Used for error reporting. */
     Tcl_Parse *parsePtr;	/* Points to a parse structure for the
 				 * command created by Tcl_ParseCommand. */
     CompileEnv *envPtr;		/* Holds resulting instructions. */
+    int optFlags;		/* What optimizations are possible. */
 {
     Tcl_Token *varTokenPtr, *incrTokenPtr;
     int simpleVarName, isScalar, localIndex, haveImmValue, immValue;
@@ -1663,11 +1672,12 @@
  */
 
 int
-TclCompileLappendCmd(interp, parsePtr, envPtr)
+TclCompileLappendCmd(interp, parsePtr, envPtr, optFlags)
     Tcl_Interp *interp;		/* Used for error reporting. */
     Tcl_Parse *parsePtr;	/* Points to a parse structure for the
 				 * command created by Tcl_ParseCommand. */
     CompileEnv *envPtr;		/* Holds resulting instructions. */
+    int optFlags;		/* What optimizations are possible. */
 {
     Tcl_Token *varTokenPtr, *valueTokenPtr;
     int numValues, simpleVarName, isScalar, localIndex, numWords;
@@ -1801,11 +1811,12 @@
  */
 
 int
-TclCompileLindexCmd(interp, parsePtr, envPtr)
+TclCompileLindexCmd(interp, parsePtr, envPtr, optFlags)
     Tcl_Interp *interp;		/* Used for error reporting. */
     Tcl_Parse *parsePtr;	/* Points to a parse structure for the
 				 * command created by Tcl_ParseCommand. */
     CompileEnv *envPtr;		/* Holds resulting instructions. */
+    int optFlags;		/* What optimizations are possible. */
 {
     Tcl_Token *varTokenPtr;
     int code, i;
@@ -1883,11 +1894,12 @@
  */
 
 int
-TclCompileListCmd(interp, parsePtr, envPtr)
+TclCompileListCmd(interp, parsePtr, envPtr, optFlags)
     Tcl_Interp *interp;		/* Used for error reporting. */
     Tcl_Parse *parsePtr;	/* Points to a parse structure for the
 				 * command created by Tcl_ParseCommand. */
     CompileEnv *envPtr;		/* Holds resulting instructions. */
+    int optFlags;		/* What optimizations are possible. */
 {
     /*
      * If we're not in a procedure, don't compile.
@@ -1955,11 +1967,12 @@
  */
 
 int
-TclCompileLlengthCmd(interp, parsePtr, envPtr)
+TclCompileLlengthCmd(interp, parsePtr, envPtr, optFlags)
     Tcl_Interp *interp;		/* Used for error reporting. */
     Tcl_Parse *parsePtr;	/* Points to a parse structure for the
 				 * command created by Tcl_ParseCommand. */
     CompileEnv *envPtr;		/* Holds resulting instructions. */
+    int optFlags;		/* What optimizations are possible. */
 {
     Tcl_Token *varTokenPtr;
     int code;
@@ -2035,11 +2048,12 @@
  */
 
 int
-TclCompileLsetCmd( interp, parsePtr, envPtr )
+TclCompileLsetCmd(interp, parsePtr, envPtr, optFlags)
     Tcl_Interp* interp;		/* Tcl interpreter for error reporting */
     Tcl_Parse* parsePtr;	/* Points to a parse structure for
 				 * the command */
     CompileEnv* envPtr;		/* Holds the resulting instructions */
+    int optFlags;		/* What optimizations are possible. */
 {
 
     int tempDepth;		/* Depth used for emitting one part
@@ -2057,7 +2071,7 @@
 
     /* Check argument count */
 
-    if ( parsePtr->numWords < 3 ) {
+    if (parsePtr->numWords < 3) {
 	/* Fail at run time, not in compilation */
 	return TCL_OUT_LINE_COMPILE;
     }
@@ -2072,15 +2086,15 @@
 
     varTokenPtr = parsePtr->tokenPtr
 	    + (parsePtr->tokenPtr->numComponents + 1);
-    result = TclPushVarName( interp, varTokenPtr, envPtr, 0,
-			     &localIndex, &simpleVarName, &isScalar );
+    result = TclPushVarName(interp, varTokenPtr, envPtr, 0,
+	    &localIndex, &simpleVarName, &isScalar);
     if (result != TCL_OK) {
 	return result;
     }
 
     /* Push the "index" args and the new element value. */
 
-    for ( i = 2; i < parsePtr->numWords; ++i ) {
+    for (i = 2; i < parsePtr->numWords; ++i) {
 
 	/* Advance to next arg */
 
@@ -2089,15 +2103,12 @@
 	/* Push an arg */
 
 	if (varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
-	    TclEmitPush( TclRegisterLiteral( envPtr,
-					     varTokenPtr[1].start,
-					     varTokenPtr[1].size,
-					     0),
-			 envPtr);
+	    TclEmitPush(TclRegisterLiteral(envPtr,
+		    varTokenPtr[1].start, varTokenPtr[1].size, 0), envPtr);
 	} else {
 	    result = TclCompileTokens(interp, varTokenPtr+1,
-				      varTokenPtr->numComponents, envPtr);
-	    if ( result != TCL_OK ) {
+		    varTokenPtr->numComponents, envPtr);
+	    if (result != TCL_OK) {
 		return result;
 	    }
 	}
@@ -2107,49 +2118,49 @@
      * Duplicate the variable name if it's been pushed.  
      */
 
-    if ( !simpleVarName || localIndex < 0 ) {
-	if ( !simpleVarName || isScalar ) {
+    if (!simpleVarName || localIndex < 0) {
+	if (!simpleVarName || isScalar) {
 	    tempDepth = parsePtr->numWords - 2;
 	} else {
 	    tempDepth = parsePtr->numWords - 1;
 	}
-	TclEmitInstInt4( INST_OVER, tempDepth, envPtr );
+	TclEmitInstInt4(INST_OVER, tempDepth, envPtr);
     }
 
     /*
      * Duplicate an array index if one's been pushed
      */
 
-    if ( simpleVarName && !isScalar ) {
-	if ( localIndex < 0 ) {
+    if (simpleVarName && !isScalar) {
+	if (localIndex < 0) {
 	    tempDepth = parsePtr->numWords - 1;
 	} else {
 	    tempDepth = parsePtr->numWords - 2;
 	}
-	TclEmitInstInt4( INST_OVER, tempDepth, envPtr );
+	TclEmitInstInt4(INST_OVER, tempDepth, envPtr);
     }
 
     /*
      * Emit code to load the variable's value.
      */
 
-    if ( !simpleVarName ) {
-	TclEmitOpcode( INST_LOAD_STK, envPtr );
-    } else if ( isScalar ) {
-	if ( localIndex < 0 ) {
-	    TclEmitOpcode( INST_LOAD_SCALAR_STK, envPtr );
-	} else if ( localIndex < 0x100 ) {
-	    TclEmitInstInt1( INST_LOAD_SCALAR1, localIndex, envPtr );
+    if (!simpleVarName) {
+	TclEmitOpcode(INST_LOAD_STK, envPtr);
+    } else if (isScalar) {
+	if (localIndex < 0) {
+	    TclEmitOpcode(INST_LOAD_SCALAR_STK, envPtr);
+	} else if (localIndex < 0x100) {
+	    TclEmitInstInt1(INST_LOAD_SCALAR1, localIndex, envPtr);
 	} else {
-	    TclEmitInstInt4( INST_LOAD_SCALAR4, localIndex, envPtr );
+	    TclEmitInstInt4(INST_LOAD_SCALAR4, localIndex, envPtr);
 	}
     } else {
-	if ( localIndex < 0 ) {
-	    TclEmitOpcode( INST_LOAD_ARRAY_STK, envPtr );
-	} else if ( localIndex < 0x100 ) {
-	    TclEmitInstInt1( INST_LOAD_ARRAY1, localIndex, envPtr );
+	if (localIndex < 0) {
+	    TclEmitOpcode(INST_LOAD_ARRAY_STK, envPtr);
+	} else if (localIndex < 0x100) {
+	    TclEmitInstInt1(INST_LOAD_ARRAY1, localIndex, envPtr);
 	} else {
-	    TclEmitInstInt4( INST_LOAD_ARRAY4, localIndex, envPtr );
+	    TclEmitInstInt4(INST_LOAD_ARRAY4, localIndex, envPtr);
 	}
     }
 
@@ -2157,38 +2168,37 @@
      * Emit the correct variety of 'lset' instruction
      */
 
-    if ( parsePtr->numWords == 4 ) {
-	TclEmitOpcode( INST_LSET_LIST, envPtr );
+    if (parsePtr->numWords == 4) {
+	TclEmitOpcode(INST_LSET_LIST, envPtr);
     } else {
-	TclEmitInstInt4( INST_LSET_FLAT, (parsePtr->numWords - 1), envPtr );
+	TclEmitInstInt4(INST_LSET_FLAT, (parsePtr->numWords - 1), envPtr);
     }
 
     /*
      * Emit code to put the value back in the variable
      */
 
-    if ( !simpleVarName ) {
-	TclEmitOpcode( INST_STORE_STK, envPtr );
-    } else if ( isScalar ) {
-	if ( localIndex < 0 ) {
-	    TclEmitOpcode( INST_STORE_SCALAR_STK, envPtr );
-	} else if ( localIndex < 0x100 ) {
-	    TclEmitInstInt1( INST_STORE_SCALAR1, localIndex, envPtr );
+    if (!simpleVarName) {
+	TclEmitOpcode(INST_STORE_STK, envPtr);
+    } else if (isScalar) {
+	if (localIndex < 0) {
+	    TclEmitOpcode(INST_STORE_SCALAR_STK, envPtr);
+	} else if (localIndex < 0x100) {
+	    TclEmitInstInt1(INST_STORE_SCALAR1, localIndex, envPtr);
 	} else {
-	    TclEmitInstInt4( INST_STORE_SCALAR4, localIndex, envPtr );
+	    TclEmitInstInt4(INST_STORE_SCALAR4, localIndex, envPtr);
 	}
     } else {
-	if ( localIndex < 0 ) {
-	    TclEmitOpcode( INST_STORE_ARRAY_STK, envPtr );
-	} else if ( localIndex < 0x100 ) {
-	    TclEmitInstInt1( INST_STORE_ARRAY1, localIndex, envPtr );
+	if (localIndex < 0) {
+	    TclEmitOpcode(INST_STORE_ARRAY_STK, envPtr);
+	} else if (localIndex < 0x100) {
+	    TclEmitInstInt1(INST_STORE_ARRAY1, localIndex, envPtr);
 	} else {
-	    TclEmitInstInt4( INST_STORE_ARRAY4, localIndex, envPtr );
+	    TclEmitInstInt4(INST_STORE_ARRAY4, localIndex, envPtr);
 	}
     }
     
     return TCL_OK;
-
 }
 
 /*
@@ -2214,11 +2224,12 @@
  */
 
 int
-TclCompileRegexpCmd(interp, parsePtr, envPtr)
+TclCompileRegexpCmd(interp, parsePtr, envPtr, optFlags)
     Tcl_Interp* interp;		/* Tcl interpreter for error reporting */
     Tcl_Parse* parsePtr;	/* Points to a parse structure for
 				 * the command */
     CompileEnv* envPtr;		/* Holds the resulting instructions */
+    int optFlags;		/* What optimizations are possible. */
 {
     Tcl_Token *varTokenPtr;	/* Pointer to the Tcl_Token representing
 				 * the parse of the RE or string */
@@ -2393,11 +2404,12 @@
  */
 
 int
-TclCompileReturnCmd(interp, parsePtr, envPtr)
+TclCompileReturnCmd(interp, parsePtr, envPtr, optFlags)
     Tcl_Interp *interp;		/* Used for error reporting. */
     Tcl_Parse *parsePtr;	/* Points to a parse structure for the
 				 * command created by Tcl_ParseCommand. */
     CompileEnv *envPtr;		/* Holds resulting instructions. */
+    int optFlags;		/* What optimizations are possible. */
 {
     Tcl_Token *varTokenPtr;
     int code;
@@ -2493,11 +2505,12 @@
  */
 
 int
-TclCompileSetCmd(interp, parsePtr, envPtr)
+TclCompileSetCmd(interp, parsePtr, envPtr, optFlags)
     Tcl_Interp *interp;		/* Used for error reporting. */
     Tcl_Parse *parsePtr;	/* Points to a parse structure for the
 				 * command created by Tcl_ParseCommand. */
     CompileEnv *envPtr;		/* Holds resulting instructions. */
+    int optFlags;		/* What optimizations are possible. */
 {
     Tcl_Token *varTokenPtr, *valueTokenPtr;
     int isAssignment, isScalar, simpleVarName, localIndex, numWords;
@@ -2614,11 +2627,12 @@
  */
 
 int
-TclCompileStringCmd(interp, parsePtr, envPtr)
+TclCompileStringCmd(interp, parsePtr, envPtr, optFlags)
     Tcl_Interp *interp;		/* Used for error reporting. */
     Tcl_Parse *parsePtr;	/* Points to a parse structure for the
 				 * command created by Tcl_ParseCommand. */
     CompileEnv *envPtr;		/* Holds resulting instructions. */
+    int optFlags;		/* What optimizations are possible. */
 {
     Tcl_Token *opTokenPtr, *varTokenPtr;
     Tcl_Obj *opObj;
@@ -2713,8 +2727,18 @@
 		varTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1);
 	    }
 
-	    TclEmitOpcode(((((enum options) index) == STR_COMPARE) ?
-		    INST_STR_CMP : INST_STR_EQ), envPtr);
+	    if (optFlags & OPTIMIZE_LOOP_TEST &&
+		    ((enum options) index) == STR_COMPARE) {
+		/*
+		 * INST_STR_EQ is higher-performance than INST_STR_CMP
+		 */
+		TclEmitOpcode(INST_STR_EQ, envPtr);
+		TclEmitOpcode(INST_LNOT, envPtr);
+	    } else {
+		TclEmitOpcode(((((enum options) index) == STR_COMPARE) ?
+			INST_STR_CMP : INST_STR_EQ), envPtr);
+	    }
+
 	    return TCL_OK;
 	}
 	case STR_INDEX: {
@@ -2866,11 +2890,12 @@
  */
 
 int
-TclCompileWhileCmd(interp, parsePtr, envPtr)
+TclCompileWhileCmd(interp, parsePtr, envPtr, optFlags)
     Tcl_Interp *interp;		/* Used for error reporting. */
     Tcl_Parse *parsePtr;	/* Points to a parse structure for the
 				 * command created by Tcl_ParseCommand. */
     CompileEnv *envPtr;		/* Holds resulting instructions. */
+    int optFlags;		/* What optimizations are possible. */
 {
     Tcl_Token *testTokenPtr, *bodyTokenPtr;
     JumpFixup jumpEvalCondFixup;
@@ -3012,7 +3037,7 @@
 	    testCodeOffset += 3;
 	}
 	envPtr->currStackDepth = savedStackDepth;
-	code = TclCompileExprWords(interp, testTokenPtr, 1, envPtr);
+	code = TclCompileExprWords(interp, testTokenPtr, 1, envPtr, 1);
 	if (code != TCL_OK) {
 	    if (code == TCL_ERROR) {
 		Tcl_AddObjErrorInfo(interp,
Index: generic/tclCompExpr.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclCompExpr.c,v
retrieving revision 1.8
diff -u -r1.8 tclCompExpr.c
--- generic/tclCompExpr.c	11 Dec 2001 14:29:40 -0000	1.8
+++ generic/tclCompExpr.c	30 May 2002 11:05:36 -0000
@@ -71,6 +71,11 @@
 				 * the expr is compiled out-of-line in order
 				 * to implement expr's 2 level substitution
 				 * semantics properly. */
+    int exprIsLoopTest;		/* Set 1 if the expression is being used as
+				 * a boolean test for an [if] or on a
+				 * [while]/[for] loop condition. Otherwise 0.
+				 * If 1, will try to apply extra optimizations
+				 * for things like [string compare]. */
 } ExprInfo;
 
 /*
@@ -223,13 +228,15 @@
  */
 
 int
-TclCompileExpr(interp, script, numBytes, envPtr)
+TclCompileExpr(interp, script, numBytes, envPtr, isTest)
     Tcl_Interp *interp;		/* Used for error reporting. */
     char *script;		/* The source script to compile. */
     int numBytes;		/* Number of bytes in script. If < 0, the
 				 * string consists of all bytes up to the
 				 * first null character. */
     CompileEnv *envPtr;		/* Holds resulting instructions. */
+    int isTest;			/* Non-zero if the result of the expression
+				 * will be used as a boolean value. */
 {
     ExprInfo info;
     Tcl_Parse parse;
@@ -272,6 +279,7 @@
     info.hasOperators = 0;
     info.exprIsJustVarRef = 1;	/* will be set 0 if anything else is seen */
     info.exprIsComparison = 0;
+    info.exprIsLoopTest = isTest;
 
     /*
      * Parse the expression then compile it.
@@ -282,6 +290,23 @@
 	goto done;
     }
 
+    /*
+     * Check if the complexity of the expression is too much.
+     */
+    if (isTest && parse.tokenPtr->numComponents != 1 &&
+	    (parse.tokenPtr[0].numComponents != 3 ||
+	    parse.tokenPtr[1].type != TCL_TOKEN_OPERATOR ||
+	    parse.tokenPtr[1].start[0] != '!' ||
+	    parse.tokenPtr[1].size != 1 ||
+	    parse.tokenPtr[2].type != TCL_TOKEN_SUB_EXPR ||
+	    parse.tokenPtr[3].type != TCL_TOKEN_COMMAND)) {
+	/*
+	 * Can't optimize, as this is not the logical negation of a
+	 * command, so might need integer value instead of boolean.
+	 */
+	info.exprIsLoopTest = 0;
+    }
+
     code = CompileSubExpr(parse.tokenPtr, &info, envPtr);
     if (code != TCL_OK) {
 	Tcl_FreeParse(&parse);
@@ -438,7 +463,8 @@
 	    
         case TCL_TOKEN_COMMAND:
 	    code = TclCompileScript(interp, tokenPtr->start+1,
-		    tokenPtr->size-2, /*nested*/ 1, envPtr);
+		    tokenPtr->size-2, 1+(infoPtr->exprIsLoopTest
+		    ? OPTIMIZE_LOOP_TEST : 0), envPtr);
 	    if (code != TCL_OK) {
 		goto done;
 	    }
Index: generic/tclCompile.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclCompile.c,v
retrieving revision 1.32
diff -u -r1.32 tclCompile.c
--- generic/tclCompile.c	15 Mar 2002 15:39:06 -0000	1.32
+++ generic/tclCompile.c	30 May 2002 11:05:36 -0000
@@ -807,7 +807,9 @@
     int nested;			/* Non-zero means this is a nested command:
 				 * close bracket ']' should be considered a
 				 * command terminator. If zero, close
-				 * bracket has no special meaning. */
+				 * bracket has no special meaning.  Special
+				 * case: 2 means we are in a loop condition
+				 * context, and can optimize harder. */
     CompileEnv *envPtr;		/* Holds resulting instructions. */
 {
     Interp *iPtr = (Interp *) interp;
@@ -824,7 +826,7 @@
     Command *cmdPtr;
     Tcl_Token *tokenPtr;
     int bytesLeft, isFirstCmd, gotParse, wordIdx, currCmdIndex;
-    int commandLength, objIndex, code;
+    int commandLength, objIndex, code, optimizeFlags;
     char prev;
     Tcl_DString ds;
 
@@ -837,6 +839,16 @@
     isFirstCmd = 1;
 
     /*
+     * Decode the optimization flags...
+     */
+    if (nested > 0) {
+	optimizeFlags = nested-1;
+	nested = 1;
+    } else {
+	optimizeFlags = 0;
+    }
+
+    /*
      * Each iteration through the following loop compiles the next
      * command from the script.
      */
@@ -949,8 +961,18 @@
 			if ((cmdPtr != NULL)
 			        && (cmdPtr->compileProc != NULL)
 			        && !(iPtr->flags & DONT_COMPILE_CMDS_INLINE)) {
+			    int realOptFlags = optimizeFlags;
+
+			    /**
+			     * Only apply loop-test optimizations to the
+			     * last command in a script.
+			     */
+			    next = parse.commandStart + parse.commandSize;
+			    if (bytesLeft - (next - p) > 0) {
+				realOptFlags &= ~OPTIMIZE_LOOP_TEST;
+			    }
 			    code = (*(cmdPtr->compileProc))(interp, &parse,
-			            envPtr);
+			            envPtr, realOptFlags);
 			    if (code == TCL_OK) {
 				goto finishCommand;
 			    } else if (code == TCL_OUT_LINE_COMPILE) {
@@ -1386,7 +1408,7 @@
  */
 
 int
-TclCompileExprWords(interp, tokenPtr, numWords, envPtr)
+TclCompileExprWords(interp, tokenPtr, numWords, envPtr, isTest)
     Tcl_Interp *interp;		/* Used for error and status reporting. */
     Tcl_Token *tokenPtr;	/* Points to first in an array of word
 				 * tokens tokens for the expression to
@@ -1395,6 +1417,8 @@
 				 * tokenPtr. Must be at least 1. Each word
 				 * token contains one or more subtokens. */
     CompileEnv *envPtr;		/* Holds the resulting instructions. */
+    int isTest;			/* Non-zero if the result of the expression
+				 * will be used as a boolean value. */
 {
     Tcl_Token *wordPtr;
     int range, numBytes, i, code;
@@ -1418,7 +1442,7 @@
 
 	script = tokenPtr[1].start;
 	numBytes = tokenPtr[1].size;
-	code = TclCompileExpr(interp, script, numBytes, envPtr);
+	code = TclCompileExpr(interp, script, numBytes, envPtr, isTest);
 	return code;
     }
    
Index: generic/tclCompile.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclCompile.h,v
retrieving revision 1.26
diff -u -r1.26 tclCompile.h
--- generic/tclCompile.h	29 Mar 2002 21:01:11 -0000	1.26
+++ generic/tclCompile.h	30 May 2002 11:05:36 -0000
@@ -763,10 +763,10 @@
 			    CompileEnv *envPtr));
 EXTERN int		TclCompileExpr _ANSI_ARGS_((Tcl_Interp *interp,
 			    char *script, int numBytes,
-			    CompileEnv *envPtr));
+			    CompileEnv *envPtr, int isTest));
 EXTERN int		TclCompileExprWords _ANSI_ARGS_((Tcl_Interp *interp,
 			    Tcl_Token *tokenPtr, int numWords,
-			    CompileEnv *envPtr));
+			    CompileEnv *envPtr, int isTest));
 EXTERN int		TclCompileScript _ANSI_ARGS_((Tcl_Interp *interp,
 			    char *script, int numBytes, int nested,
 			    CompileEnv *envPtr));
Index: generic/tclExecute.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclExecute.c,v
retrieving revision 1.56
diff -u -r1.56 tclExecute.c
--- generic/tclExecute.c	30 May 2002 03:26:40 -0000	1.56
+++ generic/tclExecute.c	30 May 2002 11:05:37 -0000
@@ -689,7 +689,7 @@
     }
     if (objPtr->typePtr != &tclByteCodeType) {
 	TclInitCompileEnv(interp, &compEnv, string, length);
-	result = TclCompileExpr(interp, string, length, &compEnv);
+	result = TclCompileExpr(interp, string, length, &compEnv, 0);
 
 	/*
 	 * Free the compilation environment's literal table bucket array if
Index: generic/tclInt.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclInt.h,v
retrieving revision 1.90
diff -u -r1.90 tclInt.h
--- generic/tclInt.h	30 May 2002 03:27:09 -0000	1.90
+++ generic/tclInt.h	30 May 2002 11:05:37 -0000
@@ -857,12 +857,22 @@
  *			CompileProc believes the command is legal but 
  *			should be compiled "out of line" by emitting code
  *			to invoke its command procedure at runtime.
+ *
+ * CompileProcs take an optimization parameter which is used to indicate
+ * what sort of optimizations can be performed.  The following bits are
+ * defined:
+ *
+ * OPTIMIZE_LOOP_TEST	The command is used as part of a [for]/[while] loop
+ *			or an [if] test, and the result is guaranteed to be
+ *			treated as a boolean value.
  */
 
 #define TCL_OUT_LINE_COMPILE	(TCL_CONTINUE + 1)
+#define OPTIMIZE_LOOP_TEST	0x1
 
 typedef int (CompileProc) _ANSI_ARGS_((Tcl_Interp *interp,
-	Tcl_Parse *parsePtr, struct CompileEnv *compEnvPtr));
+	Tcl_Parse *parsePtr, struct CompileEnv *compEnvPtr,
+	int optimizeFlags));
 
 /*
  * The type of procedure called from the compilation hook point in
@@ -2115,43 +2125,62 @@
  */
 
 EXTERN int	TclCompileAppendCmd _ANSI_ARGS_((Tcl_Interp *interp,
-		    Tcl_Parse *parsePtr, struct CompileEnv *envPtr));
+		    Tcl_Parse *parsePtr, struct CompileEnv *envPtr,
+		    int optFlags));
 EXTERN int	TclCompileBreakCmd _ANSI_ARGS_((Tcl_Interp *interp,
-		    Tcl_Parse *parsePtr, struct CompileEnv *envPtr));
+		    Tcl_Parse *parsePtr, struct CompileEnv *envPtr,
+		    int optFlags));
 EXTERN int	TclCompileCatchCmd _ANSI_ARGS_((Tcl_Interp *interp,
-		    Tcl_Parse *parsePtr, struct CompileEnv *envPtr));
+		    Tcl_Parse *parsePtr, struct CompileEnv *envPtr,
+		    int optFlags));
 EXTERN int	TclCompileContinueCmd _ANSI_ARGS_((Tcl_Interp *interp,
-		    Tcl_Parse *parsePtr, struct CompileEnv *envPtr));
+		    Tcl_Parse *parsePtr, struct CompileEnv *envPtr,
+		    int optFlags));
 EXTERN int	TclCompileExprCmd _ANSI_ARGS_((Tcl_Interp *interp,
-		    Tcl_Parse *parsePtr, struct CompileEnv *envPtr));
+		    Tcl_Parse *parsePtr, struct CompileEnv *envPtr,
+		    int optFlags));
 EXTERN int	TclCompileForCmd _ANSI_ARGS_((Tcl_Interp *interp,
-		    Tcl_Parse *parsePtr, struct CompileEnv *envPtr));
+		    Tcl_Parse *parsePtr, struct CompileEnv *envPtr,
+		    int optFlags));
 EXTERN int	TclCompileForeachCmd _ANSI_ARGS_((Tcl_Interp *interp,
-		    Tcl_Parse *parsePtr, struct CompileEnv *envPtr));
+		    Tcl_Parse *parsePtr, struct CompileEnv *envPtr,
+		    int optFlags));
 EXTERN int	TclCompileIfCmd _ANSI_ARGS_((Tcl_Interp *interp,
-		    Tcl_Parse *parsePtr, struct CompileEnv *envPtr));
+		    Tcl_Parse *parsePtr, struct CompileEnv *envPtr,
+		    int optFlags));
 EXTERN int	TclCompileIncrCmd _ANSI_ARGS_((Tcl_Interp *interp,
-		    Tcl_Parse *parsePtr, struct CompileEnv *envPtr));
+		    Tcl_Parse *parsePtr, struct CompileEnv *envPtr,
+		    int optFlags));
 EXTERN int	TclCompileLappendCmd _ANSI_ARGS_((Tcl_Interp *interp,
-		    Tcl_Parse *parsePtr, struct CompileEnv *envPtr));
+		    Tcl_Parse *parsePtr, struct CompileEnv *envPtr,
+		    int optFlags));
 EXTERN int	TclCompileLindexCmd _ANSI_ARGS_((Tcl_Interp *interp,
-		    Tcl_Parse *parsePtr, struct CompileEnv *envPtr));
+		    Tcl_Parse *parsePtr, struct CompileEnv *envPtr,
+		    int optFlags));
 EXTERN int	TclCompileListCmd _ANSI_ARGS_((Tcl_Interp *interp,
-		    Tcl_Parse *parsePtr, struct CompileEnv *envPtr));
+		    Tcl_Parse *parsePtr, struct CompileEnv *envPtr,
+		    int optFlags));
 EXTERN int	TclCompileLlengthCmd _ANSI_ARGS_((Tcl_Interp *interp,
-		    Tcl_Parse *parsePtr, struct CompileEnv *envPtr));
+		    Tcl_Parse *parsePtr, struct CompileEnv *envPtr,
+		    int optFlags));
 EXTERN int	TclCompileLsetCmd _ANSI_ARGS_((Tcl_Interp* interp,
-		    Tcl_Parse* parsePtr, struct CompileEnv* envPtr));
+		    Tcl_Parse* parsePtr, struct CompileEnv* envPtr,
+		    int optFlags));
 EXTERN int	TclCompileRegexpCmd _ANSI_ARGS_((Tcl_Interp* interp,
-		    Tcl_Parse* parsePtr, struct CompileEnv* envPtr));
+		    Tcl_Parse* parsePtr, struct CompileEnv* envPtr,
+		    int optFlags));
 EXTERN int	TclCompileReturnCmd _ANSI_ARGS_((Tcl_Interp *interp,
-		    Tcl_Parse *parsePtr, struct CompileEnv *envPtr));
+		    Tcl_Parse *parsePtr, struct CompileEnv *envPtr,
+		    int optFlags));
 EXTERN int	TclCompileSetCmd _ANSI_ARGS_((Tcl_Interp *interp,
-		    Tcl_Parse *parsePtr, struct CompileEnv *envPtr));
+		    Tcl_Parse *parsePtr, struct CompileEnv *envPtr,
+		    int optFlags));
 EXTERN int	TclCompileStringCmd _ANSI_ARGS_((Tcl_Interp *interp,
-		    Tcl_Parse *parsePtr, struct CompileEnv *envPtr));
+		    Tcl_Parse *parsePtr, struct CompileEnv *envPtr,
+		    int optFlags));
 EXTERN int	TclCompileWhileCmd _ANSI_ARGS_((Tcl_Interp *interp,
-		    Tcl_Parse *parsePtr, struct CompileEnv *envPtr));
+		    Tcl_Parse *parsePtr, struct CompileEnv *envPtr,
+		    int optFlags));
 
 /*
  *----------------------------------------------------------------
