[Bugs 2835313, 3614226]: Complete the construction of break/continue compilers

that get the stack cleanup right, even when there's expansion going on.

5 files changed, 151 insertions, 53 deletions

diff --git a/generic/tclAssembly.c b/generic/tclAssembly.c
index d1af8c6..62641e6 100644
--- a/generic/tclAssembly.c
+++ b/generic/tclAssembly.c
@@ -20,7 +20,7 @@
  *-   break and continue - if exception ranges can be sorted out.
  *-   foreach_start4, foreach_step4
  *-   returnImm, returnStk
- *-   expandStart, expandStkTop, invokeExpanded
+ *-   expandStart, expandStkTop, invokeExpanded, expandDrop
  *-   dictFirst, dictNext, dictDone
  *-   dictUpdateStart, dictUpdateEnd
  *-   jumpTable testing
diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index 3046841..365e647 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -493,37 +493,24 @@ TclCompileBreakCmd(
 
     rangePtr = TclGetInnermostExceptionRange(envPtr, TCL_BREAK, &auxPtr);
     if (rangePtr && rangePtr->type == LOOP_EXCEPTION_RANGE) {
-	int toPop = envPtr->currStackDepth - auxPtr->stackDepth;
-
 	/*
-	 * Pop off the extra stack frames.
+	 * Found the target! No need for a nasty INST_BREAK here.
 	 */
 
-	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.
-	     */
+	TclCleanupStackForBreakContinue(envPtr, auxPtr);
+	TclAddLoopBreakFixup(envPtr, auxPtr);
+    } else {
+	/*
+	 * Emit a real break.
+	 */
 
-	    TclAddLoopBreakFixup(envPtr, auxPtr);
-	    goto done;
-	}
+	PushStringLiteral(envPtr, "");
+	TclEmitOpcode(INST_DUP, envPtr);
+	TclEmitInstInt4(INST_RETURN_IMM, TCL_BREAK, envPtr);
+	TclEmitInt4(0, envPtr);
     }
 
     /*
-     * Emit a break instruction.
-     */
-
-    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,37 +827,24 @@ TclCompileContinueCmd(
 
     rangePtr = TclGetInnermostExceptionRange(envPtr, TCL_CONTINUE, &auxPtr);
     if (rangePtr && rangePtr->type == LOOP_EXCEPTION_RANGE) {
-	int toPop = envPtr->currStackDepth - auxPtr->stackDepth;
-
 	/*
-	 * Pop off the extra stack frames.
+	 * Found the target! No need for a nasty INST_CONTINUE here.
 	 */
 
-	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.
-	     */
+	TclCleanupStackForBreakContinue(envPtr, auxPtr);
+	TclAddLoopContinueFixup(envPtr, auxPtr);
+    } else {
+	/*
+	 * Emit a real continue.
+	 */
 
-	    TclAddLoopContinueFixup(envPtr, auxPtr);
-	    goto done;
-	}
+	PushStringLiteral(envPtr, "");
+	TclEmitOpcode(INST_DUP, envPtr);
+	TclEmitInstInt4(INST_RETURN_IMM, TCL_CONTINUE, envPtr);
+	TclEmitInt4(0, envPtr);
     }
 
     /*
-     * Emit a continue instruction.
-     */
-
-    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..69517bc 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -540,6 +540,10 @@ 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, popping stack elements
+	 * until the matching stack depth is reached. */
+
     {NULL, 0, 0, 0, {OPERAND_NONE}}
 };
 
@@ -571,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,
@@ -2060,8 +2065,7 @@ TclCompileScript(
 	     */
 
 	    if (expand) {
-		TclEmitOpcode(INST_EXPAND_START, envPtr);
-		envPtr->expandCount++;
+		StartExpanding(envPtr);
 	    }
 
 	    /*
@@ -3466,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;
@@ -3586,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
@@ -3626,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;
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index 957c724..15b5477 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -120,6 +120,11 @@ typedef struct ExceptionAux {
 				 * we can't currently discard them except by
 				 * doing INST_INVOKE_EXPANDED; this is a known
 				 * problem. */
+    int expandTargetDepth;	/* The stack depth expected at the outermost
+				 * expansion within the loop. Not meaningful
+				 * if there have are no open expansions
+				 * between the looping level and the point of
+				 * jump issue. */
     int numBreakTargets;	/* The number of [break]s that want to be
 				 * targeted to the place where this loop
 				 * exception will be bound to. */
@@ -772,8 +777,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
@@ -985,6 +992,8 @@ MODULE_SCOPE ByteCode *	TclCompileObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
  */
 
 MODULE_SCOPE void	TclCleanupByteCode(ByteCode *codePtr);
+MODULE_SCOPE void	TclCleanupStackForBreakContinue(CompileEnv *envPtr,
+			    ExceptionAux *auxPtr);
 MODULE_SCOPE void	TclCompileCmdWord(Tcl_Interp *interp,
 			    Tcl_Token *tokenPtr, int count,
 			    CompileEnv *envPtr);
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 8c87364..98ce51e 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -2718,6 +2718,18 @@ TEBCresume(
 	PUSH_TAUX_OBJ(objPtr);
 	NEXT_INST_F(1, 0, 0);
 
+    case INST_EXPAND_DROP:
+	/*
+	 * Drops an element of the auxObjList, popping stack elements to
+	 * restore the stack to the state before the point where the aux
+	 * element was created.
+	 */
+
+	CLANG_ASSERT(auxObjList);
+	objc = CURR_DEPTH - auxObjList->internalRep.ptrAndLongRep.value;
+	POP_TAUX_OBJ();
+	NEXT_INST_V(1, objc, 0);
+
     case INST_EXPAND_STKTOP: {
 	int i;
 	ptrdiff_t moved;