diff options
author | sebres <sebres@users.sourceforge.net> | 2019-07-23 17:40:25 (GMT) |
---|---|---|
committer | sebres <sebres@users.sourceforge.net> | 2019-07-23 17:40:25 (GMT) |
commit | 566263fc9aa031a879c81285f1a8a966590dcddd (patch) | |
tree | 32aa50c5a498fdc1e4eb9fd47f3d41a890a43aef | |
parent | 8e0fbdb4c108cf1264038ee6994c693f90699634 (diff) | |
download | tcl-566263fc9aa031a879c81285f1a8a966590dcddd.zip tcl-566263fc9aa031a879c81285f1a8a966590dcddd.tar.gz tcl-566263fc9aa031a879c81285f1a8a966590dcddd.tar.bz2 |
better rewritten loop optimization: new evalFlag "TCL_EVAL_DISCARD_RESULT" introduced, which allows to organize faster TEBC-loop
with discarding of result, simulating pop & done, like it does continue in loop (so ensures that setting of result will not smudge
the measurement).
-rw-r--r-- | generic/tclCmdMZ.c | 17 | ||||
-rw-r--r-- | generic/tclExecute.c | 10 | ||||
-rw-r--r-- | generic/tclInt.h | 1 | ||||
-rw-r--r-- | tests/cmdMZ.test | 10 |
4 files changed, 22 insertions, 16 deletions
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index b4283d0..d16baa9 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -4328,7 +4328,6 @@ Tcl_TimeRateObjCmd( }; NRE_callback *rootPtr; ByteCode *codePtr = NULL; - int codeOptimized = 0; for (i = 1; i < objc - 1; i++) { int index; @@ -4513,15 +4512,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; - } } /* @@ -4563,8 +4553,10 @@ Tcl_TimeRateObjCmd( count++; if (!direct) { /* precompiled */ rootPtr = TOP_CB(interp); + ((Interp *)interp)->evalFlags |= TCL_EVAL_DISCARD_RESULT; result = TclNRExecuteByteCode(interp, codePtr); result = TclNRRunCallbacks(interp, result, rootPtr); + ((Interp *)interp)->evalFlags &= ~TCL_EVAL_DISCARD_RESULT; } else { /* eval */ result = TclEvalObjEx(interp, objPtr, 0, NULL, 0); } @@ -4815,11 +4807,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 cdf0c5d..6959c00 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -2624,6 +2624,14 @@ TEBCresume( case INST_DONE: if (tosPtr > initTosPtr) { + + if ((iPtr->evalFlags & TCL_EVAL_DISCARD_RESULT) && (result == TCL_OK)) { + /* simulate pop & fast done (like it does continue in loop) */ + 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 @@ -8084,7 +8092,7 @@ TEBCresume( */ /* - * 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 708f60a..edf7df6 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -2206,6 +2206,7 @@ typedef struct Interp { #define TCL_EVAL_FILE 0x02 #define TCL_EVAL_SOURCE_IN_FRAME 0x10 #define TCL_EVAL_NORESOLVE 0x20 +#define TCL_EVAL_DISCARD_RESULT 0X40 /* * Flag bits for Interp structures: diff --git a/tests/cmdMZ.test b/tests/cmdMZ.test index 4286bbb..1157ada 100644 --- a/tests/cmdMZ.test +++ b/tests/cmdMZ.test @@ -353,6 +353,11 @@ test cmdMZ-5.7 {Tcl_TimeObjCmd: errors generate right trace} { "error foo" invoked from within "time {error foo}"}} +test cmdMZ-5.7.1 {Tcl_TimeObjCmd: return from time} { + set x 0 + proc r1 {} {upvar x x; time {incr x; return "r1"; incr x} 10} + list [r1] $x +} {r1 1} test cmdMZ-6.1 {Tcl_TimeRateObjCmd: basic format of command} { list [catch {timerate} msg] $msg @@ -399,6 +404,11 @@ test cmdMZ-6.7 {Tcl_TimeRateObjCmd: errors generate right trace} { "error foo" invoked from within "timerate {error foo} 1"}} +test cmdMZ-6.7.1 {Tcl_TimeRateObjCmd: return from timerate} { + set x 0 + proc r1 {} {upvar x x; timerate {incr x; return "r1"; incr x} 1000 10} + list [r1] $x +} {r1 1} test cmdMZ-6.8 {Tcl_TimeRateObjCmd: allow (conditional) break from timerate} { set m1 [timerate {break}] list \ |