diff options
| -rw-r--r-- | ChangeLog | 9 | ||||
| -rw-r--r-- | generic/tclAssembly.c | 4 | ||||
| -rw-r--r-- | generic/tclCompCmds.c | 118 | ||||
| -rw-r--r-- | generic/tclCompCmdsSZ.c | 17 | ||||
| -rw-r--r-- | generic/tclCompile.c | 301 | ||||
| -rw-r--r-- | generic/tclCompile.h | 66 | ||||
| -rw-r--r-- | tests/for.test | 74 |
7 files changed, 532 insertions, 57 deletions
@@ -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: |