* 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.

4 files changed, 104 insertions, 66 deletions

diff --git a/ChangeLog b/ChangeLog
index d6d53ee..06d9a4e 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -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 {