From 8430c2dada2e781cff07e2534fb7fbd11dcf1958 Mon Sep 17 00:00:00 2001 From: dkf Date: Thu, 30 May 2013 10:55:39 +0000 Subject: Working towards the next batch of optimizations. --- generic/tclCompCmds.c | 81 +++++++++++++++++++++++++++++++++++++++++ generic/tclCompCmdsSZ.c | 4 +++ generic/tclCompile.c | 96 +++++++++++++++++++++++++++++++++++++++---------- generic/tclCompile.h | 6 ++++ 4 files changed, 168 insertions(+), 19 deletions(-) diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c index 7046e54..1f99a22 100644 --- a/generic/tclCompCmds.c +++ b/generic/tclCompCmds.c @@ -480,11 +480,45 @@ TclCompileBreakCmd( * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { + int i, exnIdx; + ExceptionRange *rangePtr; + if (parsePtr->numWords != 1) { return TCL_ERROR; } /* + * Find the innermost exception range that contains this command. Relies + * on the fact that the range has a numCodeBytes = -1 when it is being + * populated and that inner ranges come after outer ranges. + */ + + exnIdx = -1; + for (i=0 ; iexceptArrayNext ; i++) { + rangePtr = &envPtr->exceptArrayPtr[i]; + if (envPtr->codeStart+rangePtr->codeOffset <= envPtr->codeNext + && rangePtr->numCodeBytes == -1) { + exnIdx = i; + } + } + if (exnIdx != -1) { + rangePtr = &envPtr->exceptArrayPtr[exnIdx]; + if (rangePtr->type == LOOP_EXCEPTION_RANGE) { + int toPop = envPtr->currStackDepth - + envPtr->exnStackDepthArrayPtr[exnIdx]; + + /* + * Pop off the extra stack frames. + */ + + while (toPop > 0) { + TclEmitOpcode(INST_POP, envPtr); + toPop--; + } + } + } + + /* * Emit a break instruction. */ @@ -790,6 +824,9 @@ TclCompileContinueCmd( * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { + int i, exnIdx; + ExceptionRange *rangePtr; + /* * There should be no argument after the "continue". */ @@ -799,6 +836,50 @@ TclCompileContinueCmd( } /* + * See if we can find a valid continueOffset (i.e., not -1) in the + * innermost containing exception range. Relies on the fact that the range + * has a numCodeBytes = -1 when it is being populated and that inner + * ranges come after outer ranges. + */ + + exnIdx = -1; + for (i=0 ; iexceptArrayNext ; i++) { + rangePtr = &envPtr->exceptArrayPtr[i]; + if (envPtr->codeStart+rangePtr->codeOffset <= envPtr->codeNext + && rangePtr->numCodeBytes == -1) { + exnIdx = i; + } + } + if (exnIdx >= 0) { + rangePtr = &envPtr->exceptArrayPtr[exnIdx]; + if (rangePtr->type == LOOP_EXCEPTION_RANGE) { + int toPop = envPtr->currStackDepth - + envPtr->exnStackDepthArrayPtr[exnIdx]; + + /* + * Pop off the extra stack frames. + */ + + while (toPop > 0) { + TclEmitOpcode(INST_POP, envPtr); + toPop--; + } + } + if (rangePtr->type == LOOP_EXCEPTION_RANGE + && rangePtr->continueOffset != -1) { + int offset = (rangePtr->continueOffset - CurrentOffset(envPtr)); + + /* + * Found the target! No need for a nasty INST_CONTINUE here. + */ + + TclEmitInstInt4(INST_JUMP4, offset, envPtr); + PushStringLiteral(envPtr, ""); /* Evil hack! */ + return TCL_OK; + } + } + + /* * Emit a continue instruction. */ diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c index ed4d962..4f4286e 100644 --- a/generic/tclCompCmdsSZ.c +++ b/generic/tclCompCmdsSZ.c @@ -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; diff --git a/generic/tclCompile.c b/generic/tclCompile.c index 039a694..631ff58 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.c @@ -562,7 +562,7 @@ static Command * FindCompiledCommandFromToken(Tcl_Interp *interp, static void FreeByteCodeInternalRep(Tcl_Obj *objPtr); static void FreeSubstCodeInternalRep(Tcl_Obj *objPtr); static int GetCmdLocEncodingSize(CompileEnv *envPtr); -static int IsCompactibleCompileEnv(Tcl_Interp *interp, +/* static */ int IsCompactibleCompileEnv(Tcl_Interp *interp, CompileEnv *envPtr); static void PeepholeOptimize(CompileEnv *envPtr); #ifdef TCL_COMPILE_STATS @@ -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); } /* @@ -1034,7 +1036,7 @@ TclCleanupByteCode( * --------------------------------------------------------------------- */ -static int +/* static */ int IsCompactibleCompileEnv( Tcl_Interp *interp, CompileEnv *envPtr) @@ -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 ; imallocedLiteralArray = 0; envPtr->exceptArrayPtr = envPtr->staticExceptArraySpace; + envPtr->exnStackDepthArrayPtr = envPtr->staticExnStackDepthArraySpace; envPtr->exceptArrayNext = 0; envPtr->exceptArrayEnd = COMPILEENV_INIT_EXCEPT_RANGES; envPtr->mallocedExceptArray = 0; @@ -1678,6 +1727,7 @@ TclFreeCompileEnv( } if (envPtr->mallocedExceptArray) { ckfree(envPtr->exceptArrayPtr); + ckfree(envPtr->exnStackDepthArrayPtr); } if (envPtr->mallocedCmdMap) { ckfree(envPtr->cmdMapPtr); @@ -3371,12 +3421,16 @@ TclCreateExceptRange( size_t currBytes = envPtr->exceptArrayNext * sizeof(ExceptionRange); + size_t currBytes2 = envPtr->exceptArrayNext * sizeof(int); int newElems = 2*envPtr->exceptArrayEnd; size_t newBytes = newElems * sizeof(ExceptionRange); + size_t newBytes2 = newElems * sizeof(int); if (envPtr->mallocedExceptArray) { envPtr->exceptArrayPtr = ckrealloc(envPtr->exceptArrayPtr, newBytes); + envPtr->exnStackDepthArrayPtr = + ckrealloc(envPtr->exnStackDepthArrayPtr, newBytes2); } else { /* * envPtr->exceptArrayPtr isn't a ckalloc'd pointer, so we must @@ -3384,9 +3438,12 @@ TclCreateExceptRange( */ ExceptionRange *newPtr = ckalloc(newBytes); + int *newPtr2 = ckalloc(newBytes2); memcpy(newPtr, envPtr->exceptArrayPtr, currBytes); + memcpy(newPtr2, envPtr->exnStackDepthArrayPtr, currBytes2); envPtr->exceptArrayPtr = newPtr; + envPtr->exnStackDepthArrayPtr = newPtr2; envPtr->mallocedExceptArray = 1; } envPtr->exceptArrayEnd = newElems; @@ -3401,6 +3458,7 @@ TclCreateExceptRange( rangePtr->breakOffset = -1; rangePtr->continueOffset = -1; rangePtr->catchOffset = -1; + envPtr->exnStackDepthArrayPtr[index] = envPtr->currStackDepth; return index; } diff --git a/generic/tclCompile.h b/generic/tclCompile.h index 0be5d1d..c380823 100644 --- a/generic/tclCompile.h +++ b/generic/tclCompile.h @@ -275,6 +275,9 @@ typedef struct CompileEnv { * entry. */ int mallocedExceptArray; /* 1 if ExceptionRange array was expanded and * exceptArrayPtr points in heap, else 0. */ + int *exnStackDepthArrayPtr; /* Array of stack depths to restore to 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 +299,9 @@ typedef struct CompileEnv { /* Initial storage of LiteralEntry array. */ ExceptionRange staticExceptArraySpace[COMPILEENV_INIT_EXCEPT_RANGES]; /* Initial ExceptionRange array storage. */ + int staticExnStackDepthArraySpace[COMPILEENV_INIT_EXCEPT_RANGES]; + /* Initial static except stack depth array + * storage. */ CmdLocation staticCmdMapSpace[COMPILEENV_INIT_CMD_MAP_SIZE]; /* Initial storage for cmd location map. */ AuxData staticAuxDataArraySpace[COMPILEENV_INIT_AUX_DATA_SIZE]; -- cgit v0.12 From 8d03d462d4d27ee4a2d6fec72a8d2efe9e90f94a Mon Sep 17 00:00:00 2001 From: dkf Date: Thu, 30 May 2013 10:57:13 +0000 Subject: derp --- generic/tclCompile.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/generic/tclCompile.c b/generic/tclCompile.c index 631ff58..54946ee 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.c @@ -562,7 +562,7 @@ static Command * FindCompiledCommandFromToken(Tcl_Interp *interp, static void FreeByteCodeInternalRep(Tcl_Obj *objPtr); static void FreeSubstCodeInternalRep(Tcl_Obj *objPtr); static int GetCmdLocEncodingSize(CompileEnv *envPtr); -/* static */ int IsCompactibleCompileEnv(Tcl_Interp *interp, +static int IsCompactibleCompileEnv(Tcl_Interp *interp, CompileEnv *envPtr); static void PeepholeOptimize(CompileEnv *envPtr); #ifdef TCL_COMPILE_STATS @@ -1036,7 +1036,7 @@ TclCleanupByteCode( * --------------------------------------------------------------------- */ -/* static */ int +static int IsCompactibleCompileEnv( Tcl_Interp *interp, CompileEnv *envPtr) -- cgit v0.12 From d09727e7ff46a2abd069caac727159c92f6c9436 Mon Sep 17 00:00:00 2001 From: dkf Date: Sat, 1 Jun 2013 21:05:55 +0000 Subject: Getting better at doing more efficient break/continue instruction handling. --- generic/tclCompCmds.c | 113 ++++++++++++++++++++++++++++---------------------- generic/tclCompile.c | 42 +++++++++++++++++++ generic/tclCompile.h | 6 +++ 3 files changed, 111 insertions(+), 50 deletions(-) diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c index 1f99a22..6e5d187 100644 --- a/generic/tclCompCmds.c +++ b/generic/tclCompCmds.c @@ -480,7 +480,7 @@ TclCompileBreakCmd( * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { - int i, exnIdx; + int depth; ExceptionRange *rangePtr; if (parsePtr->numWords != 1) { @@ -488,33 +488,40 @@ TclCompileBreakCmd( } /* - * Find the innermost exception range that contains this command. Relies - * on the fact that the range has a numCodeBytes = -1 when it is being - * populated and that inner ranges come after outer ranges. + * Find the innermost exception range that contains this command. */ - exnIdx = -1; - for (i=0 ; iexceptArrayNext ; i++) { - rangePtr = &envPtr->exceptArrayPtr[i]; - if (envPtr->codeStart+rangePtr->codeOffset <= envPtr->codeNext - && rangePtr->numCodeBytes == -1) { - exnIdx = i; + rangePtr = TclGetInnermostExceptionRange(envPtr, &depth); + if (rangePtr && rangePtr->type == LOOP_EXCEPTION_RANGE) { + int toPop = envPtr->currStackDepth - depth; + + /* + * Pop off the extra stack frames. + */ + + while (toPop > 0) { + TclEmitOpcode(INST_POP, envPtr); + toPop--; +#ifdef TCL_COMPILE_DEBUG + /* + * 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. + */ + TclAdjustStackDepth(1, envPtr); +#endif } - } - if (exnIdx != -1) { - rangePtr = &envPtr->exceptArrayPtr[exnIdx]; - if (rangePtr->type == LOOP_EXCEPTION_RANGE) { - int toPop = envPtr->currStackDepth - - envPtr->exnStackDepthArrayPtr[exnIdx]; + + if (envPtr->expandCount == 0 && rangePtr->breakOffset != -1) { + int offset = (rangePtr->breakOffset - CurrentOffset(envPtr)); /* - * Pop off the extra stack frames. + * Found the target! Also, no built-up expansion stack. No need + * for a nasty INST_BREAK here. */ - while (toPop > 0) { - TclEmitOpcode(INST_POP, envPtr); - toPop--; - } + TclEmitInstInt4(INST_JUMP4, offset, envPtr); + goto done; } } @@ -523,6 +530,8 @@ TclCompileBreakCmd( */ TclEmitOpcode(INST_BREAK, envPtr); + + done: #ifdef TCL_COMPILE_DEBUG /* * Instructions that raise exceptions don't really have to follow @@ -824,7 +833,7 @@ TclCompileContinueCmd( * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { - int i, exnIdx; + int depth; ExceptionRange *rangePtr; /* @@ -837,45 +846,40 @@ TclCompileContinueCmd( /* * See if we can find a valid continueOffset (i.e., not -1) in the - * innermost containing exception range. Relies on the fact that the range - * has a numCodeBytes = -1 when it is being populated and that inner - * ranges come after outer ranges. + * innermost containing exception range. */ - exnIdx = -1; - for (i=0 ; iexceptArrayNext ; i++) { - rangePtr = &envPtr->exceptArrayPtr[i]; - if (envPtr->codeStart+rangePtr->codeOffset <= envPtr->codeNext - && rangePtr->numCodeBytes == -1) { - exnIdx = i; - } - } - if (exnIdx >= 0) { - rangePtr = &envPtr->exceptArrayPtr[exnIdx]; - if (rangePtr->type == LOOP_EXCEPTION_RANGE) { - int toPop = envPtr->currStackDepth - - envPtr->exnStackDepthArrayPtr[exnIdx]; + rangePtr = TclGetInnermostExceptionRange(envPtr, &depth); + if (rangePtr && rangePtr->type == LOOP_EXCEPTION_RANGE) { + int toPop = envPtr->currStackDepth - depth; + + /* + * Pop off the extra stack frames. + */ + while (toPop > 0) { + TclEmitOpcode(INST_POP, envPtr); + toPop--; +#ifdef TCL_COMPILE_DEBUG /* - * Pop off the extra stack frames. + * 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. */ - - while (toPop > 0) { - TclEmitOpcode(INST_POP, envPtr); - toPop--; - } + TclAdjustStackDepth(1, envPtr); +#endif } - if (rangePtr->type == LOOP_EXCEPTION_RANGE - && rangePtr->continueOffset != -1) { + + if (envPtr->expandCount == 0 && rangePtr->continueOffset != -1) { int offset = (rangePtr->continueOffset - CurrentOffset(envPtr)); /* - * Found the target! No need for a nasty INST_CONTINUE here. + * Found the target! Also, no built-up expansion stack. No need + * for a nasty INST_CONTINUE here. */ TclEmitInstInt4(INST_JUMP4, offset, envPtr); - PushStringLiteral(envPtr, ""); /* Evil hack! */ - return TCL_OK; + goto done; } } @@ -884,7 +888,16 @@ TclCompileContinueCmd( */ TclEmitOpcode(INST_CONTINUE, envPtr); - PushStringLiteral(envPtr, ""); /* Evil hack! */ + + done: +#ifdef TCL_COMPILE_DEBUG + /* + * 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. + */ + TclAdjustStackDepth(1, envPtr); +#endif return TCL_OK; } diff --git a/generic/tclCompile.c b/generic/tclCompile.c index 54946ee..c56b67f 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.c @@ -1523,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 @@ -2060,6 +2061,7 @@ TclCompileScript( if (expand) { TclEmitOpcode(INST_EXPAND_START, envPtr); + envPtr->expandCount++; } /* @@ -2279,6 +2281,7 @@ TclCompileScript( */ TclEmitOpcode(INST_INVOKE_EXPANDED, envPtr); + envPtr->expandCount--; TclAdjustStackDepth(1 - wordIdx, envPtr); } else if (wordIdx > 0) { /* @@ -3463,6 +3466,45 @@ TclCreateExceptRange( } /* + * --------------------------------------------------------------------- + * + * 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 *stackDepthPtr) +{ + int exnIdx = -1, i; + + for (i=0 ; iexceptArrayNext ; i++) { + ExceptionRange *rangePtr = &envPtr->exceptArrayPtr[i]; + + if (CurrentOffset(envPtr) >= rangePtr->codeOffset && + (rangePtr->numCodeBytes == -1 || CurrentOffset(envPtr) < + rangePtr->codeOffset+rangePtr->numCodeBytes)) { + exnIdx = i; + } + } + if (exnIdx == -1) { + return NULL; + } + if (stackDepthPtr) { + *stackDepthPtr = envPtr->exnStackDepthArrayPtr[exnIdx]; + } + return &envPtr->exceptArrayPtr[exnIdx]; +} + +/* *---------------------------------------------------------------------- * * TclCreateAuxData -- diff --git a/generic/tclCompile.h b/generic/tclCompile.h index c380823..c9cbbd4 100644 --- a/generic/tclCompile.h +++ b/generic/tclCompile.h @@ -318,6 +318,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 @@ -990,6 +994,8 @@ 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 *depthPtr); #ifdef TCL_COMPILE_STATS MODULE_SCOPE char * TclLiteralStats(LiteralTable *tablePtr); MODULE_SCOPE int TclLog2(int value); -- cgit v0.12 From 8bd69e27f28e6a4927f6df9aacd29694d76c0dca Mon Sep 17 00:00:00 2001 From: dkf Date: Sun, 2 Jun 2013 17:41:14 +0000 Subject: Many improvements to code generation of efficient break and continue. --- generic/tclCompCmds.c | 93 +++++++++++----------------- generic/tclCompCmdsSZ.c | 11 ++-- generic/tclCompile.c | 160 ++++++++++++++++++++++++++++++++++++++++++++---- generic/tclCompile.h | 52 ++++++++++++++-- 4 files changed, 235 insertions(+), 81 deletions(-) diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c index 6e5d187..f2d2963 100644 --- a/generic/tclCompCmds.c +++ b/generic/tclCompCmds.c @@ -480,8 +480,8 @@ TclCompileBreakCmd( * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { - int depth; ExceptionRange *rangePtr; + ExceptionAux *auxPtr; if (parsePtr->numWords != 1) { return TCL_ERROR; @@ -491,9 +491,9 @@ TclCompileBreakCmd( * Find the innermost exception range that contains this command. */ - rangePtr = TclGetInnermostExceptionRange(envPtr, &depth); + rangePtr = TclGetInnermostExceptionRange(envPtr, &auxPtr); if (rangePtr && rangePtr->type == LOOP_EXCEPTION_RANGE) { - int toPop = envPtr->currStackDepth - depth; + int toPop = envPtr->currStackDepth - auxPtr->stackDepth; /* * Pop off the extra stack frames. @@ -501,26 +501,18 @@ TclCompileBreakCmd( while (toPop > 0) { TclEmitOpcode(INST_POP, envPtr); - toPop--; -#ifdef TCL_COMPILE_DEBUG - /* - * 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. - */ TclAdjustStackDepth(1, envPtr); -#endif + toPop--; } - if (envPtr->expandCount == 0 && rangePtr->breakOffset != -1) { - int offset = (rangePtr->breakOffset - CurrentOffset(envPtr)); - + if (envPtr->expandCount == 0) { /* * Found the target! Also, no built-up expansion stack. No need * for a nasty INST_BREAK here. */ - TclEmitInstInt4(INST_JUMP4, offset, envPtr); + TclAddLoopBreakFixup(envPtr, auxPtr); + TclEmitInstInt4(INST_JUMP4, 0, envPtr); goto done; } } @@ -532,14 +524,12 @@ TclCompileBreakCmd( TclEmitOpcode(INST_BREAK, envPtr); done: -#ifdef TCL_COMPILE_DEBUG /* - * 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; } @@ -645,7 +635,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, @@ -833,8 +823,8 @@ TclCompileContinueCmd( * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { - int depth; ExceptionRange *rangePtr; + ExceptionAux *auxPtr; /* * There should be no argument after the "continue". @@ -849,9 +839,9 @@ TclCompileContinueCmd( * innermost containing exception range. */ - rangePtr = TclGetInnermostExceptionRange(envPtr, &depth); + rangePtr = TclGetInnermostExceptionRange(envPtr, &auxPtr); if (rangePtr && rangePtr->type == LOOP_EXCEPTION_RANGE) { - int toPop = envPtr->currStackDepth - depth; + int toPop = envPtr->currStackDepth - auxPtr->stackDepth; /* * Pop off the extra stack frames. @@ -859,26 +849,18 @@ TclCompileContinueCmd( while (toPop > 0) { TclEmitOpcode(INST_POP, envPtr); - toPop--; -#ifdef TCL_COMPILE_DEBUG - /* - * 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. - */ TclAdjustStackDepth(1, envPtr); -#endif + toPop--; } - if (envPtr->expandCount == 0 && rangePtr->continueOffset != -1) { - int offset = (rangePtr->continueOffset - CurrentOffset(envPtr)); - + if (envPtr->expandCount == 0) { /* * Found the target! Also, no built-up expansion stack. No need * for a nasty INST_CONTINUE here. */ - TclEmitInstInt4(INST_JUMP4, offset, envPtr); + TclAddLoopContinueFixup(envPtr, auxPtr); + TclEmitInstInt4(INST_JUMP4, 0, envPtr); goto done; } } @@ -890,14 +872,12 @@ TclCompileContinueCmd( TclEmitOpcode(INST_CONTINUE, envPtr); done: -#ifdef TCL_COMPILE_DEBUG /* - * 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; } @@ -1350,7 +1330,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 ; inumWords ; i++) { @@ -1563,7 +1543,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); @@ -1581,7 +1561,7 @@ CompileDictEachCmd( * Set up the loop exception targets. */ - loopRange = DeclareExceptionRange(envPtr, LOOP_EXCEPTION_RANGE); + loopRange = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr); ExceptionRangeStarts(envPtr, loopRange); /* @@ -1629,6 +1609,7 @@ CompileDictEachCmd( */ ExceptionRangeTarget(envPtr, loopRange, breakOffset); + TclFinalizeLoopExceptionRange(envPtr, loopRange); TclEmitInstInt1( INST_UNSET_SCALAR, 0, envPtr); TclEmitInt4( infoIndex, envPtr); TclEmitOpcode( INST_END_CATCH, envPtr); @@ -1807,7 +1788,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); @@ -2164,7 +2145,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); @@ -2446,15 +2427,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. */ @@ -2480,6 +2452,7 @@ TclCompileForCmd( * Compile the loop body. */ + bodyRange = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr); bodyCodeOffset = ExceptionRangeStarts(envPtr, bodyRange); SetLineInformation(4); CompileBody(envPtr, bodyTokenPtr, interp); @@ -2488,9 +2461,12 @@ 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->currStackDepth = savedStackDepth; nextCodeOffset = ExceptionRangeStarts(envPtr, nextRange); SetLineInformation(3); @@ -2538,6 +2514,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. @@ -2829,7 +2807,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. @@ -2935,6 +2913,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 4f4286e..721f59a 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); @@ -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 @@ -2917,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 c56b67f..96f8683 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.c @@ -1514,7 +1514,7 @@ TclInitCompileEnv( envPtr->mallocedLiteralArray = 0; envPtr->exceptArrayPtr = envPtr->staticExceptArraySpace; - envPtr->exnStackDepthArrayPtr = envPtr->staticExnStackDepthArraySpace; + envPtr->exceptAuxArrayPtr = envPtr->staticExAuxArraySpace; envPtr->exceptArrayNext = 0; envPtr->exceptArrayEnd = COMPILEENV_INIT_EXCEPT_RANGES; envPtr->mallocedExceptArray = 0; @@ -1728,7 +1728,7 @@ TclFreeCompileEnv( } if (envPtr->mallocedExceptArray) { ckfree(envPtr->exceptArrayPtr); - ckfree(envPtr->exnStackDepthArrayPtr); + ckfree(envPtr->exceptAuxArrayPtr); } if (envPtr->mallocedCmdMap) { ckfree(envPtr->cmdMapPtr); @@ -3413,6 +3413,7 @@ TclCreateExceptRange( * new ExceptionRange structure. */ { register ExceptionRange *rangePtr; + register ExceptionAux *auxPtr; int index = envPtr->exceptArrayNext; if (index >= envPtr->exceptArrayEnd) { @@ -3424,16 +3425,16 @@ TclCreateExceptRange( size_t currBytes = envPtr->exceptArrayNext * sizeof(ExceptionRange); - size_t currBytes2 = envPtr->exceptArrayNext * sizeof(int); + size_t currBytes2 = envPtr->exceptArrayNext * sizeof(ExceptionAux); int newElems = 2*envPtr->exceptArrayEnd; size_t newBytes = newElems * sizeof(ExceptionRange); - size_t newBytes2 = newElems * sizeof(int); + size_t newBytes2 = newElems * sizeof(ExceptionAux); if (envPtr->mallocedExceptArray) { envPtr->exceptArrayPtr = ckrealloc(envPtr->exceptArrayPtr, newBytes); - envPtr->exnStackDepthArrayPtr = - ckrealloc(envPtr->exnStackDepthArrayPtr, newBytes2); + envPtr->exceptAuxArrayPtr = + ckrealloc(envPtr->exceptAuxArrayPtr, newBytes2); } else { /* * envPtr->exceptArrayPtr isn't a ckalloc'd pointer, so we must @@ -3441,12 +3442,12 @@ TclCreateExceptRange( */ ExceptionRange *newPtr = ckalloc(newBytes); - int *newPtr2 = ckalloc(newBytes2); + ExceptionAux *newPtr2 = ckalloc(newBytes2); memcpy(newPtr, envPtr->exceptArrayPtr, currBytes); - memcpy(newPtr2, envPtr->exnStackDepthArrayPtr, currBytes2); + memcpy(newPtr2, envPtr->exceptAuxArrayPtr, currBytes2); envPtr->exceptArrayPtr = newPtr; - envPtr->exnStackDepthArrayPtr = newPtr2; + envPtr->exceptAuxArrayPtr = newPtr2; envPtr->mallocedExceptArray = 1; } envPtr->exceptArrayEnd = newElems; @@ -3461,7 +3462,14 @@ TclCreateExceptRange( rangePtr->breakOffset = -1; rangePtr->continueOffset = -1; rangePtr->catchOffset = -1; - envPtr->exnStackDepthArrayPtr[index] = envPtr->currStackDepth; + auxPtr = &envPtr->exceptAuxArrayPtr[index]; + auxPtr->stackDepth = envPtr->currStackDepth; + auxPtr->numBreakTargets = 0; + auxPtr->breakTargets = NULL; + auxPtr->allocBreakTargets = 0; + auxPtr->numContinueTargets = 0; + auxPtr->continueTargets = NULL; + auxPtr->allocContinueTargets = 0; return index; } @@ -3482,7 +3490,7 @@ TclCreateExceptRange( ExceptionRange * TclGetInnermostExceptionRange( CompileEnv *envPtr, - int *stackDepthPtr) + ExceptionAux **auxPtrPtr) { int exnIdx = -1, i; @@ -3498,12 +3506,122 @@ TclGetInnermostExceptionRange( if (exnIdx == -1) { return NULL; } - if (stackDepthPtr) { - *stackDepthPtr = envPtr->exnStackDepthArrayPtr[exnIdx]; + if (auxPtrPtr) { + *auxPtrPtr = &envPtr->exceptAuxArrayPtr[exnIdx]; } return &envPtr->exceptArrayPtr[exnIdx]; } +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); +} + +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); +} + +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 ; inumBreakTargets ; i++) { + site = envPtr->codeStart + auxPtr->breakTargets[i]; + offset = rangePtr->breakOffset - auxPtr->breakTargets[i]; + TclUpdateInstInt4AtPc(INST_JUMP4, offset, site); + } + for (i=0 ; inumContinueTargets ; 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; + } +} + /* *---------------------------------------------------------------------- * @@ -3864,6 +3982,22 @@ TclFixupForwardJump( } } + for (k = 0 ; k < envPtr->exceptArrayNext ; k++) { + ExceptionAux *auxPtr = &envPtr->exceptAuxArrayPtr[k]; + int i; + + for (i=0 ; inumBreakTargets ; i++) { + if (jumpFixupPtr->codeOffset < auxPtr->breakTargets[i]) { + auxPtr->breakTargets[i] += 3; + } + } + for (i=0 ; inumContinueTargets ; 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 c9cbbd4..8430da3 100644 --- a/generic/tclCompile.h +++ b/generic/tclCompile.h @@ -100,6 +100,38 @@ 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 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 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,9 +307,11 @@ typedef struct CompileEnv { * entry. */ int mallocedExceptArray; /* 1 if ExceptionRange array was expanded and * exceptArrayPtr points in heap, else 0. */ - int *exnStackDepthArrayPtr; /* Array of stack depths to restore to when - * processing BREAK/CONTINUE exceptions. Must - * be the same size as the exceptArrayPtr. */ + 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 @@ -299,8 +333,8 @@ typedef struct CompileEnv { /* Initial storage of LiteralEntry array. */ ExceptionRange staticExceptArraySpace[COMPILEENV_INIT_EXCEPT_RANGES]; /* Initial ExceptionRange array storage. */ - int staticExnStackDepthArraySpace[COMPILEENV_INIT_EXCEPT_RANGES]; - /* Initial static except stack depth array + 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. */ @@ -995,7 +1029,13 @@ MODULE_SCOPE void TclInitCompileEnv(Tcl_Interp *interp, MODULE_SCOPE void TclInitJumpFixupArray(JumpFixupArray *fixupArrayPtr); MODULE_SCOPE void TclInitLiteralTable(LiteralTable *tablePtr); MODULE_SCOPE ExceptionRange *TclGetInnermostExceptionRange(CompileEnv *envPtr, - int *depthPtr); + 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); -- cgit v0.12 From 77f3ad2fcd5b1383a5a9e38441c20bbb4227fd03 Mon Sep 17 00:00:00 2001 From: dkf Date: Sun, 2 Jun 2013 18:54:09 +0000 Subject: Remove useless macro, use existing macro where it makes sense. --- generic/tclAssembly.c | 4 ++-- generic/tclCompile.h | 3 --- 2 files changed, 2 insertions(+), 5 deletions(-) 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/tclCompile.h b/generic/tclCompile.h index 8430da3..4b50710 100644 --- a/generic/tclCompile.h +++ b/generic/tclCompile.h @@ -1450,14 +1450,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 = \ -- cgit v0.12 From c72504b5e8f17039d8438be6e3f41d5b8e2928eb Mon Sep 17 00:00:00 2001 From: dkf Date: Sun, 2 Jun 2013 21:32:16 +0000 Subject: Fix a stack depth calculation. --- generic/tclCompCmdsSZ.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c index 721f59a..7831198 100644 --- a/generic/tclCompCmdsSZ.c +++ b/generic/tclCompCmdsSZ.c @@ -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); -- cgit v0.12 From ae411458670d6ca50c9516ed742f9b06855637a9 Mon Sep 17 00:00:00 2001 From: dkf Date: Mon, 3 Jun 2013 09:37:14 +0000 Subject: Generate [continue] optimally in [for] next clauses. Add tests for Bug 3614226. --- generic/tclCompCmds.c | 11 ++++---- generic/tclCompile.c | 35 +++++++++++++++++++++++- generic/tclCompile.h | 13 ++++++++- tests/for.test | 74 ++++++++++++++++++++++++++++++++++++++++++++++----- 4 files changed, 119 insertions(+), 14 deletions(-) diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c index f2d2963..3046841 100644 --- a/generic/tclCompCmds.c +++ b/generic/tclCompCmds.c @@ -491,7 +491,7 @@ TclCompileBreakCmd( * Find the innermost exception range that contains this command. */ - rangePtr = TclGetInnermostExceptionRange(envPtr, &auxPtr); + rangePtr = TclGetInnermostExceptionRange(envPtr, TCL_BREAK, &auxPtr); if (rangePtr && rangePtr->type == LOOP_EXCEPTION_RANGE) { int toPop = envPtr->currStackDepth - auxPtr->stackDepth; @@ -505,14 +505,13 @@ TclCompileBreakCmd( toPop--; } - if (envPtr->expandCount == 0) { + 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); - TclEmitInstInt4(INST_JUMP4, 0, envPtr); goto done; } } @@ -839,7 +838,7 @@ TclCompileContinueCmd( * innermost containing exception range. */ - rangePtr = TclGetInnermostExceptionRange(envPtr, &auxPtr); + rangePtr = TclGetInnermostExceptionRange(envPtr, TCL_CONTINUE, &auxPtr); if (rangePtr && rangePtr->type == LOOP_EXCEPTION_RANGE) { int toPop = envPtr->currStackDepth - auxPtr->stackDepth; @@ -853,14 +852,13 @@ TclCompileContinueCmd( toPop--; } - if (envPtr->expandCount == 0) { + 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); - TclEmitInstInt4(INST_JUMP4, 0, envPtr); goto done; } } @@ -2467,6 +2465,7 @@ TclCompileForCmd( */ nextRange = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr); + envPtr->exceptAuxArrayPtr[nextRange].supportsContinue = 0; envPtr->currStackDepth = savedStackDepth; nextCodeOffset = ExceptionRangeStarts(envPtr, nextRange); SetLineInformation(3); diff --git a/generic/tclCompile.c b/generic/tclCompile.c index 96f8683..f2e9329 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.c @@ -3463,7 +3463,9 @@ TclCreateExceptRange( 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; @@ -3490,6 +3492,7 @@ TclCreateExceptRange( ExceptionRange * TclGetInnermostExceptionRange( CompileEnv *envPtr, + int returnCode, ExceptionAux **auxPtrPtr) { int exnIdx = -1, i; @@ -3499,7 +3502,9 @@ TclGetInnermostExceptionRange( if (CurrentOffset(envPtr) >= rangePtr->codeOffset && (rangePtr->numCodeBytes == -1 || CurrentOffset(envPtr) < - rangePtr->codeOffset+rangePtr->numCodeBytes)) { + rangePtr->codeOffset+rangePtr->numCodeBytes) && + (returnCode != TCL_CONTINUE || + envPtr->exceptAuxArrayPtr[i].supportsContinue)) { exnIdx = i; } } @@ -3512,6 +3517,19 @@ TclGetInnermostExceptionRange( 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, @@ -3535,6 +3553,7 @@ TclAddLoopBreakFixup( } } auxPtr->breakTargets[auxPtr->numBreakTargets - 1] = CurrentOffset(envPtr); + TclEmitInstInt4(INST_JUMP4, 0, envPtr); } void @@ -3561,7 +3580,21 @@ TclAddLoopContinueFixup( } 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( diff --git a/generic/tclCompile.h b/generic/tclCompile.h index 4b50710..957c724 100644 --- a/generic/tclCompile.h +++ b/generic/tclCompile.h @@ -105,10 +105,21 @@ typedef struct ExceptionRange { */ 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. */ @@ -1029,7 +1040,7 @@ MODULE_SCOPE void TclInitCompileEnv(Tcl_Interp *interp, MODULE_SCOPE void TclInitJumpFixupArray(JumpFixupArray *fixupArrayPtr); MODULE_SCOPE void TclInitLiteralTable(LiteralTable *tablePtr); MODULE_SCOPE ExceptionRange *TclGetInnermostExceptionRange(CompileEnv *envPtr, - ExceptionAux **auxPtrPtr); + int returnCode, ExceptionAux **auxPtrPtr); MODULE_SCOPE void TclAddLoopBreakFixup(CompileEnv *envPtr, ExceptionAux *auxPtr); MODULE_SCOPE void TclAddLoopContinueFixup(CompileEnv *envPtr, 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: -- cgit v0.12