diff options
| -rw-r--r-- | ChangeLog | 7 | ||||
| -rw-r--r-- | generic/tclCompCmds.c | 466 |
2 files changed, 280 insertions, 193 deletions
@@ -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--; |