diff options
| -rw-r--r-- | ChangeLog | 4 | ||||
| -rw-r--r-- | generic/tclBasic.c | 20 | ||||
| -rw-r--r-- | generic/tclExecute.c | 9 | ||||
| -rw-r--r-- | generic/tclNamesp.c | 7 |
4 files changed, 22 insertions, 18 deletions
@@ -1,5 +1,9 @@ 2009-12-13 Miguel Sofer <msofer@users.sf.net> + * generic/tclBasic.c: Release TclPopCallFrame() from its + * generic/tclExecute.c: tailcall-management duties + * generic/tclNamesp.c: + * generic/tclBasic.c: Moving TclBCArgumentRelease call * generic/tclExecute.c: from TclNRTailcallObjCmd to TEBC, so that the pairing of the Enter and Release calls is clearer. 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); - } } /* |