diff options
| author | jan.nijtmans <nijtmans@users.sourceforge.net> | 2021-06-23 12:20:59 (GMT) |
|---|---|---|
| committer | jan.nijtmans <nijtmans@users.sourceforge.net> | 2021-06-23 12:20:59 (GMT) |
| commit | 814c9b57aaf622f67d64bf335061ceedf51a5c40 (patch) | |
| tree | 8c01ed8f3d937c1fcb96f0ffc87b0bea69ba7c34 /generic | |
| parent | d7d411426de72cbced551fa007a4e99c84d2fd0a (diff) | |
| parent | 6f34bcda8f5613edbb17c22b97774e0c4317a951 (diff) | |
| download | tcl-814c9b57aaf622f67d64bf335061ceedf51a5c40.zip tcl-814c9b57aaf622f67d64bf335061ceedf51a5c40.tar.gz tcl-814c9b57aaf622f67d64bf335061ceedf51a5c40.tar.bz2 | |
Now really merge [bug-f9800d52bd61f240] (previous commit contains test-cases only)
Diffstat (limited to 'generic')
| -rw-r--r-- | generic/tclBasic.c | 24 | ||||
| -rw-r--r-- | generic/tclExecute.c | 1 | ||||
| -rw-r--r-- | generic/tclInt.h | 5 |
3 files changed, 29 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; diff --git a/generic/tclExecute.c b/generic/tclExecute.c index f9c2954..7e51c0d 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -2506,6 +2506,7 @@ TEBCresume( Tcl_IncrRefCount(valuePtr); iPtr->execEnvPtr = corPtr->callerEEPtr; TclSetTailcall(interp, valuePtr); + corPtr->yieldPtr = valuePtr; iPtr->execEnvPtr = corPtr->eePtr; yieldParameter = (PTR2INT(NULL)+1); /*==CORO_ACTIVATE_YIELDM*/ diff --git a/generic/tclInt.h b/generic/tclInt.h index ad9a5c1..05167b7 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -1496,6 +1496,11 @@ typedef struct CoroutineData { 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 { |