From d9990b25f1fc6db099c55ae7ce637230bc41d02c Mon Sep 17 00:00:00 2001
From: Miguel Sofer <miguel.sofer@gmail.com>
Date: Thu, 21 Aug 2008 21:01:17 +0000
Subject: 	* generic/tclBasic.c:   Fix the cmdFrame level count in 
 * generic/tclCmdIL.c:   coroutines. Fix small bug on coroutine 	*
 generic/tclInt.h:     rewind.

---
 ChangeLog          |  6 ++++++
 generic/tclBasic.c | 28 +++++++++++++++++++++-------
 generic/tclCmdIL.c | 12 +++++++++++-
 generic/tclInt.h   |  3 ++-
 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;
 
-- 
cgit v0.12