From 2a3000c25e6712d2bc2e4c1f631fdf6a22b41547 Mon Sep 17 00:00:00 2001 From: dkf Date: Mon, 3 Jun 2013 14:57:48 +0000 Subject: Next stage of fixing the break/continue generation. --- generic/tclCompCmds.c | 76 +++++++++++++++++++++++++++++---------------------- generic/tclCompile.c | 3 ++ generic/tclCompile.h | 4 ++- generic/tclExecute.c | 11 ++++++++ tests/for.test | 4 +-- 5 files changed, 63 insertions(+), 35 deletions(-) diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c index 3046841..3d6abcf 100644 --- a/generic/tclCompCmds.c +++ b/generic/tclCompCmds.c @@ -493,36 +493,42 @@ TclCompileBreakCmd( rangePtr = TclGetInnermostExceptionRange(envPtr, TCL_BREAK, &auxPtr); if (rangePtr && rangePtr->type == LOOP_EXCEPTION_RANGE) { - int toPop = envPtr->currStackDepth - auxPtr->stackDepth; + int toPop; + + /* + * Ditch the extra elements from the auxiliary stack. + */ + + toPop = envPtr->expandCount - auxPtr->expandTarget; + while (toPop > 0) { + TclEmitOpcode(INST_EXPAND_DROP, envPtr); + toPop--; + } /* * Pop off the extra stack frames. */ + toPop = envPtr->currStackDepth - auxPtr->stackDepth; while (toPop > 0) { TclEmitOpcode(INST_POP, envPtr); TclAdjustStackDepth(1, envPtr); toPop--; } - if (envPtr->expandCount == auxPtr->expandTarget) { - /* - * Found the target! Also, no built-up expansion stack. No need - * for a nasty INST_BREAK here. - */ - - TclAddLoopBreakFixup(envPtr, auxPtr); - goto done; - } - } + /* + * Found the target! No need for a nasty INST_BREAK here. + */ - /* - * Emit a break instruction. - */ + TclAddLoopBreakFixup(envPtr, auxPtr); + } else { + /* + * Emit a break instruction. + */ - TclEmitOpcode(INST_BREAK, envPtr); + TclEmitOpcode(INST_BREAK, envPtr); + } - done: /* * Instructions that raise exceptions don't really have to follow the * usual stack management rules, but the cleanup code does. @@ -840,36 +846,42 @@ TclCompileContinueCmd( rangePtr = TclGetInnermostExceptionRange(envPtr, TCL_CONTINUE, &auxPtr); if (rangePtr && rangePtr->type == LOOP_EXCEPTION_RANGE) { - int toPop = envPtr->currStackDepth - auxPtr->stackDepth; + int toPop; + + /* + * Ditch the extra elements from the auxiliary stack. + */ + + toPop = envPtr->expandCount - auxPtr->expandTarget; + while (toPop > 0) { + TclEmitOpcode(INST_EXPAND_DROP, envPtr); + toPop--; + } /* * Pop off the extra stack frames. */ + toPop = envPtr->currStackDepth - auxPtr->stackDepth; while (toPop > 0) { TclEmitOpcode(INST_POP, envPtr); TclAdjustStackDepth(1, envPtr); toPop--; } - if (envPtr->expandCount == auxPtr->expandTarget) { - /* - * Found the target! Also, no built-up expansion stack. No need - * for a nasty INST_CONTINUE here. - */ - - TclAddLoopContinueFixup(envPtr, auxPtr); - goto done; - } - } + /* + * Found the target! No need for a nasty INST_CONTINUE here. + */ - /* - * Emit a continue instruction. - */ + TclAddLoopContinueFixup(envPtr, auxPtr); + } else { + /* + * Emit a continue instruction. + */ - TclEmitOpcode(INST_CONTINUE, envPtr); + TclEmitOpcode(INST_CONTINUE, envPtr); + } - done: /* * Instructions that raise exceptions don't really have to follow the * usual stack management rules, but the cleanup code does. diff --git a/generic/tclCompile.c b/generic/tclCompile.c index f2e9329..f8dd504 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.c @@ -540,6 +540,9 @@ InstructionDesc const tclInstructionTable[] = { * list and pushes that resulting list onto the stack. * Stack: ... list1 list2 => ... [lconcat list1 list2] */ + {"expandDrop", 1, 0, 0, {OPERAND_NONE}}, + /* Drops an element from the auxiliary stack. */ + {NULL, 0, 0, 0, {OPERAND_NONE}} }; diff --git a/generic/tclCompile.h b/generic/tclCompile.h index 957c724..75de025 100644 --- a/generic/tclCompile.h +++ b/generic/tclCompile.h @@ -772,8 +772,10 @@ typedef struct ByteCode { #define INST_LIST_CONCAT 164 +#define INST_EXPAND_DROP 165 + /* The last opcode */ -#define LAST_INST_OPCODE 164 +#define LAST_INST_OPCODE 165 /* * Table describing the Tcl bytecode instructions: their name (for displaying diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 7c645e7..559df0b 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -2718,6 +2718,17 @@ TEBCresume( PUSH_TAUX_OBJ(objPtr); NEXT_INST_F(1, 0, 0); + case INST_EXPAND_DROP: + /* + * Drops an element of the auxObjList. Does not do any clean up of the + * actual stack. + * + * TODO: POP MAIN STACK BACK TO MARKER + */ + + POP_TAUX_OBJ(); + NEXT_INST_F(1, 0, 0); + case INST_EXPAND_STKTOP: { int i; ptrdiff_t moved; diff --git a/tests/for.test b/tests/for.test index 3f4d2b7..cfba1fe 100644 --- a/tests/for.test +++ b/tests/for.test @@ -854,7 +854,7 @@ test for-7.2 {Bug 3614226: ensure that continue cleans up the stack} memory { expr {$end - $tmp} }} } 0 -test for-7.3 {Bug 3614226: ensure that break cleans up the expansion stack} {memory knownBug} { +test for-7.3 {Bug 3614226: ensure that break cleans up the expansion stack} memory { apply {{} { # Can't use [memtest]; must be careful when we change stack frames set end [meminfo] @@ -868,7 +868,7 @@ test for-7.3 {Bug 3614226: ensure that break cleans up the expansion stack} {mem expr {$end - $tmp} }} } 0 -test for-7.4 {Bug 3614226: ensure that continue cleans up the expansion stack} {memory knownBug} { +test for-7.4 {Bug 3614226: ensure that continue cleans up the expansion stack} memory { apply {{} { # Can't use [memtest]; must be careful when we change stack frames set end [meminfo] -- cgit v0.12