Attachment "str_optimize.patch" to
ticket [562297ffff]
added by
dkf
2002-05-30 18:11:31.
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 <[email protected]>
+
+ * 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 <[email protected]>
* 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));
/*
*----------------------------------------------------------------