diff options
| -rw-r--r-- | ChangeLog | 76 | ||||
| -rw-r--r-- | generic/tclAssembly.c | 2 | ||||
| -rw-r--r-- | generic/tclCompCmds.c | 70 | ||||
| -rw-r--r-- | generic/tclCompile.c | 109 | ||||
| -rw-r--r-- | generic/tclCompile.h | 11 | ||||
| -rw-r--r-- | generic/tclExecute.c | 12 | ||||
| -rw-r--r-- | tests/for.test | 64 |
7 files changed, 254 insertions, 90 deletions
@@ -1,8 +1,17 @@ +2013-06-05 Donal K. Fellows <dkf@users.sf.net> + + * generic/tclExecute.c (INST_EXPAND_DROP): [Bugs 2835313, 3614226]: + New opcode to allow resetting the stack to get rid of an expansion, + restoring the stack to a known state in the process. + * generic/tclCompile.c, generic/tclCompCmds.c: Adjusted the compilers + for [break] and [continue] to get stack cleanup right in the majority + of cases. + * tests/for.test (for-7.*): Set of tests for these evil cases. + 2013-06-04 Jan Nijtmans <nijtmans@users.sf.net> - * unix/tcl.m4: Eliminate NO_VIZ macro as current - zlib uses HAVE_HIDDEN in stead. One more last-moment - fix for FreeBSD by Pietro Cerutti + * unix/tcl.m4: Eliminate NO_VIZ macro as current zlib uses HAVE_HIDDEN + instead. One more last-moment fix for FreeBSD by Pietro Cerutti 2013-06-03 Miguel Sofer <msofer@users.sf.net> @@ -10,7 +19,7 @@ (https://groups.google.com/forum/?fromgroups#!topic/comp.lang.tcl/vfpI3bc-DkQ), diagnosed by dgp to be a close relative of [Bug 781585], which was fixed by commit [f46fb50cb3]. This bug was introduced by myself in - commit [cbfe055d8c]. + commit [cbfe055d8c]. 2013-06-03 Donal K. Fellows <dkf@users.sf.net> @@ -24,14 +33,14 @@ 2013-05-27 Harald Oehlmann <oehhar@users.sf.net> * library/msgcat/msgcat.tcl: [Bug 3036566]: Also get locale from - registry key HCU\Control Panel\Desktop : PreferredUILanguages to - honor installed language packs on Vista+. + registry key HCU\Control Panel\Desktop : PreferredUILanguages to honor + installed language packs on Vista+. Bumped msgcat version to 1.5.2 2013-05-22 Andreas Kupries <andreask@activestate.com> * tclCompile.c: Removed duplicate const qualifier causing the HP - native cc to error out. + native cc to error out. 2013-05-22 Donal K. Fellows <dkf@users.sf.net> @@ -93,10 +102,9 @@ 2013-04-30 Andreas Kupries <andreask@activestate.com> * library/platform/platform.tcl (::platform::LibcVersion): - * library/platform/pkgIndex.tcl: Followup to the 2013-01-30 - change. The RE become too restrictive again. SuSe added a - timestamp after the version. Loosened up a bit. Bumped package - to version 1.0.12. + * library/platform/pkgIndex.tcl: Followup to the 2013-01-30 change. + The RE become too restrictive again. SuSe added a timestamp after the + version. Loosened up a bit. Bumped package to version 1.0.12. 2013-04-29 Donal K. Fellows <dkf@users.sf.net> @@ -115,8 +123,8 @@ 2013-04-19 Jan Nijtmans <nijtmans@users.sf.net> * generic/tclDecls.h: Implement many Tcl_*Var* functions and - Tcl_GetIndexFromObj as (faster/stack-saving) macros around resp - their Tcl_*Var*2 equivalent and Tcl_GetIndexFromObjStruct. + Tcl_GetIndexFromObj as (faster/stack-saving) macros around resp their + Tcl_*Var*2 equivalent and Tcl_GetIndexFromObjStruct. 2013-04-12 Jan Nijtmans <nijtmans@users.sf.net> @@ -125,16 +133,16 @@ 2013-04-08 Don Porter <dgp@users.sourceforge.net> - * generic/regc_color.c: [Bug 3610026] Stop crash when the number of - * generic/regerrs.h: "colors" in a regular expression overflows - * generic/regex.h: a short int. Thanks to Heikki Linnakangas - * generic/regguts.h: for the report and the patch. + * generic/regc_color.c: [Bug 3610026]: Stop crash when the number of + * generic/regerrs.h: "colors" in a regular expression overflows a + * generic/regex.h: short int. Thanks to Heikki Linnakangas for + * generic/regguts.h: the report and the patch. * tests/regexp.test: 2013-04-04 Reinhard Max <max@suse.de> - * library/http/http.tcl (http::geturl): Allow URLs that don't have - a path, but a query query, e.g. http://example.com?foo=bar . + * library/http/http.tcl (http::geturl): Allow URLs that don't have a + path, but a query query, e.g. http://example.com?foo=bar * Bump the http package to 2.8.7. 2013-03-22 Venkat Iyer <venkat@comit.com> @@ -166,12 +174,12 @@ 2013-03-21 Don Porter <dgp@users.sourceforge.net> - * library/auto.tcl: [Bug 2102614] Add ensemble indexing support - * tests/autoMkindex.test: to [auto_mkindex]. Thanks Brian Griffin. + * library/auto.tcl: [Bug 2102614]: Add ensemble indexing support to + * tests/autoMkindex.test: [auto_mkindex]. Thanks Brian Griffin. 2013-03-19 Don Porter <dgp@users.sourceforge.net> - * generic/tclFCmd.c: [Bug 3597000] Consistent [file copy] result. + * generic/tclFCmd.c: [Bug 3597000]: Consistent [file copy] result. * tests/fileSystem.test: 2013-03-19 Jan Nijtmans <nijtmans@users.sf.net> @@ -191,20 +199,20 @@ 2013-03-11 Don Porter <dgp@users.sourceforge.net> - * generic/tclCompile.c: [Bugs 3607246,3607372] Unbalanced refcounts + * generic/tclCompile.c: [Bugs 3607246,3607372]: Unbalanced refcounts * generic/tclLiteral.c: of literals in the global literal table. 2013-03-06 Don Porter <dgp@users.sourceforge.net> - * generic/regc_nfa.c: [Bugs 3604074,3606683] Rewrite of the - * generic/regcomp.c: fixempties() routine (and supporting - routines) to completely eliminate the infinite loop hazard. - Thanks to Tom Lane for the much improved solution. + * generic/regc_nfa.c: [Bugs 3604074,3606683]: Rewrite of the + * generic/regcomp.c: fixempties() routine (and supporting routines) + to completely eliminate the infinite loop hazard. Thanks to Tom Lane + for the much improved solution. 2013-02-28 Don Porter <dgp@users.sourceforge.net> - * generic/tclLiteral.c: Revise TclReleaseLiteral() to tolerate a - NULL interp argument. + * generic/tclLiteral.c: Revise TclReleaseLiteral() to tolerate a NULL + interp argument. * generic/tclCompile.c: Update callers and revise mistaken comments. * generic/tclProc.c: @@ -4899,8 +4907,7 @@ 2010-05-19 Alexandre Ferrieux <ferrieux@users.sourceforge.net> * tests/dict.test: Add missing tests for [Bug 3004007], fixed under - the radar on 2010-02-24 (dkf): EIAS violation in - list-dict conversions. + the radar on 2010-02-24 (dkf): EIAS violation in list-dict conversions 2010-05-19 Jan Nijtmans <nijtmans@users.sf.net> @@ -6754,10 +6761,9 @@ 2009-11-11 Alexandre Ferrieux <ferrieux@users.sourceforge.net> - * generic/tclIO.c: Fix [Bug 2888099] (close discards ENOSPC error) - by saving the errno from the first of two - FlushChannel()s. Uneasy to test; might need - specific channel drivers. Four-hands with aku. + * generic/tclIO.c: Fix [Bug 2888099] (close discards ENOSPC error) by + saving the errno from the first of two FlushChannel()s. Uneasy to + test; might need specific channel drivers. Four-hands with aku. 2009-11-10 Pat Thoyts <patthoyts@users.sourceforge.net> 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; diff --git a/tests/for.test b/tests/for.test index 3f4d2b7..8936682 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] @@ -882,6 +882,66 @@ test for-7.4 {Bug 3614226: ensure that continue cleans up the expansion stack} { expr {$end - $tmp} }} } 0 +test for-7.5 {Bug 3614226: ensure that break cleans up the combination of main and expansion stack} memory { + apply {{} { + set l [lrepeat 50 p q r] + # 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 {*}$l {*}[puts a b c {*}$l {*}[break] d e f]] + } + set tmp $end + set end [meminfo] + } + expr {$end - $tmp} + }} +} 0 +test for-7.6 {Bug 3614226: ensure that continue cleans up the combination of main and expansion stack} memory { + apply {{} { + set l [lrepeat 50 p q r] + # 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 {*}$l {*}[puts a b c {*}$l {*}[continue] d e f]] + } + set tmp $end + set end [meminfo] + } + expr {$end - $tmp} + }} +} 0 +test for-7.7 {Bug 3614226: ensure that break only cleans up the right amount} memory { + apply {{} { + set l [lrepeat 50 p q r] + # Can't use [memtest]; must be careful when we change stack frames + set end [meminfo] + for {set i 0} {$i < 5} {incr i} { + unset -nocomplain {*}[for {set x 0} {[incr x]<50} {} { + puts [puts {*}$l {*}[puts a b c {*}$l {*}[break] d e f]] + }] + set tmp $end + set end [meminfo] + } + expr {$end - $tmp} + }} +} 0 +test for-7.8 {Bug 3614226: ensure that continue only cleans up the right amount} memory { + apply {{} { + set l [lrepeat 50 p q r] + # Can't use [memtest]; must be careful when we change stack frames + set end [meminfo] + for {set i 0} {$i < 5} {incr i} { + unset -nocomplain {*}[for {set x 0} {[incr x]<50} {} { + puts [puts {*}$l {*}[puts a b c {*}$l {*}[continue] d e f]] + }] + set tmp $end + set end [meminfo] + } + expr {$end - $tmp} + }} +} 0 # cleanup ::tcltest::cleanupTests |