summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--generic/tclCompCmds.c76
-rw-r--r--generic/tclCompile.c3
-rw-r--r--generic/tclCompile.h4
-rw-r--r--generic/tclExecute.c11
-rw-r--r--tests/for.test4
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]