summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
authorMiguel Sofer <miguel.sofer@gmail.com>2008-08-21 23:57:41 (GMT)
committerMiguel Sofer <miguel.sofer@gmail.com>2008-08-21 23:57:41 (GMT)
commitc81af542ef2037176d7f71f883aa3e93dfc4196b (patch)
treecda129ecc3b3ff0b8e2b9b4b241ae31614de5556 /generic
parentedfda9078ba74cdc4c6038b014e610f7b6efcc96 (diff)
downloadtcl-c81af542ef2037176d7f71f883aa3e93dfc4196b.zip
tcl-c81af542ef2037176d7f71f883aa3e93dfc4196b.tar.gz
tcl-c81af542ef2037176d7f71f883aa3e93dfc4196b.tar.bz2
* generic/tclBasic.c: Previous fix, now done right.
* generic/tclCmdIL.c: * generic/tclInt.h: * tests/unsupported.test:
Diffstat (limited to 'generic')
-rw-r--r--generic/tclBasic.c11
-rw-r--r--generic/tclCmdIL.c70
-rw-r--r--generic/tclInt.h3
3 files changed, 29 insertions, 55 deletions
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index b50234b..53be9de 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.358 2008/08/21 21:01:23 msofer Exp $
+ * RCS: @(#) $Id: tclBasic.c,v 1.359 2008/08/21 23:57:42 msofer Exp $
*/
#include "tclInt.h"
@@ -8173,7 +8173,6 @@ PlugCoroutineChains(
corPtr->base.framePtr->callerVarPtr = corPtr->caller.varFramePtr;
corPtr->base.cmdFramePtr->nextPtr = corPtr->caller.cmdFramePtr;
- corPtr->levelOffset = iPtr->cmdFramePtr->level;
}
static int
@@ -8190,12 +8189,6 @@ NRCoroutineFirstCallback(
tmpPtr = tmpPtr->nextPtr;
}
- /*
- * Set the base cmdFrame level to zero, it will be computed using the
- * offset.
- */
-
- tmpPtr->level = 0;
corPtr->base.cmdFramePtr = tmpPtr;
}
@@ -8396,8 +8389,6 @@ TclNRCoroutineObjCmd(
* 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 d6d0b09..a96f555 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.150 2008/08/21 21:24:53 msofer Exp $
+ * RCS: @(#) $Id: tclCmdIL.c,v 1.151 2008/08/21 23:57:43 msofer Exp $
*/
#include "tclInt.h"
@@ -1043,30 +1043,29 @@ InfoFrameCmd(
Tcl_Obj *const objv[]) /* Argument objects. */
{
Interp *iPtr = (Interp *) interp;
- int level;
+ int level, topLevel;
CmdFrame *framePtr;
- int absoluteLevel = ((iPtr->cmdFramePtr == NULL)
+
+ topLevel = ((iPtr->cmdFramePtr == NULL)
? 0
: 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.
+ * A coroutine: must fix the level computations
*/
- absoluteLevel += iPtr->execEnvPtr->corPtr->levelOffset;
+ topLevel += iPtr->execEnvPtr->corPtr->caller.cmdFramePtr->level + 1 -
+ iPtr->execEnvPtr->corPtr->base.cmdFramePtr->level;
}
-
+
if (objc == 1) {
/*
* Just "info frame".
*/
- int levels =
- (iPtr->cmdFramePtr == NULL ? 0 : absoluteLevel);
-
- Tcl_SetObjResult(interp, Tcl_NewIntObj (levels));
+ Tcl_SetObjResult(interp, Tcl_NewIntObj (topLevel));
return TCL_OK;
} else if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "?number?");
@@ -1080,44 +1079,29 @@ InfoFrameCmd(
if (TclGetIntFromObj(interp, objv[1], &level) != TCL_OK) {
return TCL_ERROR;
}
- if (level <= 0) {
- /*
- * Negative levels are adressing relative to the current frame's
- * depth.
- */
-
- if (iPtr->cmdFramePtr == NULL) {
- levelError:
- Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "bad level \"",
- TclGetString(objv[1]), "\"", NULL);
- return TCL_ERROR;
- }
- /*
- * Convert to absolute.
- */
+ if ((level > topLevel) || (level <= - topLevel)) {
+ levelError:
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "bad level \"",
+ TclGetString(objv[1]), "\"", NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Let us convert to relative so that we know how many levels to go back
+ */
- level += iPtr->cmdFramePtr->level;
+ if (level > 0) {
+ level -= topLevel;
}
- for (framePtr = iPtr->cmdFramePtr; framePtr != NULL;
- framePtr = framePtr->nextPtr) {
- absoluteLevel = framePtr->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 (absoluteLevel == level) {
- break;
+ framePtr = iPtr->cmdFramePtr;
+ while (++level <= 0) {
+ framePtr = framePtr->nextPtr;
+ if (!framePtr) {
+ goto levelError;
}
}
- if (framePtr == NULL) {
- goto levelError;
- }
Tcl_SetObjResult(interp, TclInfoFrame(interp, framePtr));
return TCL_OK;
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 1b2014b..7084cd1 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.393 2008/08/21 21:01:25 msofer Exp $
+ * RCS: @(#) $Id: tclInt.h,v 1.394 2008/08/21 23:57:43 msofer Exp $
*/
#ifndef _TCLINT
@@ -1347,7 +1347,6 @@ typedef struct CoroutineData {
CorContext caller;
CorContext running;
CorContext base;
- int levelOffset;
int *stackLevel;
} CoroutineData;