summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
authorMiguel Sofer <miguel.sofer@gmail.com>2010-04-24 17:07:31 (GMT)
committerMiguel Sofer <miguel.sofer@gmail.com>2010-04-24 17:07:31 (GMT)
commiteac8ecf3bb3d3d4cc99c78f12abf28cf9e408174 (patch)
treed59a6f9ca7c0173219c9823ef65353c715633f70 /generic
parent31f9ebcae6f4c9e30de64b164c8e35f1f13db6e1 (diff)
downloadtcl-eac8ecf3bb3d3d4cc99c78f12abf28cf9e408174.zip
tcl-eac8ecf3bb3d3d4cc99c78f12abf28cf9e408174.tar.gz
tcl-eac8ecf3bb3d3d4cc99c78f12abf28cf9e408174.tar.bz2
* 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.
Diffstat (limited to 'generic')
-rw-r--r--generic/tclBasic.c14
-rw-r--r--generic/tclExecute.c4
-rw-r--r--generic/tclInt.h5
3 files changed, 12 insertions, 11 deletions
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