From eac8ecf3bb3d3d4cc99c78f12abf28cf9e408174 Mon Sep 17 00:00:00 2001 From: Miguel Sofer Date: Sat, 24 Apr 2010 17:07:31 +0000 Subject: * generic/tclBasic.test: modify api of TclSpliceTailcall() * generic/tclExecute.c: to fix yieldTo, which had not survived * generic/tclInt.h: the latest mods to tailcall. Thanks kbk for detecting the problem. --- ChangeLog | 7 +++++++ generic/tclBasic.c | 14 +++++++------- generic/tclExecute.c | 4 ++-- generic/tclInt.h | 5 +++-- 4 files changed, 19 insertions(+), 11 deletions(-) diff --git a/ChangeLog b/ChangeLog index 5a2b140..621f806 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,10 @@ +2010-04-24 Miguel Sofer + + * generic/tclBasic.test: modify api of TclSpliceTailcall() + * generic/tclExecute.c: to fix yieldTo, which had not survived + * generic/tclInt.h: the latest mods to tailcall. Thanks kbk + for detecting the problem. + 2010-04-23 Jan Nijtmans * unix/tclUnixPort.h Fix [Bug #2991415] tclport.h #included before limits.h diff --git a/generic/tclBasic.c b/generic/tclBasic.c index ca2b045..e3b5714 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.450 2010/04/05 19:44:45 ferrieux Exp $ + * RCS: @(#) $Id: tclBasic.c,v 1.451 2010/04/24 17:07:31 msofer Exp $ */ #include "tclInt.h" @@ -8270,25 +8270,25 @@ Tcl_NRCmdSwap( void TclSpliceTailcall( Tcl_Interp *interp, - TEOV_callback *tailcallPtr) + TEOV_callback *tailcallPtr, + int skip) { /* * 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), and we skip the first command that we - * find: it corresponds to [tailcall] itself. + * find if requested to do so: 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]) { - if (second) break; - second = 1; + if (!skip) break; + skip = 0; } } if (!runPtr) { @@ -8566,7 +8566,7 @@ YieldToCallback( cbPtr = TOP_CB(interp); TOP_CB(interp) = cbPtr->nextPtr; - TclSpliceTailcall(interp, cbPtr); + TclSpliceTailcall(interp, cbPtr, 0); return TCL_OK; } diff --git a/generic/tclExecute.c b/generic/tclExecute.c index a7212ef..3c440c3 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.476 2010/04/19 15:43:36 dkf Exp $ + * RCS: @(#) $Id: tclExecute.c,v 1.477 2010/04/24 17:07:32 msofer Exp $ */ #include "tclInt.h" @@ -2872,7 +2872,7 @@ TclExecuteByteCode( goto checkForCatch; } iPtr->varFramePtr->tailcallPtr = param; - TclSpliceTailcall(interp, param); + TclSpliceTailcall(interp, param, 1); goto abnormalReturn; case TCL_NR_YIELD_TYPE: { /* [yield] */ CoroutineData *corPtr = iPtr->execEnvPtr->corPtr; diff --git a/generic/tclInt.h b/generic/tclInt.h index d04bd07..28b0e3c 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.469 2010/04/22 11:40:31 nijtmans Exp $ + * RCS: @(#) $Id: tclInt.h,v 1.470 2010/04/24 17:07:32 msofer Exp $ */ #ifndef _TCLINT @@ -2756,7 +2756,8 @@ MODULE_SCOPE Tcl_ObjCmdProc TclNRYieldToObjCmd; MODULE_SCOPE void TclClearTailcall(Tcl_Interp *interp, struct TEOV_callback *tailcallPtr); MODULE_SCOPE void TclSpliceTailcall(Tcl_Interp *interp, - struct TEOV_callback *tailcallPtr); + struct TEOV_callback *tailcallPtr, + int skip); /* * This structure holds the data for the various iteration callbacks used to -- cgit v0.12