summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorMiguel Sofer <miguel.sofer@gmail.com>2009-12-06 20:35:38 (GMT)
committerMiguel Sofer <miguel.sofer@gmail.com>2009-12-06 20:35:38 (GMT)
commitfa22561193e48c63681c637db297f6808b80ce1a (patch)
tree06eda450bdbd56c35fa55ffddcc9e0ac45ee3b54
parent39cc2a0e16b0e756662ae39eb7e7381535dc5b54 (diff)
downloadtcl-fa22561193e48c63681c637db297f6808b80ce1a.zip
tcl-fa22561193e48c63681c637db297f6808b80ce1a.tar.gz
tcl-fa22561193e48c63681c637db297f6808b80ce1a.tar.bz2
factoring TclSpliceTailcall out of TclPopStackFrame
-rw-r--r--generic/tclBasic.c53
-rw-r--r--generic/tclExecute.c3
-rw-r--r--generic/tclInt.h4
-rw-r--r--generic/tclNamesp.c47
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);
}
}