summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
authorMiguel Sofer <miguel.sofer@gmail.com>2009-12-13 17:11:47 (GMT)
committerMiguel Sofer <miguel.sofer@gmail.com>2009-12-13 17:11:47 (GMT)
commit64cd452abe0622edb368d64ef22b368689b6cc86 (patch)
tree308535394c93daef6801a789aefdf38a27605407 /generic
parenteb5b16a4cf09bf5b1a7d496074935db1ed60eed2 (diff)
downloadtcl-64cd452abe0622edb368d64ef22b368689b6cc86.zip
tcl-64cd452abe0622edb368d64ef22b368689b6cc86.tar.gz
tcl-64cd452abe0622edb368d64ef22b368689b6cc86.tar.bz2
* generic/tclBasic.c: Release TclPopCallFrame() from its
* generic/tclExecute.c: tailcall-management duties * generic/tclNamesp.c:
Diffstat (limited to 'generic')
-rw-r--r--generic/tclBasic.c20
-rw-r--r--generic/tclExecute.c9
-rw-r--r--generic/tclNamesp.c7
3 files changed, 18 insertions, 18 deletions
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 43bd2d5..5440bca 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.432 2009/12/13 16:41:37 msofer Exp $
+ * RCS: @(#) $Id: tclBasic.c,v 1.433 2009/12/13 17:11:47 msofer Exp $
*/
#include "tclInt.h"
@@ -8206,17 +8206,20 @@ TclSpliceTailcall(
/*
* 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)
+ * (used by command redirectors), and we skip the first command that we
+ * find: it corresponds to [tailcall] itself.
*/
Interp *iPtr = (Interp *) interp;
TEOV_callback *runPtr;
ExecEnv *eePtr = NULL;
-
+ int second = 0;
+
restart:
for (runPtr = TOP_CB(interp); runPtr; runPtr = runPtr->nextPtr) {
if (((runPtr->procPtr) == NRCommand) && !runPtr->data[1]) {
- break;
+ if (second) break;
+ second = 1;
}
}
if (!runPtr) {
@@ -8259,6 +8262,7 @@ TclNRTailcallObjCmd(
Tcl_Obj *listPtr, *nsObjPtr;
Tcl_Namespace *nsPtr = (Tcl_Namespace *) iPtr->varFramePtr->nsPtr;
Tcl_Namespace *ns1Ptr;
+ TEOV_callback *tailcallPtr;
if (objc < 2) {
Tcl_WrongNumArgs(interp, 1, objv, "command ?arg ...?");
@@ -8294,11 +8298,13 @@ TclNRTailcallObjCmd(
*/
TclNRAddCallback(interp, NRTailcallEval, listPtr, nsObjPtr, NULL, NULL);
- iPtr->varFramePtr->tailcallPtr = TOP_CB(interp);
- TOP_CB(interp) = TOP_CB(interp)->nextPtr;
+ //iPtr->varFramePtr->tailcallPtr = TOP_CB(interp);
+ //TclSpliceTailcall(interp, TOP_CB(interp));
+ tailcallPtr = TOP_CB(interp);
+ TOP_CB(interp) = tailcallPtr->nextPtr;
TclNRAddCallback(interp, NRCallTEBC, INT2PTR(TCL_NR_TAILCALL_TYPE),
- NULL, NULL, NULL);
+ tailcallPtr, NULL, NULL);
return TCL_OK;
}
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index a8a979d..e553356 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.467 2009/12/13 16:41:37 msofer Exp $
+ * RCS: @(#) $Id: tclExecute.c,v 1.468 2009/12/13 17:11:47 msofer Exp $
*/
#include "tclInt.h"
@@ -2856,10 +2856,7 @@ TclExecuteByteCode(
TclArgumentBCRelease((Tcl_Interp *) iPtr, bcFramePtr);
if (catchTop != initCatchTop) {
- TEOV_callback *tailcallPtr =
- iPtr->varFramePtr->tailcallPtr;
-
- TclClearTailcall(interp, tailcallPtr);
+ TclClearTailcall(interp, param);
iPtr->varFramePtr->tailcallPtr = NULL;
TRESULT = TCL_ERROR;
Tcl_SetResult(interp,
@@ -2870,6 +2867,8 @@ TclExecuteByteCode(
pc--;
goto checkForCatch;
}
+ iPtr->varFramePtr->tailcallPtr = param;
+ TclSpliceTailcall(interp, param);
goto abnormalReturn;
case TCL_NR_YIELD_TYPE: { /* [yield] */
CoroutineData *corPtr = iPtr->execEnvPtr->corPtr;
diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c
index dbeb70d..507007d 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.197 2009/12/06 20:35:41 msofer Exp $
+ * RCS: @(#) $Id: tclNamesp.c,v 1.198 2009/12/13 17:11:47 msofer Exp $
*/
#include "tclInt.h"
@@ -456,7 +456,6 @@ Tcl_PushCallFrame(
* Modifies the call stack of the interpreter. Resets various fields of
* the popped call frame. If a namespace has been deleted and has no more
* activations on the call stack, the namespace is destroyed.
- * Schedules a tailcall if one is present.
*
*----------------------------------------------------------------------
*/
@@ -508,10 +507,6 @@ Tcl_PopCallFrame(
Tcl_DeleteNamespace((Tcl_Namespace *) nsPtr);
}
framePtr->nsPtr = NULL;
-
- if (framePtr->tailcallPtr) {
- TclSpliceTailcall(interp, framePtr->tailcallPtr);
- }
}
/*