diff options
author | Miguel Sofer <miguel.sofer@gmail.com> | 2008-08-21 21:01:17 (GMT) |
---|---|---|
committer | Miguel Sofer <miguel.sofer@gmail.com> | 2008-08-21 21:01:17 (GMT) |
commit | d9990b25f1fc6db099c55ae7ce637230bc41d02c (patch) | |
tree | 2b215719a85e8c5af53cf2ee862bff6fdbf60993 | |
parent | 0aefd12ecc49b90bb53275239ab60e815c7e2ad5 (diff) | |
download | tcl-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-- | ChangeLog | 6 | ||||
-rw-r--r-- | generic/tclBasic.c | 28 | ||||
-rw-r--r-- | generic/tclCmdIL.c | 12 | ||||
-rw-r--r-- | generic/tclInt.h | 3 |
4 files changed, 40 insertions, 9 deletions
@@ -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; |