? CORODIFF.tmp
? CORODIFF2.tmp
? YIELDTO.diff
? pkgs/itcl/itclConfig.sh
? pkgs/itcl/pkgIndex.tcl
? unix/dltest.marker
? unix/tcl.pc
Index: ChangeLog
===================================================================
RCS file: /cvsroot/tcl/tcl/ChangeLog,v
retrieving revision 1.4856
diff -u -r1.4856 ChangeLog
--- ChangeLog	7 Dec 2009 15:08:46 -0000	1.4856
+++ ChangeLog	7 Dec 2009 16:28:01 -0000
@@ -1,3 +1,8 @@
+2009-12-07  Miguel Sofer  <msofer@users.sf.net>
+
+	* generic/tclBasic.c:  ::tcl::unsupported::yieldTo
+	* generic/tclInt.h:    [Patch 2910056] 
+
 2009-12-07  Donal K. Fellows  <dkf@users.sf.net>
 
 	* generic/tclCmdMZ.c (TryPostBody): [Bug 2910044]: Close off memory
Index: generic/tclBasic.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclBasic.c,v
retrieving revision 1.414
diff -u -r1.414 tclBasic.c
--- generic/tclBasic.c	7 Dec 2009 14:04:27 -0000	1.414
+++ generic/tclBasic.c	7 Dec 2009 16:28:07 -0000
@@ -799,6 +799,9 @@
     Tcl_NRCreateCommand(interp, "tailcall", NULL, TclNRTailcallObjCmd,
 	    NULL, NULL);
 
+    Tcl_NRCreateCommand(interp, "::tcl::unsupported::yieldTo", NULL,
+	    TclNRYieldToObjCmd, NULL, NULL);
+
 #ifdef USE_DTRACE
     /*
      * Register the tcl::dtrace command.
@@ -8415,15 +8418,24 @@
     int result)
 {
     CoroutineData *corPtr = data[0];
-    Tcl_Obj *cmdPtr = data[1];
+    Tcl_Obj *listPtr = data[1];
 
     corPtr->stackLevel = NULL; /* mark suspended */
     iPtr->execEnvPtr = corPtr->callerEEPtr;
 
-    if (cmdPtr) {
-	/* yieldTo: invoke the command, use tailcall tech */
+    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);
     }
-    return result;
+    return TCL_OK;
 }
   
 int
@@ -8459,6 +8471,55 @@
 	    NULL, NULL, NULL);
     return TCL_OK;
 }
+
+int
+TclNRYieldToObjCmd(
+    ClientData clientData,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const objv[])
+{
+    CoroutineData *corPtr = iPtr->execEnvPtr->corPtr;
+    int numLevels = iPtr->numLevels;
+
+    Tcl_Obj *listPtr, *nsObjPtr;
+    Tcl_Namespace *nsPtr = (Tcl_Namespace *) iPtr->varFramePtr->nsPtr;
+    Tcl_Namespace *ns1Ptr;
+
+    if (objc < 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "command ?arg ...?");
+	return TCL_ERROR;
+    }
+
+    if (!corPtr) {
+	Tcl_SetResult(interp, "yieldTo can only be called in a coroutine",
+		TCL_STATIC);
+	return TCL_ERROR;
+    }
+
+    iPtr->numLevels = corPtr->auxNumLevels;
+    corPtr->auxNumLevels = numLevels - corPtr->auxNumLevels;
+
+    /*
+     * This is essentially code from TclNRTailcallObjCmd
+     */
+
+    listPtr = Tcl_NewListObj(objc-1, objv+1);
+    Tcl_IncrRefCount(listPtr);
+
+    nsObjPtr = Tcl_NewStringObj(nsPtr->fullName, -1);
+    if ((TCL_OK != TclGetNamespaceFromObj(interp, nsObjPtr, &ns1Ptr))
+	    || (nsPtr != ns1Ptr)) {
+	Tcl_Panic("yieldTo failed to find the proper namespace");
+    }
+    Tcl_IncrRefCount(nsObjPtr);
+    
+    TclNRAddCallback(interp, YieldCallback, corPtr, listPtr, nsObjPtr, NULL);
+    TclNRAddCallback(interp, NRCallTEBC, INT2PTR(TCL_NR_YIELD_TYPE),
+	    NULL, NULL, NULL);
+    return TCL_OK;
+}
+
 
 static int
 RewindCoroutine(
Index: generic/tclInt.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclInt.h,v
retrieving revision 1.449
diff -u -r1.449 tclInt.h
--- generic/tclInt.h	6 Dec 2009 20:35:39 -0000	1.449
+++ generic/tclInt.h	7 Dec 2009 16:28:11 -0000
@@ -2660,6 +2660,7 @@
 MODULE_SCOPE Tcl_ObjCmdProc TclNRTailcallObjCmd;
 MODULE_SCOPE Tcl_ObjCmdProc TclNRCoroutineObjCmd;
 MODULE_SCOPE Tcl_ObjCmdProc TclNRYieldObjCmd;
+MODULE_SCOPE Tcl_ObjCmdProc TclNRYieldToObjCmd;
 
 MODULE_SCOPE void	TclClearTailcall(Tcl_Interp *interp,
 			    struct TEOV_callback *tailcallPtr);
