summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
authorsebres <sebres@users.sourceforge.net>2019-07-24 13:49:46 (GMT)
committersebres <sebres@users.sourceforge.net>2019-07-24 13:49:46 (GMT)
commit2a43bf86a01bf3f023388c71cd45c653c0adaab1 (patch)
tree8cfa38afd7bfbbfa78a3cf44d127b7812e0c902c /generic
parentc69df5188c331d7c820e396131163d6bff0368fb (diff)
downloadtcl-2a43bf86a01bf3f023388c71cd45c653c0adaab1.zip
tcl-2a43bf86a01bf3f023388c71cd45c653c0adaab1.tar.gz
tcl-2a43bf86a01bf3f023388c71cd45c653c0adaab1.tar.bz2
cherrypick timerate-loop-opti--discard-result
Diffstat (limited to 'generic')
-rw-r--r--generic/tclCmdMZ.c21
-rw-r--r--generic/tclExecute.c18
-rw-r--r--generic/tclInt.h1
3 files changed, 24 insertions, 16 deletions
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index d36b0f0..255fca1 100644
--- a/generic/tclCmdMZ.c
+++ b/generic/tclCmdMZ.c
@@ -4009,7 +4009,6 @@ Tcl_TimeRateObjCmd(
TMRT_EV_DIRECT, TMRT_OVERHEAD, TMRT_CALIBRATE, TMRT_LAST
};
ByteCode *codePtr = NULL;
- int codeOptimized = 0;
for (i = 1; i < objc - 1; i++) {
int index;
@@ -4194,15 +4193,6 @@ Tcl_TimeRateObjCmd(
}
codePtr = TclCompileObj(interp, objPtr, NULL, 0);
TclPreserveByteCode(codePtr);
- /*
- * Replace last compiled done instruction with continue: it's a part of
- * iteration, this way evaluation will be more similar to a cycle (also
- * avoids extra overhead to set result to interp, etc.)
- */
- if (codePtr->codeStart[codePtr->numCodeBytes-1] == INST_DONE) {
- codePtr->codeStart[codePtr->numCodeBytes-1] = INST_CONTINUE;
- codeOptimized = 1;
- }
}
/*
@@ -4243,6 +4233,12 @@ Tcl_TimeRateObjCmd(
count++;
if (!direct) { /* precompiled */
+ /*
+ * Use loop optimized TEBC call (TCL_EVAL_DISCARD_RESULT): it's a part of
+ * iteration, this way evaluation will be more similar to a cycle (also
+ * avoids extra overhead to set result to interp, etc.)
+ */
+ ((Interp *)interp)->evalFlags |= TCL_EVAL_DISCARD_RESULT;
result = TclExecuteByteCode(interp, codePtr);
} else { /* eval */
result = TclEvalObjEx(interp, objPtr, 0, NULL, 0);
@@ -4492,11 +4488,6 @@ Tcl_TimeRateObjCmd(
done:
if (codePtr != NULL) {
- if ( codeOptimized
- && codePtr->codeStart[codePtr->numCodeBytes-1] == INST_CONTINUE
- ) {
- codePtr->codeStart[codePtr->numCodeBytes-1] = INST_DONE;
- }
TclReleaseByteCode(codePtr);
}
return result;
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 0c2baab..7a8bf39 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -1790,6 +1790,7 @@ TclExecuteByteCode(
Tcl_Obj *expandNestList = NULL;
int checkInterp = 0; /* Indicates when a check of interp readyness
* is necessary. Set by CACHE_STACK_INFO() */
+ int curEvalFlags = iPtr->evalFlags;
/*
* Transfer variables - needed only between opcodes, but not while
@@ -1819,6 +1820,12 @@ TclExecuteByteCode(
const char *curInstName = NULL;
/*
+ * Reset discard result flag - because it is applicable for this call only,
+ * and should not affect all the nested invocations may return result.
+ */
+ iPtr->evalFlags &= ~TCL_EVAL_DISCARD_RESULT;
+
+ /*
* The execution uses a unified stack: first the catch stack, immediately
* above it a CmdFrame, then the execution stack.
*
@@ -2051,6 +2058,15 @@ TclExecuteByteCode(
case INST_DONE:
if (tosPtr > initTosPtr) {
+
+ if ((curEvalFlags & TCL_EVAL_DISCARD_RESULT) && (result == TCL_OK)) {
+ /* simulate pop & fast done (like it does continue in loop) */
+ Tcl_Obj *objPtr;
+ TRACE_WITH_OBJ(("=> discarding "), OBJ_AT_TOS);
+ objPtr = POP_OBJECT();
+ TclDecrRefCount(objPtr);
+ goto abnormalReturn;
+ }
/*
* Set the interpreter's object result to point to the topmost
* object from the stack, and check for a possible [catch]. The
@@ -7403,7 +7419,7 @@ TclExecuteByteCode(
*/
/*
- * Abnormal return code. Restore the stack to state it had when
+ * Done or abnormal return code. Restore the stack to state it had when
* starting to execute the ByteCode. Panic if the stack is below the
* initial level.
*/
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 974dd0d..12634f9 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -1979,6 +1979,7 @@ typedef struct Interp {
#define TCL_ALLOW_EXCEPTIONS 4
#define TCL_EVAL_FILE 2
#define TCL_EVAL_CTX 8
+#define TCL_EVAL_DISCARD_RESULT 0X40
/*
* Flag bits for Interp structures: