cherrypick timerate-loop-opti--discard-result

4 files changed, 63 insertions, 20 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:
diff --git a/tests/cmdMZ.test b/tests/cmdMZ.test
index e7c8e6c..45d68b3 100644
--- a/tests/cmdMZ.test
+++ b/tests/cmdMZ.test
@@ -358,6 +358,24 @@ 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-5.8 {Tcl_TimeObjCmd: done optimization: nested call of self inside time (if compiled)} {
+    set x [set y 0]
+    set m1 {
+	if {[incr x] <= 5} {
+	    # nested call should return result, so covering that:
+	    if {![string is integer -strict [eval $m1]]} {error unexpected}
+	}
+	# increase again (no "continue" from nested call):
+	incr x
+    }
+    time {incr y; eval $m1} 5
+    list $y $x
+} {5 20}
 
 test cmdMZ-6.1 {Tcl_TimeRateObjCmd: basic format of command} {
     list [catch {timerate} msg] $msg
@@ -404,6 +422,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 \
@@ -415,10 +438,10 @@ test cmdMZ-6.8 {Tcl_TimeRateObjCmd: allow (conditional) break from timerate} {
 test cmdMZ-6.8.1 {Tcl_TimeRateObjCmd: allow (conditional) continue in timerate} {
     set m1 [timerate {continue; return -code error "unexpected"} 1000 10]
     list \
-    [expr {[lindex $m1 0] < 1000}] \
-    [expr {[lindex $m1 2] == 10}] \
-    [expr {[lindex $m1 4] > 1000}] \
-    [expr {[lindex $m1 6] < 100}]
+	[expr {[lindex $m1 0] < 1000}] \
+	[expr {[lindex $m1 2] == 10}] \
+	[expr {[lindex $m1 4] > 1000}] \
+	[expr {[lindex $m1 6] < 100}]
 } {1 1 1 1}
 test cmdMZ-6.9 {Tcl_TimeRateObjCmd: max count of iterations} {
     set m1 [timerate {} 1000 5];	# max-count wins
@@ -439,6 +462,18 @@ test cmdMZ-6.11 {Tcl_TimeRateObjCmd: done/continue optimization rollback} {
     timerate $m1 1000 10
     if 1 $m1; # if rollback is missing throws an error: invoked "continue" outside of a loop
 } ok
+test cmdMZ-6.12 {Tcl_TimeRateObjCmd: done optimization: nested call of self inside timerate} {
+    set x 0
+    set m1 {
+	if {[incr x] <= 5} {
+	    # nested call should return result, so covering that:
+	    if {![string is integer -strict [eval $m1]]} {error unexpected}
+	}
+	# increase again (no "continue" from nested call):
+	incr x
+    }
+    list [lindex [timerate $m1 1000 5] 2] $x
+} {5 20}
 
 # The tests for Tcl_WhileObjCmd are in while.test