Index: generic/tclBasic.c ================================================================== --- generic/tclBasic.c +++ generic/tclBasic.c @@ -509,10 +509,12 @@ Tcl_IncrRefCount(iPtr->objResultPtr); iPtr->handle = TclHandleCreate(iPtr); iPtr->globalNsPtr = NULL; 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 */ iPtr->varFramePtr = NULL; /* Initialise as soon as :: is available */ Index: generic/tclCmdIL.c ================================================================== --- generic/tclCmdIL.c +++ generic/tclCmdIL.c @@ -1145,45 +1145,42 @@ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ 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; - - /* TODO - deal with overflow */ - topLevel += corPtr->caller.cmdFramePtr->level; - while (runPtr) { - runPtr->level += corPtr->caller.cmdFramePtr->level; - lastPtr = runPtr; - runPtr = runPtr->nextPtr; - } - if (lastPtr) { - lastPtr->nextPtr = corPtr->caller.cmdFramePtr; - } else { - iPtr->cmdFramePtr = corPtr->caller.cmdFramePtr; - } + while (corPtr) { + while (*cmdFramePtrPtr) { + topLevel++; + cmdFramePtrPtr = &((*cmdFramePtrPtr)->nextPtr); + } + if (corPtr->caller.cmdFramePtr) { + *cmdFramePtrPtr = corPtr->caller.cmdFramePtr; + } + corPtr = corPtr->callerEEPtr->corPtr; + } + topLevel += (*cmdFramePtrPtr)->level; + + if (topLevel != iPtr->cmdFramePtr->level) { + framePtr = iPtr->cmdFramePtr; + while (framePtr) { + framePtr->level = topLevel--; + framePtr = framePtr->nextPtr; + } + if (topLevel) { + Tcl_Panic("Broken frame level calculation"); + } + topLevel = iPtr->cmdFramePtr->level; } if (objc == 1) { /* * Just "info frame". @@ -1229,24 +1226,31 @@ } Tcl_SetObjResult(interp, TclInfoFrame(interp, framePtr)); done: - if (corPtr) { + cmdFramePtrPtr = &iPtr->cmdFramePtr; + corPtr = iPtr->execEnvPtr->corPtr; + while (corPtr) { + CmdFrame *endPtr = corPtr->caller.cmdFramePtr; - 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; + if (endPtr) { + if (*cmdFramePtrPtr == endPtr) { + *cmdFramePtrPtr = NULL; + } else { + CmdFrame *runPtr = *cmdFramePtrPtr; + + 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; } /* Index: generic/tclCompile.c ================================================================== --- generic/tclCompile.c +++ generic/tclCompile.c @@ -763,11 +763,13 @@ /* * Apply some peephole optimizations that can cross specific/generic * instruction generator boundaries. */ - TclOptimizeBytecode(&compEnv); + if (iPtr->optimizer) { + (iPtr->optimizer)(&compEnv); + } /* * Invoke the compilation hook procedure if one exists. */ Index: generic/tclCompile.h ================================================================== --- generic/tclCompile.h +++ generic/tclCompile.h @@ -1062,11 +1062,11 @@ int range); #ifdef TCL_COMPILE_STATS 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); #endif MODULE_SCOPE int TclPrintInstruction(ByteCode *codePtr, Index: generic/tclInt.h ================================================================== --- generic/tclInt.h +++ generic/tclInt.h @@ -1798,10 +1798,11 @@ * of hidden commands on a per-interp * basis. */ 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. */ Index: generic/tclOptimize.c ================================================================== --- generic/tclOptimize.c +++ generic/tclOptimize.c @@ -425,11 +425,11 @@ * ---------------------------------------------------------------------- */ void TclOptimizeBytecode( - CompileEnv *envPtr) + void *envPtr) { ConvertZeroEffectToNOP(envPtr); AdvanceJumps(envPtr); TrimUnreachable(envPtr); } Index: tests/coroutine.test ================================================================== --- tests/coroutine.test +++ tests/coroutine.test @@ -340,10 +340,13 @@ coroutine aa a } -cleanup { 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 {} { set v 1 trace add variable v {write unset} bar