summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
Diffstat (limited to 'generic')
-rw-r--r--generic/tclAssembly.c2
-rw-r--r--generic/tclCompCmds.c70
-rw-r--r--generic/tclCompile.c109
-rw-r--r--generic/tclCompile.h11
-rw-r--r--generic/tclExecute.c12
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;
generated by cgit v0.12 at 2024-07-15 22:05:09 (GMT)