Tcl Source Code

static int
NRCommand(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    Interp *iPtr = (Interp *) interp;
    Tcl_Obj *listPtr;

    iPtr->numLevels--;

     /*
      * If there is a tailcall, schedule it next
      */

    if (data[1] && (data[1] != INT2PTR(1))) {
	listPtr = (Tcl_Obj *)data[1];
	data[1] = NULL;

	TclNRAddCallback(interp, TclNRTailcallEval, listPtr, NULL, NULL, NULL);
    }

    /* OPT ??
     * Do not interrupt a series of cleanups with async or limit checks:
     * just check at the end?
     */

    /*
     * Add the callback in the caller's env, then instruct TEBC to yield.
     */

    iPtr->execEnvPtr = corPtr->callerEEPtr;
    TclSetTailcall(interp, listPtr);
    corPtr->yieldPtr = listPtr;
    iPtr->execEnvPtr = corPtr->eePtr;

    return TclNRYieldObjCmd(INT2PTR(CORO_ACTIVATE_YIELDM), interp, 1, objv);
}

static int
RewindCoroutineCallback(

        iPtr->numLevels += numLevels;
    } else {
        /*
         * Coroutine is active: yield
         */

        if (corPtr->stackLevel != stackLevel) {
	    NRE_callback *runPtr;

	    iPtr->execEnvPtr = corPtr->callerEEPtr;
	    if (corPtr->yieldPtr) {
		for (runPtr = TOP_CB(interp); runPtr; runPtr = runPtr->nextPtr) {
		    if (runPtr->data[1] == corPtr->yieldPtr) {
			runPtr->data[1] = NULL;
			Tcl_DecrRefCount(corPtr->yieldPtr);
			corPtr->yieldPtr = NULL;
			break;
		    }
		}
	    }
	    iPtr->execEnvPtr = corPtr->eePtr;


            Tcl_SetObjResult(interp, Tcl_NewStringObj(
                    "cannot yield: C stack busy", -1));
            Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "CANT_YIELD",
                    NULL);
            return TCL_ERROR;
        }

        if (type == CORO_ACTIVATE_YIELD) {
            corPtr->nargs = COROUTINE_ARGUMENTS_SINGLE_OPTIONAL;
        } else if (type == CORO_ACTIVATE_YIELDM) {
            corPtr->nargs = COROUTINE_ARGUMENTS_ARBITRARY;
        } else {
            Tcl_Panic("Yield received an option which is not implemented");
        }

	corPtr->yieldPtr = NULL;
        corPtr->stackLevel = NULL;

        numLevels = iPtr->numLevels;
        iPtr->numLevels = corPtr->auxNumLevels;
        corPtr->auxNumLevels = numLevels - corPtr->auxNumLevels;

        iPtr->execEnvPtr = corPtr->callerEEPtr;

	 * yield. The yield is switched into multi-return mode (via the
	 * 'yieldParameter').
	 */

	Tcl_IncrRefCount(valuePtr);
	iPtr->execEnvPtr = corPtr->callerEEPtr;
	TclSetTailcall(interp, valuePtr);
	corPtr->yieldPtr = valuePtr;
	iPtr->execEnvPtr = corPtr->eePtr;
	yieldParameter = (PTR2INT(NULL)+1);	/*==CORO_ACTIVATE_YIELDM*/

    doYield:
	/* TIP #280: Record the last piece of info needed by
	 * 'TclGetSrcInfoForPc', and push the frame.
	 */

    int auxNumLevels;		/* While the coroutine is running the
				 * numLevels of the create/resume command is
				 * stored here; for suspended coroutines it
				 * holds the nesting numLevels at yield. */
    int nargs;                  /* Number of args required for resuming this
				 * coroutine; -2 means "0 or 1" (default), -1
				 * means "any" */
    Tcl_Obj *yieldPtr;		/* The command to yield to.  Stored here in
				 * order to reset splice point in
				 * TclNRCoroutineActivateCallback if the
				 * coroutine is busy.
				*/
} CoroutineData;

typedef struct ExecEnv {
    ExecStack *execStackPtr;	/* Points to the first item in the evaluation
				 * stack on the heap. */
    Tcl_Obj *constants[2];	/* Pointers to constant "0" and "1" objs. */
    struct Tcl_Interp *interp;

    }
    boom   ; # does not crash: the coro floor is a good insulator
    list
} -cleanup {
    rename boom {}; rename cc {}; rename c {}
} -result {}


test coroutine-7.13 {
issue f9800d52bd61f240

vwait is not NRE-enabled, and yieldto cannot find the right splicing spot
} -body {
	coroutine c0 apply [list {} {
		variable done
		yield
		yieldto c1
		after 0 c2 
		vwait [namespace current]::done
	} [namespace current]]

	coroutine c1 apply [list {} {
		yield
		tailcall c0
	} [namespace current]]

	coroutine c2 apply [list {} {
		variable done
		yield
		after 0 [list [info coroutine]]
		yieldto try {yieldto c1}
		after 0 [list [info coroutine]]
		yieldto try {yieldto c1}
		set done 1
	} [namespace current]]

	after 0 [list [namespace which c0]]
	vwait [namespace current]::done
	return $done
} -result 1 

test coroutine-8.0.0 {coro inject executed} -body {
    coroutine demo apply {{} { foreach i {1 2} yield }}
    demo
    set ::result none
    tcl::unsupported::inject demo set ::result inject-executed
    demo
    set ::result