diff options
author | sebres <sebres@users.sourceforge.net> | 2019-07-24 13:49:46 (GMT) |
---|---|---|
committer | sebres <sebres@users.sourceforge.net> | 2019-07-24 13:49:46 (GMT) |
commit | 2a43bf86a01bf3f023388c71cd45c653c0adaab1 (patch) | |
tree | 8cfa38afd7bfbbfa78a3cf44d127b7812e0c902c /generic | |
parent | c69df5188c331d7c820e396131163d6bff0368fb (diff) | |
download | tcl-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.c | 21 | ||||
-rw-r--r-- | generic/tclExecute.c | 18 | ||||
-rw-r--r-- | generic/tclInt.h | 1 |
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: |