summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorMiguel Sofer <miguel.sofer@gmail.com>2008-08-21 21:01:17 (GMT)
committerMiguel Sofer <miguel.sofer@gmail.com>2008-08-21 21:01:17 (GMT)
commitd9990b25f1fc6db099c55ae7ce637230bc41d02c (patch)
tree2b215719a85e8c5af53cf2ee862bff6fdbf60993
parent0aefd12ecc49b90bb53275239ab60e815c7e2ad5 (diff)
downloadtcl-d9990b25f1fc6db099c55ae7ce637230bc41d02c.zip
tcl-d9990b25f1fc6db099c55ae7ce637230bc41d02c.tar.gz
tcl-d9990b25f1fc6db099c55ae7ce637230bc41d02c.tar.bz2
* generic/tclBasic.c: Fix the cmdFrame level count in
* generic/tclCmdIL.c: coroutines. Fix small bug on coroutine * generic/tclInt.h: rewind.
-rw-r--r--ChangeLog6
-rw-r--r--generic/tclBasic.c28
-rw-r--r--generic/tclCmdIL.c12
-rw-r--r--generic/tclInt.h3
4 files changed, 40 insertions, 9 deletions
diff --git a/ChangeLog b/ChangeLog
index 5595080..6d71661 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,9 @@
+2008-08-21 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclBasic.c: Fix the cmdFrame level count in
+ * generic/tclCmdIL.c: coroutines. Fix small bug on coroutine
+ * generic/tclInt.h: rewind.
+
2008-08-21 Donal K. Fellows <dkf@users.sf.net>
* generic/tclProc.c (Tcl_DisassembleObjCmd): Added ability to
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index ac7fd5e..b50234b 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.357 2008/08/20 23:48:42 patthoyts Exp $
+ * RCS: @(#) $Id: tclBasic.c,v 1.358 2008/08/21 21:01:23 msofer Exp $
*/
#include "tclInt.h"
@@ -8144,10 +8144,12 @@ static void
DeleteCoroutine(
ClientData clientData)
{
- register CoroutineData *corPtr = clientData;
-
+ CoroutineData *corPtr = (CoroutineData *) clientData;
+ Tcl_Interp *interp = corPtr->eePtr->interp;
+ TEOV_callback *rootPtr = TOP_CB(interp);
+
if (COR_IS_SUSPENDED(corPtr)) {
- RewindCoroutine(corPtr, TCL_OK);
+ (void) TclNRRunCallbacks(interp, RewindCoroutine(corPtr, TCL_OK), rootPtr, 0);
}
}
@@ -8171,9 +8173,7 @@ PlugCoroutineChains(
corPtr->base.framePtr->callerVarPtr = corPtr->caller.varFramePtr;
corPtr->base.cmdFramePtr->nextPtr = corPtr->caller.cmdFramePtr;
- corPtr->base.cmdFramePtr->level = (iPtr->cmdFramePtr == NULL?
- 1 : iPtr->cmdFramePtr->level + 1);
- corPtr->base.cmdFramePtr->numLevels = iPtr->numLevels;
+ corPtr->levelOffset = iPtr->cmdFramePtr->level;
}
static int
@@ -8189,6 +8189,13 @@ NRCoroutineFirstCallback(
while (tmpPtr->nextPtr != corPtr->caller.cmdFramePtr) {
tmpPtr = tmpPtr->nextPtr;
}
+
+ /*
+ * Set the base cmdFrame level to zero, it will be computed using the
+ * offset.
+ */
+
+ tmpPtr->level = 0;
corPtr->base.cmdFramePtr = tmpPtr;
}
@@ -8384,6 +8391,13 @@ TclNRCoroutineObjCmd(
corPtr->eePtr->corPtr = corPtr;
corPtr->stackLevel = NULL;
+ /*
+ * On first run just set a 0 level-offset, the natural numbering is
+ * correct. The offset will be fixed for later runs.
+ */
+
+ corPtr->levelOffset = 0;
+
Tcl_DStringInit(&ds);
if (nsPtr != iPtr->globalNsPtr) {
Tcl_DStringAppend(&ds, nsPtr->fullName, -1);
diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c
index fb8d54e..7e4973b 100644
--- a/generic/tclCmdIL.c
+++ b/generic/tclCmdIL.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: tclCmdIL.c,v 1.148 2008/08/14 02:09:46 das Exp $
+ * RCS: @(#) $Id: tclCmdIL.c,v 1.149 2008/08/21 21:01:25 msofer Exp $
*/
#include "tclInt.h"
@@ -1045,7 +1045,17 @@ InfoFrameCmd(
Interp *iPtr = (Interp *) interp;
int level;
CmdFrame *framePtr;
+ int absoluteLevel = iPtr->cmdFramePtr->level;
+ if (iPtr->execEnvPtr->corPtr) {
+ /*
+ * We are running within a coroutine, the levels are relative to the
+ * coroutine's initial frame: do the correction here.
+ */
+
+ absoluteLevel += iPtr->execEnvPtr->corPtr->levelOffset;
+ }
+
if (objc == 1) {
/*
* Just "info frame".
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 811278b..1b2014b 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.392 2008/08/20 15:41:24 dkf Exp $
+ * RCS: @(#) $Id: tclInt.h,v 1.393 2008/08/21 21:01:25 msofer Exp $
*/
#ifndef _TCLINT
@@ -1347,6 +1347,7 @@ typedef struct CoroutineData {
CorContext caller;
CorContext running;
CorContext base;
+ int levelOffset;
int *stackLevel;
} CoroutineData;