diff options
| -rw-r--r-- | ChangeLog | 5 | ||||
| -rw-r--r-- | generic/tclBasic.c | 87 | ||||
| -rw-r--r-- | generic/tclExecute.c | 73 | ||||
| -rw-r--r-- | generic/tclInt.h | 5 |
4 files changed, 104 insertions, 66 deletions
@@ -1,5 +1,10 @@ 2009-12-08 Miguel Sofer <msofer@users.sf.net> + * generic/tclBasic.c: Partial nre-enabling of coroutines. + * generic/tclExecute.c: The initial call still requires its + * generic/tclInt.h: own instance of tebc, but on resume coros + can execute in the caller's tebc. + * generic/tclExecute.c (TEBC): silence warning about pcAdjustment 2009-12-08 Donal K. Fellows <dkf@users.sf.net> diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 11da4cc..3d777d3 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.417 2009/12/08 14:18:34 dkf Exp $ + * RCS: @(#) $Id: tclBasic.c,v 1.418 2009/12/08 20:56:29 msofer Exp $ */ #include "tclInt.h" @@ -143,7 +143,8 @@ static Tcl_NRPostProc NRRunObjProc; static Tcl_NRPostProc TailcallCleanup; static Tcl_NRPostProc NRTailcallEval; -static Tcl_NRPostProc YieldCallback; +static Tcl_NRPostProc RewindCoroutineCallback; +static Tcl_NRPostProc YieldToCallback; /* * The following structure define the commands in the Tcl core. @@ -8417,29 +8418,24 @@ static const CorContext NULL_CONTEXT = {NULL, NULL, NULL, NULL}; #define iPtr ((Interp *) interp) static int -YieldCallback( +YieldToCallback( ClientData data[], Tcl_Interp *interp, int result) { - CoroutineData *corPtr = data[0]; + /* CoroutineData *corPtr = data[0];*/ Tcl_Obj *listPtr = data[1]; + ClientData nsPtr = data[2]; - corPtr->stackLevel = NULL; /* mark suspended */ - iPtr->execEnvPtr = corPtr->callerEEPtr; - - if (listPtr) { - /* yieldTo: invoke the command using tailcall tech */ - TEOV_callback *cbPtr; - ClientData nsPtr = data[2]; - - TclNRAddCallback(interp, NRTailcallEval, listPtr, nsPtr, - NULL, NULL); - cbPtr = TOP_CB(interp); - TOP_CB(interp) = cbPtr->nextPtr; - - TclSpliceTailcall(interp, cbPtr); - } + /* yieldTo: invoke the command using tailcall tech */ + TEOV_callback *cbPtr; + + TclNRAddCallback(interp, NRTailcallEval, listPtr, nsPtr, + NULL, NULL); + cbPtr = TOP_CB(interp); + TOP_CB(interp) = cbPtr->nextPtr; + + TclSpliceTailcall(interp, cbPtr); return TCL_OK; } @@ -8471,7 +8467,6 @@ TclNRYieldObjCmd( iPtr->numLevels = corPtr->auxNumLevels; corPtr->auxNumLevels = numLevels - corPtr->auxNumLevels; - TclNRAddCallback(interp, YieldCallback, corPtr, NULL, NULL, NULL); TclNRAddCallback(interp, NRCallTEBC, INT2PTR(TCL_NR_YIELD_TYPE), NULL, NULL, NULL); return TCL_OK; @@ -8518,8 +8513,15 @@ TclNRYieldToObjCmd( Tcl_Panic("yieldTo failed to find the proper namespace"); } Tcl_IncrRefCount(nsObjPtr); + + /* + * Add the callback in the caller's env, then instruct TEBC to yield + */ - TclNRAddCallback(interp, YieldCallback, corPtr, listPtr, nsObjPtr, NULL); + iPtr->execEnvPtr = corPtr->callerEEPtr; + TclNRAddCallback(interp, YieldToCallback, corPtr, listPtr, nsObjPtr, NULL); + iPtr->execEnvPtr = corPtr->eePtr; + TclNRAddCallback(interp, NRCallTEBC, INT2PTR(TCL_NR_YIELD_TYPE), NULL, NULL, NULL); return TCL_OK; @@ -8527,11 +8529,19 @@ TclNRYieldToObjCmd( static int +RewindCoroutineCallback( + ClientData data[], + Tcl_Interp *interp, + int result) +{ + return Tcl_RestoreInterpState(interp, data[0]); +} + +static int RewindCoroutine( CoroutineData *corPtr, int result) { - Tcl_Obj *objPtr; Tcl_Interp *interp = corPtr->eePtr->interp; Tcl_InterpState state = Tcl_SaveInterpState(interp, result); @@ -8540,17 +8550,10 @@ RewindCoroutine( NRE_ASSERT(corPtr->eePtr->bottomPtr != NULL); NRE_ASSERT(corPtr->eePtr != iPtr->execEnvPtr); - TclNewObj(objPtr); - Tcl_IncrRefCount(objPtr); - corPtr->eePtr->rewind = 1; - result = NRInterpCoroutine(corPtr, interp, 1, &objPtr); - - NRE_ASSERT(iPtr->execEnvPtr == corPtr->eePtr); - - Tcl_DecrRefCount(objPtr); - result = Tcl_RestoreInterpState(interp, state); - return result; + TclNRAddCallback(interp, RewindCoroutineCallback, state, + NULL, NULL, NULL); + return NRInterpCoroutine(corPtr, interp, 0, NULL); } static void @@ -8718,7 +8721,11 @@ NRInterpCoroutine( CoroutineData *corPtr = clientData; int nestNumLevels = corPtr->auxNumLevels; - if ((objc != 1) && (objc != 2)) { + /* + * objc==0 indicates a call to rewind the coroutine + */ + + if (objc > 2) { Tcl_WrongNumArgs(interp, 1, objv, "?arg?"); return TCL_ERROR; } @@ -8750,9 +8757,13 @@ NRInterpCoroutine( TclNRAddCallback(interp, NRCoroutineCallerCallback, corPtr, NULL, NULL, NULL); + corPtr->callerBP = NULL;; corPtr->callerEEPtr = iPtr->execEnvPtr; iPtr->execEnvPtr = corPtr->eePtr; - return TclExecuteByteCode(interp, NULL); + + TclNRAddCallback(interp, NRCallTEBC, INT2PTR(TCL_NR_BC_TYPE), NULL, + NULL, NULL); + return TCL_OK; } int @@ -8771,7 +8782,6 @@ TclNRCoroutineObjCmd( const char *procName; Namespace *nsPtr, *altNsPtr, *cxtNsPtr; Tcl_DString ds; - int result; if (objc < 3) { Tcl_WrongNumArgs(interp, 1, objv, "name cmd ?arg ...?"); @@ -8810,7 +8820,8 @@ TclNRCoroutineObjCmd( corPtr->callerEEPtr = iPtr->execEnvPtr; corPtr->eePtr->corPtr = corPtr; corPtr->stackLevel = NULL; - + corPtr->callerBP = NULL; + /* * On first run just set a 0 level-offset, the natural numbering is * correct. The offset will be fixed for later runs. @@ -8924,9 +8935,9 @@ TclNRCoroutineObjCmd( TclNRAddCallback(interp, NRCoroutineExitCallback, corPtr, NULL,NULL,NULL); iPtr->evalFlags |= TCL_EVAL_REDIRECT; - result = TclNREvalObjEx(interp, cmdObjPtr, 0, NULL, 0); + TclNREvalObjEx(interp, cmdObjPtr, 0, NULL, 0); - return TclNRRunCallbacks(interp, result, rootPtr, 0); + return TclNRRunCallbacks(interp, TCL_OK, rootPtr, 0); } /* diff --git a/generic/tclExecute.c b/generic/tclExecute.c index d8cd7f6..039ad24 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -14,7 +14,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclExecute.c,v 1.454 2009/12/08 19:00:25 msofer Exp $ + * RCS: @(#) $Id: tclExecute.c,v 1.455 2009/12/08 20:56:29 msofer Exp $ */ #include "tclInt.h" @@ -205,6 +205,7 @@ typedef struct BottomData { cleanup = BP->cleanup; \ TAUX.esPtr = iPtr->execEnvPtr->execStackPtr; \ tosPtr = TAUX.esPtr->tosPtr; \ + TAUX.compiledLocals = iPtr->varFramePtr->compiledLocals;\ } while (0) #define PUSH_TAUX_OBJ(objPtr) \ @@ -2006,7 +2007,7 @@ TclExecuteByteCode( iPtr->execEnvPtr->bottomPtr = BP; TAUX.esPtr = iPtr->execEnvPtr->execStackPtr; - TAUX.compiledLocals = iPtr->varFramePtr->compiledLocals;// + TAUX.compiledLocals = iPtr->varFramePtr->compiledLocals; pc = codePtr->codeStart; catchTop = initCatchTop; @@ -2817,15 +2818,17 @@ TclExecuteByteCode( if (param) { codePtr = param; goto nonRecursiveCallStart; + } else { + CoroutineData *corPtr = iPtr->execEnvPtr->corPtr; + + corPtr->callerBP = BP; + goto resumeCoroutine; } - /* NOT CALLED, does not (yet?) work */ - goto resumeCoroutine; - case TCL_NR_TAILCALL_TYPE: - /* - * A request to perform a tailcall: just drop this - * bytecode. - */ - + break; + case TCL_NR_TAILCALL_TYPE: + /* + * A request to perform a tailcall: just drop this + * bytecode. */ #ifdef TCL_COMPILE_DEBUG if (traceInstructions) { fprintf(stdout, " Tailcall request received\n"); @@ -2860,34 +2863,35 @@ TclExecuteByteCode( pc--; goto checkForCatch; } + NRE_ASSERT(iPtr->execEnvPtr == corPtr->eePtr); NRE_ASSERT(corPtr->stackLevel != NULL); NRE_ASSERT(BP == corPtr->eePtr->bottomPtr); if (corPtr->stackLevel != &TAUX) { - Tcl_SetResult(interp, - "cannot yield: C stack busy", TCL_STATIC); - Tcl_SetErrorCode(interp, "TCL", "COROUTINE", - "CANT_YIELD", NULL); + Tcl_SetResult(interp, "cannot yield: C stack busy", + TCL_STATIC); + Tcl_SetErrorCode(interp, "COROUTINE_CANT_YIELD", NULL); TRESULT = TCL_ERROR; pc--; goto checkForCatch; } - + /* * Save our state and return */ - - NR_DATA_BURY(); - TAUX.esPtr->tosPtr = tosPtr; - iPtr->execEnvPtr->bottomPtr = BP; - return TCL_OK; + + corPtr->stackLevel = NULL; /* mark suspended */ + + iPtr->execEnvPtr = corPtr->callerEEPtr; + OBP = corPtr->callerBP; + goto returnToCaller; } default: Tcl_Panic("TEBC: TRCB sent us a callback we cannot handle!"); } } } - + pc += pcAdjustment; nonRecursiveCallReturn: @@ -7448,7 +7452,7 @@ TclExecuteByteCode( statePtr->typePtr = &dictIteratorType; statePtr->internalRep.twoPtrValue.ptr1 = searchPtr; statePtr->internalRep.twoPtrValue.ptr2 = dictPtr; - varPtr = LOCAL(opnd);// + varPtr = LOCAL(opnd); if (varPtr->value.objPtr) { if (varPtr->value.objPtr->typePtr != &dictIteratorType) { TclDecrRefCount(varPtr->value.objPtr); @@ -7971,13 +7975,10 @@ TclExecuteByteCode( NR_DATA_DIG(); if (TOP_CB(interp) == BP->rootPtr) { /* - * The bytecode is returning, all callbacks were run. Remove the - * caller's arguments and keep processing the caller. + * The bytecode is returning, all callbacks were run: keep + * processing the caller. */ - TAUX.esPtr = iPtr->execEnvPtr->execStackPtr; - TAUX.compiledLocals = iPtr->varFramePtr->compiledLocals; - goto nonRecursiveCallReturn; } else { TEOV_callback *callbackPtr = TOP_CB(iPtr); @@ -8009,6 +8010,24 @@ TclExecuteByteCode( } } + /* + * Deal with coros running in the caller's TEBC + */ + + if (iPtr->execEnvPtr->corPtr) { + CoroutineData *corPtr = iPtr->execEnvPtr->corPtr; + /* + * The coro is returning internally iff + * - this is its base TEBC + * - this is it's callers TEBC, signalled by callerBP!=NULL + */ + + OBP = corPtr->callerBP; + if (OBP && (corPtr->stackLevel == &TAUX)) { + goto returnToCaller; + } + } + iPtr->execEnvPtr->bottomPtr = NULL; return TRESULT; } diff --git a/generic/tclInt.h b/generic/tclInt.h index 6eb542e..91f301f 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -15,7 +15,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclInt.h,v 1.451 2009/12/08 01:34:05 msofer Exp $ + * RCS: @(#) $Id: tclInt.h,v 1.452 2009/12/08 20:56:29 msofer Exp $ */ #ifndef _TCLINT @@ -1405,6 +1405,9 @@ typedef struct CoroutineData { * numLevels of the create/resume command is * stored here; for suspended coroutines it * holds the nesting numLevels at yield. */ + struct BottomData *callerBP;/* The caller's bottomPointer, if the coro is + * running in the caller's TEBC instance. NULL + * otherwise. */ } CoroutineData; typedef struct ExecEnv { |