Attachment "newRangeNPeep.patch" to
ticket [453709ffff]
added by
msofer
2002-03-07 19:46:32.
Index: ChangeLog
===================================================================
RCS file: /cvsroot/tcl/tcl/ChangeLog,v
retrieving revision 1.896
diff -u -r1.896 ChangeLog
--- ChangeLog 6 Mar 2002 15:20:23 -0000 1.896
+++ ChangeLog 7 Mar 2002 12:36:43 -0000
@@ -1,3 +1,21 @@
+2002-03-06 Miguel Sofer <[email protected]>
+
+ * generic/tclCompCmds.c:
+ * generic/tclCompile.c:
+ * generic/tclCompile.h: loop rotation optimisation when compiling
+ [foreach]; modification of the compiler's tools for handling
+ exception ranges: new functions TclBeginExceptRange and
+ TclEndExceptRange, TclCreateExceptRange is gone.
+ * generic/tclExecute.c: (a) faster exception range lookup algorithm
+ (GetExceptRangeForPc)
+ (b) peep-hole optimisation in INST_FOREACH4 to avoid (creating,
+ pushing, popping, testing, destroying) an object and save
+ executing a INST_JUMP_FALSE instruction.
+ (c) peep-hole optimisation at several other instructions to avoid
+ pushing an object that will be popped right away and save
+ executing a INST_POP instruction.
+ [Patch 453709]
+
2002-03-06 Donal K. Fellows <[email protected]>
* generic/tcl.h, tools/tcl.wse.in, unix/configure.in,
Index: generic/tclCompCmds.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclCompCmds.c,v
retrieving revision 1.27
diff -u -r1.27 tclCompCmds.c
--- generic/tclCompCmds.c 26 Feb 2002 17:26:25 -0000 1.27
+++ generic/tclCompCmds.c 7 Mar 2002 12:36:44 -0000
@@ -242,7 +242,7 @@
JumpFixup jumpFixup;
Tcl_Token *cmdTokenPtr, *nameTokenPtr;
char *name;
- int localIndex, nameChars, range, startOffset, jumpDist;
+ int localIndex, nameChars, range, jumpDist;
int code;
char buffer[32 + TCL_INTEGER_SPACE];
int savedStackDepth = envPtr->currStackDepth;
@@ -289,17 +289,6 @@
}
/*
- * We will compile the catch command. Emit a beginCatch instruction at
- * the start of the catch body: the subcommand it controls.
- */
-
- envPtr->exceptDepth++;
- envPtr->maxExceptDepth =
- TclMax(envPtr->exceptDepth, envPtr->maxExceptDepth);
- range = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr);
- TclEmitInstInt4(INST_BEGIN_CATCH4, range, envPtr);
-
- /*
* If the body is a simple word, compile the instructions to
* eval it. Otherwise, compile instructions to substitute its
* text without catching, a catch instruction that resets the
@@ -310,16 +299,23 @@
*/
if (cmdTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
- startOffset = (envPtr->codeNext - envPtr->codeStart);
+ range = TclBeginExceptRange(CATCH_EXCEPTION_RANGE, envPtr);
+ TclEmitInstInt4(INST_BEGIN_CATCH4, range, envPtr)
code = TclCompileCmdWord(interp, cmdTokenPtr+1, 1, envPtr);
} else {
+ /*
+ * REMARK: this will store an off-by-one stack depth in the
+ * catchStack, but this is not important: we rely on INST_EVAL_STK
+ * to pop its argument before going to checkForCatch.
+ */
+
code = TclCompileTokens(interp, cmdTokenPtr+1,
cmdTokenPtr->numComponents, envPtr);
- startOffset = (envPtr->codeNext - envPtr->codeStart);
+ range = TclBeginExceptRange(CATCH_EXCEPTION_RANGE, envPtr);
+ TclEmitInstInt4(INST_BEGIN_CATCH4, range, envPtr)
TclEmitOpcode(INST_EVAL_STK, envPtr);
}
- envPtr->exceptArrayPtr[range].codeOffset = startOffset;
-
+
if (code != TCL_OK) {
if (code == TCL_ERROR) {
sprintf(buffer, "\n (\"catch\" body line %d)",
@@ -328,9 +324,8 @@
}
goto done;
}
- envPtr->exceptArrayPtr[range].numCodeBytes =
- (envPtr->codeNext - envPtr->codeStart) - startOffset;
-
+ TclEndExceptRange(range, envPtr);
+
/*
* The "no errors" epilogue code: store the body's result into the
* variable (if any), push "0" (TCL_OK) as the catch's "no error"
@@ -375,16 +370,16 @@
* an endCatch instruction at the end of the catch command.
*/
- jumpDist = (envPtr->codeNext - envPtr->codeStart)
- - jumpFixup.codeOffset;
+ jumpDist = (envPtr->codeNext - envPtr->codeStart) -
+ jumpFixup.codeOffset;
if (TclFixupForwardJump(envPtr, &jumpFixup, jumpDist, 127)) {
panic("TclCompileCatchCmd: bad jump distance %d\n", jumpDist);
}
+
TclEmitOpcode(INST_END_CATCH, envPtr);
done:
envPtr->currStackDepth = savedStackDepth + 1;
- envPtr->exceptDepth--;
return code;
}
@@ -501,7 +496,7 @@
{
Tcl_Token *startTokenPtr, *testTokenPtr, *nextTokenPtr, *bodyTokenPtr;
JumpFixup jumpEvalCondFixup;
- int testCodeOffset, bodyCodeOffset, nextCodeOffset, jumpDist;
+ int jumpDist;
int bodyRange, nextRange, code;
char buffer[32 + TCL_INTEGER_SPACE];
int savedStackDepth = envPtr->currStackDepth;
@@ -539,18 +534,6 @@
}
/*
- * Create ExceptionRange records for the body and the "next" command.
- * The "next" command's ExceptionRange supports break but not continue
- * (and has a -1 continueOffset).
- */
-
- envPtr->exceptDepth++;
- envPtr->maxExceptDepth =
- TclMax(envPtr->exceptDepth, envPtr->maxExceptDepth);
- bodyRange = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr);
- nextRange = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr);
-
- /*
* Inline compile the initial command.
*/
@@ -561,7 +544,7 @@
Tcl_AddObjErrorInfo(interp,
"\n (\"for\" initial command)", -1);
}
- goto done;
+ return code;
}
TclEmitOpcode(INST_POP, envPtr);
@@ -580,10 +563,10 @@
TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &jumpEvalCondFixup);
/*
- * Compile the loop body.
+ * Compile the loop body. Create an ExceptionRange.
*/
- bodyCodeOffset = (envPtr->codeNext - envPtr->codeStart);
+ bodyRange = TclBeginExceptRange(LOOP_EXCEPTION_RANGE, envPtr);
code = TclCompileCmdWord(interp, bodyTokenPtr+1,
bodyTokenPtr->numComponents, envPtr);
@@ -594,19 +577,19 @@
interp->errorLine);
Tcl_AddObjErrorInfo(interp, buffer, -1);
}
- goto done;
+ return code;
}
- envPtr->exceptArrayPtr[bodyRange].numCodeBytes =
- (envPtr->codeNext - envPtr->codeStart) - bodyCodeOffset;
+ TclEndExceptRange(bodyRange, envPtr);
TclEmitOpcode(INST_POP, envPtr);
-
/*
- * Compile the "next" subcommand.
+ * Compile the "next" subcommand. Create an ExceptionRange that
+ * supports break but not continue (and has a -1 continueOffset).
*/
- nextCodeOffset = (envPtr->codeNext - envPtr->codeStart);
-
+ nextRange = TclBeginExceptRange(LOOP_EXCEPTION_RANGE, envPtr);
+ envPtr->exceptArrayPtr[bodyRange].continueOffset =
+ (envPtr->codeNext - envPtr->codeStart);
envPtr->currStackDepth = savedStackDepth;
code = TclCompileCmdWord(interp, nextTokenPtr+1,
nextTokenPtr->numComponents, envPtr);
@@ -616,27 +599,19 @@
Tcl_AddObjErrorInfo(interp,
"\n (\"for\" loop-end command)", -1);
}
- goto done;
+ return code;
}
- envPtr->exceptArrayPtr[nextRange].numCodeBytes =
- (envPtr->codeNext - envPtr->codeStart)
- - nextCodeOffset;
+ TclEndExceptRange(nextRange, envPtr);
TclEmitOpcode(INST_POP, envPtr);
envPtr->currStackDepth = savedStackDepth;
/*
- * Compile the test expression then emit the conditional jump that
- * terminates the for.
+ * Compile the test expression.
*/
- testCodeOffset = (envPtr->codeNext - envPtr->codeStart);
-
- jumpDist = testCodeOffset - jumpEvalCondFixup.codeOffset;
- if (TclFixupForwardJump(envPtr, &jumpEvalCondFixup, jumpDist, 127)) {
- bodyCodeOffset += 3;
- nextCodeOffset += 3;
- testCodeOffset += 3;
- }
+ jumpDist = (envPtr->codeNext - envPtr->codeStart)
+ - jumpEvalCondFixup.codeOffset;
+ (void) TclFixupForwardJump(envPtr, &jumpEvalCondFixup, jumpDist, 127);
envPtr->currStackDepth = savedStackDepth;
code = TclCompileExprWords(interp, testTokenPtr, 1, envPtr);
@@ -645,11 +620,16 @@
Tcl_AddObjErrorInfo(interp,
"\n (\"for\" test expression)", -1);
}
- goto done;
+ return code;
}
envPtr->currStackDepth = savedStackDepth + 1;
-
- jumpDist = (envPtr->codeNext - envPtr->codeStart) - bodyCodeOffset;
+
+ /*
+ * Emit the conditional jump that terminates the for.
+ */
+
+ jumpDist = (envPtr->codeNext - envPtr->codeStart) -
+ envPtr->exceptArrayPtr[bodyRange].codeOffset;
if (jumpDist > 127) {
TclEmitInstInt4(INST_JUMP_TRUE4, -jumpDist, envPtr);
} else {
@@ -657,14 +637,9 @@
}
/*
- * Set the loop's offsets and break target.
+ * Set the loop's break target.
*/
- envPtr->exceptArrayPtr[bodyRange].codeOffset = bodyCodeOffset;
- envPtr->exceptArrayPtr[bodyRange].continueOffset = nextCodeOffset;
-
- envPtr->exceptArrayPtr[nextRange].codeOffset = nextCodeOffset;
-
envPtr->exceptArrayPtr[bodyRange].breakOffset =
envPtr->exceptArrayPtr[nextRange].breakOffset =
(envPtr->codeNext - envPtr->codeStart);
@@ -675,11 +650,7 @@
envPtr->currStackDepth = savedStackDepth;
TclEmitPush(TclRegisterLiteral(envPtr, "", 0, /*onHeap*/ 0), envPtr);
- code = TCL_OK;
-
- done:
- envPtr->exceptDepth--;
- return code;
+ return TCL_OK;
}
/*
@@ -722,9 +693,8 @@
* iteration count. */
Tcl_Token *tokenPtr, *bodyTokenPtr;
char *varList;
- unsigned char *jumpPc;
- JumpFixup jumpFalseFixup;
- int jumpDist, jumpBackDist, jumpBackOffset, infoIndex, range;
+ JumpFixup jumpFixup;
+ int jumpDist, infoIndex, range;
int numWords, numLists, numVars, loopIndex, tempVar, i, j, code;
char savedChar;
char buffer[32 + TCL_INTEGER_SPACE];
@@ -891,8 +861,6 @@
* Evaluate then store each value list in the associated temporary.
*/
- range = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr);
-
loopIndex = 0;
for (i = 0, tokenPtr = parsePtr->tokenPtr;
i < numWords-1;
@@ -922,21 +890,20 @@
TclEmitInstInt4(INST_FOREACH_START4, infoIndex, envPtr);
/*
- * Top of loop code: assign each loop variable and check whether
- * to terminate the loop.
+ * END OF LOOP INITIALIZATION, START OF ACTUAL LOOP CODE.
+ *
+ * Jump to the assignement and test at the end of the loop,
+ * using the loop rotation algorithm (see comments in the
+ * code for [while].
*/
- envPtr->exceptArrayPtr[range].continueOffset =
- (envPtr->codeNext - envPtr->codeStart);
- TclEmitInstInt4(INST_FOREACH_STEP4, infoIndex, envPtr);
- TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, &jumpFalseFixup);
-
+ TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &jumpFixup);
+
/*
* Inline compile the loop body.
*/
- envPtr->exceptArrayPtr[range].codeOffset =
- (envPtr->codeNext - envPtr->codeStart);
+ range = TclBeginExceptRange(LOOP_EXCEPTION_RANGE, envPtr);
code = TclCompileCmdWord(interp, bodyTokenPtr+1,
bodyTokenPtr->numComponents, envPtr);
envPtr->currStackDepth = savedStackDepth + 1;
@@ -948,53 +915,37 @@
}
goto done;
}
- envPtr->exceptArrayPtr[range].numCodeBytes =
- (envPtr->codeNext - envPtr->codeStart)
- - envPtr->exceptArrayPtr[range].codeOffset;
+ TclEndExceptRange(range, envPtr);
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.
+ * Fixup the initial jump.
*/
- jumpBackOffset = (envPtr->codeNext - envPtr->codeStart);
- jumpBackDist =
- (jumpBackOffset - envPtr->exceptArrayPtr[range].continueOffset);
- if (jumpBackDist > 120) {
- TclEmitInstInt4(INST_JUMP4, -jumpBackDist, envPtr);
- } else {
- TclEmitInstInt1(INST_JUMP1, -jumpBackDist, envPtr);
- }
+ jumpDist = (envPtr->codeNext - envPtr->codeStart) -
+ jumpFixup.codeOffset;
+ (void) TclFixupForwardJump(envPtr, &jumpFixup, jumpDist, 127);
/*
- * Fix the target of the jump after the foreach_step test.
+ * Assign each loop variable and check whether to terminate
+ * the loop, then jump back to the top of the loop if INST_FOREACH_STEP
+ * says so.
+ *
+ * FUTURE: let INST_FOREACH_STEP do this jump, we do not need the
+ * extra operations: create a TCL_OBJ, push it, instruction to test it
+ * and jump. Not done now for backwards compatibility with .tbc
*/
- 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.
- */
+ envPtr->exceptArrayPtr[range].continueOffset =
+ (envPtr->codeNext - envPtr->codeStart);
+ TclEmitInstInt4(INST_FOREACH_STEP4, infoIndex, envPtr);
- jumpBackOffset += 3;
- jumpPc = (envPtr->codeStart + jumpBackOffset);
- jumpBackDist += 3;
- if (jumpBackDist > 120) {
- TclUpdateInstInt4AtPc(INST_JUMP4, -jumpBackDist, jumpPc);
- } else {
- TclUpdateInstInt1AtPc(INST_JUMP1, -jumpBackDist, jumpPc);
- }
+ jumpDist = (envPtr->codeNext - envPtr->codeStart) -
+ envPtr->exceptArrayPtr[range].codeOffset;
+ if (jumpDist > 120) {
+ TclEmitInstInt4(INST_JUMP_TRUE4, -jumpDist, envPtr);
+ } else {
+ TclEmitInstInt1(INST_JUMP_TRUE1, -jumpDist, envPtr);
}
/*
@@ -1022,7 +973,6 @@
ckfree((char *) varcList);
ckfree((char *) varvList);
}
- envPtr->exceptDepth--;
return code;
}
@@ -2880,7 +2830,7 @@
{
Tcl_Token *testTokenPtr, *bodyTokenPtr;
JumpFixup jumpEvalCondFixup;
- int testCodeOffset, bodyCodeOffset, jumpDist;
+ int testCodeOffset, jumpDist;
int range, code;
char buffer[32 + TCL_INTEGER_SPACE];
int savedStackDepth = envPtr->currStackDepth;
@@ -2952,16 +2902,6 @@
Tcl_ResetResult(interp);
}
*savedPos = savedChar;
-
- /*
- * Create a ExceptionRange record for the loop body. This is used to
- * implement break and continue.
- */
-
- envPtr->exceptDepth++;
- envPtr->maxExceptDepth =
- TclMax(envPtr->exceptDepth, envPtr->maxExceptDepth);
- range = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr);
/*
* Jump to the evaluation of the condition. This code uses the "loop
@@ -2989,7 +2929,7 @@
* Compile the loop body.
*/
- bodyCodeOffset = (envPtr->codeNext - envPtr->codeStart);
+ range = TclBeginExceptRange(LOOP_EXCEPTION_RANGE, envPtr);
code = TclCompileCmdWord(interp, bodyTokenPtr+1,
bodyTokenPtr->numComponents, envPtr);
envPtr->currStackDepth = savedStackDepth + 1;
@@ -2999,10 +2939,9 @@
interp->errorLine);
Tcl_AddObjErrorInfo(interp, buffer, -1);
}
- goto error;
+ return code;
}
- envPtr->exceptArrayPtr[range].numCodeBytes =
- (envPtr->codeNext - envPtr->codeStart) - bodyCodeOffset;
+ TclEndExceptRange(range, envPtr);
TclEmitOpcode(INST_POP, envPtr);
/*
@@ -3014,7 +2953,6 @@
testCodeOffset = (envPtr->codeNext - envPtr->codeStart);
jumpDist = testCodeOffset - jumpEvalCondFixup.codeOffset;
if (TclFixupForwardJump(envPtr, &jumpEvalCondFixup, jumpDist, 127)) {
- bodyCodeOffset += 3;
testCodeOffset += 3;
}
envPtr->currStackDepth = savedStackDepth;
@@ -3024,18 +2962,19 @@
Tcl_AddObjErrorInfo(interp,
"\n (\"while\" test expression)", -1);
}
- goto error;
+ return code;
}
envPtr->currStackDepth = savedStackDepth + 1;
-
- jumpDist = (envPtr->codeNext - envPtr->codeStart) - bodyCodeOffset;
+ jumpDist = (envPtr->codeNext - envPtr->codeStart) -
+ envPtr->exceptArrayPtr[range].codeOffset;
if (jumpDist > 127) {
TclEmitInstInt4(INST_JUMP_TRUE4, -jumpDist, envPtr);
} else {
TclEmitInstInt1(INST_JUMP_TRUE1, -jumpDist, envPtr);
}
} else {
- jumpDist = (envPtr->codeNext - envPtr->codeStart) - bodyCodeOffset;
+ jumpDist = (envPtr->codeNext - envPtr->codeStart) -
+ envPtr->exceptArrayPtr[range].codeOffset;
if (jumpDist > 127) {
TclEmitInstInt4(INST_JUMP4, -jumpDist, envPtr);
} else {
@@ -3045,11 +2984,10 @@
/*
- * Set the loop's body, continue and break offsets.
+ * Set the loop's continue and break offsets.
*/
envPtr->exceptArrayPtr[range].continueOffset = testCodeOffset;
- envPtr->exceptArrayPtr[range].codeOffset = bodyCodeOffset;
envPtr->exceptArrayPtr[range].breakOffset =
(envPtr->codeNext - envPtr->codeStart);
@@ -3060,12 +2998,7 @@
pushResult:
envPtr->currStackDepth = savedStackDepth;
TclEmitPush(TclRegisterLiteral(envPtr, "", 0, /*onHeap*/ 0), envPtr);
- envPtr->exceptDepth--;
return TCL_OK;
-
- error:
- envPtr->exceptDepth--;
- return code;
}
/*
Index: generic/tclCompile.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclCompile.c,v
retrieving revision 1.31
diff -u -r1.31 tclCompile.c
--- generic/tclCompile.c 25 Jan 2002 20:40:55 -0000 1.31
+++ generic/tclCompile.c 7 Mar 2002 12:36:46 -0000
@@ -2074,7 +2074,7 @@
/*
*----------------------------------------------------------------------
*
- * TclCreateExceptRange --
+ * TclBeginExceptRange --
*
* Procedure that allocates and initializes a new ExceptionRange
* structure of the specified kind in a CompileEnv.
@@ -2088,12 +2088,14 @@
* allocated, if envPtr->mallocedExceptArray is non-zero the old
* array is freed, and ExceptionRange entries are copied from the old
* array to the new one.
+ * The codeOffset field of the ExceptionRange is initialized to
+ * the current position, the compilation environment's exceptDepth
+ * and maxExceptDepth are updated.
*
*----------------------------------------------------------------------
*/
-int
-TclCreateExceptRange(type, envPtr)
+int TclBeginExceptRange(type, envPtr)
ExceptionRangeType type; /* The kind of ExceptionRange desired. */
register CompileEnv *envPtr;/* Points to CompileEnv for which to
* create a new ExceptionRange structure. */
@@ -2131,16 +2133,49 @@
envPtr->mallocedExceptArray = 1;
}
envPtr->exceptArrayNext++;
+ envPtr->exceptDepth++;
+ envPtr->maxExceptDepth =
+ TclMax(envPtr->exceptDepth, envPtr->maxExceptDepth);
rangePtr = &(envPtr->exceptArrayPtr[index]);
rangePtr->type = type;
rangePtr->nestingLevel = envPtr->exceptDepth;
- rangePtr->codeOffset = -1;
+ rangePtr->codeOffset = (envPtr->codeNext - envPtr->codeStart);
rangePtr->numCodeBytes = -1;
rangePtr->breakOffset = -1;
rangePtr->continueOffset = -1;
rangePtr->catchOffset = -1;
return index;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclEndExceptRange --
+ *
+ *
+ * Procedure that closes an existing ExceptionRange.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The numCodeBytes field of the ExceptionRange is initialized to
+ * reflect the current position, the compilation environment's
+ * exceptDepth is updated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void TclEndExceptRange(index, envPtr)
+ int index; /* The index of the exception range. */
+ CompileEnv *envPtr;/* CompileEnv for this exceptionRange.*/
+{
+ register ExceptionRange *rangePtr = &(envPtr->exceptArrayPtr[index]);
+
+ rangePtr->numCodeBytes =
+ (envPtr->codeNext - envPtr->codeStart) - rangePtr->codeOffset;
+ envPtr->exceptDepth--;
}
/*
Index: generic/tclCompile.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclCompile.h,v
retrieving revision 1.25
diff -u -r1.25 tclCompile.h
--- generic/tclCompile.h 15 Feb 2002 14:28:48 -0000 1.25
+++ generic/tclCompile.h 7 Mar 2002 12:36:47 -0000
@@ -757,6 +757,8 @@
*----------------------------------------------------------------
*/
+EXTERN int TclBeginExceptRange _ANSI_ARGS_((
+ ExceptionRangeType type, CompileEnv *envPtr));
EXTERN void TclCleanupByteCode _ANSI_ARGS_((ByteCode *codePtr));
EXTERN int TclCompileCmdWord _ANSI_ARGS_((Tcl_Interp *interp,
Tcl_Token *tokenPtr, int count,
@@ -775,14 +777,14 @@
CompileEnv *envPtr));
EXTERN int TclCreateAuxData _ANSI_ARGS_((ClientData clientData,
AuxDataType *typePtr, CompileEnv *envPtr));
-EXTERN int TclCreateExceptRange _ANSI_ARGS_((
- ExceptionRangeType type, CompileEnv *envPtr));
EXTERN ExecEnv * TclCreateExecEnv _ANSI_ARGS_((Tcl_Interp *interp));
EXTERN void TclDeleteExecEnv _ANSI_ARGS_((ExecEnv *eePtr));
EXTERN void TclDeleteLiteralTable _ANSI_ARGS_((
Tcl_Interp *interp, LiteralTable *tablePtr));
EXTERN void TclEmitForwardJump _ANSI_ARGS_((CompileEnv *envPtr,
TclJumpType jumpType, JumpFixup *jumpFixupPtr));
+EXTERN void TclEndExceptRange _ANSI_ARGS_((
+ int index, CompileEnv *envPtr));
EXTERN ExceptionRange * TclGetExceptionRangeForPc _ANSI_ARGS_((
unsigned char *pc, int catchOnly,
ByteCode* codePtr));
Index: generic/tclExecute.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclExecute.c,v
retrieving revision 1.49
diff -u -r1.49 tclExecute.c
--- generic/tclExecute.c 28 Feb 2002 13:03:53 -0000 1.49
+++ generic/tclExecute.c 7 Mar 2002 12:36:50 -0000
@@ -187,6 +187,26 @@
(stackPtr[stackTop--])
/*
+ * Macros for run-time peep-hole optimisation.
+ */
+
+/*
+ * PEEP_PUSH_OBJECT() will look ahead for an INST_POP instruction;
+ * if it does find one, it will skip the push/pop operation and go
+ * directly to the following instruction.
+ */
+
+#ifdef TCL_COMPILE_DEBUG
+#define PUSH_OBJECT_PEEP_FOR_POP(offset, objPtr) PUSH_OBJECT(objPtr)
+#else
+#define PUSH_OBJECT_PEEP_FOR_POP(offset, objPtr) \
+ if (*(pc+(offset)) == INST_POP) { \
+ ADJUST_PC((offset) + 1); \
+ } \
+ PUSH_OBJECT(objPtr)
+#endif
+
+/*
* Macros used to trace instruction execution. The macros TRACE,
* TRACE_WITH_OBJ, and O2S are only used inside TclExecuteByteCode.
* O2S is only used in TRACE* calls to get a string from an object.
@@ -1187,13 +1207,12 @@
PUSH_OBJECT(valuePtr);
TRACE_WITH_OBJ(("%u => ", TclGetInt1AtPtr(pc+1)), valuePtr);
#else
- PUSH_OBJECT(codePtr->objArrayPtr[TclGetUInt1AtPtr(pc+1)]);
+ PUSH_OBJECT_PEEP_FOR_POP(2, codePtr->objArrayPtr[TclGetUInt1AtPtr(pc+1)]);
#endif /* TCL_COMPILE_DEBUG */
ADJUST_PC(2);
case INST_PUSH4:
- valuePtr = codePtr->objArrayPtr[TclGetUInt4AtPtr(pc+1)];
- PUSH_OBJECT(valuePtr);
+ PUSH_OBJECT_PEEP_FOR_POP(5, codePtr->objArrayPtr[TclGetUInt4AtPtr(pc+1)]);
TRACE_WITH_OBJ(("%u => ", TclGetUInt4AtPtr(pc+1)), valuePtr);
ADJUST_PC(5);
@@ -1262,7 +1281,7 @@
}
}
stackTop -= opnd;
-
+
PUSH_OBJECT(concatObjPtr);
TRACE_WITH_OBJ(("%u => ", opnd), concatObjPtr);
ADJUST_PC(2);
@@ -1385,7 +1404,7 @@
* Push the call's object result and continue execution
* with the next instruction.
*/
- PUSH_OBJECT(Tcl_GetObjResult(interp));
+ PUSH_OBJECT_PEEP_FOR_POP(pcAdjustment, Tcl_GetObjResult(interp));
TRACE_WITH_OBJ(("%u => ...after \"%.20s\", result=",
objc, cmdNameBuf), Tcl_GetObjResult(interp));
ADJUST_PC(pcAdjustment);
@@ -1467,6 +1486,12 @@
}
case INST_EVAL_STK:
+ /*
+ * Note to maintainers: it is important that INST_EVAL_STK
+ * pop its argument from the stack before jumping to
+ * checkForCatch! DO NOT OPTIMISE!
+ */
+
objPtr = POP_OBJECT();
DECACHE_STACK_INFO();
result = TclCompEvalObj(interp, objPtr, /* engineCall */ 1);
@@ -1475,10 +1500,10 @@
/*
* Normal return; push the eval's object result.
*/
- PUSH_OBJECT(Tcl_GetObjResult(interp));
TRACE_WITH_OBJ(("\"%.30s\" => ", O2S(objPtr)),
Tcl_GetObjResult(interp));
TclDecrRefCount(objPtr);
+ PUSH_OBJECT_PEEP_FOR_POP(1, Tcl_GetObjResult(interp));
ADJUST_PC(1);
} else if ((result == TCL_BREAK) || (result == TCL_CONTINUE)) {
/*
@@ -1565,7 +1590,7 @@
result = TCL_ERROR;
goto checkForCatch;
}
- PUSH_OBJECT(valuePtr);
+ PUSH_OBJECT_PEEP_FOR_POP(2, valuePtr);
TRACE_WITH_OBJ(("%u => ", opnd), valuePtr);
ADJUST_PC(2);
@@ -1580,7 +1605,7 @@
result = TCL_ERROR;
goto checkForCatch;
}
- PUSH_OBJECT(valuePtr);
+ PUSH_OBJECT_PEEP_FOR_POP(5, valuePtr);
TRACE_WITH_OBJ(("%u => ", opnd), valuePtr);
ADJUST_PC(5);
@@ -1597,9 +1622,9 @@
result = TCL_ERROR;
goto checkForCatch;
}
- PUSH_OBJECT(valuePtr);
TRACE_WITH_OBJ(("\"%.30s\" => ", O2S(objPtr)), valuePtr);
TclDecrRefCount(objPtr);
+ PUSH_OBJECT_PEEP_FOR_POP(1, valuePtr);
ADJUST_PC(1);
case INST_LOAD_ARRAY4:
@@ -1625,10 +1650,10 @@
result = TCL_ERROR;
goto checkForCatch;
}
- PUSH_OBJECT(valuePtr);
TRACE_WITH_OBJ(("%u \"%.30s\" => ",
opnd, O2S(elemPtr)),valuePtr);
TclDecrRefCount(elemPtr);
+ PUSH_OBJECT_PEEP_FOR_POP(pcAdjustment, valuePtr);
ADJUST_PC(pcAdjustment);
case INST_LOAD_ARRAY_STK:
@@ -1647,11 +1672,11 @@
result = TCL_ERROR;
goto checkForCatch;
}
- PUSH_OBJECT(valuePtr);
TRACE_WITH_OBJ(("\"%.30s(%.30s)\" => ",
O2S(objPtr), O2S(elemPtr)), valuePtr);
TclDecrRefCount(objPtr);
TclDecrRefCount(elemPtr);
+ PUSH_OBJECT_PEEP_FOR_POP(1, valuePtr);
ADJUST_PC(1);
case INST_STORE_SCALAR4:
@@ -1676,10 +1701,10 @@
result = TCL_ERROR;
goto checkForCatch;
}
- PUSH_OBJECT(value2Ptr);
TRACE_WITH_OBJ(("%u <- \"%.30s\" => ",
opnd, O2S(valuePtr)), value2Ptr);
TclDecrRefCount(valuePtr);
+ PUSH_OBJECT_PEEP_FOR_POP(pcAdjustment, value2Ptr);
ADJUST_PC(pcAdjustment);
case INST_STORE_STK:
@@ -1699,11 +1724,11 @@
result = TCL_ERROR;
goto checkForCatch;
}
- PUSH_OBJECT(value2Ptr);
TRACE_WITH_OBJ(("\"%.30s\" <- \"%.30s\" => ",
O2S(objPtr), O2S(valuePtr)), value2Ptr);
TclDecrRefCount(objPtr);
TclDecrRefCount(valuePtr);
+ PUSH_OBJECT_PEEP_FOR_POP(1, value2Ptr);
ADJUST_PC(1);
case INST_STORE_ARRAY4:
@@ -1731,11 +1756,11 @@
result = TCL_ERROR;
goto checkForCatch;
}
- PUSH_OBJECT(value2Ptr);
TRACE_WITH_OBJ(("%u \"%.30s\" <- \"%.30s\" => ",
opnd, O2S(elemPtr), O2S(valuePtr)), value2Ptr);
TclDecrRefCount(elemPtr);
TclDecrRefCount(valuePtr);
+ PUSH_OBJECT_PEEP_FOR_POP(pcAdjustment, value2Ptr);
ADJUST_PC(pcAdjustment);
case INST_STORE_ARRAY_STK:
@@ -1756,13 +1781,13 @@
result = TCL_ERROR;
goto checkForCatch;
}
- PUSH_OBJECT(value2Ptr);
TRACE_WITH_OBJ(("\"%.30s(%.30s)\" <- \"%.30s\" => ",
O2S(objPtr), O2S(elemPtr), O2S(valuePtr)),
value2Ptr);
TclDecrRefCount(objPtr);
TclDecrRefCount(elemPtr);
TclDecrRefCount(valuePtr);
+ PUSH_OBJECT_PEEP_FOR_POP(1, value2Ptr);
ADJUST_PC(1);
/*
@@ -1791,10 +1816,10 @@
result = TCL_ERROR;
goto checkForCatch;
}
- PUSH_OBJECT(value2Ptr);
TRACE_WITH_OBJ(("%u <- \"%.30s\" => ",
opnd, O2S(valuePtr)), value2Ptr);
TclDecrRefCount(valuePtr);
+ PUSH_OBJECT_PEEP_FOR_POP(pcAdjustment, value2Ptr);
ADJUST_PC(pcAdjustment);
case INST_APPEND_STK:
@@ -1827,7 +1852,6 @@
result = TCL_ERROR;
goto checkForCatch;
}
- PUSH_OBJECT(value2Ptr);
if (elemPtr) {
TRACE_WITH_OBJ(("\"%.30s(%.30s)\" <-+ \"%.30s\" => ",
O2S(objPtr), O2S(elemPtr), O2S(valuePtr)),
@@ -1839,6 +1863,7 @@
}
TclDecrRefCount(objPtr);
TclDecrRefCount(valuePtr);
+ PUSH_OBJECT_PEEP_FOR_POP(1, value2Ptr);
ADJUST_PC(1);
case INST_APPEND_ARRAY4:
@@ -1866,11 +1891,11 @@
result = TCL_ERROR;
goto checkForCatch;
}
- PUSH_OBJECT(value2Ptr);
TRACE_WITH_OBJ(("%u \"%.30s\" <-+ \"%.30s\" => ",
opnd, O2S(elemPtr), O2S(valuePtr)), value2Ptr);
TclDecrRefCount(elemPtr);
TclDecrRefCount(valuePtr);
+ PUSH_OBJECT_PEEP_FOR_POP(pcAdjustment, value2Ptr);
ADJUST_PC(pcAdjustment);
/*
@@ -1889,7 +1914,7 @@
objPtr = POP_OBJECT();
TclDecrRefCount(objPtr);
}
- PUSH_OBJECT(valuePtr);
+ PUSH_OBJECT_PEEP_FOR_POP(5, valuePtr);
TRACE_WITH_OBJ(("%u => ", opnd), valuePtr);
ADJUST_PC(5);
@@ -1919,10 +1944,10 @@
result = TCL_ERROR;
goto checkForCatch;
}
- PUSH_OBJECT(value2Ptr);
TRACE_WITH_OBJ(("%u <- \"%.30s\" => ",
opnd, O2S(valuePtr)), value2Ptr);
TclDecrRefCount(valuePtr);
+ PUSH_OBJECT_PEEP_FOR_POP(pcAdjustment, value2Ptr);
ADJUST_PC(pcAdjustment);
case INST_LAPPEND_STK:
@@ -2007,7 +2032,6 @@
result = TCL_ERROR;
goto checkForCatch;
}
- PUSH_OBJECT(newValuePtr);
if (elemPtr) {
TRACE_WITH_OBJ(("\"%.30s(%.30s)\" <- \"%.30s\" => ",
O2S(objPtr), O2S(elemPtr), O2S(valuePtr)),
@@ -2019,6 +2043,7 @@
}
TclDecrRefCount(objPtr);
TclDecrRefCount(value2Ptr);
+ PUSH_OBJECT_PEEP_FOR_POP(1, newValuePtr);
ADJUST_PC(1);
}
@@ -2048,11 +2073,11 @@
result = TCL_ERROR;
goto checkForCatch;
}
- PUSH_OBJECT(value2Ptr);
TRACE_WITH_OBJ(("%u \"%.30s\" <-+ \"%.30s\" => ",
opnd, O2S(elemPtr), O2S(valuePtr)), value2Ptr);
TclDecrRefCount(elemPtr);
TclDecrRefCount(valuePtr);
+ PUSH_OBJECT_PEEP_FOR_POP(pcAdjustment, value2Ptr);
ADJUST_PC(pcAdjustment);
/*
@@ -2088,9 +2113,9 @@
result = TCL_ERROR;
goto checkForCatch;
}
- PUSH_OBJECT(value2Ptr);
TRACE_WITH_OBJ(("%u (by %ld) => ", opnd, i), value2Ptr);
TclDecrRefCount(valuePtr);
+ PUSH_OBJECT_PEEP_FOR_POP(2, value2Ptr);
ADJUST_PC(2);
case INST_INCR_SCALAR_STK:
@@ -2127,11 +2152,11 @@
result = TCL_ERROR;
goto checkForCatch;
}
- PUSH_OBJECT(value2Ptr);
TRACE_WITH_OBJ(("\"%.30s\" (by %ld) => ", O2S(objPtr), i),
value2Ptr);
TclDecrRefCount(objPtr);
TclDecrRefCount(valuePtr);
+ PUSH_OBJECT_PEEP_FOR_POP(1, value2Ptr);
ADJUST_PC(1);
case INST_INCR_ARRAY1:
@@ -2169,11 +2194,11 @@
result = TCL_ERROR;
goto checkForCatch;
}
- PUSH_OBJECT(value2Ptr);
TRACE_WITH_OBJ(("%u \"%.30s\" (by %ld) => ",
opnd, O2S(elemPtr), i), value2Ptr);
TclDecrRefCount(elemPtr);
TclDecrRefCount(valuePtr);
+ PUSH_OBJECT_PEEP_FOR_POP(2, value2Ptr);
ADJUST_PC(2);
case INST_INCR_ARRAY_STK:
@@ -2213,12 +2238,12 @@
result = TCL_ERROR;
goto checkForCatch;
}
- PUSH_OBJECT(value2Ptr);
TRACE_WITH_OBJ(("\"%.30s(%.30s)\" (by %ld) => ",
O2S(objPtr), O2S(elemPtr), i), value2Ptr);
TclDecrRefCount(objPtr);
TclDecrRefCount(elemPtr);
TclDecrRefCount(valuePtr);
+ PUSH_OBJECT_PEEP_FOR_POP(1, value2Ptr);
ADJUST_PC(1);
case INST_INCR_SCALAR1_IMM:
@@ -2233,7 +2258,7 @@
result = TCL_ERROR;
goto checkForCatch;
}
- PUSH_OBJECT(value2Ptr);
+ PUSH_OBJECT_PEEP_FOR_POP(3, value2Ptr);
TRACE_WITH_OBJ(("%u %ld => ", opnd, i), value2Ptr);
ADJUST_PC(3);
@@ -2252,10 +2277,10 @@
TclDecrRefCount(objPtr);
goto checkForCatch;
}
- PUSH_OBJECT(value2Ptr);
TRACE_WITH_OBJ(("\"%.30s\" %ld => ", O2S(objPtr), i),
value2Ptr);
TclDecrRefCount(objPtr);
+ PUSH_OBJECT_PEEP_FOR_POP(2, value2Ptr);
ADJUST_PC(2);
case INST_INCR_ARRAY1_IMM:
@@ -2274,10 +2299,10 @@
result = TCL_ERROR;
goto checkForCatch;
}
- PUSH_OBJECT(value2Ptr);
TRACE_WITH_OBJ(("%u \"%.30s\" (by %ld) => ",
opnd, O2S(elemPtr), i), value2Ptr);
TclDecrRefCount(elemPtr);
+ PUSH_OBJECT_PEEP_FOR_POP(3, value2Ptr);
ADJUST_PC(3);
case INST_INCR_ARRAY_STK_IMM:
@@ -2297,11 +2322,11 @@
result = TCL_ERROR;
goto checkForCatch;
}
- PUSH_OBJECT(value2Ptr);
TRACE_WITH_OBJ(("\"%.30s(%.30s)\" (by %ld) => ",
O2S(objPtr), O2S(elemPtr), i), value2Ptr);
TclDecrRefCount(objPtr);
TclDecrRefCount(elemPtr);
+ PUSH_OBJECT_PEEP_FOR_POP(2, value2Ptr);
ADJUST_PC(2);
/*
@@ -2314,16 +2339,18 @@
TRACE(("%d => new pc %u\n", opnd,
(unsigned int)(pc + opnd - codePtr->codeStart)));
pc += opnd;
+ continue;
#else
- pc += TclGetInt1AtPtr(pc+1);
+ ADJUST_PC(TclGetInt1AtPtr(pc+1));
#endif /* TCL_COMPILE_DEBUG */
- continue;
case INST_JUMP4:
+#ifdef TCL_COMPILE_DEBUG
opnd = TclGetInt4AtPtr(pc+1);
TRACE(("%d => new pc %u\n", opnd,
(unsigned int)(pc + opnd - codePtr->codeStart)));
- ADJUST_PC(opnd);
+#endif
+ ADJUST_PC(TclGetInt4AtPtr(pc+1));
case INST_JUMP_TRUE4:
opnd = TclGetInt4AtPtr(pc+1);
@@ -2687,7 +2714,7 @@
/*
* Set result
*/
- PUSH_OBJECT(objPtr);
+ PUSH_OBJECT_PEEP_FOR_POP(5, objPtr);
TRACE(("%d => %s\n", opnd, O2S(objPtr)));
TclDecrRefCount(objPtr);
}
@@ -2730,7 +2757,7 @@
/*
* Set result
*/
- PUSH_OBJECT(objPtr);
+ PUSH_OBJECT_PEEP_FOR_POP(1, objPtr);
TRACE(("=> %s\n", O2S(objPtr)));
TclDecrRefCount(objPtr);
ADJUST_PC(1);
@@ -4329,16 +4356,46 @@
listTmpIndex++;
}
}
-
- /*
- * Push 1 if at least one value list had a remaining element
- * and the loop should continue. Otherwise push 0.
+
+ /*
+ * Peephole code for the new [foreach] compiler, avoiding the
+ * pushing/popping/testing/elimination of a freshly created
+ * Tcl_Obj.
+ * The "old style" code remains for usage by .tbc code compiled
+ * with previous versions of the compiler.
*/
- PUSH_OBJECT(Tcl_NewLongObj(continueLoop));
TRACE(("%u => %d lists, iter %d, %s loop\n",
opnd, numLists, iterNum,
(continueLoop? "continue" : "exit")));
+ {
+ register unsigned char nextInst = *(pc+5);
+
+ if (nextInst == INST_JUMP_TRUE1) {
+ if (continueLoop) {
+ ADJUST_PC(5 + TclGetInt1AtPtr(pc+6));
+ } else {
+ ADJUST_PC(7);
+ }
+ } else if (nextInst == INST_JUMP_TRUE4) {
+ if (continueLoop) {
+ ADJUST_PC(5 + TclGetInt4AtPtr(pc+6));
+ } else {
+ ADJUST_PC(10);
+ }
+ }
+ }
+
+ /*
+ * *** Old-style code, for usage by old .tbc code which follows
+ * *** foreach with INST_JUMP_FALSE, as well as any other
+ * *** non-standard user of this instruction.
+ *
+ * Push 1 if at least one value list had a remaining element
+ * and the loop should continue. Otherwise push 0.
+ */
+
+ PUSH_OBJECT(Tcl_NewLongObj(continueLoop));
}
ADJUST_PC(5);
@@ -4360,12 +4417,12 @@
ADJUST_PC(1);
case INST_PUSH_RESULT:
- PUSH_OBJECT(Tcl_GetObjResult(interp));
+ PUSH_OBJECT_PEEP_FOR_POP(1, Tcl_GetObjResult(interp));
TRACE_WITH_OBJ(("=> "), Tcl_GetObjResult(interp));
ADJUST_PC(1);
case INST_PUSH_RETURN_CODE:
- PUSH_OBJECT(Tcl_NewLongObj(result));
+ PUSH_OBJECT_PEEP_FOR_POP(1, Tcl_NewLongObj(result));
TRACE(("=> %u\n", result));
ADJUST_PC(1);
@@ -4830,25 +4887,28 @@
int numRanges = codePtr->numExceptRanges;
register ExceptionRange *rangePtr;
int pcOffset = (pc - codePtr->codeStart);
- register int i, level;
+ register int start;
if (numRanges == 0) {
return NULL;
}
- rangeArrayPtr = codePtr->exceptArrayPtr;
- for (level = codePtr->maxExceptDepth; level >= 0; level--) {
- for (i = 0; i < numRanges; i++) {
- rangePtr = &(rangeArrayPtr[i]);
- if (rangePtr->nestingLevel == level) {
- int start = rangePtr->codeOffset;
- int end = (start + rangePtr->numCodeBytes);
- if ((start <= pcOffset) && (pcOffset < end)) {
- if ((!catchOnly)
- || (rangePtr->type == CATCH_EXCEPTION_RANGE)) {
- return rangePtr;
- }
- }
+ /*
+ * This exploits peculiarities of our compiler: nested ranges
+ * are always *after* their containing ranges, so that by scanning
+ * backwards we are sure that the first matching range is indeed
+ * the deepest.
+ */
+
+ rangeArrayPtr = codePtr->exceptArrayPtr;
+ rangePtr = rangeArrayPtr + numRanges;
+ while (--rangePtr >= rangeArrayPtr) {
+ start = rangePtr->codeOffset;
+ if ((start <= pcOffset) &&
+ (pcOffset < (start + rangePtr->numCodeBytes))) {
+ if ((!catchOnly)
+ || (rangePtr->type == CATCH_EXCEPTION_RANGE)) {
+ return rangePtr;
}
}
}