Next stage of fixing the break/continue generation.

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]