summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
Diffstat (limited to 'generic')
-rw-r--r--generic/tclBasic.c3
-rw-r--r--generic/tclInterp.c4
-rw-r--r--generic/tclNamesp.c25
3 files changed, 28 insertions, 4 deletions
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index b0cc7f6..ce330b1 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.410 2009/11/18 21:59:50 nijtmans Exp $
+ * RCS: @(#) $Id: tclBasic.c,v 1.411 2009/12/05 21:30:05 msofer Exp $
*/
#include "tclInt.h"
@@ -8783,6 +8783,7 @@ TclNRCoroutineObjCmd(
corPtr->auxNumLevels = iPtr->numLevels;
TclNRAddCallback(interp, NRCoroutineExitCallback, corPtr, NULL,NULL,NULL);
+ iPtr->evalFlags |= TCL_EVAL_REDIRECT;
return TclNRRunCallbacks(interp,
TclNREvalObjEx(interp, cmdObjPtr, 0, NULL, 0), rootPtr, 0);
}
diff --git a/generic/tclInterp.c b/generic/tclInterp.c
index 3c841d9..edf31ff 100644
--- a/generic/tclInterp.c
+++ b/generic/tclInterp.c
@@ -10,7 +10,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclInterp.c,v 1.106 2009/10/06 16:55:59 dgp Exp $
+ * RCS: @(#) $Id: tclInterp.c,v 1.107 2009/12/05 21:30:05 msofer Exp $
*/
#include "tclInt.h"
@@ -1805,7 +1805,7 @@ AliasNRCmd(
*/
if (isRootEnsemble) {
- TclNRAddCallback(interp, TclClearRootEnsemble, NULL, NULL, NULL, NULL);
+ TclNRDeferCallback(interp, TclClearRootEnsemble, NULL, NULL, NULL, NULL);
}
iPtr->evalFlags |= TCL_EVAL_REDIRECT;
return Tcl_NREvalObj(interp, listPtr, flags);
diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c
index 5d08bcb..99f3f1a 100644
--- a/generic/tclNamesp.c
+++ b/generic/tclNamesp.c
@@ -23,7 +23,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclNamesp.c,v 1.195 2009/11/16 18:00:11 dgp Exp $
+ * RCS: @(#) $Id: tclNamesp.c,v 1.196 2009/12/05 21:30:05 msofer Exp $
*/
#include "tclInt.h"
@@ -517,13 +517,27 @@ Tcl_PopCallFrame(
*/
TEOV_callback *tailcallPtr, *runPtr;
+ ExecEnv *eePtr = NULL;
+
+ restart:
for (runPtr = TOP_CB(interp); runPtr; runPtr = runPtr->nextPtr) {
if (((runPtr->procPtr) == NRCommand) && !runPtr->data[1]) {
break;
}
}
if (!runPtr) {
+ /*
+ * If we are tailcalling out of a coroutine, the splicing spot is
+ * in the caller's execEnv: go find it!
+ */
+
+ CoroutineData *corPtr = iPtr->execEnvPtr->corPtr;
+ if (corPtr) {
+ eePtr = iPtr->execEnvPtr;
+ iPtr->execEnvPtr = corPtr->callerEEPtr;
+ goto restart;
+ }
Tcl_Panic("Tailcall cannot find the right splicing spot: should not happen!");
}
@@ -531,6 +545,15 @@ Tcl_PopCallFrame(
tailcallPtr->nextPtr = runPtr->nextPtr;
runPtr->nextPtr = tailcallPtr;
+
+ if (eePtr) {
+ /*
+ * Restore the right execEnv if it was swapped for tailcalling out
+ * of a coroutine.
+ */
+
+ iPtr->execEnvPtr = eePtr;
+ }
}
}