diff options
| author | jan.nijtmans <nijtmans@users.sourceforge.net> | 2021-06-23 13:27:55 (GMT) |
|---|---|---|
| committer | jan.nijtmans <nijtmans@users.sourceforge.net> | 2021-06-23 13:27:55 (GMT) |
| commit | cbb66412ca40047eab4b424f4f86150f71b622d9 (patch) | |
| tree | 52a5e0aa2fc7151657345a0a0cbbe4edd3802d23 /generic/tclBasic.c | |
| parent | 20fcf335945daf5dedf6f10f940026b681dd7f1b (diff) | |
| parent | 501954d5aaf9401f977885fd340298baacde61a2 (diff) | |
| download | tcl-cbb66412ca40047eab4b424f4f86150f71b622d9.zip tcl-cbb66412ca40047eab4b424f4f86150f71b622d9.tar.gz tcl-cbb66412ca40047eab4b424f4f86150f71b622d9.tar.bz2 | |
Merge 8.7
Diffstat (limited to 'generic/tclBasic.c')
| -rw-r--r-- | generic/tclBasic.c | 24 |
1 files changed, 23 insertions, 1 deletions
diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 86d7960..69194f8 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -4866,6 +4866,7 @@ NRCommand( int result) { Interp *iPtr = (Interp *) interp; + Tcl_Obj *listPtr; iPtr->numLevels--; @@ -4874,7 +4875,10 @@ NRCommand( */ if (data[1] && (data[1] != INT2PTR(1))) { - TclNRAddCallback(interp, TclNRTailcallEval, data[1], NULL, NULL, NULL); + listPtr = (Tcl_Obj *)data[1]; + data[1] = NULL; + + TclNRAddCallback(interp, TclNRTailcallEval, listPtr, NULL, NULL, NULL); } /* OPT ?? @@ -9449,6 +9453,7 @@ TclNRYieldToObjCmd( iPtr->execEnvPtr = corPtr->callerEEPtr; TclSetTailcall(interp, listPtr); + corPtr->yieldPtr = listPtr; iPtr->execEnvPtr = corPtr->eePtr; return TclNRYieldObjCmd(INT2PTR(CORO_ACTIVATE_YIELDM), interp, 1, objv); @@ -9646,6 +9651,22 @@ TclNRCoroutineActivateCallback( */ 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", @@ -9661,6 +9682,7 @@ TclNRCoroutineActivateCallback( Tcl_Panic("Yield received an option which is not implemented"); } + corPtr->yieldPtr = NULL; corPtr->stackLevel = NULL; numLevels = iPtr->numLevels; |