diff options
author | dkf <donal.k.fellows@manchester.ac.uk> | 2013-06-05 07:19:02 (GMT) |
---|---|---|
committer | dkf <donal.k.fellows@manchester.ac.uk> | 2013-06-05 07:19:02 (GMT) |
commit | e2aebdd0bfef45036c0e1242c55efd86773ecca4 (patch) | |
tree | 9fd8c663b8cbd76efefec52f9614115721d587b0 /generic/tclCompile.c | |
parent | 63a81f0f749c1cc9965874146ba78f865ad5393a (diff) | |
download | tcl-e2aebdd0bfef45036c0e1242c55efd86773ecca4.zip tcl-e2aebdd0bfef45036c0e1242c55efd86773ecca4.tar.gz tcl-e2aebdd0bfef45036c0e1242c55efd86773ecca4.tar.bz2 |
Stack cleanup works now even in the most evil expansion cases.
Diffstat (limited to 'generic/tclCompile.c')
-rw-r--r-- | generic/tclCompile.c | 108 |
1 files changed, 104 insertions, 4 deletions
diff --git a/generic/tclCompile.c b/generic/tclCompile.c index f8dd504..69517bc 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.c @@ -541,7 +541,8 @@ InstructionDesc const tclInstructionTable[] = { * Stack: ... list1 list2 => ... [lconcat list1 list2] */ {"expandDrop", 1, 0, 0, {OPERAND_NONE}}, - /* Drops an element from the auxiliary stack. */ + /* Drops an element from the auxiliary stack, popping stack elements + * until the matching stack depth is reached. */ {NULL, 0, 0, 0, {OPERAND_NONE}} }; @@ -574,6 +575,7 @@ static void RecordByteCodeStats(ByteCode *codePtr); static void RegisterAuxDataType(const AuxDataType *typePtr); static int SetByteCodeFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); +static void StartExpanding(CompileEnv *envPtr); static int FormatInstruction(ByteCode *codePtr, const unsigned char *pc, Tcl_Obj *bufferObj); static void PrintSourceToObj(Tcl_Obj *appendObj, @@ -2063,8 +2065,7 @@ TclCompileScript( */ if (expand) { - TclEmitOpcode(INST_EXPAND_START, envPtr); - envPtr->expandCount++; + StartExpanding(envPtr); } /* @@ -3469,6 +3470,7 @@ TclCreateExceptRange( auxPtr->supportsContinue = 1; auxPtr->stackDepth = envPtr->currStackDepth; auxPtr->expandTarget = envPtr->expandCount; + auxPtr->expandTargetDepth = -1; auxPtr->numBreakTargets = 0; auxPtr->breakTargets = NULL; auxPtr->allocBreakTargets = 0; @@ -3589,6 +3591,103 @@ TclAddLoopContinueFixup( /* * --------------------------------------------------------------------- * + * TclCleanupStackForBreakContinue -- + * + * Ditch the extra elements from the auxiliary stack and the main + * stack. How to do this exactly depends on whether there are any + * elements on the auxiliary stack to pop. + * + * --------------------------------------------------------------------- + */ + +void +TclCleanupStackForBreakContinue( + CompileEnv *envPtr, + ExceptionAux *auxPtr) +{ + int toPop = envPtr->expandCount - auxPtr->expandTarget; + + if (toPop > 0) { + while (toPop > 0) { + TclEmitOpcode(INST_EXPAND_DROP, envPtr); + toPop--; + } + toPop = auxPtr->expandTargetDepth - auxPtr->stackDepth; + while (toPop > 0) { + TclEmitOpcode(INST_POP, envPtr); + TclAdjustStackDepth(1, envPtr); + toPop--; + } + } else { + toPop = envPtr->currStackDepth - auxPtr->stackDepth; + while (toPop > 0) { + TclEmitOpcode(INST_POP, envPtr); + TclAdjustStackDepth(1, envPtr); + toPop--; + } + } +} + +/* + * --------------------------------------------------------------------- + * + * StartExpanding -- + * + * Pushes an INST_EXPAND_START and does some additional housekeeping so + * that the [break] and [continue] compilers can use an exception-free + * issue to discard it. + * + * --------------------------------------------------------------------- + */ + +static void +StartExpanding( + CompileEnv *envPtr) +{ + int i; + + TclEmitOpcode(INST_EXPAND_START, envPtr); + + /* + * Update inner exception ranges with information about the environment + * where this expansion started. + */ + + for (i=0 ; i<envPtr->exceptArrayNext ; i++) { + ExceptionRange *rangePtr = &envPtr->exceptArrayPtr[i]; + ExceptionAux *auxPtr = &envPtr->exceptAuxArrayPtr[i]; + + /* + * Ignore loops unless they're still being built. + */ + + if (rangePtr->codeOffset > CurrentOffset(envPtr)) { + continue; + } + if (rangePtr->numCodeBytes != -1) { + continue; + } + + /* + * Adequate condition: further out loops and further in exceptions + * don't actually need this information. + */ + + if (auxPtr->expandTarget == envPtr->expandCount) { + auxPtr->expandTargetDepth = envPtr->currStackDepth; + } + } + + /* + * There's now one more expansion being processed on the auxiliary stack. + */ + + envPtr->expandCount++; +} + +/* + * --------------------------------------------------------------------- + * * TclFinalizeLoopExceptionRange -- * * Finalizes a loop exception range, binding the registered [break] and @@ -3629,7 +3728,8 @@ TclFinalizeLoopExceptionRange( int j; /* - * WTF? Can't bind, so revert to an INST_CONTINUE. + * WTF? Can't bind, so revert to an INST_CONTINUE. Not enough + * space to do anything else. */ *site = INST_CONTINUE; |