diff options
| -rw-r--r-- | generic/tclCompile.c | 462 |
1 files changed, 266 insertions, 196 deletions
diff --git a/generic/tclCompile.c b/generic/tclCompile.c index 388b8a0..1958d47 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.c @@ -1760,6 +1760,255 @@ ExpandRequested( return 0; } +static void +CompileInvocation( + Tcl_Interp *interp, + Tcl_Token *tokenPtr, + Tcl_Obj *cmdObj, + int numWords, + int wlineat, + CompileEnv *envPtr) +{ + int isnew, wordIdx = 0; + ExtCmdLoc *eclPtr = envPtr->extCmdMapPtr; + + if (cmdObj) { + int numBytes; + const char *bytes = Tcl_GetStringFromObj(cmdObj, &numBytes); + int cmdLitIdx = TclRegisterNewCmdLiteral(envPtr, bytes, numBytes); + Command *cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, cmdObj); + + if (cmdPtr) { + TclSetCmdNameObj(interp, TclFetchLiteral(envPtr, cmdLitIdx), + cmdPtr); + } + TclEmitPush(cmdLitIdx, envPtr); + + wordIdx = 1; + tokenPtr += tokenPtr->numComponents + 1; + } + + for (; wordIdx < numWords; + wordIdx++, tokenPtr += tokenPtr->numComponents + 1) { + int objIdx; + + envPtr->line = eclPtr->loc[wlineat].line[wordIdx]; + envPtr->clNext = eclPtr->loc[wlineat].next[wordIdx]; + + if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { + CompileTokens(envPtr, tokenPtr, interp); + continue; + } + + objIdx = TclRegisterNewLiteral(envPtr, + tokenPtr[1].start, tokenPtr[1].size); + if (envPtr->clNext) { + TclContinuationsEnterDerived(TclFetchLiteral(envPtr, objIdx), + tokenPtr[1].start - envPtr->source, + eclPtr->loc[wlineat].next[wordIdx]); + } + TclEmitPush(objIdx, envPtr); + } + + /* + * Save PC -> command map for the TclArgumentBC* functions. + */ + + Tcl_SetHashValue(Tcl_CreateHashEntry(&eclPtr->litInfo, + INT2PTR(envPtr->codeNext - envPtr->codeStart), &isnew), + INT2PTR(wlineat)); + + if (wordIdx <= 255) { + TclEmitInstInt1(INST_INVOKE_STK1, wordIdx, envPtr); + } else { + TclEmitInstInt4(INST_INVOKE_STK4, wordIdx, envPtr); + } +} + +static void +CompileExpanded( + Tcl_Interp *interp, + Tcl_Token *tokenPtr, + Tcl_Obj *cmdObj, + int numWords, + int wlineat, + CompileEnv *envPtr) +{ + int wordIdx = 0; + ExtCmdLoc *eclPtr = envPtr->extCmdMapPtr; + + StartExpanding(envPtr); + if (cmdObj) { + int numBytes; + const char *bytes = Tcl_GetStringFromObj(cmdObj, &numBytes); + int cmdLitIdx = TclRegisterNewCmdLiteral(envPtr, bytes, numBytes); + Command *cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, cmdObj); + + if (cmdPtr) { + TclSetCmdNameObj(interp, + TclFetchLiteral(envPtr, cmdLitIdx), cmdPtr); + } + TclEmitPush(cmdLitIdx, envPtr); + + wordIdx = 1; + tokenPtr += tokenPtr->numComponents + 1; + } + + for (; wordIdx < numWords; + wordIdx++, tokenPtr += tokenPtr->numComponents + 1) { + int objIdx; + + envPtr->line = eclPtr->loc[wlineat].line[wordIdx]; + envPtr->clNext = eclPtr->loc[wlineat].next[wordIdx]; + + if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { + CompileTokens(envPtr, tokenPtr, interp); + if (tokenPtr->type == TCL_TOKEN_EXPAND_WORD) { + TclEmitInstInt4(INST_EXPAND_STKTOP, + envPtr->currStackDepth, envPtr); + } + continue; + } + + objIdx = TclRegisterNewLiteral(envPtr, + tokenPtr[1].start, tokenPtr[1].size); + if (envPtr->clNext) { + TclContinuationsEnterDerived(TclFetchLiteral(envPtr, objIdx), + tokenPtr[1].start - envPtr->source, + eclPtr->loc[wlineat].next[wordIdx]); + } + TclEmitPush(objIdx, envPtr); + } + + /* + * 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). + * + * 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); +} + +static int +CompileCmdCompileProc( + Tcl_Interp *interp, + Tcl_Parse *parsePtr, + Command *cmdPtr, + int startCodeOffset, + CompileEnv *envPtr) +{ + ExtCmdLoc *eclPtr = envPtr->extCmdMapPtr; + int savedNumCmds = envPtr->numCommands; + int startStackDepth = envPtr->currStackDepth; + int wlineat = eclPtr->nuloc - 1; + int update = 0; + + /* + * Mark the start of the command; the proper bytecode + * length will be updated later. There is no need to + * do this for the first bytecode in the compile env, + * as the check is done before calling + * TclNRExecuteByteCode(). Do emit an INST_START_CMD + * in special cases where the first bytecode is in a + * loop, to insure that the corresponding command is + * counted properly. Compilers for commands able to + * produce such a beast (currently 'while 1' only) set + * envPtr->atCmdStart to 0 in order to signal this + * case. [Bug 1752146] + * + * Note that the environment is initialised with + * atCmdStart=1 to avoid emitting ISC for the first + * command. + */ + + if (envPtr->atCmdStart == 1) { + if (startCodeOffset) { + /* + * Increase the number of commands being + * started at the current point. Note that + * this depends on the exact layout of the + * INST_START_CMD's operands, so be careful! + */ + + TclIncrUInt4AtPtr(envPtr->codeNext - 4, 1) + } + } else if (envPtr->atCmdStart == 0) { + TclEmitInstInt4(INST_START_CMD, 0, envPtr); + TclEmitInt4(1, envPtr); + update = 1; + } + + if (TCL_OK == cmdPtr->compileProc(interp, parsePtr, cmdPtr, envPtr)) { + +#ifdef TCL_COMPILE_DEBUG + /* + * Confirm that the command compiler generated a + * single value on the stack as its result. This + * is only done in debugging mode, as it *should* + * be correct and normal users have no reasonable + * way to fix it anyway. + */ + + int diff = envPtr->currStackDepth - startStackDepth; + + if (diff != 1) { + Tcl_Panic("bad stack adjustment when compiling" + " %.*s (was %d instead of 1)", parsePtr->tokenPtr->size, + parsePtr->tokenPtr->start, diff); + } +#endif + if (update) { + /* + * Fix the bytecode length. + */ + + unsigned char *fixPtr = envPtr->codeStart + startCodeOffset + 1; + unsigned fixLen = envPtr->codeNext - fixPtr + 1; + + TclStoreInt4AtPtr(fixLen, fixPtr); + } + return TCL_OK; + } + + if (envPtr->atCmdStart == 1 && startCodeOffset != 0) { + /* + * Decrease the number of commands being started + * at the current point. Note that this depends on + * the exact layout of the INST_START_CMD's + * operands, so be careful! + */ + + TclIncrUInt4AtPtr(envPtr->codeNext - 4, -1); + } + + /* + * Restore numCommands, codeNext, and currStackDepth to their + * correct values, removing any commands compiled before the + * failure to produce bytecode got reported. + * [Bugs 705406, 735055, 3614102] + */ + + envPtr->numCommands = savedNumCmds; + envPtr->codeNext = envPtr->codeStart + startCodeOffset; + envPtr->currStackDepth = startStackDepth; + + envPtr->line = eclPtr->loc[wlineat].line[0]; + envPtr->clNext = eclPtr->loc[wlineat].next[0]; + return TCL_ERROR; +} + static int CompileCommandTokens( Tcl_Interp *interp, @@ -1771,14 +2020,15 @@ CompileCommandTokens( ExtCmdLoc *eclPtr = envPtr->extCmdMapPtr; Tcl_Obj *cmdObj = Tcl_NewObj(); Command *cmdPtr = NULL; - int wordIdx, cmdKnown, expand = -1, numWords = parsePtr->numWords; + int code = TCL_ERROR; + int cmdKnown, expand = -1; int *wlines, wlineat; int cmdLine = envPtr->line; int *clNext = envPtr->clNext; int cmdIdx = envPtr->numCommands; int startCodeOffset = envPtr->codeNext - envPtr->codeStart; - assert (numWords > 0); + assert (parsePtr->numWords > 0); /* Pre-Compile */ @@ -1830,210 +2080,30 @@ CompileCommandTokens( } } } - /* If cmdPtr != NULL, we will try to call cmdPtr->compileProc */ + /* If cmdPtr != NULL, we will try to call cmdPtr->compileProc */ if (cmdPtr) { - int savedNumCmds = envPtr->numCommands; - int update = 0; - int startStackDepth = envPtr->currStackDepth; - - /* - * Mark the start of the command; the proper bytecode - * length will be updated later. There is no need to - * do this for the first bytecode in the compile env, - * as the check is done before calling - * TclNRExecuteByteCode(). Do emit an INST_START_CMD - * in special cases where the first bytecode is in a - * loop, to insure that the corresponding command is - * counted properly. Compilers for commands able to - * produce such a beast (currently 'while 1' only) set - * envPtr->atCmdStart to 0 in order to signal this - * case. [Bug 1752146] - * - * Note that the environment is initialised with - * atCmdStart=1 to avoid emitting ISC for the first - * command. - */ - - if (envPtr->atCmdStart == 1) { - if (startCodeOffset) { - /* - * Increase the number of commands being - * started at the current point. Note that - * this depends on the exact layout of the - * INST_START_CMD's operands, so be careful! - */ - - TclIncrUInt4AtPtr(envPtr->codeNext - 4, 1) - } - } else if (envPtr->atCmdStart == 0) { - TclEmitInstInt4(INST_START_CMD, 0, envPtr); - TclEmitInt4(1, envPtr); - update = 1; - } - - if (TCL_OK == cmdPtr->compileProc(interp, parsePtr, cmdPtr, envPtr)) { - -#ifdef TCL_COMPILE_DEBUG - /* - * Confirm that the command compiler generated a - * single value on the stack as its result. This - * is only done in debugging mode, as it *should* - * be correct and normal users have no reasonable - * way to fix it anyway. - */ - - int diff = envPtr->currStackDepth - startStackDepth; - - if (diff != 1) { - Tcl_Panic("bad stack adjustment when compiling" - " %.*s (was %d instead of 1)", - parsePtr->tokenPtr->size, - parsePtr->tokenPtr->start, diff); - } -#endif - if (update) { - /* - * Fix the bytecode length. - */ - - unsigned char *fixPtr = envPtr->codeStart + startCodeOffset + 1; - unsigned fixLen = envPtr->codeNext - fixPtr + 1; - - TclStoreInt4AtPtr(fixLen, fixPtr); - } - goto finishCommand; - } - - if (envPtr->atCmdStart == 1 && startCodeOffset != 0) { - /* - * Decrease the number of commands being started - * at the current point. Note that this depends on - * the exact layout of the INST_START_CMD's - * operands, so be careful! - */ - - TclIncrUInt4AtPtr(envPtr->codeNext - 4, -1); - } - - /* - * Restore numCommands, codeNext, and currStackDepth to their - * correct values, removing any commands compiled before the - * failure to produce bytecode got reported. - * [Bugs 705406, 735055, 3614102] - */ - - envPtr->numCommands = savedNumCmds; - envPtr->codeNext = envPtr->codeStart + startCodeOffset; - envPtr->currStackDepth = startStackDepth; - - envPtr->line = eclPtr->loc[wlineat].line[0]; - envPtr->clNext = eclPtr->loc[wlineat].next[0]; - } - - if (expand < 0) { - expand = ExpandRequested(parsePtr->tokenPtr, parsePtr->numWords); - } - - if (expand) { - StartExpanding(envPtr); - } - - /* - * No complile attempted, or it failed. - * Need to emit instructions to invoke, with expansion if needed. - */ - - wordIdx = 0; - tokenPtr = parsePtr->tokenPtr; - if (cmdKnown) { - int cmdLitIdx, numBytes; - const char *bytes = Tcl_GetStringFromObj(cmdObj, &numBytes); - - cmdLitIdx = TclRegisterNewCmdLiteral(envPtr, bytes, numBytes); - cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, cmdObj); - if (cmdPtr) { - TclSetCmdNameObj(interp, - TclFetchLiteral(envPtr, cmdLitIdx), cmdPtr); - } - TclEmitPush(cmdLitIdx, envPtr); - - wordIdx = 1; - tokenPtr += tokenPtr->numComponents + 1; + code = CompileCmdCompileProc(interp, parsePtr, cmdPtr, + startCodeOffset, envPtr); } - for (; wordIdx < numWords; - wordIdx++, tokenPtr += tokenPtr->numComponents + 1) { - int objIdx; - - envPtr->line = eclPtr->loc[wlineat].line[wordIdx]; - envPtr->clNext = eclPtr->loc[wlineat].next[wordIdx]; - - if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { - CompileTokens(envPtr, tokenPtr, interp); - if (tokenPtr->type == TCL_TOKEN_EXPAND_WORD) { - TclEmitInstInt4(INST_EXPAND_STKTOP, - envPtr->currStackDepth, envPtr); - } - continue; - } - - objIdx = TclRegisterNewLiteral(envPtr, - tokenPtr[1].start, tokenPtr[1].size); - if (envPtr->clNext) { - TclContinuationsEnterDerived(TclFetchLiteral(envPtr, objIdx), - tokenPtr[1].start - envPtr->source, - eclPtr->loc[wlineat].next[wordIdx]); + if (code == TCL_ERROR) { + if (expand < 0) { + expand = ExpandRequested(parsePtr->tokenPtr, parsePtr->numWords); } - TclEmitPush(objIdx, envPtr); - } - - /* - * Emit an invoke instruction for the command. We skip this if a - * compile procedure was found for the command. - */ - if (expand) { - /* - * 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). - * - * 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); - } else { - /* - * Save PC -> command map for the TclArgumentBC* functions. - */ - - int isnew; - Tcl_HashEntry *hePtr = Tcl_CreateHashEntry(&eclPtr->litInfo, - INT2PTR(envPtr->codeNext - envPtr->codeStart), &isnew); - - Tcl_SetHashValue(hePtr, INT2PTR(wlineat)); - if (wordIdx <= 255) { - TclEmitInstInt1(INST_INVOKE_STK1, wordIdx, envPtr); + if (expand) { + CompileExpanded(interp, parsePtr->tokenPtr, + cmdKnown ? cmdObj : NULL, parsePtr->numWords, wlineat, + envPtr); } else { - TclEmitInstInt4(INST_INVOKE_STK4, wordIdx, envPtr); + CompileInvocation(interp, parsePtr->tokenPtr, + cmdKnown ? cmdObj : NULL, parsePtr->numWords, wlineat, + envPtr); } } -finishCommand: - if (cmdKnown) { - Tcl_DecrRefCount(cmdObj); - } + Tcl_DecrRefCount(cmdObj); TclEmitOpcode(INST_POP, envPtr); EnterCmdExtentData(envPtr, cmdIdx, |