From 54bc7a4be035ab032c4311c97a7e2240fb08b0cd Mon Sep 17 00:00:00 2001
From: Miguel Sofer <miguel.sofer@gmail.com>
Date: Sun, 6 Dec 2009 18:12:25 +0000
Subject: 	* generic/tclBasic.c:   Small changes for clarity in tailcall 
 * generic/tclExecute.c: and coroutine code.

---
 ChangeLog            |  3 +++
 generic/tclBasic.c   | 42 ++++++++++++++++++++++++++++++++----------
 generic/tclExecute.c | 17 ++++++++++-------
 3 files changed, 45 insertions(+), 17 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index 3bb7aba..37be2a2 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,8 @@
 2009-12-05  Miguel Sofer  <msofer@users.sf.net>
 
+	* generic/tclBasic.c:   Small changes for clarity in tailcall
+	* generic/tclExecute.c: and coroutine code.
+	
 	* tests/tailcall.test: remove some old unused crud; improved the
 	stack depth tests.	
 	
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index ce330b1..0376a0a 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.411 2009/12/05 21:30:05 msofer Exp $
+ * RCS: @(#) $Id: tclBasic.c,v 1.412 2009/12/06 18:12:26 msofer Exp $
  */
 
 #include "tclInt.h"
@@ -8188,7 +8188,6 @@ TclNRTailcallObjCmd(
     Tcl_Obj *const objv[])
 {
     Interp *iPtr = (Interp *) interp;
-    TEOV_callback *tailcallPtr;
     Tcl_Obj *listPtr, *nsObjPtr;
     Tcl_Namespace *nsPtr = (Tcl_Namespace *) iPtr->varFramePtr->nsPtr;
     Tcl_Namespace *ns1Ptr;
@@ -8236,10 +8235,10 @@ TclNRTailcallObjCmd(
     }
 
     TclNRAddCallback(interp, NRTailcallEval, listPtr, nsObjPtr, NULL, NULL);
-    tailcallPtr = TOP_CB(interp);
-    TOP_CB(interp) = tailcallPtr->nextPtr;
+    iPtr->varFramePtr->tailcallPtr = TOP_CB(interp);
+    TOP_CB(interp) = TOP_CB(interp)->nextPtr;
 
-    TclNRAddCallback(interp, NRCallTEBC, INT2PTR(TCL_NR_TAILCALL_TYPE), tailcallPtr, NULL, NULL);
+    TclNRAddCallback(interp, NRCallTEBC, INT2PTR(TCL_NR_TAILCALL_TYPE), NULL, NULL, NULL);
     return TCL_OK;
 }
 
@@ -8354,8 +8353,27 @@ static const CorContext NULL_CONTEXT = {NULL, NULL, NULL, NULL};
     iPtr->cmdFramePtr = (context).cmdFramePtr;		\
     iPtr->lineLABCPtr = (context).lineLABCPtr
 
-#define iPtr ((Interp *) interp)
 
+#define iPtr ((Interp *) interp)
+
+static int
+YieldCallback(
+    ClientData data[],
+    Tcl_Interp *interp,
+    int result)
+{
+    CoroutineData *corPtr = data[0];
+    Tcl_Obj *cmdPtr = data[1];
+
+    corPtr->stackLevel = NULL; /* mark suspended */
+    iPtr->execEnvPtr = corPtr->callerEEPtr;
+
+    if (cmdPtr) {
+	/* yieldTo: invoke the command, use tailcall tech */
+    }
+    return result;
+}
+  
 int
 TclNRYieldObjCmd(
     ClientData clientData,
@@ -8384,6 +8402,7 @@ 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;
@@ -8634,7 +8653,8 @@ TclNRCoroutineObjCmd(
     const char *procName;
     Namespace *nsPtr, *altNsPtr, *cxtNsPtr;
     Tcl_DString ds;
-
+    int result;
+    
     if (objc < 3) {
 	Tcl_WrongNumArgs(interp, 1, objv, "name cmd ?arg ...?");
 	return TCL_ERROR;
@@ -8781,11 +8801,13 @@ TclNRCoroutineObjCmd(
     iPtr->varFramePtr = iPtr->rootFramePtr;
     iPtr->lookupNsPtr = iPtr->framePtr->nsPtr;
     corPtr->auxNumLevels = iPtr->numLevels;
-
+    
     TclNRAddCallback(interp, NRCoroutineExitCallback, corPtr, NULL,NULL,NULL);
+
     iPtr->evalFlags |= TCL_EVAL_REDIRECT;
-    return TclNRRunCallbacks(interp,
-	    TclNREvalObjEx(interp, cmdObjPtr, 0, NULL, 0), rootPtr, 0);
+    result = TclNREvalObjEx(interp, cmdObjPtr, 0, NULL, 0); 
+
+    return TclNRRunCallbacks(interp, result, rootPtr, 0);
 }
 
 /*
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 404696c..6ad9043 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.448 2009/11/18 21:59:51 nijtmans Exp $
+ * RCS: @(#) $Id: tclExecute.c,v 1.449 2009/12/06 18:12:26 msofer Exp $
  */
 
 #include "tclInt.h"
@@ -1945,6 +1945,7 @@ TclExecuteByteCode(
     int nested = 0;
 
     if (!codePtr) {
+	resumeCoroutine:
 	/*
 	 * Reawakening a suspended coroutine: the [yield] command
 	 * is returning.
@@ -1989,6 +1990,9 @@ TclExecuteByteCode(
 		 */
 
 		codePtr = param;
+		if (!codePtr) {
+		    goto resumeCoroutine;
+		}
 		break;
 	    case TCL_NR_TAILCALL_TYPE: {
 		/*
@@ -2001,14 +2005,16 @@ TclExecuteByteCode(
 		}
 #endif
 		if (catchTop != initCatchTop) {
-		    TclClearTailcall(interp, param);
+		    TEOV_callback *tailcallPtr = iPtr->varFramePtr->tailcallPtr;
+		    
+		    TclClearTailcall(interp, tailcallPtr);
+		    iPtr->varFramePtr->tailcallPtr = NULL;
 		    result = TCL_ERROR;
 		    Tcl_SetResult(interp,"Tailcall called from within a catch environment",
 			    TCL_STATIC);
 		    pc--;
 		    goto checkForCatch;
 		}
-		iPtr->varFramePtr->tailcallPtr = param;
 		goto abnormalReturn;
 	    }
 	    case TCL_NR_YIELD_TYPE: { /*[yield] */
@@ -2036,15 +2042,12 @@ TclExecuteByteCode(
 		}
 
 		/*
-		 * Save our state, restore the caller's execEnv and return
+		 * Save our state and return
 		 */
 
 		NR_DATA_BURY();
 		esPtr->tosPtr = tosPtr;
-		corPtr->stackLevel = NULL; /* mark suspended */
 		iPtr->execEnvPtr->bottomPtr = bottomPtr;
-
-		iPtr->execEnvPtr = corPtr->callerEEPtr;
 		return TCL_OK;
 	    }
 	    default:
-- 
cgit v0.12