diff options
Diffstat (limited to 'generic/tclCompile.c')
| -rw-r--r-- | generic/tclCompile.c | 325 |
1 files changed, 251 insertions, 74 deletions
diff --git a/generic/tclCompile.c b/generic/tclCompile.c index d15ef3a..3c8e4ef 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); } } @@ -1755,7 +1755,6 @@ CompileExpanded( int wordIdx = 0; DefineLineInformation; - StartExpanding(envPtr); if (cmdObj) { CompileCmdLiteral(interp, cmdObj, envPtr); @@ -1787,24 +1786,20 @@ 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. */ - TclEmitOpcode(INST_INVOKE_EXPANDED, envPtr); - envPtr->expandCount--; - TclAdjustStackDepth(1 - wordIdx, envPtr); + TclEmitInvoke(envPtr, INST_INVOKE_EXPANDED, wordIdx); } static int @@ -1818,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. @@ -1850,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; @@ -1868,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); @@ -1878,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; } @@ -1914,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, @@ -1940,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) @@ -1985,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; @@ -2071,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; } @@ -2103,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++; @@ -2458,7 +2455,7 @@ TclCompileCmdWord( */ TclCompileTokens(interp, tokenPtr, count, envPtr); - TclEmitOpcode(INST_EVAL_STK, envPtr); + TclEmitInvoke(envPtr, INST_EVAL_STK); } } @@ -3355,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. * * --------------------------------------------------------------------- */ @@ -3371,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; } @@ -3904,6 +3894,193 @@ TclFixupForwardJump( /* *---------------------------------------------------------------------- * + * 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, + int opcode, + ...) +{ + va_list argList; + ExceptionRange *rangePtr; + ExceptionAux *auxBreakPtr, *auxContinuePtr; + int arg1, arg2, wordCount = 0, expandCount = 0; + int loopRange = 0, breakRange = 0, continueRange = 0; + + /* + * 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_EVAL_STK: + wordCount = 1; + arg1 = arg2 = 0; + break; + case INST_RETURN_STK: + wordCount = 2; + arg1 = arg2 = 0; + break; + case INST_INVOKE_EXPANDED: + wordCount = arg1 = va_arg(argList, int); + arg2 = 0; + expandCount = 1; + 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). + * + * These must be done separately; they can be different (especially for + * calls from inside a [for] increment clause). + */ + + 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-expandCount) { + auxBreakPtr = NULL; + } else { + breakRange = auxBreakPtr - envPtr->exceptAuxArrayPtr; + } + + 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-expandCount) { + auxContinuePtr = NULL; + } else { + continueRange = auxBreakPtr - envPtr->exceptAuxArrayPtr; + } + + if (auxBreakPtr != NULL || auxContinuePtr != NULL) { + loopRange = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr); + ExceptionRangeStarts(envPtr, loopRange); + } + + /* + * 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); + 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); + 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; + + if (auxBreakPtr != NULL) { + auxBreakPtr = envPtr->exceptAuxArrayPtr + breakRange; + } + if (auxContinuePtr != NULL) { + auxContinuePtr = envPtr->exceptAuxArrayPtr + continueRange; + } + + ExceptionRangeEnds(envPtr, loopRange); + TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &nonTrapFixup); + + /* + * 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); + + ExceptionRangeTarget(envPtr, loopRange, breakOffset); + TclCleanupStackForBreakContinue(envPtr, auxBreakPtr); + TclAddLoopBreakFixup(envPtr, auxBreakPtr); + + envPtr->currStackDepth = savedStackDepth; + envPtr->expandCount = savedExpandCount; + } + + if (auxContinuePtr != NULL) { + TclAdjustStackDepth(-1, envPtr); + + ExceptionRangeTarget(envPtr, loopRange, continueOffset); + TclCleanupStackForBreakContinue(envPtr, auxContinuePtr); + TclAddLoopContinueFixup(envPtr, auxContinuePtr); + + envPtr->currStackDepth = savedStackDepth; + envPtr->expandCount = savedExpandCount; + } + + TclFinalizeLoopExceptionRange(envPtr, loopRange); + TclFixupForwardJumpToHere(envPtr, &nonTrapFixup, 127); + } +} + +/* + *---------------------------------------------------------------------- + * * TclGetInstructionTable -- * * Returns a pointer to the table describing Tcl bytecode instructions. |