summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--ChangeLog9
-rw-r--r--generic/tclAssembly.c4
-rw-r--r--generic/tclCompCmds.c118
-rw-r--r--generic/tclCompCmdsSZ.c17
-rw-r--r--generic/tclCompile.c301
-rw-r--r--generic/tclCompile.h66
-rw-r--r--tests/for.test74
7 files changed, 532 insertions, 57 deletions
diff --git a/ChangeLog b/ChangeLog
index a98f995..30d0f0d 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,12 @@
+2013-06-03 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclCompCmds.c (TclCompileBreakCmd, TclCompileContinueCmd):
+ Added code to allow [break] and [continue] to be issued as a jump (in
+ the most common cases) rather than using the more expensive exception
+ processing path in the bytecode engine. [Bug 3614226]: Partial fix for
+ the issues relating to cleaning up the stack when dealing with [break]
+ and [continue].
+
2013-05-27 Harald Oehlmann <oehhar@users.sf.net>
* library/msgcat/msgcat.tcl: [Bug 3036566]: Also get locale from
diff --git a/generic/tclAssembly.c b/generic/tclAssembly.c
index 0fe50b3a..d1af8c6 100644
--- a/generic/tclAssembly.c
+++ b/generic/tclAssembly.c
@@ -650,7 +650,7 @@ BBEmitOpcode(
}
TclEmitInt1(op, envPtr);
- envPtr->atCmdStart = ((op) == INST_START_CMD);
+ TclUpdateAtCmdStart(op, envPtr);
BBUpdateStackReqs(bbPtr, tblIdx, count);
}
@@ -711,7 +711,7 @@ BBEmitInst1or4(
} else {
TclEmitInt4(param, envPtr);
}
- envPtr->atCmdStart = ((op) == INST_START_CMD);
+ TclUpdateAtCmdStart(op, envPtr);
BBUpdateStackReqs(bbPtr, tblIdx, count);
}
diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index 7046e54..3046841 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -480,23 +480,55 @@ TclCompileBreakCmd(
* compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
+ ExceptionRange *rangePtr;
+ ExceptionAux *auxPtr;
+
if (parsePtr->numWords != 1) {
return TCL_ERROR;
}
/*
+ * Find the innermost exception range that contains this command.
+ */
+
+ 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.
+ */
+
+ 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;
+ }
+ }
+
+ /*
* Emit a break instruction.
*/
TclEmitOpcode(INST_BREAK, envPtr);
-#ifdef TCL_COMPILE_DEBUG
+
+ done:
/*
- * Instructions that raise exceptions don't really have to follow
- * the usual stack management rules. But the checker wants them
- * followed, so lie about stack usage to make it happy.
+ * Instructions that raise exceptions don't really have to follow the
+ * usual stack management rules, but the cleanup code does.
*/
+
TclAdjustStackDepth(1, envPtr);
-#endif
return TCL_OK;
}
@@ -602,7 +634,7 @@ TclCompileCatchCmd(
* uses.
*/
- range = DeclareExceptionRange(envPtr, CATCH_EXCEPTION_RANGE);
+ range = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr);
/*
* If the body is a simple word, compile a BEGIN_CATCH instruction,
@@ -790,6 +822,9 @@ TclCompileContinueCmd(
* compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
+ ExceptionRange *rangePtr;
+ ExceptionAux *auxPtr;
+
/*
* There should be no argument after the "continue".
*/
@@ -799,11 +834,48 @@ TclCompileContinueCmd(
}
/*
+ * See if we can find a valid continueOffset (i.e., not -1) in the
+ * innermost containing exception range.
+ */
+
+ 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.
+ */
+
+ 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;
+ }
+ }
+
+ /*
* Emit a continue instruction.
*/
TclEmitOpcode(INST_CONTINUE, envPtr);
- PushStringLiteral(envPtr, ""); /* Evil hack! */
+
+ done:
+ /*
+ * Instructions that raise exceptions don't really have to follow the
+ * usual stack management rules, but the cleanup code does.
+ */
+
+ TclAdjustStackDepth(1, envPtr);
return TCL_OK;
}
@@ -1256,7 +1328,7 @@ TclCompileDictMergeCmd(
* For each of the remaining dictionaries...
*/
- outLoop = DeclareExceptionRange(envPtr, CATCH_EXCEPTION_RANGE);
+ outLoop = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr);
TclEmitInstInt4( INST_BEGIN_CATCH4, outLoop, envPtr);
ExceptionRangeStarts(envPtr, outLoop);
for (i=2 ; i<parsePtr->numWords ; i++) {
@@ -1469,7 +1541,7 @@ CompileDictEachCmd(
* started by Tcl_DictObjFirst above.
*/
- catchRange = DeclareExceptionRange(envPtr, CATCH_EXCEPTION_RANGE);
+ catchRange = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr);
TclEmitInstInt4( INST_BEGIN_CATCH4, catchRange, envPtr);
ExceptionRangeStarts(envPtr, catchRange);
@@ -1487,7 +1559,7 @@ CompileDictEachCmd(
* Set up the loop exception targets.
*/
- loopRange = DeclareExceptionRange(envPtr, LOOP_EXCEPTION_RANGE);
+ loopRange = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr);
ExceptionRangeStarts(envPtr, loopRange);
/*
@@ -1535,6 +1607,7 @@ CompileDictEachCmd(
*/
ExceptionRangeTarget(envPtr, loopRange, breakOffset);
+ TclFinalizeLoopExceptionRange(envPtr, loopRange);
TclEmitInstInt1( INST_UNSET_SCALAR, 0, envPtr);
TclEmitInt4( infoIndex, envPtr);
TclEmitOpcode( INST_END_CATCH, envPtr);
@@ -1713,7 +1786,7 @@ TclCompileDictUpdateCmd(
TclEmitInstInt4( INST_DICT_UPDATE_START, dictIndex, envPtr);
TclEmitInt4( infoIndex, envPtr);
- range = DeclareExceptionRange(envPtr, CATCH_EXCEPTION_RANGE);
+ range = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr);
TclEmitInstInt4( INST_BEGIN_CATCH4, range, envPtr);
ExceptionRangeStarts(envPtr, range);
@@ -2070,7 +2143,7 @@ TclCompileDictWithCmd(
* Now the body of the [dict with].
*/
- range = DeclareExceptionRange(envPtr, CATCH_EXCEPTION_RANGE);
+ range = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr);
TclEmitInstInt4( INST_BEGIN_CATCH4, range, envPtr);
ExceptionRangeStarts(envPtr, range);
@@ -2352,15 +2425,6 @@ TclCompileForCmd(
}
/*
- * Create ExceptionRange records for the body and the "next" command. The
- * "next" command's ExceptionRange supports break but not continue (and
- * has a -1 continueOffset).
- */
-
- bodyRange = DeclareExceptionRange(envPtr, LOOP_EXCEPTION_RANGE);
- nextRange = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr);
-
- /*
* Inline compile the initial command.
*/
@@ -2386,6 +2450,7 @@ TclCompileForCmd(
* Compile the loop body.
*/
+ bodyRange = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr);
bodyCodeOffset = ExceptionRangeStarts(envPtr, bodyRange);
SetLineInformation(4);
CompileBody(envPtr, bodyTokenPtr, interp);
@@ -2394,9 +2459,13 @@ TclCompileForCmd(
TclEmitOpcode(INST_POP, envPtr);
/*
- * Compile the "next" subcommand.
+ * Compile the "next" subcommand. Note that this exception range will not
+ * have a continueOffset (other than -1) connected to it; it won't trap
+ * TCL_CONTINUE but rather just TCL_BREAK.
*/
+ nextRange = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr);
+ envPtr->exceptAuxArrayPtr[nextRange].supportsContinue = 0;
envPtr->currStackDepth = savedStackDepth;
nextCodeOffset = ExceptionRangeStarts(envPtr, nextRange);
SetLineInformation(3);
@@ -2444,6 +2513,8 @@ TclCompileForCmd(
ExceptionRangeTarget(envPtr, bodyRange, breakOffset);
ExceptionRangeTarget(envPtr, nextRange, breakOffset);
+ TclFinalizeLoopExceptionRange(envPtr, bodyRange);
+ TclFinalizeLoopExceptionRange(envPtr, nextRange);
/*
* The for command's result is an empty string.
@@ -2735,7 +2806,7 @@ CompileEachloopCmd(
* Create an exception record to handle [break] and [continue].
*/
- range = DeclareExceptionRange(envPtr, LOOP_EXCEPTION_RANGE);
+ range = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr);
/*
* Evaluate then store each value list in the associated temporary.
@@ -2841,6 +2912,7 @@ CompileEachloopCmd(
*/
ExceptionRangeTarget(envPtr, range, breakOffset);
+ TclFinalizeLoopExceptionRange(envPtr, range);
/*
* The command's result is an empty string if not collecting, or the
diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c
index ed4d962..7831198 100644
--- a/generic/tclCompCmdsSZ.c
+++ b/generic/tclCompCmdsSZ.c
@@ -834,7 +834,7 @@ TclSubstCompile(
}
envPtr->line = bline;
- catchRange = DeclareExceptionRange(envPtr, CATCH_EXCEPTION_RANGE);
+ catchRange = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr);
OP4( BEGIN_CATCH4, catchRange);
ExceptionRangeStarts(envPtr, catchRange);
@@ -1518,7 +1518,7 @@ IssueSwitchChainedTests(
*/
OP( POP);
- envPtr->currStackDepth = savedStackDepth + 1;
+ envPtr->currStackDepth = savedStackDepth;
envPtr->line = bodyLines[i+1]; /* TIP #280 */
envPtr->clNext = bodyContLines[i+1]; /* TIP #280 */
TclCompileCmdWord(interp, bodyToken[i+1], 1, envPtr);
@@ -2302,7 +2302,7 @@ IssueTryInstructions(
* (and it's never called when there's a finally clause).
*/
- range = DeclareExceptionRange(envPtr, CATCH_EXCEPTION_RANGE);
+ range = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr);
OP4( BEGIN_CATCH4, range);
ExceptionRangeStarts(envPtr, range);
BODY( bodyToken, 1);
@@ -2455,7 +2455,7 @@ IssueTryFinallyInstructions(
* (if any trap matches) and run a finally clause.
*/
- range = DeclareExceptionRange(envPtr, CATCH_EXCEPTION_RANGE);
+ range = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr);
OP4( BEGIN_CATCH4, range);
ExceptionRangeStarts(envPtr, range);
envPtr->currStackDepth = savedStackDepth;
@@ -2522,7 +2522,7 @@ IssueTryFinallyInstructions(
*/
if (resultVars[i] >= 0 || handlerTokens[i]) {
- range = DeclareExceptionRange(envPtr, CATCH_EXCEPTION_RANGE);
+ range = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr);
OP4( BEGIN_CATCH4, range);
ExceptionRangeStarts(envPtr, range);
}
@@ -2833,7 +2833,7 @@ TclCompileWhileCmd(
* implement break and continue.
*/
- range = DeclareExceptionRange(envPtr, LOOP_EXCEPTION_RANGE);
+ range = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr);
/*
* Jump to the evaluation of the condition. This code uses the "loop
@@ -2869,6 +2869,10 @@ TclCompileWhileCmd(
SetLineInformation(2);
bodyCodeOffset = ExceptionRangeStarts(envPtr, range);
+ if (!loopMayEnd) {
+ envPtr->exceptArrayPtr[range].continueOffset = testCodeOffset;
+ envPtr->exceptArrayPtr[range].codeOffset = bodyCodeOffset;
+ }
CompileBody(envPtr, bodyTokenPtr, interp);
ExceptionRangeEnds(envPtr, range);
envPtr->currStackDepth = savedStackDepth + 1;
@@ -2913,6 +2917,7 @@ TclCompileWhileCmd(
envPtr->exceptArrayPtr[range].continueOffset = testCodeOffset;
envPtr->exceptArrayPtr[range].codeOffset = bodyCodeOffset;
ExceptionRangeTarget(envPtr, range, breakOffset);
+ TclFinalizeLoopExceptionRange(envPtr, range);
/*
* The while command's result is an empty string.
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index 039a694..f2e9329 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -745,7 +745,9 @@ TclSetByteCodeFromAny(
}
compEnv.atCmdStart = 2; /* The disabling magic. */
TclCompileScript(interp, stringPtr, length, &compEnv);
+ assert (compEnv.atCmdStart > 1);
TclEmitOpcode(INST_DONE, &compEnv);
+ assert (compEnv.atCmdStart > 1);
}
/*
@@ -1084,9 +1086,11 @@ IsCompactibleCompileEnv(
case INST_NSUPVAR:
case INST_VARIABLE:
return 0;
+ default:
+ size = tclInstructionTable[*pc].numBytes;
+ assert (size > 0);
+ break;
}
- size = tclInstructionTable[*pc].numBytes;
- assert (size > 0);
}
return 1;
@@ -1145,31 +1149,39 @@ PeepholeOptimize(
(void) Tcl_CreateHashEntry(&targets, (void *) target, &isNew);
}
break;
+ case INST_START_CMD:
+ assert (envPtr->atCmdStart < 2);
}
}
/*
- * Replace PUSH/POP sequences (when non-hazardous) with NOPs.
+ * Replace PUSH/POP sequences (when non-hazardous) with NOPs. Also replace
+ * PUSH empty/CONCAT and TRY_CVT_NUMERIC (when followed by an operation
+ * that guarantees the check for arithmeticity).
*/
(void) Tcl_CreateHashEntry(&targets, (void *) pc, &isNew);
for (pc = envPtr->codeStart ; pc < envPtr->codeNext ; pc += size) {
- int blank = 0, i;
+ int blank = 0, i, inst;
size = tclInstructionTable[*pc].numBytes;
prev2 = prev1;
prev1 = pc;
+ while (*(pc+size) == INST_NOP) {
+ if (Tcl_FindHashEntry(&targets, (void *) (pc + size))) {
+ break;
+ }
+ size += tclInstructionTable[INST_NOP].numBytes;
+ }
if (Tcl_FindHashEntry(&targets, (void *) (pc + size))) {
continue;
}
+ inst = *(pc + size);
switch (*pc) {
case INST_PUSH1:
- while (*(pc+size) == INST_NOP) {
- size++;
- }
- if (*(pc+size) == INST_POP) {
- blank = size + 1;
- } else if (*(pc+size) == INST_CONCAT1
+ if (inst == INST_POP) {
+ blank = size + tclInstructionTable[inst].numBytes;
+ } else if (inst == INST_CONCAT1
&& TclGetUInt1AtPtr(pc + size + 1) == 2) {
Tcl_Obj *litPtr = TclFetchLiteral(envPtr,
TclGetUInt1AtPtr(pc + 1));
@@ -1177,17 +1189,14 @@ PeepholeOptimize(
(void) Tcl_GetStringFromObj(litPtr, &numBytes);
if (numBytes == 0) {
- blank = size + 2;
+ blank = size + tclInstructionTable[inst].numBytes;
}
}
break;
case INST_PUSH4:
- while (*(pc+size) == INST_NOP) {
- size++;
- }
- if (*(pc+size) == INST_POP) {
+ if (inst == INST_POP) {
blank = size + 1;
- } else if (*(pc+size) == INST_CONCAT1
+ } else if (inst == INST_CONCAT1
&& TclGetUInt1AtPtr(pc + size + 1) == 2) {
Tcl_Obj *litPtr = TclFetchLiteral(envPtr,
TclGetUInt4AtPtr(pc + 1));
@@ -1195,10 +1204,49 @@ PeepholeOptimize(
(void) Tcl_GetStringFromObj(litPtr, &numBytes);
if (numBytes == 0) {
- blank = size + 2;
+ blank = size + tclInstructionTable[inst].numBytes;
}
}
break;
+ case INST_TRY_CVT_TO_NUMERIC:
+ switch (inst) {
+ case INST_JUMP_TRUE1:
+ case INST_JUMP_TRUE4:
+ case INST_JUMP_FALSE1:
+ case INST_JUMP_FALSE4:
+ case INST_INCR_SCALAR1:
+ case INST_INCR_ARRAY1:
+ case INST_INCR_ARRAY_STK:
+ case INST_INCR_SCALAR_STK:
+ case INST_INCR_STK:
+ case INST_LOR:
+ case INST_LAND:
+ case INST_EQ:
+ case INST_NEQ:
+ case INST_LT:
+ case INST_LE:
+ case INST_GT:
+ case INST_GE:
+ case INST_MOD:
+ case INST_LSHIFT:
+ case INST_RSHIFT:
+ case INST_BITOR:
+ case INST_BITXOR:
+ case INST_BITAND:
+ case INST_EXPON:
+ case INST_ADD:
+ case INST_SUB:
+ case INST_DIV:
+ case INST_MULT:
+ case INST_LNOT:
+ case INST_BITNOT:
+ case INST_UMINUS:
+ case INST_UPLUS:
+ case INST_TRY_CVT_TO_NUMERIC:
+ blank = size;
+ break;
+ }
+ break;
}
if (blank > 0) {
for (i=0 ; i<blank ; i++) {
@@ -1466,6 +1514,7 @@ TclInitCompileEnv(
envPtr->mallocedLiteralArray = 0;
envPtr->exceptArrayPtr = envPtr->staticExceptArraySpace;
+ envPtr->exceptAuxArrayPtr = envPtr->staticExAuxArraySpace;
envPtr->exceptArrayNext = 0;
envPtr->exceptArrayEnd = COMPILEENV_INIT_EXCEPT_RANGES;
envPtr->mallocedExceptArray = 0;
@@ -1474,6 +1523,7 @@ TclInitCompileEnv(
envPtr->cmdMapEnd = COMPILEENV_INIT_CMD_MAP_SIZE;
envPtr->mallocedCmdMap = 0;
envPtr->atCmdStart = 1;
+ envPtr->expandCount = 0;
/*
* TIP #280: Set up the extended command location information, based on
@@ -1678,6 +1728,7 @@ TclFreeCompileEnv(
}
if (envPtr->mallocedExceptArray) {
ckfree(envPtr->exceptArrayPtr);
+ ckfree(envPtr->exceptAuxArrayPtr);
}
if (envPtr->mallocedCmdMap) {
ckfree(envPtr->cmdMapPtr);
@@ -2010,6 +2061,7 @@ TclCompileScript(
if (expand) {
TclEmitOpcode(INST_EXPAND_START, envPtr);
+ envPtr->expandCount++;
}
/*
@@ -2229,6 +2281,7 @@ TclCompileScript(
*/
TclEmitOpcode(INST_INVOKE_EXPANDED, envPtr);
+ envPtr->expandCount--;
TclAdjustStackDepth(1 - wordIdx, envPtr);
} else if (wordIdx > 0) {
/*
@@ -3360,6 +3413,7 @@ TclCreateExceptRange(
* new ExceptionRange structure. */
{
register ExceptionRange *rangePtr;
+ register ExceptionAux *auxPtr;
int index = envPtr->exceptArrayNext;
if (index >= envPtr->exceptArrayEnd) {
@@ -3371,12 +3425,16 @@ TclCreateExceptRange(
size_t currBytes =
envPtr->exceptArrayNext * sizeof(ExceptionRange);
+ size_t currBytes2 = envPtr->exceptArrayNext * sizeof(ExceptionAux);
int newElems = 2*envPtr->exceptArrayEnd;
size_t newBytes = newElems * sizeof(ExceptionRange);
+ size_t newBytes2 = newElems * sizeof(ExceptionAux);
if (envPtr->mallocedExceptArray) {
envPtr->exceptArrayPtr =
ckrealloc(envPtr->exceptArrayPtr, newBytes);
+ envPtr->exceptAuxArrayPtr =
+ ckrealloc(envPtr->exceptAuxArrayPtr, newBytes2);
} else {
/*
* envPtr->exceptArrayPtr isn't a ckalloc'd pointer, so we must
@@ -3384,9 +3442,12 @@ TclCreateExceptRange(
*/
ExceptionRange *newPtr = ckalloc(newBytes);
+ ExceptionAux *newPtr2 = ckalloc(newBytes2);
memcpy(newPtr, envPtr->exceptArrayPtr, currBytes);
+ memcpy(newPtr2, envPtr->exceptAuxArrayPtr, currBytes2);
envPtr->exceptArrayPtr = newPtr;
+ envPtr->exceptAuxArrayPtr = newPtr2;
envPtr->mallocedExceptArray = 1;
}
envPtr->exceptArrayEnd = newElems;
@@ -3401,10 +3462,200 @@ TclCreateExceptRange(
rangePtr->breakOffset = -1;
rangePtr->continueOffset = -1;
rangePtr->catchOffset = -1;
+ auxPtr = &envPtr->exceptAuxArrayPtr[index];
+ auxPtr->supportsContinue = 1;
+ auxPtr->stackDepth = envPtr->currStackDepth;
+ auxPtr->expandTarget = envPtr->expandCount;
+ auxPtr->numBreakTargets = 0;
+ auxPtr->breakTargets = NULL;
+ auxPtr->allocBreakTargets = 0;
+ auxPtr->numContinueTargets = 0;
+ auxPtr->continueTargets = NULL;
+ auxPtr->allocContinueTargets = 0;
return index;
}
/*
+ * ---------------------------------------------------------------------
+ *
+ * TclGetInnermostExceptionRange --
+ *
+ * Returns the innermost exception range that covers the current code
+ * creation point, and (optionally) the stack depth that is expected at
+ * that point. Relies on the fact that the range has a numCodeBytes = -1
+ * when it is being populated and that inner ranges come after outer
+ * ranges.
+ *
+ * ---------------------------------------------------------------------
+ */
+
+ExceptionRange *
+TclGetInnermostExceptionRange(
+ CompileEnv *envPtr,
+ int returnCode,
+ ExceptionAux **auxPtrPtr)
+{
+ int exnIdx = -1, i;
+
+ for (i=0 ; i<envPtr->exceptArrayNext ; i++) {
+ ExceptionRange *rangePtr = &envPtr->exceptArrayPtr[i];
+
+ if (CurrentOffset(envPtr) >= rangePtr->codeOffset &&
+ (rangePtr->numCodeBytes == -1 || CurrentOffset(envPtr) <
+ rangePtr->codeOffset+rangePtr->numCodeBytes) &&
+ (returnCode != TCL_CONTINUE ||
+ envPtr->exceptAuxArrayPtr[i].supportsContinue)) {
+ exnIdx = i;
+ }
+ }
+ if (exnIdx == -1) {
+ return NULL;
+ }
+ if (auxPtrPtr) {
+ *auxPtrPtr = &envPtr->exceptAuxArrayPtr[exnIdx];
+ }
+ return &envPtr->exceptArrayPtr[exnIdx];
+}
+
+/*
+ * ---------------------------------------------------------------------
+ *
+ * TclAddLoopBreakFixup, TclAddLoopContinueFixup --
+ *
+ * Adds a place that wants to break/continue to the loop exception range
+ * tracking that will be fixed up once the loop can be finalized. These
+ * functions will generate an INST_JUMP4 that will be fixed up during the
+ * loop finalization.
+ *
+ * ---------------------------------------------------------------------
+ */
+
+void
+TclAddLoopBreakFixup(
+ CompileEnv *envPtr,
+ ExceptionAux *auxPtr)
+{
+ int range = auxPtr - envPtr->exceptAuxArrayPtr;
+
+ if (envPtr->exceptArrayPtr[range].type != LOOP_EXCEPTION_RANGE) {
+ Tcl_Panic("trying to add 'break' fixup to full exception range");
+ }
+
+ if (++auxPtr->numBreakTargets > auxPtr->allocBreakTargets) {
+ auxPtr->allocBreakTargets *= 2;
+ auxPtr->allocBreakTargets += 2;
+ if (auxPtr->breakTargets) {
+ auxPtr->breakTargets = ckrealloc(auxPtr->breakTargets,
+ sizeof(int) * auxPtr->allocBreakTargets);
+ } else {
+ auxPtr->breakTargets =
+ ckalloc(sizeof(int) * auxPtr->allocBreakTargets);
+ }
+ }
+ auxPtr->breakTargets[auxPtr->numBreakTargets - 1] = CurrentOffset(envPtr);
+ TclEmitInstInt4(INST_JUMP4, 0, envPtr);
+}
+
+void
+TclAddLoopContinueFixup(
+ CompileEnv *envPtr,
+ ExceptionAux *auxPtr)
+{
+ int range = auxPtr - envPtr->exceptAuxArrayPtr;
+
+ if (envPtr->exceptArrayPtr[range].type != LOOP_EXCEPTION_RANGE) {
+ Tcl_Panic("trying to add 'continue' fixup to full exception range");
+ }
+
+ if (++auxPtr->numContinueTargets > auxPtr->allocContinueTargets) {
+ auxPtr->allocContinueTargets *= 2;
+ auxPtr->allocContinueTargets += 2;
+ if (auxPtr->continueTargets) {
+ auxPtr->continueTargets = ckrealloc(auxPtr->continueTargets,
+ sizeof(int) * auxPtr->allocContinueTargets);
+ } else {
+ auxPtr->continueTargets =
+ ckalloc(sizeof(int) * auxPtr->allocContinueTargets);
+ }
+ }
+ auxPtr->continueTargets[auxPtr->numContinueTargets - 1] =
+ CurrentOffset(envPtr);
+ TclEmitInstInt4(INST_JUMP4, 0, envPtr);
+}
+
+/*
+ * ---------------------------------------------------------------------
+ *
+ * TclFinalizeLoopExceptionRange --
+ *
+ * Finalizes a loop exception range, binding the registered [break] and
+ * [continue] implementations so that they jump to the correct place.
+ * Note that this must only be called after *all* the exception range
+ * target offsets have been set.
+ *
+ * ---------------------------------------------------------------------
+ */
+
+void
+TclFinalizeLoopExceptionRange(
+ CompileEnv *envPtr,
+ int range)
+{
+ ExceptionRange *rangePtr = &envPtr->exceptArrayPtr[range];
+ ExceptionAux *auxPtr = &envPtr->exceptAuxArrayPtr[range];
+ int i, offset;
+ unsigned char *site;
+
+ if (rangePtr->type != LOOP_EXCEPTION_RANGE) {
+ Tcl_Panic("trying to finalize a loop exception range");
+ }
+
+ /*
+ * Do the jump fixups. Note that these are always issued as INST_JUMP4 so
+ * there is no need to fuss around with updating code offsets.
+ */
+
+ for (i=0 ; i<auxPtr->numBreakTargets ; i++) {
+ site = envPtr->codeStart + auxPtr->breakTargets[i];
+ offset = rangePtr->breakOffset - auxPtr->breakTargets[i];
+ TclUpdateInstInt4AtPc(INST_JUMP4, offset, site);
+ }
+ for (i=0 ; i<auxPtr->numContinueTargets ; i++) {
+ site = envPtr->codeStart + auxPtr->continueTargets[i];
+ if (rangePtr->continueOffset == -1) {
+ int j;
+
+ /*
+ * WTF? Can't bind, so revert to an INST_CONTINUE.
+ */
+
+ *site = INST_CONTINUE;
+ for (j=0 ; j<4 ; j++) {
+ *++site = INST_NOP;
+ }
+ } else {
+ offset = rangePtr->continueOffset - auxPtr->continueTargets[i];
+ TclUpdateInstInt4AtPc(INST_JUMP4, offset, site);
+ }
+ }
+
+ /*
+ * Drop the arrays we were holding the only reference to.
+ */
+
+ if (auxPtr->breakTargets) {
+ ckfree(auxPtr->breakTargets);
+ auxPtr->breakTargets = NULL;
+ auxPtr->numBreakTargets = 0;
+ }
+ if (auxPtr->continueTargets) {
+ ckfree(auxPtr->continueTargets);
+ auxPtr->continueTargets = NULL;
+ auxPtr->numContinueTargets = 0;
+ }
+}
+
+/*
*----------------------------------------------------------------------
*
* TclCreateAuxData --
@@ -3764,6 +4015,22 @@ TclFixupForwardJump(
}
}
+ for (k = 0 ; k < envPtr->exceptArrayNext ; k++) {
+ ExceptionAux *auxPtr = &envPtr->exceptAuxArrayPtr[k];
+ int i;
+
+ for (i=0 ; i<auxPtr->numBreakTargets ; i++) {
+ if (jumpFixupPtr->codeOffset < auxPtr->breakTargets[i]) {
+ auxPtr->breakTargets[i] += 3;
+ }
+ }
+ for (i=0 ; i<auxPtr->numContinueTargets ; i++) {
+ if (jumpFixupPtr->codeOffset < auxPtr->continueTargets[i]) {
+ auxPtr->continueTargets[i] += 3;
+ }
+ }
+ }
+
/*
* TIP #280: Adjust the mapping from PC values to the per-command
* information about arguments and their line numbers.
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index 0be5d1d..957c724 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -100,6 +100,49 @@ typedef struct ExceptionRange {
} ExceptionRange;
/*
+ * Auxiliary data used when issuing (currently just loop) exception ranges,
+ * but which is not required during execution.
+ */
+
+typedef struct ExceptionAux {
+ int supportsContinue; /* Whether this exception range will have a
+ * continueOffset created for it; if it is a
+ * loop exception range that *doesn't* have
+ * one (see [for] next-clause) then we must
+ * not pick up the range when scanning for a
+ * target to continue to. */
+ int stackDepth; /* The stack depth at the point where the
+ * exception range was created. This is used
+ * to calculate the number of POPs required to
+ * restore the stack to its prior state. */
+ int expandTarget; /* The number of expansions expected on the
+ * auxData stack at the time the loop starts;
+ * we can't currently discard them except by
+ * doing INST_INVOKE_EXPANDED; this is a known
+ * problem. */
+ int numBreakTargets; /* The number of [break]s that want to be
+ * targeted to the place where this loop
+ * exception will be bound to. */
+ int *breakTargets; /* The offsets of the INST_JUMP4 instructions
+ * issued by the [break]s that we must
+ * update. Note that resizing a jump (via
+ * TclFixupForwardJump) can cause the contents
+ * of this array to be updated. When
+ * numBreakTargets==0, this is NULL. */
+ int allocBreakTargets; /* The size of the breakTargets array. */
+ int numContinueTargets; /* The number of [continue]s that want to be
+ * targeted to the place where this loop
+ * exception will be bound to. */
+ int *continueTargets; /* The offsets of the INST_JUMP4 instructions
+ * issued by the [continue]s that we must
+ * update. Note that resizing a jump (via
+ * TclFixupForwardJump) can cause the contents
+ * of this array to be updated. When
+ * numContinueTargets==0, this is NULL. */
+ int allocContinueTargets; /* The size of the continueTargets array. */
+} ExceptionAux;
+
+/*
* Structure used to map between instruction pc and source locations. It
* defines for each compiled Tcl command its code's starting offset and its
* source's starting offset and length. Note that the code offset increases
@@ -275,6 +318,11 @@ typedef struct CompileEnv {
* entry. */
int mallocedExceptArray; /* 1 if ExceptionRange array was expanded and
* exceptArrayPtr points in heap, else 0. */
+ ExceptionAux *exceptAuxArrayPtr;
+ /* Array of information used to restore the
+ * state when processing BREAK/CONTINUE
+ * exceptions. Must be the same size as the
+ * exceptArrayPtr. */
CmdLocation *cmdMapPtr; /* Points to start of CmdLocation array.
* numCommands is the index of the next entry
* to use; (numCommands-1) is the entry index
@@ -296,6 +344,9 @@ typedef struct CompileEnv {
/* Initial storage of LiteralEntry array. */
ExceptionRange staticExceptArraySpace[COMPILEENV_INIT_EXCEPT_RANGES];
/* Initial ExceptionRange array storage. */
+ ExceptionAux staticExAuxArraySpace[COMPILEENV_INIT_EXCEPT_RANGES];
+ /* Initial static except auxiliary info array
+ * storage. */
CmdLocation staticCmdMapSpace[COMPILEENV_INIT_CMD_MAP_SIZE];
/* Initial storage for cmd location map. */
AuxData staticAuxDataArraySpace[COMPILEENV_INIT_AUX_DATA_SIZE];
@@ -312,6 +363,10 @@ typedef struct CompileEnv {
* inefficient. If set to 2, that instruction
* should not be issued at all (by the generic
* part of the command compiler). */
+ int expandCount; /* Number of INST_EXPAND_START instructions
+ * encountered that have not yet been paired
+ * with a corresponding
+ * INST_INVOKE_EXPANDED. */
ContLineLoc *clLoc; /* If not NULL, the table holding the
* locations of the invisible continuation
* lines in the input script, to adjust the
@@ -984,6 +1039,14 @@ MODULE_SCOPE void TclInitCompileEnv(Tcl_Interp *interp,
int numBytes, const CmdFrame *invoker, int word);
MODULE_SCOPE void TclInitJumpFixupArray(JumpFixupArray *fixupArrayPtr);
MODULE_SCOPE void TclInitLiteralTable(LiteralTable *tablePtr);
+MODULE_SCOPE ExceptionRange *TclGetInnermostExceptionRange(CompileEnv *envPtr,
+ int returnCode, ExceptionAux **auxPtrPtr);
+MODULE_SCOPE void TclAddLoopBreakFixup(CompileEnv *envPtr,
+ ExceptionAux *auxPtr);
+MODULE_SCOPE void TclAddLoopContinueFixup(CompileEnv *envPtr,
+ ExceptionAux *auxPtr);
+MODULE_SCOPE void TclFinalizeLoopExceptionRange(CompileEnv *envPtr,
+ int range);
#ifdef TCL_COMPILE_STATS
MODULE_SCOPE char * TclLiteralStats(LiteralTable *tablePtr);
MODULE_SCOPE int TclLog2(int value);
@@ -1398,14 +1461,11 @@ MODULE_SCOPE Tcl_Obj *TclNewInstNameObj(unsigned char inst);
* of LOOP ranges is an interesting datum for debugging purposes, and that is
* what we compute now.
*
- * static int DeclareExceptionRange(CompileEnv *envPtr, int type);
* static int ExceptionRangeStarts(CompileEnv *envPtr, int index);
* static void ExceptionRangeEnds(CompileEnv *envPtr, int index);
* static void ExceptionRangeTarget(CompileEnv *envPtr, int index, LABEL);
*/
-#define DeclareExceptionRange(envPtr, type) \
- (TclCreateExceptRange((type), (envPtr)))
#define ExceptionRangeStarts(envPtr, index) \
(((envPtr)->exceptDepth++), \
((envPtr)->maxExceptDepth = \
diff --git a/tests/for.test b/tests/for.test
index ff4dc0e..3f4d2b7 100644
--- a/tests/for.test
+++ b/tests/for.test
@@ -14,6 +14,12 @@ if {[lsearch [namespace children] ::tcltest] == -1} {
namespace import -force ::tcltest::*
}
+# Used for constraining memory leak tests
+testConstraint memory [llength [info commands memory]]
+if {[testConstraint memory]} {
+ proc meminfo {} {lindex [split [memory info] "\n"] 3 3}
+}
+
# Basic "for" operation.
test for-1.1 {TclCompileForCmd: missing initial command} {
@@ -345,7 +351,6 @@ proc formatMail {} {
64 { UNIX (Solaris 2.* and SunOS, other systems soon to follow). Easy to install} \
65 { binary packages are now for sale at the Sun Labs Tcl/Tk Shop. Check it out!} \
}
-
set result ""
set NL "
"
@@ -365,7 +370,6 @@ proc formatMail {} {
} else {
set break 1
}
-
set xmailer 0
set inheaders 1
set last [array size lines]
@@ -386,9 +390,7 @@ proc formatMail {} {
set limit 55
} else {
set limit 55
-
# Decide whether or not to break the body line
-
if {$plen > 0} {
if {[string first {> } $line] == 0} {
# This is quoted text from previous message, don't reformat
@@ -431,7 +433,7 @@ proc formatMail {} {
set climit [expr $limit-1]
set cutoff 50
set continuation 0
-
+
while {[string length $line] > $limit} {
for {set c [expr $limit-1]} {$c >= $cutoff} {incr c -1} {
set char [string index $line $c]
@@ -824,7 +826,67 @@ test for-6.18 {Tcl_ForObjCmd: for command result} {
1 {invoked "continue" outside of a loop} \
]
-
+test for-7.1 {Bug 3614226: ensure that break cleans up the stack} memory {
+ apply {{} {
+ # Can't use [memtest]; must be careful when we change stack frames
+ set end [meminfo]
+ for {set i 0} {$i < 5} {incr i} {
+ for {set x 0} {$x < 5} {incr x} {
+ list a b c [break] d e f
+ }
+ set tmp $end
+ set end [meminfo]
+ }
+ expr {$end - $tmp}
+ }}
+} 0
+test for-7.2 {Bug 3614226: ensure that continue cleans up the stack} memory {
+ apply {{} {
+ # Can't use [memtest]; must be careful when we change stack frames
+ set end [meminfo]
+ for {set i 0} {$i < 5} {incr i} {
+ for {set x 0} {$x < 5} {incr x} {
+ list a b c [continue] d e f
+ }
+ set tmp $end
+ set end [meminfo]
+ }
+ expr {$end - $tmp}
+ }}
+} 0
+test for-7.3 {Bug 3614226: ensure that break cleans up the expansion stack} {memory knownBug} {
+ apply {{} {
+ # Can't use [memtest]; must be careful when we change stack frames
+ set end [meminfo]
+ for {set i 0} {$i < 5} {incr i} {
+ for {set x 0} {[incr x]<50} {} {
+ puts {*}[puts a b c {*}[break] d e f]
+ }
+ set tmp $end
+ set end [meminfo]
+ }
+ expr {$end - $tmp}
+ }}
+} 0
+test for-7.4 {Bug 3614226: ensure that continue cleans up the expansion stack} {memory knownBug} {
+ apply {{} {
+ # Can't use [memtest]; must be careful when we change stack frames
+ set end [meminfo]
+ for {set i 0} {$i < 5} {incr i} {
+ for {set x 0} {[incr x]<50} {} {
+ puts {*}[puts a b c {*}[continue] d e f]
+ }
+ set tmp $end
+ set end [meminfo]
+ }
+ expr {$end - $tmp}
+ }}
+} 0
+
# cleanup
::tcltest::cleanupTests
return
+
+# Local Variables:
+# mode: tcl
+# End: