diff options
Diffstat (limited to 'generic')
-rw-r--r-- | generic/tclBasic.c | 95 |
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); |