Attachment "str_optimize.patch2" to
ticket [562297ffff]
added by
msofer
2002-05-30 22:48:12.
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 15:22:23 -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.9
diff -u -r1.9 tclCompExpr.c
--- generic/tclCompExpr.c 30 May 2002 15:03:56 -0000 1.9
+++ generic/tclCompExpr.c 30 May 2002 15:22:24 -0000
@@ -59,6 +59,11 @@
* compiling an expr, a tryCvtToNumeric
* instruction is emitted to convert the
* primary to a number if possible. */
+ 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;
/*
@@ -201,13 +206,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;
@@ -248,6 +255,7 @@
info.expr = script;
info.lastChar = (script + numBytes);
info.hasOperators = 0;
+ info.exprIsLoopTest = isTest;
/*
* Parse the expression then compile it.
@@ -258,6 +266,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);
@@ -399,7 +424,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.33
diff -u -r1.33 tclCompile.c
--- generic/tclCompile.c 30 May 2002 15:03:57 -0000 1.33
+++ generic/tclCompile.c 30 May 2002 15:22:26 -0000
@@ -805,7 +805,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;
@@ -822,7 +824,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;
@@ -835,6 +837,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.
*/
@@ -947,8 +959,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) {
@@ -1384,7 +1406,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
@@ -1393,6 +1415,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;
@@ -1414,7 +1438,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.27
diff -u -r1.27 tclCompile.h
--- generic/tclCompile.h 30 May 2002 15:03:57 -0000 1.27
+++ generic/tclCompile.h 30 May 2002 15:22:27 -0000
@@ -751,10 +751,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 15:22:30 -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 15:22:34 -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));
/*
*----------------------------------------------------------------
