summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
authorMiguel Sofer <miguel.sofer@gmail.com>2010-06-05 16:24:26 (GMT)
committerMiguel Sofer <miguel.sofer@gmail.com>2010-06-05 16:24:26 (GMT)
commit84f4fa52310247fb505be4eed77e19e48be226a0 (patch)
tree39d30bfda5d5c3bd2964a7ab8139326bf6e4fc74 /generic
parent5c5e3f51ea23ae06e71dd6b272376ed8a833aa84 (diff)
downloadtcl-84f4fa52310247fb505be4eed77e19e48be226a0.zip
tcl-84f4fa52310247fb505be4eed77e19e48be226a0.tar.gz
tcl-84f4fa52310247fb505be4eed77e19e48be226a0.tar.bz2
* generic/tclBasic.c: Fix for #3008307: make callerPtr chains
* generic/tclExecute.c: be traversable accross coro boundaries. Add the special coroutine CallFrame (partially reverting commit of 2009-12-10), as it is needed for coroutines that do not push a CF - eg, those with [eval] as command. Thanks to Colin McCormack (coldstore) and Alexandre Ferrieux for the hard work on this.
Diffstat (limited to 'generic')
-rw-r--r--generic/tclBasic.c37
-rw-r--r--generic/tclExecute.c4
2 files changed, 28 insertions, 13 deletions
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index a7dce89..6f695af 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -16,7 +16,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclBasic.c,v 1.456 2010/05/03 14:36:41 nijtmans Exp $
+ * RCS: @(#) $Id: tclBasic.c,v 1.457 2010/06/05 16:24:26 msofer Exp $
*/
#include "tclInt.h"
@@ -8710,6 +8710,7 @@ NRCoroutineExitCallback(
TclCleanupCommandMacro(cmdPtr);
corPtr->eePtr->corPtr = NULL;
+ TclPopStackFrame(interp);
TclDeleteExecEnv(corPtr->eePtr);
corPtr->eePtr = NULL;
@@ -8790,6 +8791,7 @@ NRInterpCoroutine(
*/
SAVE_CONTEXT(corPtr->caller);
+ corPtr->base.framePtr->callerPtr = iPtr->framePtr;
RESTORE_CONTEXT(corPtr->running);
corPtr->auxNumLevels = iPtr->numLevels;
iPtr->numLevels += nestNumLevels;
@@ -8819,6 +8821,8 @@ TclNRCoroutineObjCmd(
const char *procName;
Namespace *nsPtr, *altNsPtr, *cxtNsPtr;
Tcl_DString ds;
+ Tcl_CallFrame *framePtr;
+
if (objc < 3) {
Tcl_WrongNumArgs(interp, 1, objv, "name cmd ?arg ...?");
@@ -8922,11 +8926,31 @@ TclNRCoroutineObjCmd(
}
/*
+ * Create the coro's execEnv and switch to it so that any CallFrames or
+ * callbacks refer to the new execEnv's stack.
+ */
+
+ corPtr->eePtr = TclCreateExecEnv(interp, CORO_STACK_INITIAL_SIZE);
+ corPtr->callerEEPtr = iPtr->execEnvPtr;
+ corPtr->eePtr->corPtr = corPtr;
+ iPtr->execEnvPtr = corPtr->eePtr;
+
+ /* push a base call frame; save the current namespace to do a correct
+ * command lookup.
+ */
+
+ nsPtr = iPtr->varFramePtr->nsPtr;
+ TclPushStackFrame(interp, &framePtr,
+ (Tcl_Namespace *) iPtr->globalNsPtr, 0);
+ iPtr->varFramePtr = iPtr->rootFramePtr;
+
+ /*
* Save the base context. The base cmdFramePtr is unknown at this time: it
* will be allocated in the Tcl stack. So signal TEBC that it has to
* initialize the base cmdFramePtr by setting it to NULL.
*/
+ SAVE_CONTEXT(corPtr->base);
corPtr->base.cmdFramePtr = NULL;
corPtr->running = NULL_CONTEXT;
corPtr->stackLevel = NULL;
@@ -8944,20 +8968,13 @@ TclNRCoroutineObjCmd(
cmdObjPtr->typePtr = NULL;
/*
- * Create the coro's execEnv and switch to it so that any CallFrames or
- * callbacks refer to the new execEnv's stack. Add the exit callback, then
- * the callback to eval the coro body.
+ * Add the exit callback, then the callback to eval the coro body
*/
- corPtr->eePtr = TclCreateExecEnv(interp, CORO_STACK_INITIAL_SIZE);
- corPtr->callerEEPtr = iPtr->execEnvPtr;
- corPtr->eePtr->corPtr = corPtr;
- iPtr->execEnvPtr = corPtr->eePtr;
-
TclNRAddCallback(interp, NRCoroutineExitCallback, corPtr,
NULL, NULL, NULL);
iPtr->evalFlags |= TCL_EVAL_REDIRECT;
- iPtr->lookupNsPtr = iPtr->varFramePtr->nsPtr;
+ iPtr->lookupNsPtr = nsPtr;
TclNREvalObjEx(interp, cmdObjPtr, 0, NULL, 0);
return TCL_OK;
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index aae542a..934a9fb 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.484 2010/05/31 08:54:15 nijtmans Exp $
+ * RCS: @(#) $Id: tclExecute.c,v 1.485 2010/06/05 16:24:26 msofer Exp $
*/
#include "tclInt.h"
@@ -2084,13 +2084,11 @@ TclExecuteByteCode(
* - base.cmdFramePtr not set
* - need to monkey-patch the BP chain
* - set the running level for the coroutine
- * - insure that the coro runs in #0
*/
corPtr->base.cmdFramePtr = bcFramePtr;
corPtr->callerBPPtr = &BP->prevBottomPtr;
corPtr->stackLevel = &TAUX;
- iPtr->varFramePtr = iPtr->rootFramePtr;
}
if (iPtr->execEnvPtr->rewind) {