summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
Diffstat (limited to 'generic')
-rw-r--r--generic/tclBasic.c95
1 files changed, 46 insertions, 49 deletions
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index aa1e26b..079d034 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.426 2009/12/10 17:48:39 msofer Exp $
+ * RCS: @(#) $Id: tclBasic.c,v 1.427 2009/12/10 18:23:28 msofer Exp $
*/
#include "tclInt.h"
@@ -8775,13 +8775,20 @@ TclNRCoroutineObjCmd(
return TCL_ERROR;
}
- corPtr = (CoroutineData *) ckalloc(sizeof(CoroutineData));
- corPtr->eePtr = TclCreateExecEnv(interp, CORO_STACK_INITIAL_SIZE);
- corPtr->callerEEPtr = iPtr->execEnvPtr;
- corPtr->eePtr->corPtr = corPtr;
- corPtr->stackLevel = NULL;
- corPtr->callerBP = NULL;
+ /*
+ * We ARE creating the coroutine command: allocate the corresponding
+ * struct, add the callback in caller's env and record the caller's
+ * frames.
+ */
+ corPtr = (CoroutineData *) ckalloc(sizeof(CoroutineData));
+ TclNRAddCallback(interp, NRCoroutineCallerCallback, corPtr, NULL, NULL,
+ NULL);
+ SAVE_CONTEXT(corPtr->caller);
+
+ /*
+ * Create the coroutine command.
+ */
Tcl_DStringInit(&ds);
if (nsPtr != iPtr->globalNsPtr) {
@@ -8798,39 +8805,6 @@ TclNRCoroutineObjCmd(
cmdPtr->refCount++;
/*
- * Be sure not to pass a canonical list for the command so that we insure
- * the body is bytecompiled: we need a TEBC instance to handle [yield]
- */
-
- cmdObjPtr = Tcl_NewListObj(objc-2, &objv[2]);
- TclGetString(cmdObjPtr);
- TclFreeIntRep(cmdObjPtr);
- cmdObjPtr->typePtr = NULL;
-
- /*
- * Set up the callback in caller execEnv and switch to the new execEnv.
- * Switch now so that the CallFrame is allocated on the new execEnv's
- * stack. Then push a CallFrame and CmdFrame.
- */
-
- TclNRAddCallback(interp, NRCoroutineCallerCallback, corPtr, NULL, NULL,
- NULL);
- SAVE_CONTEXT(corPtr->caller);
-
- iPtr->execEnvPtr = corPtr->eePtr;
-
- /*
- * 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;
-
-
- /*
* #280.
* Provide the new coroutine with its own copy of the lineLABCPtr
* hashtable for literal command arguments in bytecode. Note that that
@@ -8871,20 +8845,43 @@ TclNRCoroutineObjCmd(
}
/*
- * Eval things in 'uplevel #0', except for the very first command lookup
- * which should be looked up in caller's context.
- *
- * A better approach would use the lambda infrastructure, but it is a bit
- * clumsy for now: we have the "lambda is a nameless proc" hack, we'd need
- * the cleaner "proc is a named lambda" to do this properly.
+ * 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.
*/
-
- iPtr->lookupNsPtr = iPtr->framePtr->nsPtr;
+
+ SAVE_CONTEXT(corPtr->base);
+ corPtr->base.cmdFramePtr = NULL;
+ corPtr->running = NULL_CONTEXT;
+ corPtr->stackLevel = NULL;
corPtr->auxNumLevels = iPtr->numLevels;
+ corPtr->callerBP = NULL;
+
+ /*
+ * Create the command that will run at the bottom of the coroutine.
+ * Be sure not to pass a canonical list for the command so that we insure
+ * the body is bytecompiled: we need a TEBC instance to handle [yield]
+ */
+
+ cmdObjPtr = Tcl_NewListObj(objc-2, &objv[2]);
+ TclGetString(cmdObjPtr);
+ TclFreeIntRep(cmdObjPtr);
+ 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.
+ */
+
+ 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;
TclNREvalObjEx(interp, cmdObjPtr, 0, NULL, 0);