summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorMiguel Sofer <miguel.sofer@gmail.com>2010-01-21 17:23:49 (GMT)
committerMiguel Sofer <miguel.sofer@gmail.com>2010-01-21 17:23:49 (GMT)
commit81ddbd4ea03baa8e607252b67b96e72038fd5c57 (patch)
tree9adf2b51c518fd83970c7611821260f56d8b6d98
parent1549d82a2029add6f62dde489d26a70b466f4fd0 (diff)
downloadtcl-81ddbd4ea03baa8e607252b67b96e72038fd5c57.zip
tcl-81ddbd4ea03baa8e607252b67b96e72038fd5c57.tar.gz
tcl-81ddbd4ea03baa8e607252b67b96e72038fd5c57.tar.bz2
* generic/tclCompile.h: NRE-enable direct eval on BC spoilage
* generic/tclExecute.c: [Bug 2910748] * tests/nre.test:
-rw-r--r--ChangeLog6
-rw-r--r--generic/tclCompile.h4
-rw-r--r--generic/tclExecute.c46
-rw-r--r--tests/nre.test24
4 files changed, 54 insertions, 26 deletions
diff --git a/ChangeLog b/ChangeLog
index b846268..d6e1915 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,9 @@
+2010-01-21 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclCompile.h: NRE-enable direct eval on BC spoilage
+ * generic/tclExecute.c: [Bug 2910748]
+ * tests/nre.test:
+
2010-01-19 Donal K. Fellows <dkf@users.sf.net>
* doc/dict.n: [Bug 2929546]: Clarify just what [dict with] and [dict
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index a41e094..3c514d0 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -9,7 +9,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclCompile.h,v 1.120 2010/01/03 20:29:11 msofer Exp $
+ * RCS: @(#) $Id: tclCompile.h,v 1.121 2010/01/21 17:23:49 msofer Exp $
*/
#ifndef _TCLCOMPILATION
@@ -343,6 +343,8 @@ typedef struct CompileEnv {
#define TCL_BYTECODE_RESOLVE_VARS 0x0002
+#define TCL_BYTECODE_RECOMPILE 0x0004
+
typedef struct ByteCode {
TclHandle interpHandle; /* Handle for interpreter containing the
* compiled code. Commands and their compile
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index e553356..ffb8242 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -14,7 +14,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclExecute.c,v 1.468 2009/12/13 17:11:47 msofer Exp $
+ * RCS: @(#) $Id: tclExecute.c,v 1.469 2010/01/21 17:23:49 msofer Exp $
*/
#include "tclInt.h"
@@ -2353,32 +2353,25 @@ TclExecuteByteCode(
} else {
const char *bytes;
int length = 0, opnd;
- Tcl_Obj *newObjResultPtr;
-
- bytes = GetSrcInfoForPc(pc, codePtr, &length);
- DECACHE_STACK_INFO();
- TRESULT = Tcl_EvalEx(interp, bytes, length, 0);
- CACHE_STACK_INFO();
- if (TRESULT != TCL_OK) {
- cleanup = 0;
- if (TRESULT == TCL_ERROR) {
- /*
- * Tcl_EvalEx already did the task of logging the error to
- * the stack trace for us, so set a flag to prevent the
- * TEBC exception handling machinery from trying to do it
- * again. See test execute-8.4. [Bug 2037338]
- */
+
+ /*
+ * We used to switch to direct eval; for NRE-awareness we now
+ * compile and eval the command so that this evaluation does not
+ * add a new TEBC instance [Bug 2910748]
+ */
+
- iPtr->flags |= ERR_ALREADY_LOGGED;
- }
- goto processExceptionReturn;
+ if (TclInterpReady(interp) == TCL_ERROR) {
+ TRESULT = TCL_ERROR;
+ goto checkForCatch;
}
+
+ codePtr->flags |= TCL_BYTECODE_RECOMPILE;
+ bytes = GetSrcInfoForPc(pc, codePtr, &length);
opnd = TclGetUInt4AtPtr(pc+1);
- objResultPtr = Tcl_GetObjResult(interp);
- TclNewObj(newObjResultPtr);
- Tcl_IncrRefCount(newObjResultPtr);
- iPtr->objResultPtr = newObjResultPtr;
- NEXT_INST_F(opnd, 0, -1);
+ pc += (opnd-1);
+ PUSH_OBJECT(Tcl_NewStringObj(bytes, length));
+ goto instEvalStk;
}
case INST_NOP:
@@ -2675,6 +2668,7 @@ TclExecuteByteCode(
int objc, pcAdjustment;
Tcl_Obj **objv;
+ instEvalStk:
case INST_EVAL_STK: {
/*
* Moved here to support transforming the eval of objects to a
@@ -2915,6 +2909,10 @@ TclExecuteByteCode(
nonRecursiveCallReturn:
+ if (codePtr->flags & TCL_BYTECODE_RECOMPILE) {
+ iPtr->flags |= ERR_ALREADY_LOGGED;
+ codePtr->flags &= ~TCL_BYTECODE_RECOMPILE;
+ }
NRE_ASSERT(iPtr->cmdFramePtr == bcFramePtr);
iPtr->cmdFramePtr = bcFramePtr->nextPtr;
TclArgumentBCRelease((Tcl_Interp *) iPtr, bcFramePtr);
diff --git a/tests/nre.test b/tests/nre.test
index 2c91e7a..dcc2180 100644
--- a/tests/nre.test
+++ b/tests/nre.test
@@ -9,7 +9,7 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: nre.test,v 1.11 2009/06/25 19:24:16 dgp Exp $
+# RCS: @(#) $Id: nre.test,v 1.12 2010/01/21 17:23:49 msofer Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
@@ -280,6 +280,28 @@ test nre-7.7 {[eval] is not recursive} -setup {
testnrelevels
} -result {{0 2 2 1} 0}
+test nre-7.8 {bug #2910748: switch out of stale BC is not nre-aware} -setup {
+ proc foo args {}
+ foo
+ coroutine bar apply {{} {
+ yield
+ proc foo args {return ok}
+ while 1 {
+ yield [incr i]
+ foo
+ }
+ }}
+} -body {
+ # if switching to plain eval is not nre aware, this will cause a "cannot
+ # yield" error
+
+ list [bar] [bar] [bar]
+} -cleanup {
+ rename bar {}
+ rename foo {}
+} -result {1 2 3}
+
+
test nre-8.1 {nre and {*}} -body {
# force an expansion that grows the evaluation stack, check that nre
# adapts the bottomPtr. This crashes on failure.