merge trunk

7 files changed, 51 insertions, 39 deletions

diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index b6e7227..d18bdda 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -512,6 +512,8 @@ Tcl_CreateInterp(void)
     iPtr->hiddenCmdTablePtr = NULL;
     iPtr->interpInfo = NULL;
 
+    iPtr->optimizer = TclOptimizeBytecode;
+
     iPtr->numLevels = 0;
     iPtr->maxNestingDepth = MAX_NESTING_DEPTH;
     iPtr->framePtr = NULL;	/* Initialise as soon as :: is available */
diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c
index a4c422e..0219f5c 100644
--- a/generic/tclCmdIL.c
+++ b/generic/tclCmdIL.c
@@ -1147,41 +1147,38 @@ InfoFrameCmd(
     Tcl_Obj *const objv[])	/* Argument objects. */
 {
     Interp *iPtr = (Interp *) interp;
-    int level, topLevel, code = TCL_OK;
-    CmdFrame *runPtr, *framePtr;
+    int level, code = TCL_OK;
+    CmdFrame *framePtr, **cmdFramePtrPtr = &iPtr->cmdFramePtr;
     CoroutineData *corPtr = iPtr->execEnvPtr->corPtr;
+    int topLevel = 0;
 
     if (objc > 2) {
 	Tcl_WrongNumArgs(interp, 1, objv, "?number?");
 	return TCL_ERROR;
     }
 
-    topLevel = ((iPtr->cmdFramePtr == NULL)
-	    ? 0
-	    : iPtr->cmdFramePtr->level);
-
-    if (corPtr) {
-	/*
-	 * A coroutine: must fix the level computations AND the cmdFrame chain,
-	 * which is interrupted at the base.
-	 */
-
-	CmdFrame *lastPtr = NULL;
-
-	runPtr = iPtr->cmdFramePtr;
+    while (corPtr) {
+	while (*cmdFramePtrPtr) {
+	    topLevel++;
+	    cmdFramePtrPtr = &((*cmdFramePtrPtr)->nextPtr);
+	}
+	if (corPtr->caller.cmdFramePtr) {
+	    *cmdFramePtrPtr = corPtr->caller.cmdFramePtr;
+	}
+	corPtr = corPtr->callerEEPtr->corPtr;
+    }
+    topLevel += (*cmdFramePtrPtr)->level;
 
-	/* TODO - deal with overflow */
-	topLevel += corPtr->caller.cmdFramePtr->level;
-	while (runPtr) {
-	    runPtr->level += corPtr->caller.cmdFramePtr->level;
-	    lastPtr = runPtr;
-	    runPtr = runPtr->nextPtr;
+    if (topLevel != iPtr->cmdFramePtr->level) {
+	framePtr = iPtr->cmdFramePtr;
+	while (framePtr) {
+	    framePtr->level = topLevel--;
+	    framePtr = framePtr->nextPtr;
 	}
-	if (lastPtr) {
-	    lastPtr->nextPtr = corPtr->caller.cmdFramePtr;
-	} else {
-	    iPtr->cmdFramePtr = corPtr->caller.cmdFramePtr;
+	if (topLevel) {
+	    Tcl_Panic("Broken frame level calculation");
 	}
+	topLevel = iPtr->cmdFramePtr->level;
     }
 
     if (objc == 1) {
@@ -1231,20 +1228,27 @@ InfoFrameCmd(
     Tcl_SetObjResult(interp, TclInfoFrame(interp, framePtr));
 
   done:
-    if (corPtr) {
+    cmdFramePtrPtr = &iPtr->cmdFramePtr;
+    corPtr = iPtr->execEnvPtr->corPtr;
+    while (corPtr) {
+	CmdFrame *endPtr = corPtr->caller.cmdFramePtr;
+
+	if (endPtr) {
+	    if (*cmdFramePtrPtr == endPtr) {
+		*cmdFramePtrPtr = NULL;
+	    } else {
+		CmdFrame *runPtr = *cmdFramePtrPtr;
 
-	if (iPtr->cmdFramePtr == corPtr->caller.cmdFramePtr) {
-	    iPtr->cmdFramePtr = NULL;
-	} else {
-	    runPtr = iPtr->cmdFramePtr;
-	    while (runPtr->nextPtr != corPtr->caller.cmdFramePtr) {
-	    	runPtr->level -= corPtr->caller.cmdFramePtr->level;
-		runPtr = runPtr->nextPtr;
+		while (runPtr->nextPtr != endPtr) {
+		    runPtr->level -= endPtr->level;
+		    runPtr = runPtr->nextPtr;
+		}
+		runPtr->level = 1;
+		runPtr->nextPtr = NULL;
 	    }
-	    runPtr->level = 1;
-	    runPtr->nextPtr = NULL;
+	    cmdFramePtrPtr = &corPtr->caller.cmdFramePtr;
 	}
-
+	corPtr = corPtr->callerEEPtr->corPtr;
     }
     return code;
 }
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index 6c2e2b6..90645c3 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -765,7 +765,9 @@ TclSetByteCodeFromAny(
      * instruction generator boundaries.
      */
 
-    TclOptimizeBytecode(&compEnv);
+    if (iPtr->optimizer) {
+	(iPtr->optimizer)(&compEnv);
+    }
 
     /*
      * Invoke the compilation hook procedure if one exists.
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index 57953d6..8e3a767 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -1064,7 +1064,7 @@ MODULE_SCOPE void	TclFinalizeLoopExceptionRange(CompileEnv *envPtr,
 MODULE_SCOPE char *	TclLiteralStats(LiteralTable *tablePtr);
 MODULE_SCOPE int	TclLog2(int value);
 #endif
-MODULE_SCOPE void	TclOptimizeBytecode(CompileEnv *envPtr);
+MODULE_SCOPE void	TclOptimizeBytecode(void *envPtr);
 #ifdef TCL_COMPILE_DEBUG
 MODULE_SCOPE void	TclPrintByteCodeObj(Tcl_Interp *interp,
 			    Tcl_Obj *objPtr);
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 6626f86..1362a03 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -1800,6 +1800,7 @@ typedef struct Interp {
     ClientData interpInfo;	/* Information used by tclInterp.c to keep
 				 * track of master/slave interps on a
 				 * per-interp basis. */
+    void (*optimizer)(void *envPtr);
     /*
      * Information related to procedures and variables. See tclProc.c and
      * tclVar.c for usage.
diff --git a/generic/tclOptimize.c b/generic/tclOptimize.c
index 3b16e6e..74de7a3 100644
--- a/generic/tclOptimize.c
+++ b/generic/tclOptimize.c
@@ -427,7 +427,7 @@ AdvanceJumps(
 
 void
 TclOptimizeBytecode(
-    CompileEnv *envPtr)
+    void *envPtr)
 {
     ConvertZeroEffectToNOP(envPtr);
     AdvanceJumps(envPtr);
diff --git a/tests/coroutine.test b/tests/coroutine.test
index 03c63ad..a360fd5 100644
--- a/tests/coroutine.test
+++ b/tests/coroutine.test
@@ -342,6 +342,9 @@ test coroutine-3.6 {info frame, bug #2910094} -setup {
     rename stack {}
     rename a {}
 } -result {}
+test coroutine-3.7 {bug 0b874c344d} {
+    dict get [coroutine X coroutine Y info frame 0] cmd
+} {coroutine X coroutine Y info frame 0}
 
 test coroutine-4.1 {bug #2093188} -setup {
     proc foo {} {