From fa22561193e48c63681c637db297f6808b80ce1a Mon Sep 17 00:00:00 2001
From: Miguel Sofer <miguel.sofer@gmail.com>
Date: Sun, 6 Dec 2009 20:35:38 +0000
Subject: factoring TclSpliceTailcall out of TclPopStackFrame

---
 generic/tclBasic.c   | 53 +++++++++++++++++++++++++++++++++++++++++++++++++++-
 generic/tclExecute.c |  3 ++-
 generic/tclInt.h     |  4 +++-
 generic/tclNamesp.c  | 47 ++--------------------------------------------
 4 files changed, 59 insertions(+), 48 deletions(-)

diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 0376a0a..fa9eb6e 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.412 2009/12/06 18:12:26 msofer Exp $
+ * RCS: @(#) $Id: tclBasic.c,v 1.413 2009/12/06 20:35:38 msofer Exp $
  */
 
 #include "tclInt.h"
@@ -8180,6 +8180,57 @@ Tcl_NRCmdSwap(
  * FIXME NRE!
  */
 
+void
+TclSpliceTailcall (
+    Tcl_Interp *interp,
+    TEOV_callback *tailcallPtr)
+{
+    /*
+     * Find the splicing spot: right before the NRCommand of the thing
+     * being tailcalled. Note that we skip NRCommands marked in data[1]
+     * (used by command redirectors)
+     */
+    
+    Interp *iPtr = (Interp *) interp;
+    TEOV_callback *runPtr;
+    ExecEnv *eePtr = NULL;
+    
+    
+    
+    restart:
+    for (runPtr = TOP_CB(interp); runPtr; runPtr = runPtr->nextPtr) {
+	if (((runPtr->procPtr) == NRCommand) && !runPtr->data[1]) {
+	    break;
+	}
+    }
+    if (!runPtr) {
+	/*
+	 * If we are tailcalling out of a coroutine, the splicing spot is
+	 * in the caller's execEnv: go find it!
+	 */
+	
+	CoroutineData *corPtr = iPtr->execEnvPtr->corPtr;
+	if (corPtr) {
+	    eePtr = iPtr->execEnvPtr;		
+	    iPtr->execEnvPtr = corPtr->callerEEPtr;
+	    goto restart;
+	}
+	Tcl_Panic("Tailcall cannot find the right splicing spot: should not happen!");
+    }
+    
+    tailcallPtr->nextPtr = runPtr->nextPtr;
+    runPtr->nextPtr = tailcallPtr;
+    
+    if (eePtr) {
+	/*
+	 * Restore the right execEnv if it was swapped for tailcalling out
+	 * of a coroutine.
+	 */
+	
+	iPtr->execEnvPtr = eePtr;
+    }
+}
+
 int
 TclNRTailcallObjCmd(
     ClientData clientData,
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 6ad9043..9758676 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.449 2009/12/06 18:12:26 msofer Exp $
+ * RCS: @(#) $Id: tclExecute.c,v 1.450 2009/12/06 20:35:39 msofer Exp $
  */
 
 #include "tclInt.h"
@@ -1991,6 +1991,7 @@ TclExecuteByteCode(
 
 		codePtr = param;
 		if (!codePtr) {
+		    /* NOT CALLED, does not (yet?) work */
 		    goto resumeCoroutine;
 		}
 		break;
diff --git a/generic/tclInt.h b/generic/tclInt.h
index d02df6b..efde2ce 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.448 2009/11/18 23:46:05 nijtmans Exp $
+ * RCS: @(#) $Id: tclInt.h,v 1.449 2009/12/06 20:35:39 msofer Exp $
  */
 
 #ifndef _TCLINT
@@ -2663,6 +2663,8 @@ MODULE_SCOPE Tcl_ObjCmdProc TclNRYieldObjCmd;
 
 MODULE_SCOPE void	TclClearTailcall(Tcl_Interp *interp,
 			    struct TEOV_callback *tailcallPtr);
+MODULE_SCOPE void       TclSpliceTailcall(Tcl_Interp *interp,
+			    struct TEOV_callback *tailcallPtr);
 
 /*
  * This structure holds the data for the various iteration callbacks used to
diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c
index 99f3f1a..dbeb70d 100644
--- a/generic/tclNamesp.c
+++ b/generic/tclNamesp.c
@@ -23,7 +23,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclNamesp.c,v 1.196 2009/12/05 21:30:05 msofer Exp $
+ * RCS: @(#) $Id: tclNamesp.c,v 1.197 2009/12/06 20:35:41 msofer Exp $
  */
 
 #include "tclInt.h"
@@ -510,50 +510,7 @@ Tcl_PopCallFrame(
     framePtr->nsPtr = NULL;
 
     if (framePtr->tailcallPtr) {
-	/*
-	 * Find the splicing spot: right before the NRCommand of the thing
-	 * being tailcalled. Note that we skip NRCommands marked in data[1]
-	 * (used by command redirectors)
-	 */
-
-	TEOV_callback *tailcallPtr, *runPtr;
-	ExecEnv *eePtr = NULL;
-
-	
-	restart:
-	for (runPtr = TOP_CB(interp); runPtr; runPtr = runPtr->nextPtr) {
-	    if (((runPtr->procPtr) == NRCommand) && !runPtr->data[1]) {
-		break;
-	    }
-	}
-	if (!runPtr) {
-	    /*
-	     * If we are tailcalling out of a coroutine, the splicing spot is
-	     * in the caller's execEnv: go find it!
-	     */
-	    
-	    CoroutineData *corPtr = iPtr->execEnvPtr->corPtr;
-	    if (corPtr) {
-		eePtr = iPtr->execEnvPtr;		
-		iPtr->execEnvPtr = corPtr->callerEEPtr;
-		goto restart;
-	    }
-	    Tcl_Panic("Tailcall cannot find the right splicing spot: should not happen!");
-	}
-
-	tailcallPtr = framePtr->tailcallPtr;
-	
-	tailcallPtr->nextPtr = runPtr->nextPtr;
-	runPtr->nextPtr = tailcallPtr;
-
-	if (eePtr) {
-	    /*
-	     * Restore the right execEnv if it was swapped for tailcalling out
-	     * of a coroutine.
-	     */
-	    
-	    iPtr->execEnvPtr = eePtr;
-	}
+	TclSpliceTailcall(interp, framePtr->tailcallPtr);
     }
 }
 
-- 
cgit v0.12