From 784987f7c11d9990ed7e2db04d85d42f177bdefd Mon Sep 17 00:00:00 2001 From: dkf Date: Tue, 8 Oct 2013 09:02:50 +0000 Subject: Working towards better handling of stack balance with break and continue exceptions. --- generic/tclAssembly.c | 1 + generic/tclCompCmds.c | 4 +- generic/tclCompCmdsSZ.c | 4 +- generic/tclCompExpr.c | 4 +- generic/tclCompile.c | 150 +++++++++++++++++++++++++++++++++++++++++++++++- generic/tclCompile.h | 1 + generic/tclEnsemble.c | 4 +- 7 files changed, 156 insertions(+), 12 deletions(-) diff --git a/generic/tclAssembly.c b/generic/tclAssembly.c index 946c729..08da075 100644 --- a/generic/tclAssembly.c +++ b/generic/tclAssembly.c @@ -1450,6 +1450,7 @@ AssembleOneLine( goto cleanup; } + // FIXME - use TclEmitInvoke BBEmitInst1or4(assemEnvPtr, tblIdx, opnd, opnd); break; diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c index 7e6b6da..942d74c 100644 --- a/generic/tclCompCmds.c +++ b/generic/tclCompCmds.c @@ -269,7 +269,7 @@ TclCompileArraySetCmd( if (isDataValid && !isDataEven) { PushStringLiteral(envPtr, "list must have an even number of elements"); PushStringLiteral(envPtr, "-errorCode {TCL ARGUMENT FORMAT}"); - TclEmitInstInt4(INST_RETURN_IMM, 1, envPtr); + TclEmitInstInt4(INST_RETURN_IMM, TCL_ERROR, envPtr); TclEmitInt4( 0, envPtr); goto done; } @@ -354,7 +354,7 @@ TclCompileArraySetCmd( TclEmitInstInt1(INST_JUMP_FALSE1, 0, envPtr); PushStringLiteral(envPtr, "list must have an even number of elements"); PushStringLiteral(envPtr, "-errorCode {TCL ARGUMENT FORMAT}"); - TclEmitInstInt4(INST_RETURN_IMM, 1, envPtr); + TclEmitInstInt4(INST_RETURN_IMM, TCL_ERROR, envPtr); TclEmitInt4( 0, envPtr); TclAdjustStackDepth(-1, envPtr); fwd = CurrentOffset(envPtr) - offsetFwd; diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c index 44cb66e..a5ec731 100644 --- a/generic/tclCompCmdsSZ.c +++ b/generic/tclCompCmdsSZ.c @@ -1965,7 +1965,7 @@ TclCompileThrowCmd( OP( LIST_LENGTH); OP1( JUMP_FALSE1, 16); OP4( LIST, 2); - OP44( RETURN_IMM, 1, 0); + OP44( RETURN_IMM, TCL_ERROR, 0); TclAdjustStackDepth(2, envPtr); OP( POP); OP( POP); @@ -1974,7 +1974,7 @@ TclCompileThrowCmd( PUSH( "type must be non-empty list"); PUSH( "-errorcode {TCL OPERATION THROW BADEXCEPTION}"); } - OP44( RETURN_IMM, 1, 0); + OP44( RETURN_IMM, TCL_ERROR, 0); return TCL_OK; } diff --git a/generic/tclCompExpr.c b/generic/tclCompExpr.c index d8e4d9f..94c1bd6 100644 --- a/generic/tclCompExpr.c +++ b/generic/tclCompExpr.c @@ -2335,9 +2335,9 @@ CompileExprTree( */ if (numWords < 255) { - TclEmitInstInt1(INST_INVOKE_STK1, numWords, envPtr); + TclEmitInvoke(envPtr, INST_INVOKE_STK1, numWords); } else { - TclEmitInstInt4(INST_INVOKE_STK4, numWords, envPtr); + TclEmitInvoke(envPtr, INST_INVOKE_STK4, numWords); } /* diff --git a/generic/tclCompile.c b/generic/tclCompile.c index d15ef3a..a5b0bd8 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.c @@ -1738,9 +1738,9 @@ TclCompileInvocation( } if (wordIdx <= 255) { - TclEmitInstInt1(INST_INVOKE_STK1, wordIdx, envPtr); + TclEmitInvoke(envPtr, INST_INVOKE_STK1, wordIdx); } else { - TclEmitInstInt4(INST_INVOKE_STK4, wordIdx, envPtr); + TclEmitInvoke(envPtr, INST_INVOKE_STK4, wordIdx); } } @@ -1802,7 +1802,7 @@ CompileExpanded( * stack-neutral in general. */ - TclEmitOpcode(INST_INVOKE_EXPANDED, envPtr); + TclEmitInvoke(envPtr, INST_INVOKE_EXPANDED); envPtr->expandCount--; TclAdjustStackDepth(1 - wordIdx, envPtr); } @@ -3901,6 +3901,150 @@ TclFixupForwardJump( return 1; /* the jump was grown */ } +void +TclEmitInvoke( + CompileEnv *envPtr, + int opcode, + ...) +{ + va_list argList; + ExceptionRange *rangePtr; + ExceptionAux *auxBreakPtr, *auxContinuePtr; + int arg1, arg2, wordCount = 0, loopRange, predictedDepth; + + /* + * Parse the arguments. + */ + + va_start(argList, opcode); + switch (opcode) { + case INST_INVOKE_STK1: + wordCount = arg1 = va_arg(argList, int); + arg2 = 0; + break; + case INST_INVOKE_STK4: + wordCount = arg1 = va_arg(argList, int); + arg2 = 0; + break; + case INST_INVOKE_REPLACE: + arg1 = va_arg(argList, int); + arg2 = va_arg(argList, int); + wordCount = arg1 + arg2 - 1; + break; + default: + Tcl_Panic("unexpected opcode"); + case INST_INVOKE_EXPANDED: + wordCount = arg1 = arg2 = 0; + break; + } + va_end(argList); + + /* + * Determine if we need to handle break and continue exceptions with a + * special handling exception range (so that we can correctly unwind the + * stack). + */ + + rangePtr = TclGetInnermostExceptionRange(envPtr, TCL_BREAK, &auxBreakPtr); + if (rangePtr == NULL || rangePtr->type != LOOP_EXCEPTION_RANGE) { + auxBreakPtr = NULL; + } else if (auxBreakPtr->stackDepth == envPtr->currStackDepth-wordCount + && auxBreakPtr->expandTarget == envPtr->expandCount) { + auxBreakPtr = NULL; + } + rangePtr = TclGetInnermostExceptionRange(envPtr, TCL_CONTINUE, + &auxContinuePtr); + if (rangePtr == NULL || rangePtr->type != LOOP_EXCEPTION_RANGE) { + auxContinuePtr = NULL; + } else if (auxContinuePtr->stackDepth == envPtr->currStackDepth-wordCount + && auxContinuePtr->expandTarget == envPtr->expandCount) { + auxContinuePtr = NULL; + } + if (auxBreakPtr != NULL || auxContinuePtr != NULL) { + fprintf(stderr,"loop call(%s,d=%d/%d(%d/%d),t=%d/%d(%d))\n", + tclInstructionTable[opcode].name, + (auxBreakPtr?auxBreakPtr->stackDepth:-1), + (auxContinuePtr?auxContinuePtr->stackDepth:-1), + envPtr->currStackDepth, + wordCount, + (auxBreakPtr?auxBreakPtr->expandTarget:-1), + (auxContinuePtr?auxContinuePtr->expandTarget:-1), + envPtr->expandCount); + loopRange = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr); + ExceptionRangeStarts(envPtr, loopRange); + } + predictedDepth = envPtr->currStackDepth - wordCount; + + /* + * Issue the invoke itself. + */ + + switch (opcode) { + case INST_INVOKE_STK1: + TclEmitInstInt1(INST_INVOKE_STK1, arg1, envPtr); + break; + case INST_INVOKE_STK4: + TclEmitInstInt4(INST_INVOKE_STK4, arg1, envPtr); + break; + case INST_INVOKE_EXPANDED: + TclEmitOpcode(INST_INVOKE_EXPANDED, envPtr); + break; + case INST_INVOKE_REPLACE: + TclEmitInstInt4(INST_INVOKE_REPLACE, arg1, envPtr); + TclEmitInt1(arg2, envPtr); + TclAdjustStackDepth(-1, envPtr); /* Correction to stack depth calcs */ + break; + } + + /* + * If we're generating a special wrapper exception range, we need to + * finish that up now. + */ + + if (auxBreakPtr != NULL || auxContinuePtr != NULL) { + int savedStackDepth = envPtr->currStackDepth; + int savedExpandCount = envPtr->expandCount; + JumpFixup nonTrapFixup; + int off; + + ExceptionRangeEnds(envPtr, loopRange); + TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &nonTrapFixup); + fprintf(stderr,"loop call(d=%d,t=%d|%p,%p)\n",savedStackDepth-1,savedExpandCount,auxBreakPtr,auxContinuePtr); + + /* + * Careful! When generating these stack unwinding sequences, the depth + * of stack in the cases where they are taken is not the same as if + * the exception is not taken. + */ + + if (auxBreakPtr != NULL) { + TclAdjustStackDepth(-1, envPtr); /* Correction to stack depth calcs */ + assert(envPtr->currStackDepth == predictedDepth); + ExceptionRangeTarget(envPtr, loopRange, breakOffset); + off = CurrentOffset(envPtr); + TclCleanupStackForBreakContinue(envPtr, auxBreakPtr); + fprintf(stderr,"popped(break):%ld\n",CurrentOffset(envPtr) - off); + TclAddLoopBreakFixup(envPtr, auxBreakPtr); + envPtr->currStackDepth = savedStackDepth; + envPtr->expandCount = savedExpandCount; + } + + if (auxContinuePtr != NULL) { + TclAdjustStackDepth(-1, envPtr); /* Correction to stack depth calcs */ + assert(envPtr->currStackDepth == predictedDepth); + ExceptionRangeTarget(envPtr, loopRange, continueOffset); + off = CurrentOffset(envPtr); + TclCleanupStackForBreakContinue(envPtr, auxContinuePtr); + fprintf(stderr,"popped(continue):%ld\n",CurrentOffset(envPtr) - off); + TclAddLoopContinueFixup(envPtr, auxContinuePtr); + envPtr->currStackDepth = savedStackDepth; + envPtr->expandCount = savedExpandCount; + } + + TclFixupForwardJumpToHere(envPtr, &nonTrapFixup, 127); + } +} + /* *---------------------------------------------------------------------- * diff --git a/generic/tclCompile.h b/generic/tclCompile.h index 5660055..a39e0f1 100644 --- a/generic/tclCompile.h +++ b/generic/tclCompile.h @@ -1021,6 +1021,7 @@ MODULE_SCOPE void TclDeleteLiteralTable(Tcl_Interp *interp, LiteralTable *tablePtr); MODULE_SCOPE void TclEmitForwardJump(CompileEnv *envPtr, TclJumpType jumpType, JumpFixup *jumpFixupPtr); +MODULE_SCOPE void TclEmitInvoke(CompileEnv *envPtr, int opcode, ...); MODULE_SCOPE ExceptionRange * TclGetExceptionRangeForPc(unsigned char *pc, int catchOnly, ByteCode *codePtr); MODULE_SCOPE void TclExpandJumpFixupArray(JumpFixupArray *fixupArrayPtr); diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c index ad11785..9bb7a0c 100644 --- a/generic/tclEnsemble.c +++ b/generic/tclEnsemble.c @@ -3179,9 +3179,7 @@ CompileToInvokedCommand( * Do the replacing dispatch. */ - TclEmitInstInt4(INST_INVOKE_REPLACE, parsePtr->numWords, envPtr); - TclEmitInt1(numWords+1, envPtr); - TclAdjustStackDepth(-1, envPtr); /* Correction to stack depth calcs. */ + TclEmitInvoke(envPtr, INST_INVOKE_REPLACE, parsePtr->numWords,numWords+1); } /* -- cgit v0.12 From 18620aebd7623aaa3031162500c392cf2fa6ade7 Mon Sep 17 00:00:00 2001 From: dkf Date: Sun, 13 Oct 2013 12:09:22 +0000 Subject: Stop crashing in interactive testing. (The unknown and history mechanisms tend to exercise some parts of the bytecode compiler very well.) --- generic/tclCompile.c | 49 ++++++++++++++++++++++++++++++------------------- 1 file changed, 30 insertions(+), 19 deletions(-) diff --git a/generic/tclCompile.c b/generic/tclCompile.c index a5b0bd8..74a9c8c 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.c @@ -3911,6 +3911,7 @@ TclEmitInvoke( ExceptionRange *rangePtr; ExceptionAux *auxBreakPtr, *auxContinuePtr; int arg1, arg2, wordCount = 0, loopRange, predictedDepth; + int breakRange = -1, continueRange = -1; /* * Parse the arguments. @@ -3943,6 +3944,9 @@ TclEmitInvoke( * Determine if we need to handle break and continue exceptions with a * special handling exception range (so that we can correctly unwind the * stack). + * + * These must be done separately; they can be different (especially for + * calls from inside a [for] increment clause). */ rangePtr = TclGetInnermostExceptionRange(envPtr, TCL_BREAK, &auxBreakPtr); @@ -3951,7 +3955,10 @@ TclEmitInvoke( } else if (auxBreakPtr->stackDepth == envPtr->currStackDepth-wordCount && auxBreakPtr->expandTarget == envPtr->expandCount) { auxBreakPtr = NULL; + } else { + breakRange = auxBreakPtr - envPtr->exceptAuxArrayPtr; } + rangePtr = TclGetInnermostExceptionRange(envPtr, TCL_CONTINUE, &auxContinuePtr); if (rangePtr == NULL || rangePtr->type != LOOP_EXCEPTION_RANGE) { @@ -3959,17 +3966,11 @@ TclEmitInvoke( } else if (auxContinuePtr->stackDepth == envPtr->currStackDepth-wordCount && auxContinuePtr->expandTarget == envPtr->expandCount) { auxContinuePtr = NULL; + } else { + continueRange = auxBreakPtr - envPtr->exceptAuxArrayPtr; } + if (auxBreakPtr != NULL || auxContinuePtr != NULL) { - fprintf(stderr,"loop call(%s,d=%d/%d(%d/%d),t=%d/%d(%d))\n", - tclInstructionTable[opcode].name, - (auxBreakPtr?auxBreakPtr->stackDepth:-1), - (auxContinuePtr?auxContinuePtr->stackDepth:-1), - envPtr->currStackDepth, - wordCount, - (auxBreakPtr?auxBreakPtr->expandTarget:-1), - (auxContinuePtr?auxContinuePtr->expandTarget:-1), - envPtr->expandCount); loopRange = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr); ExceptionRangeStarts(envPtr, loopRange); } @@ -4005,11 +4006,17 @@ TclEmitInvoke( int savedStackDepth = envPtr->currStackDepth; int savedExpandCount = envPtr->expandCount; JumpFixup nonTrapFixup; - int off; + ExceptionAux *exceptAux = envPtr->exceptAuxArrayPtr + loopRange; + + if (auxBreakPtr != NULL) { + auxBreakPtr = envPtr->exceptAuxArrayPtr + breakRange; + } + if (auxContinuePtr != NULL) { + auxContinuePtr = envPtr->exceptAuxArrayPtr + continueRange; + } ExceptionRangeEnds(envPtr, loopRange); TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &nonTrapFixup); - fprintf(stderr,"loop call(d=%d,t=%d|%p,%p)\n",savedStackDepth-1,savedExpandCount,auxBreakPtr,auxContinuePtr); /* * Careful! When generating these stack unwinding sequences, the depth @@ -4018,25 +4025,29 @@ TclEmitInvoke( */ if (auxBreakPtr != NULL) { - TclAdjustStackDepth(-1, envPtr); /* Correction to stack depth calcs */ + TclAdjustStackDepth(-1, envPtr); assert(envPtr->currStackDepth == predictedDepth); + exceptAux->stackDepth = auxBreakPtr->stackDepth; + exceptAux->expandTarget = auxBreakPtr->expandTarget; + ExceptionRangeTarget(envPtr, loopRange, breakOffset); - off = CurrentOffset(envPtr); - TclCleanupStackForBreakContinue(envPtr, auxBreakPtr); - fprintf(stderr,"popped(break):%ld\n",CurrentOffset(envPtr) - off); + TclCleanupStackForBreakContinue(envPtr, exceptAux); TclAddLoopBreakFixup(envPtr, auxBreakPtr); + envPtr->currStackDepth = savedStackDepth; envPtr->expandCount = savedExpandCount; } if (auxContinuePtr != NULL) { - TclAdjustStackDepth(-1, envPtr); /* Correction to stack depth calcs */ + TclAdjustStackDepth(-1, envPtr); assert(envPtr->currStackDepth == predictedDepth); + exceptAux->stackDepth = auxContinuePtr->stackDepth; + exceptAux->expandTarget = auxContinuePtr->expandTarget; + ExceptionRangeTarget(envPtr, loopRange, continueOffset); - off = CurrentOffset(envPtr); - TclCleanupStackForBreakContinue(envPtr, auxContinuePtr); - fprintf(stderr,"popped(continue):%ld\n",CurrentOffset(envPtr) - off); + TclCleanupStackForBreakContinue(envPtr, exceptAux); TclAddLoopContinueFixup(envPtr, auxContinuePtr); + envPtr->currStackDepth = savedStackDepth; envPtr->expandCount = savedExpandCount; } -- cgit v0.12 From 62cb43456456d34b7a1b738feb2d2114915aff3c Mon Sep 17 00:00:00 2001 From: dkf Date: Sun, 13 Oct 2013 13:34:01 +0000 Subject: update comments --- generic/tclCompCmdsGR.c | 1 + generic/tclCompile.c | 21 +++++++++++++++++++++ 2 files changed, 22 insertions(+) diff --git a/generic/tclCompCmdsGR.c b/generic/tclCompCmdsGR.c index 43ea3d3..3efcba7 100644 --- a/generic/tclCompCmdsGR.c +++ b/generic/tclCompCmdsGR.c @@ -2480,6 +2480,7 @@ TclCompileReturnCmd( * emit the INST_RETURN_IMM instruction with code and level as operands. */ + // TODO: when (code==TCL_BREAK || code==TCL_CONTINUE)&&(level==0&&size==0), check for stack balance and jump opportunities CompileReturnInternal(envPtr, INST_RETURN_IMM, code, level, returnOpts); return TCL_OK; diff --git a/generic/tclCompile.c b/generic/tclCompile.c index 74a9c8c..68b7649 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.c @@ -3901,6 +3901,27 @@ TclFixupForwardJump( return 1; /* the jump was grown */ } +/* + *---------------------------------------------------------------------- + * + * TclEmitInvoke -- + * + * Emit one of the invoke-related instructions, wrapping it if necessary + * in code that ensures that any break or continue operation passing + * through it gets the stack unwinding correct, converting it into an + * internal jump if in an appropriate context. + * + * Results: + * None + * + * Side effects: + * Issues the jump with all correct stack management. May create another + * loop exception range; pointers to ExceptionRange and ExceptionAux + * structures should not be held across this call. + * + *---------------------------------------------------------------------- + */ + void TclEmitInvoke( CompileEnv *envPtr, -- cgit v0.12 From 9adfa74f671acd5bcc33247b07176d117eda3357 Mon Sep 17 00:00:00 2001 From: dkf Date: Sun, 13 Oct 2013 13:57:27 +0000 Subject: Added the tests I want to pass... --- tests/for.test | 126 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 126 insertions(+) diff --git a/tests/for.test b/tests/for.test index 8936682..6a18abe 100644 --- a/tests/for.test +++ b/tests/for.test @@ -942,6 +942,132 @@ test for-7.8 {Bug 3614226: ensure that continue only cleans up the right amount} expr {$end - $tmp} }} } 0 +test for-7.9 {Bug 3614226: ensure that break from invoked command 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 [apply {{} {return -code break}}] d e f + } + set tmp $end + set end [meminfo] + } + expr {$end - $tmp} + }} +} 0 +test for-7.10 {Bug 3614226: ensure that continue from invoked command 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 [apply {{} {return -code continue}}] d e f + } + set tmp $end + set end [meminfo] + } + expr {$end - $tmp} + }} +} 0 +test for-7.11 {Bug 3614226: ensure that break from invoked command cleans up the expansion 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} {[incr x]<50} {} { + puts {*}[puts a b c {*}[apply {{} {return -code break}}] d e f] + } + set tmp $end + set end [meminfo] + } + expr {$end - $tmp} + }} +} 0 +test for-7.12 {Bug 3614226: ensure that continue from invoked command cleans up the expansion 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} {[incr x]<50} {} { + puts {*}[puts a b c {*}[apply {{} { + return -code continue + }}] d e f] + } + set tmp $end + set end [meminfo] + } + expr {$end - $tmp} + }} +} 0 +test for-7.13 {Bug 3614226: ensure that break from invoked command 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 {*}[apply {{} { + return -code break + }}] d e f]] + } + set tmp $end + set end [meminfo] + } + expr {$end - $tmp} + }} +} 0 +test for-7.14 {Bug 3614226: ensure that continue from invoked command 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 {*}[apply {{} { + return -code continue + }}] d e f]] + } + set tmp $end + set end [meminfo] + } + expr {$end - $tmp} + }} +} 0 +test for-7.15 {Bug 3614226: ensure that break from invoked command 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 {*}[apply {{} { + return -code break + }}] d e f]] + }] + set tmp $end + set end [meminfo] + } + expr {$end - $tmp} + }} +} 0 +test for-7.16 {Bug 3614226: ensure that continue from invoked command 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 {*}[apply {{} { + return -code continue + }}] d e f]] + }] + set tmp $end + set end [meminfo] + } + expr {$end - $tmp} + }} +} 0 # cleanup ::tcltest::cleanupTests -- cgit v0.12 From 21e6601f4971f249f7681508432b98605729fb9d Mon Sep 17 00:00:00 2001 From: dkf Date: Tue, 15 Oct 2013 00:27:56 +0000 Subject: Do jump generation at places where INST_RETURN_IMM might occur. --- generic/tclCompCmdsGR.c | 18 +++++++++++++- generic/tclCompile.c | 6 +---- generic/tclOptimize.c | 18 +++++++++++++- tests/compile.test | 64 +++++++++++++++++++++++++++++++++++++++++++++++++ 4 files changed, 99 insertions(+), 7 deletions(-) diff --git a/generic/tclCompCmdsGR.c b/generic/tclCompCmdsGR.c index 3efcba7..5513b01 100644 --- a/generic/tclCompCmdsGR.c +++ b/generic/tclCompCmdsGR.c @@ -2480,7 +2480,6 @@ TclCompileReturnCmd( * emit the INST_RETURN_IMM instruction with code and level as operands. */ - // TODO: when (code==TCL_BREAK || code==TCL_CONTINUE)&&(level==0&&size==0), check for stack balance and jump opportunities CompileReturnInternal(envPtr, INST_RETURN_IMM, code, level, returnOpts); return TCL_OK; @@ -2522,6 +2521,23 @@ CompileReturnInternal( int level, Tcl_Obj *returnOpts) { + if (level == 0 && (code == TCL_BREAK || code == TCL_CONTINUE)) { + ExceptionRange *rangePtr; + ExceptionAux *exceptAux; + + rangePtr = TclGetInnermostExceptionRange(envPtr, code, &exceptAux); + if (rangePtr && rangePtr->type == LOOP_EXCEPTION_RANGE) { + TclCleanupStackForBreakContinue(envPtr, exceptAux); + if (code == TCL_BREAK) { + TclAddLoopBreakFixup(envPtr, exceptAux); + } else { + TclAddLoopContinueFixup(envPtr, exceptAux); + } + Tcl_DecrRefCount(returnOpts); + return; + } + } + TclEmitPush(TclAddLiteralObj(envPtr, returnOpts, NULL), envPtr); TclEmitInstInt4(op, code, envPtr); TclEmitInt4(level, envPtr); diff --git a/generic/tclCompile.c b/generic/tclCompile.c index 68b7649..427ccab 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.c @@ -3931,8 +3931,7 @@ TclEmitInvoke( va_list argList; ExceptionRange *rangePtr; ExceptionAux *auxBreakPtr, *auxContinuePtr; - int arg1, arg2, wordCount = 0, loopRange, predictedDepth; - int breakRange = -1, continueRange = -1; + int arg1, arg2, wordCount = 0, loopRange, breakRange, continueRange; /* * Parse the arguments. @@ -3995,7 +3994,6 @@ TclEmitInvoke( loopRange = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr); ExceptionRangeStarts(envPtr, loopRange); } - predictedDepth = envPtr->currStackDepth - wordCount; /* * Issue the invoke itself. @@ -4047,7 +4045,6 @@ TclEmitInvoke( if (auxBreakPtr != NULL) { TclAdjustStackDepth(-1, envPtr); - assert(envPtr->currStackDepth == predictedDepth); exceptAux->stackDepth = auxBreakPtr->stackDepth; exceptAux->expandTarget = auxBreakPtr->expandTarget; @@ -4061,7 +4058,6 @@ TclEmitInvoke( if (auxContinuePtr != NULL) { TclAdjustStackDepth(-1, envPtr); - assert(envPtr->currStackDepth == predictedDepth); exceptAux->stackDepth = auxContinuePtr->stackDepth; exceptAux->expandTarget = auxContinuePtr->expandTarget; diff --git a/generic/tclOptimize.c b/generic/tclOptimize.c index b7f4173..3b16e6e 100644 --- a/generic/tclOptimize.c +++ b/generic/tclOptimize.c @@ -344,21 +344,28 @@ AdvanceJumps( CompileEnv *envPtr) { unsigned char *currentInstPtr; + Tcl_HashTable jumps; for (currentInstPtr = envPtr->codeStart ; currentInstPtr < envPtr->codeNext-1 ; currentInstPtr += AddrLength(currentInstPtr)) { - int offset, delta; + int offset, delta, isNew; switch (*currentInstPtr) { case INST_JUMP1: case INST_JUMP_TRUE1: case INST_JUMP_FALSE1: offset = TclGetInt1AtPtr(currentInstPtr + 1); + Tcl_InitHashTable(&jumps, TCL_ONE_WORD_KEYS); for (delta=0 ; offset+delta != 0 ;) { if (offset + delta < -128 || offset + delta > 127) { break; } + Tcl_CreateHashEntry(&jumps, INT2PTR(offset), &isNew); + if (!isNew) { + offset = TclGetInt1AtPtr(currentInstPtr + 1); + break; + } offset += delta; switch (*(currentInstPtr + offset)) { case INST_NOP: @@ -373,13 +380,21 @@ AdvanceJumps( } break; } + Tcl_DeleteHashTable(&jumps); TclStoreInt1AtPtr(offset, currentInstPtr + 1); continue; case INST_JUMP4: case INST_JUMP_TRUE4: case INST_JUMP_FALSE4: + Tcl_InitHashTable(&jumps, TCL_ONE_WORD_KEYS); + Tcl_CreateHashEntry(&jumps, INT2PTR(0), &isNew); for (offset = TclGetInt4AtPtr(currentInstPtr + 1); offset!=0 ;) { + Tcl_CreateHashEntry(&jumps, INT2PTR(offset), &isNew); + if (!isNew) { + offset = TclGetInt4AtPtr(currentInstPtr + 1); + break; + } switch (*(currentInstPtr + offset)) { case INST_NOP: offset += InstLength(INST_NOP); @@ -393,6 +408,7 @@ AdvanceJumps( } break; } + Tcl_DeleteHashTable(&jumps); TclStoreInt4AtPtr(offset, currentInstPtr + 1); continue; } diff --git a/tests/compile.test b/tests/compile.test index 51db0a2..36e24de 100644 --- a/tests/compile.test +++ b/tests/compile.test @@ -713,6 +713,70 @@ test compile-19.0 {Bug 3614102: reset stack housekeeping} -body { apply {{} {list [if 1]}} } -returnCodes error -match glob -result * +test compile-20.1 {ensure there are no infinite loops in optimizing} { + tcl::unsupported::disassemble script { + while 1 { + return -code continue -level 0 + } + } + return +} {} +test compile-20.2 {ensure there are no infinite loops in optimizing} { + tcl::unsupported::disassemble script { + while 1 { + while 1 { + return -code break -level 0 + } + } + } + return +} {} + +test compile-21.1 {stack balance management} { + apply {{} { + set result {} + while 1 { + lappend result a + lappend result [list b [break]] + lappend result c + } + return $result + }} +} a +test compile-21.2 {stack balance management} { + apply {{} { + set result {} + while {[incr i] <= 10} { + lappend result $i + lappend result [list b [continue] c] + lappend result c + } + return $result + }} +} {1 2 3 4 5 6 7 8 9 10} +test compile-21.3 {stack balance management} { + apply {args { + set result {} + while 1 { + lappend result a + lappend result [concat {*}$args [break]] + lappend result c + } + return $result + }} P Q R S T +} a +test compile-21.4 {stack balance management} { + apply {args { + set result {} + while {[incr i] <= 10} { + lappend result $i + lappend result [concat {*}$args [continue] c] + lappend result c + } + return $result + }} P Q R S T +} {1 2 3 4 5 6 7 8 9 10} + # TODO sometime - check that bytecode from tbcload is *not* disassembled. # cleanup -- cgit v0.12 From c00bdffb6aa0fca3575ef0ab1a07813f696f1839 Mon Sep 17 00:00:00 2001 From: dkf Date: Fri, 18 Oct 2013 07:08:46 +0000 Subject: Tackle evalStk by reusing existing machinery. --- generic/tclCompCmds.c | 2 +- generic/tclCompile.c | 6 +++++- 2 files changed, 6 insertions(+), 2 deletions(-) diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c index 942d74c..25201eb 100644 --- a/generic/tclCompCmds.c +++ b/generic/tclCompCmds.c @@ -620,7 +620,7 @@ TclCompileCatchCmd( TclEmitInstInt4( INST_BEGIN_CATCH4, range, envPtr); ExceptionRangeStarts(envPtr, range); TclEmitOpcode( INST_DUP, envPtr); - TclEmitOpcode( INST_EVAL_STK, envPtr); + TclEmitInvoke(envPtr, INST_EVAL_STK); } /* Stack at this point: * nonsimple: script result diff --git a/generic/tclCompile.c b/generic/tclCompile.c index 427ccab..f91c2fd 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.c @@ -2458,7 +2458,7 @@ TclCompileCmdWord( */ TclCompileTokens(interp, tokenPtr, count, envPtr); - TclEmitOpcode(INST_EVAL_STK, envPtr); + TclEmitInvoke(envPtr, INST_EVAL_STK); } } @@ -3954,6 +3954,7 @@ TclEmitInvoke( break; default: Tcl_Panic("unexpected opcode"); + case INST_EVAL_STK: case INST_INVOKE_EXPANDED: wordCount = arg1 = arg2 = 0; break; @@ -4009,6 +4010,9 @@ TclEmitInvoke( case INST_INVOKE_EXPANDED: TclEmitOpcode(INST_INVOKE_EXPANDED, envPtr); break; + case INST_EVAL_STK: + TclEmitOpcode(INST_EVAL_STK, envPtr); + break; case INST_INVOKE_REPLACE: TclEmitInstInt4(INST_INVOKE_REPLACE, arg1, envPtr); TclEmitInt1(arg2, envPtr); -- cgit v0.12 From 3e798bfe4700fd510a0daf3944429c75596786da Mon Sep 17 00:00:00 2001 From: dkf Date: Sat, 19 Oct 2013 11:20:46 +0000 Subject: Improve coverage of [error] compilation. --- generic/tclCompCmds.c | 43 ++++++++++++++++++++++++++++++++++++------- 1 file changed, 36 insertions(+), 7 deletions(-) diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c index 25201eb..c55635a 100644 --- a/generic/tclCompCmds.c +++ b/generic/tclCompCmds.c @@ -2135,19 +2135,48 @@ TclCompileErrorCmd( { /* * General syntax: [error message ?errorInfo? ?errorCode?] - * However, we only deal with the case where there is just a message. */ - Tcl_Token *messageTokenPtr; + + Tcl_Token *tokenPtr; DefineLineInformation; /* TIP #280 */ - if (parsePtr->numWords != 2) { + if (parsePtr->numWords < 2 || parsePtr->numWords > 4) { return TCL_ERROR; } - messageTokenPtr = TokenAfter(parsePtr->tokenPtr); - PushStringLiteral(envPtr, "-code error -level 0"); - CompileWord(envPtr, messageTokenPtr, interp, 1); - TclEmitOpcode(INST_RETURN_STK, envPtr); + /* + * Handle the message. + */ + + tokenPtr = TokenAfter(parsePtr->tokenPtr); + CompileWord(envPtr, tokenPtr, interp, 1); + + /* + * Construct the options. Note that -code and -level are not here. + */ + + if (parsePtr->numWords == 2) { + PushStringLiteral(envPtr, ""); + } else { + PushStringLiteral(envPtr, "-errorinfo"); + tokenPtr = TokenAfter(tokenPtr); + CompileWord(envPtr, tokenPtr, interp, 2); + if (parsePtr->numWords == 3) { + TclEmitInstInt4( INST_LIST, 2, envPtr); + } else { + PushStringLiteral(envPtr, "-errorcode"); + tokenPtr = TokenAfter(tokenPtr); + CompileWord(envPtr, tokenPtr, interp, 3); + TclEmitInstInt4( INST_LIST, 4, envPtr); + } + } + + /* + * Issue the error via 'returnImm error 0'. + */ + + TclEmitInstInt4( INST_RETURN_IMM, TCL_ERROR, envPtr); + TclEmitInt4( 0, envPtr); return TCL_OK; } -- cgit v0.12 From 674d5acbcfa7bfb12b407c88bd4bf67ae1b1d0ac Mon Sep 17 00:00:00 2001 From: dkf Date: Sat, 19 Oct 2013 12:29:06 +0000 Subject: Added missing exception range finalize. --- generic/tclCompile.c | 1 + 1 file changed, 1 insertion(+) diff --git a/generic/tclCompile.c b/generic/tclCompile.c index f91c2fd..89b9011 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.c @@ -4073,6 +4073,7 @@ TclEmitInvoke( envPtr->expandCount = savedExpandCount; } + TclFinalizeLoopExceptionRange(envPtr, loopRange); TclFixupForwardJumpToHere(envPtr, &nonTrapFixup, 127); } } -- cgit v0.12 From acfb2a50369dae9afcf444519e5d3875812d5a3b Mon Sep 17 00:00:00 2001 From: dkf Date: Sat, 19 Oct 2013 14:11:28 +0000 Subject: Fix handling of 'invokeExpanded' and start to do 'returnStk'. --- generic/tclCompCmdsGR.c | 4 +- generic/tclCompile.c | 27 ++++++++--- tests/for.test | 116 ++++++++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 138 insertions(+), 9 deletions(-) diff --git a/generic/tclCompCmdsGR.c b/generic/tclCompCmdsGR.c index 5513b01..fbd370b 100644 --- a/generic/tclCompCmdsGR.c +++ b/generic/tclCompCmdsGR.c @@ -2367,7 +2367,7 @@ TclCompileReturnCmd( CompileWord(envPtr, optsTokenPtr, interp, 2); CompileWord(envPtr, msgTokenPtr, interp, 3); - TclEmitOpcode(INST_RETURN_STK, envPtr); + TclEmitInvoke(envPtr, INST_RETURN_STK); return TCL_OK; } @@ -2509,7 +2509,7 @@ TclCompileReturnCmd( * Issue the RETURN itself. */ - TclEmitOpcode(INST_RETURN_STK, envPtr); + TclEmitInvoke(envPtr, INST_RETURN_STK); return TCL_OK; } diff --git a/generic/tclCompile.c b/generic/tclCompile.c index 89b9011..ae6e56c 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.c @@ -1802,9 +1802,7 @@ CompileExpanded( * stack-neutral in general. */ - TclEmitInvoke(envPtr, INST_INVOKE_EXPANDED); - envPtr->expandCount--; - TclAdjustStackDepth(1 - wordIdx, envPtr); + TclEmitInvoke(envPtr, INST_INVOKE_EXPANDED, wordIdx); } static int @@ -3931,7 +3929,8 @@ TclEmitInvoke( va_list argList; ExceptionRange *rangePtr; ExceptionAux *auxBreakPtr, *auxContinuePtr; - int arg1, arg2, wordCount = 0, loopRange, breakRange, continueRange; + int arg1, arg2, wordCount = 0, expandCount = 0; + int loopRange, breakRange, continueRange; /* * Parse the arguments. @@ -3955,8 +3954,17 @@ TclEmitInvoke( default: Tcl_Panic("unexpected opcode"); case INST_EVAL_STK: + wordCount = 1; + arg1 = arg2 = 0; + break; + case INST_RETURN_STK: + wordCount = 2; + arg1 = arg2 = 0; + break; case INST_INVOKE_EXPANDED: - wordCount = arg1 = arg2 = 0; + wordCount = arg1 = va_arg(argList, int); + arg2 = 0; + expandCount = 1; break; } va_end(argList); @@ -3974,7 +3982,7 @@ TclEmitInvoke( if (rangePtr == NULL || rangePtr->type != LOOP_EXCEPTION_RANGE) { auxBreakPtr = NULL; } else if (auxBreakPtr->stackDepth == envPtr->currStackDepth-wordCount - && auxBreakPtr->expandTarget == envPtr->expandCount) { + && auxBreakPtr->expandTarget == envPtr->expandCount-expandCount) { auxBreakPtr = NULL; } else { breakRange = auxBreakPtr - envPtr->exceptAuxArrayPtr; @@ -3985,7 +3993,7 @@ TclEmitInvoke( if (rangePtr == NULL || rangePtr->type != LOOP_EXCEPTION_RANGE) { auxContinuePtr = NULL; } else if (auxContinuePtr->stackDepth == envPtr->currStackDepth-wordCount - && auxContinuePtr->expandTarget == envPtr->expandCount) { + && auxContinuePtr->expandTarget == envPtr->expandCount-expandCount) { auxContinuePtr = NULL; } else { continueRange = auxBreakPtr - envPtr->exceptAuxArrayPtr; @@ -4009,10 +4017,15 @@ TclEmitInvoke( break; case INST_INVOKE_EXPANDED: TclEmitOpcode(INST_INVOKE_EXPANDED, envPtr); + envPtr->expandCount--; + TclAdjustStackDepth(1 - arg1, envPtr); break; case INST_EVAL_STK: TclEmitOpcode(INST_EVAL_STK, envPtr); break; + case INST_RETURN_STK: + TclEmitOpcode(INST_RETURN_STK, envPtr); + break; case INST_INVOKE_REPLACE: TclEmitInstInt4(INST_INVOKE_REPLACE, arg1, envPtr); TclEmitInt1(arg2, envPtr); diff --git a/tests/for.test b/tests/for.test index 6a18abe..8abd270 100644 --- a/tests/for.test +++ b/tests/for.test @@ -1068,6 +1068,122 @@ test for-7.16 {Bug 3614226: ensure that continue from invoked command only clean expr {$end - $tmp} }} } 0 +test for-7.17 {Bug 3614226: ensure that break from expanded command cleans up the stack} memory { + apply {op { + # 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 [{*}$op] d e f + } + set tmp $end + set end [meminfo] + } + expr {$end - $tmp} + }} {return -level 0 -code break} +} 0 +test for-7.18 {Bug 3614226: ensure that continue from expanded command cleans up the stack} memory { + apply {op { + # 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 [{*}$op] d e f + } + set tmp $end + set end [meminfo] + } + expr {$end - $tmp} + }} {return -level 0 -code continue} +} 0 +test for-7.19 {Bug 3614226: ensure that break from expanded command cleans up the expansion stack} memory { + apply {op { + # 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 {*}[{*}$op] d e f] + } + set tmp $end + set end [meminfo] + } + expr {$end - $tmp} + }} {return -level 0 -code break} +} 0 +test for-7.20 {Bug 3614226: ensure that continue from expanded command cleans up the expansion stack} memory { + apply {op { + # 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 {*}[{*}$op] d e f] + } + set tmp $end + set end [meminfo] + } + expr {$end - $tmp} + }} {return -level 0 -code continue} +} 0 +test for-7.21 {Bug 3614226: ensure that break from expanded command cleans up the combination of main and expansion stack} memory { + apply {op { + 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 {*}[{*}$op] d e f]] + } + set tmp $end + set end [meminfo] + } + expr {$end - $tmp} + }} {return -level 0 -code break} +} 0 +test for-7.22 {Bug 3614226: ensure that continue from expanded command cleans up the combination of main and expansion stack} memory { + apply {op { + 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 {*}[{*}$op] d e f]] + } + set tmp $end + set end [meminfo] + } + expr {$end - $tmp} + }} {return -level 0 -code continue} +} 0 +test for-7.23 {Bug 3614226: ensure that break from expanded command only cleans up the right amount} memory { + apply {op { + 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 {*}[{*}$op] d e f]] + }] + set tmp $end + set end [meminfo] + } + expr {$end - $tmp} + }} {return -level 0 -code break} +} 0 +test for-7.24 {Bug 3614226: ensure that continue from expanded command only cleans up the right amount} memory { + apply {op { + 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 {*}[{*}$op] d e f]] + }] + set tmp $end + set end [meminfo] + } + expr {$end - $tmp} + }} {return -level 0 -code continue} +} 0 # cleanup ::tcltest::cleanupTests -- cgit v0.12 From 39e314ad912cdbd29ba3e01673b1097b40118f8b Mon Sep 17 00:00:00 2001 From: dkf Date: Sun, 20 Oct 2013 18:11:35 +0000 Subject: And the last bits that need fixing; the code is still less efficient than desired but should now not crash. --- generic/tclAssembly.c | 35 +++++++++++++++++++++++++++++++---- generic/tclCompCmds.c | 4 ++-- generic/tclCompCmdsGR.c | 6 +++++- generic/tclCompCmdsSZ.c | 12 +++++++----- 4 files changed, 45 insertions(+), 12 deletions(-) diff --git a/generic/tclAssembly.c b/generic/tclAssembly.c index 08da075..fc51457 100644 --- a/generic/tclAssembly.c +++ b/generic/tclAssembly.c @@ -246,6 +246,8 @@ static void BBEmitInstInt4(AssemblyEnv* assemEnvPtr, int tblIdx, int opnd, int count); static void BBEmitInst1or4(AssemblyEnv* assemEnvPtr, int tblIdx, int param, int count); +static void BBEmitInvoke1or4(AssemblyEnv* assemEnvPtr, int tblIdx, + int param, int count); static void BBEmitOpcode(AssemblyEnv* assemEnvPtr, int tblIdx, int count); static int BuildExceptionRanges(AssemblyEnv* assemEnvPtr); @@ -679,10 +681,13 @@ BBEmitInstInt4( /* *----------------------------------------------------------------------------- * - * BBEmitInst1or4 -- + * BBEmitInst1or4, BBEmitInvoke1or4 -- * * Emits a 1- or 4-byte operation according to the magnitude of the - * operand + * operand. The Invoke variant generates wrapping stack-balance + * management if necessary (which is not normally required in assembled + * code, as loop exception ranges, expansions, breaks and continues can't + * be issued currently). * *----------------------------------------------------------------------------- */ @@ -714,6 +719,29 @@ BBEmitInst1or4( TclUpdateAtCmdStart(op, envPtr); BBUpdateStackReqs(bbPtr, tblIdx, count); } + +static void +BBEmitInvoke1or4( + AssemblyEnv* assemEnvPtr, /* Assembly environment */ + int tblIdx, /* Index in TalInstructionTable of op */ + int param, /* Variable-length parameter */ + int count) /* Arity if variadic */ +{ + CompileEnv* envPtr = assemEnvPtr->envPtr; + /* Compilation environment */ + BasicBlock* bbPtr = assemEnvPtr->curr_bb; + /* Current basic block */ + int op = TalInstructionTable[tblIdx].tclInstCode; + + if (param <= 0xff) { + op >>= 8; + } else { + op &= 0xff; + } + TclEmitInvoke(envPtr, op, param); + TclUpdateAtCmdStart(op, envPtr); + BBUpdateStackReqs(bbPtr, tblIdx, count); +} /* *----------------------------------------------------------------------------- @@ -1450,8 +1478,7 @@ AssembleOneLine( goto cleanup; } - // FIXME - use TclEmitInvoke - BBEmitInst1or4(assemEnvPtr, tblIdx, opnd, opnd); + BBEmitInvoke1or4(assemEnvPtr, tblIdx, opnd, opnd); break; case ASSEM_JUMP: diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c index c55635a..9c43bfe 100644 --- a/generic/tclCompCmds.c +++ b/generic/tclCompCmds.c @@ -1675,7 +1675,7 @@ TclCompileDictUpdateCmd( TclEmitInstInt4( INST_DICT_UPDATE_END, dictIndex, envPtr); TclEmitInt4( infoIndex, envPtr); - TclEmitOpcode( INST_RETURN_STK, envPtr); + TclEmitInvoke(envPtr,INST_RETURN_STK); if (TclFixupForwardJumpToHere(envPtr, &jumpFixup, 127)) { Tcl_Panic("TclCompileDictCmd(update): bad jump distance %d", @@ -2033,7 +2033,7 @@ TclCompileDictWithCmd( } else { TclEmitInstInt4( INST_DICT_RECOMBINE_IMM, dictVar, envPtr); } - TclEmitOpcode( INST_RETURN_STK, envPtr); + TclEmitInvoke(envPtr, INST_RETURN_STK); /* * Prepare for the start of the next command. diff --git a/generic/tclCompCmdsGR.c b/generic/tclCompCmdsGR.c index fbd370b..d00327d 100644 --- a/generic/tclCompCmdsGR.c +++ b/generic/tclCompCmdsGR.c @@ -2381,6 +2381,10 @@ TclCompileReturnCmd( * Scan through the return options. If any are unknown at compile time, * there is no value in bytecompiling. Save the option values known in an * objv array for merging into a return options dictionary. + * + * TODO: There is potential for improvement if all option keys are known + * at compile time and all option values relating to '-code' and '-level' + * are known at compile time. */ for (objc = 0; objc < numOptionWords; objc++) { @@ -2388,7 +2392,7 @@ TclCompileReturnCmd( Tcl_IncrRefCount(objv[objc]); if (!TclWordKnownAtCompileTime(wordTokenPtr, objv[objc])) { /* - * Non-literal, so punt to run-time. + * Non-literal, so punt to run-time assembly of the dictionary. */ for (; objc>=0 ; objc--) { diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c index a5ec731..754238f 100644 --- a/generic/tclCompCmdsSZ.c +++ b/generic/tclCompCmdsSZ.c @@ -99,6 +99,8 @@ const AuxDataType tclJumptableInfoType = { if ((idx)<256) {OP1(LOAD_SCALAR1,(idx));} else {OP4(LOAD_SCALAR4,(idx));} #define STORE(idx) \ if ((idx)<256) {OP1(STORE_SCALAR1,(idx));} else {OP4(STORE_SCALAR4,(idx));} +#define INVOKE(name) \ + TclEmitInvoke(envPtr,INST_##name) /* *---------------------------------------------------------------------- @@ -873,7 +875,7 @@ TclSubstCompile( OP( END_CATCH); OP( RETURN_CODE_BRANCH); - /* ERROR -> reraise it */ + /* ERROR -> reraise it; NB: can't require BREAK/CONTINUE handling */ OP( RETURN_STK); OP( NOP); @@ -2396,7 +2398,7 @@ IssueTryClausesInstructions( TclAdjustStackDepth(-1, envPtr); FIXJUMP1( dontChangeOptions); OP4( REVERSE, 2); - OP( RETURN_STK); + INVOKE( RETURN_STK); } JUMP4( JUMP, addrsToFix[i]); @@ -2415,7 +2417,7 @@ IssueTryClausesInstructions( OP( POP); LOAD( optionsVar); LOAD( resultVar); - OP( RETURN_STK); + INVOKE( RETURN_STK); /* * Fix all the jumps from taken clauses to here (which is the end of the @@ -2724,7 +2726,7 @@ IssueTryClausesFinallyInstructions( FIXJUMP1( finalOK); LOAD( optionsVar); LOAD( resultVar); - OP( RETURN_STK); + INVOKE( RETURN_STK); return TCL_OK; } @@ -2783,7 +2785,7 @@ IssueTryFinallyInstructions( OP1( JUMP1, 7); FIXJUMP1( jumpOK); OP4( REVERSE, 2); - OP( RETURN_STK); + INVOKE( RETURN_STK); return TCL_OK; } -- cgit v0.12 From 30cd4b442c047d01653b1c217b0364eb6b5c8101 Mon Sep 17 00:00:00 2001 From: dgp Date: Mon, 21 Oct 2013 14:35:02 +0000 Subject: silence compiler warnings --- generic/tclCompile.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/generic/tclCompile.c b/generic/tclCompile.c index ae6e56c..a150fc2 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.c @@ -3930,7 +3930,7 @@ TclEmitInvoke( ExceptionRange *rangePtr; ExceptionAux *auxBreakPtr, *auxContinuePtr; int arg1, arg2, wordCount = 0, expandCount = 0; - int loopRange, breakRange, continueRange; + int loopRange = 0, breakRange = 0, continueRange = 0; /* * Parse the arguments. -- cgit v0.12 From 545698c7c06b1e3d1956d77508ecaf251163fb22 Mon Sep 17 00:00:00 2001 From: dkf Date: Tue, 22 Oct 2013 14:29:03 +0000 Subject: Fix problems in for.test --- generic/tclCompile.c | 136 +++++++++++++++++++++++---------------------------- 1 file changed, 62 insertions(+), 74 deletions(-) diff --git a/generic/tclCompile.c b/generic/tclCompile.c index a150fc2..dcd74f1 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.c @@ -1755,7 +1755,6 @@ CompileExpanded( int wordIdx = 0; DefineLineInformation; - StartExpanding(envPtr); if (cmdObj) { CompileCmdLiteral(interp, cmdObj, envPtr); @@ -1787,19 +1786,17 @@ CompileExpanded( } /* - * The stack depth during argument expansion can only be - * managed at runtime, as the number of elements in the - * expanded lists is not known at compile time. We adjust here - * the stack depth estimate so that it is correct after the - * command with expanded arguments returns. + * The stack depth during argument expansion can only be managed at + * runtime, as the number of elements in the expanded lists is not known + * at compile time. We adjust here the stack depth estimate so that it is + * correct after the command with expanded arguments returns. * - * The end effect of this command's invocation is that all the - * words of the command are popped from the stack, and the - * result is pushed: the stack top changes by (1-wordIdx). + * The end effect of this command's invocation is that all the words of + * the command are popped from the stack, and the result is pushed: the + * stack top changes by (1-wordIdx). * - * Note that the estimates are not correct while the command - * is being prepared and run, INST_EXPAND_STKTOP is not - * stack-neutral in general. + * Note that the estimates are not correct while the command is being + * prepared and run, INST_EXPAND_STKTOP is not stack-neutral in general. */ TclEmitInvoke(envPtr, INST_INVOKE_EXPANDED, wordIdx); @@ -1816,8 +1813,8 @@ CompileCmdCompileProc( DefineLineInformation; /* - * Emit of the INST_START_CMD instruction is controlled by - * the value of envPtr->atCmdStart: + * Emit of the INST_START_CMD instruction is controlled by the value of + * envPtr->atCmdStart: * * atCmdStart == 2 : We are not using the INST_START_CMD instruction. * atCmdStart == 1 : INST_START_CMD was the last instruction emitted. @@ -1848,9 +1845,10 @@ CompileCmdCompileProc( if (TCL_OK == TclAttemptCompileProc(interp, parsePtr, 1, cmdPtr, envPtr)) { if (incrOffset >= 0) { /* - * We successfully compiled a command. Increment the number - * of commands that start at the currently active INST_START_CMD. + * We successfully compiled a command. Increment the number of + * commands that start at the currently active INST_START_CMD. */ + unsigned char *incrPtr = envPtr->codeStart + incrOffset; unsigned char *startPtr = incrPtr - 5; @@ -1866,9 +1864,9 @@ CompileCmdCompileProc( envPtr->codeNext -= unwind; /* Unwind INST_START_CMD */ /* - * Throw out any line information generated by the failed - * compile attempt. + * Throw out any line information generated by the failed compile attempt. */ + while (mapPtr->nuloc - 1 > eclIndex) { mapPtr->nuloc--; ckfree(mapPtr->loc[mapPtr->nuloc].line); @@ -1876,11 +1874,11 @@ CompileCmdCompileProc( } /* - * Reset the index of next command. - * Toss out any from failed nested partial compiles. + * Reset the index of next command. Toss out any from failed nested + * partial compiles. */ - envPtr->numCommands = mapPtr->nuloc; + envPtr->numCommands = mapPtr->nuloc; return TCL_ERROR; } @@ -1912,11 +1910,10 @@ CompileCommandTokens( parsePtr->commandStart - envPtr->source, startCodeOffset); /* - * TIP #280. Scan the words and compute the extended location - * information. The map first contain full per-word line - * information for use by the compiler. This is later replaced by - * a reduced form which signals non-literal words, stored in - * 'wlines'. + * TIP #280. Scan the words and compute the extended location information. + * The map first contain full per-word line information for use by the + * compiler. This is later replaced by a reduced form which signals + * non-literal words, stored in 'wlines'. */ EnterCmdWordData(eclPtr, parsePtr->commandStart - envPtr->source, @@ -1938,8 +1935,8 @@ CompileCommandTokens( cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, cmdObj); if (cmdPtr) { /* - * Found a command. Test the ways we can be told - * not to attempt to compile it. + * Found a command. Test the ways we can be told not to attempt + * to compile it. */ if ((cmdPtr->compileProc == NULL) || (cmdPtr->nsPtr->flags & NS_SUPPRESS_COMPILATION) @@ -1983,8 +1980,8 @@ CompileCommandTokens( (envPtr->codeNext-envPtr->codeStart) - startCodeOffset); /* - * TIP #280: Free full form of per-word line data and insert the - * reduced form now + * TIP #280: Free full form of per-word line data and insert the reduced + * form now */ envPtr->line = cmdLine; @@ -2069,20 +2066,20 @@ TclCompileScript( if (parse.numWords == 0) { /* - * The "command" parsed has no words. In this case - * we can skip the rest of the loop body. With no words, - * clearly CompileCommandTokens() has nothing to do. Since - * the parser aggressively sucks up leading comment and white - * space, including newlines, parse.commandStart must be - * pointing at either the end of script, or a command-terminating - * semi-colon. In either case, the TclAdvance*() calls have - * nothing to do. Finally, when no words are parsed, no - * tokens have been allocated at parse.tokenPtr so there's - * also nothing for Tcl_FreeParse() to do. + * The "command" parsed has no words. In this case we can skip + * the rest of the loop body. With no words, clearly + * CompileCommandTokens() has nothing to do. Since the parser + * aggressively sucks up leading comment and white space, + * including newlines, parse.commandStart must be pointing at + * either the end of script, or a command-terminating semi-colon. + * In either case, the TclAdvance*() calls have nothing to do. + * Finally, when no words are parsed, no tokens have been + * allocated at parse.tokenPtr so there's also nothing for + * Tcl_FreeParse() to do. * * The advantage of this shortcut is that CompileCommandTokens() - * can be written with an assumption that parse.numWords > 0, - * with the implication the CCT() always generates bytecode. + * can be written with an assumption that parse.numWords > 0, with + * the implication the CCT() always generates bytecode. */ continue; } @@ -2101,23 +2098,25 @@ TclCompileScript( if (lastCmdIdx == -1) { /* - * Compiling the script yielded no bytecode. The script must be - * all whitespace, comments, and empty commands. Such scripts - * are defined to successfully produce the empty string result, - * so we emit the simple bytecode that makes that happen. + * Compiling the script yielded no bytecode. The script must be all + * whitespace, comments, and empty commands. Such scripts are defined + * to successfully produce the empty string result, so we emit the + * simple bytecode that makes that happen. */ + PushStringLiteral(envPtr, ""); } else { /* * We compiled at least one command to bytecode. The routine * CompileCommandTokens() follows the bytecode of each compiled - * command with an INST_POP, so that stack balance is maintained - * when several commands are in sequence. (The result of each - * command is thrown away before moving on to the next command). - * For the last command compiled, we need to undo that INST_POP - * so that the result of the last command becomes the result of - * the script. The code here removes that trailing INST_POP. + * command with an INST_POP, so that stack balance is maintained when + * several commands are in sequence. (The result of each command is + * thrown away before moving on to the next command). For the last + * command compiled, we need to undo that INST_POP so that the result + * of the last command becomes the result of the script. The code + * here removes that trailing INST_POP. */ + envPtr->cmdMapPtr[lastCmdIdx].numCodeBytes--; envPtr->codeNext--; envPtr->currStackDepth++; @@ -3353,9 +3352,9 @@ 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. + * 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. * * --------------------------------------------------------------------- */ @@ -3369,23 +3368,16 @@ TclCleanupStackForBreakContinue( int toPop = envPtr->expandCount - auxPtr->expandTarget; if (toPop > 0) { - while (toPop > 0) { + while (toPop --> 0) { TclEmitOpcode(INST_EXPAND_DROP, envPtr); - toPop--; } TclAdjustStackDepth(auxPtr->expandTargetDepth - envPtr->currStackDepth, envPtr); - toPop = auxPtr->expandTargetDepth - auxPtr->stackDepth; - while (toPop > 0) { - TclEmitOpcode(INST_POP, envPtr); - toPop--; - } - } else { - toPop = envPtr->currStackDepth - auxPtr->stackDepth; - while (toPop > 0) { - TclEmitOpcode(INST_POP, envPtr); - toPop--; - } + envPtr->currStackDepth = auxPtr->expandTargetDepth; + } + toPop = envPtr->currStackDepth - auxPtr->stackDepth; + while (toPop --> 0) { + TclEmitOpcode(INST_POP, envPtr); } envPtr->currStackDepth = savedStackDepth; } @@ -4062,11 +4054,9 @@ TclEmitInvoke( if (auxBreakPtr != NULL) { TclAdjustStackDepth(-1, envPtr); - exceptAux->stackDepth = auxBreakPtr->stackDepth; - exceptAux->expandTarget = auxBreakPtr->expandTarget; ExceptionRangeTarget(envPtr, loopRange, breakOffset); - TclCleanupStackForBreakContinue(envPtr, exceptAux); + TclCleanupStackForBreakContinue(envPtr, auxBreakPtr); TclAddLoopBreakFixup(envPtr, auxBreakPtr); envPtr->currStackDepth = savedStackDepth; @@ -4075,11 +4065,9 @@ TclEmitInvoke( if (auxContinuePtr != NULL) { TclAdjustStackDepth(-1, envPtr); - exceptAux->stackDepth = auxContinuePtr->stackDepth; - exceptAux->expandTarget = auxContinuePtr->expandTarget; ExceptionRangeTarget(envPtr, loopRange, continueOffset); - TclCleanupStackForBreakContinue(envPtr, exceptAux); + TclCleanupStackForBreakContinue(envPtr, auxContinuePtr); TclAddLoopContinueFixup(envPtr, auxContinuePtr); envPtr->currStackDepth = savedStackDepth; -- cgit v0.12