diff options
Diffstat (limited to 'generic/tclCompile.c')
-rw-r--r-- | generic/tclCompile.c | 424 |
1 files changed, 424 insertions, 0 deletions
diff --git a/generic/tclCompile.c b/generic/tclCompile.c index 633966e..5aab69c 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.c @@ -16,6 +16,8 @@ #include "tclCompile.h" #include <assert.h> +#define REWRITE + /* * Table of all AuxData types. */ @@ -562,8 +564,10 @@ static void EnterCmdExtentData(CompileEnv *envPtr, int cmdNumber, int numSrcBytes, int numCodeBytes); static void EnterCmdStartData(CompileEnv *envPtr, int cmdNumber, int srcOffset, int codeOffset); +#ifndef REWRITE static Command * FindCompiledCommandFromToken(Tcl_Interp *interp, Tcl_Token *tokenPtr); +#endif static void FreeByteCodeInternalRep(Tcl_Obj *objPtr); static void FreeSubstCodeInternalRep(Tcl_Obj *objPtr); static int GetCmdLocEncodingSize(CompileEnv *envPtr); @@ -1671,6 +1675,7 @@ TclWordKnownAtCompileTime( return 1; } +#ifndef REWRITE /* * --------------------------------------------------------------------- * @@ -1718,6 +1723,7 @@ FindCompiledCommandFromToken( Tcl_DStringFree(&ds); return cmdPtr; } +#endif /* *---------------------------------------------------------------------- @@ -1737,6 +1743,307 @@ FindCompiledCommandFromToken( *---------------------------------------------------------------------- */ +#ifdef REWRITE +static int +CompileCommandTokens( + Tcl_Interp *interp, + Tcl_Parse *parsePtr, + CompileEnv *envPtr) +{ + Interp *iPtr = (Interp *) interp; + Tcl_Token *tokenPtr = parsePtr->tokenPtr; + ExtCmdLoc *eclPtr = envPtr->extCmdMapPtr; + Tcl_Obj *cmdObj = Tcl_NewObj(); + Command *cmdPtr = NULL; + int wordIdx, cmdKnown, expand = 0, numWords = parsePtr->numWords; + int *wlines, wlineat; + int cmdLine = envPtr->line; + int *clNext = envPtr->clNext; + int cmdIdx = envPtr->numCommands; + int startCodeOffset = envPtr->codeNext - envPtr->codeStart; + + assert (numWords > 0); + + /* Determine whether any words of the command require expansion */ + for (wordIdx = 0; wordIdx < numWords; + wordIdx++, tokenPtr += tokenPtr->numComponents + 1) { + if (tokenPtr->type == TCL_TOKEN_EXPAND_WORD) { + expand = 1; + break; + } + } + + /* Do we know the command word? */ + Tcl_IncrRefCount(cmdObj); + tokenPtr = parsePtr->tokenPtr; + cmdKnown = TclWordKnownAtCompileTime(tokenPtr, cmdObj); + + /* Is this a command we should (try to) compile with a compileProc ? */ + if (cmdKnown && !(iPtr->flags & DONT_COMPILE_CMDS_INLINE)) { + cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, cmdObj); + if (cmdPtr) { + /* + * Found a command. Test all the ways we can be told + * not to attempt to compile it. + */ + if ((cmdPtr->compileProc == NULL) + || (cmdPtr->nsPtr->flags & NS_SUPPRESS_COMPILATION) + || (cmdPtr->flags & CMD_HAS_EXEC_TRACES) + || (expand && !(cmdPtr->flags & CMD_COMPILES_EXPANDED))) { + cmdPtr = NULL; + } + } + } + /* If cmdPtr != NULL, we will try to call cmdPtr->compileProc */ + + /* Pre-Compile */ + + envPtr->numCommands++; + EnterCmdStartData(envPtr, cmdIdx, + parsePtr->commandStart - envPtr->source, startCodeOffset); + + if (expand && !cmdPtr) { + StartExpanding(envPtr); + } + + /* + * 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, + parsePtr->tokenPtr, parsePtr->commandStart, + parsePtr->commandSize, parsePtr->numWords, cmdLine, + clNext, &wlines, envPtr); + wlineat = eclPtr->nuloc - 1; + + envPtr->line = eclPtr->loc[wlineat].line[0]; + envPtr->clNext = eclPtr->loc[wlineat].next[0]; + + 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]; + + /* TODO: Can this happen? If so, is this right? */ + 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; + } + + 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); + } + + /* + * 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); + } else { + TclEmitInstInt4(INST_INVOKE_STK4, wordIdx, envPtr); + } + } + +finishCommand: + TclEmitOpcode(INST_POP, envPtr); + EnterCmdExtentData(envPtr, cmdIdx, + parsePtr->term - parsePtr->commandStart, + (envPtr->codeNext-envPtr->codeStart) - startCodeOffset); + + if (cmdKnown) { + Tcl_DecrRefCount(cmdObj); + } + + /* + * TIP #280: Free full form of per-word line data and insert the + * reduced form now + */ + + envPtr->line = cmdLine; + envPtr->clNext = clNext; + ckfree(eclPtr->loc[wlineat].line); + ckfree(eclPtr->loc[wlineat].next); + eclPtr->loc[wlineat].line = wlines; + eclPtr->loc[wlineat].next = NULL; + + return cmdIdx; +} +#endif + void TclCompileScript( Tcl_Interp *interp, /* Used for error and status reporting. Also @@ -1748,6 +2055,122 @@ TclCompileScript( * first null character. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { +#ifdef REWRITE + int lastCmdIdx = -1; /* Index into envPtr->cmdMapPtr of the last + * command this routine compiles into bytecode. + * Initial value of -1 indicates this routine + * has not yet generated any bytecode. */ + const char *p = script; /* Where we are in our compile. */ + + if (envPtr->iPtr == NULL) { + Tcl_Panic("TclCompileScript() called on uninitialized CompileEnv"); + } + + /* Each iteration compiles one command from the script. */ + + while (numBytes > 0) { + Tcl_Parse parse; + const char *next; + + if (TCL_OK != Tcl_ParseCommand(interp, p, numBytes, 0, &parse)) { + /* + * Compile bytecodes to report the parse error at runtime. + */ + + Tcl_LogCommandInfo(interp, script, parse.commandStart, + parse.term + 1 - parse.commandStart); + TclCompileSyntaxError(interp, envPtr); + Tcl_FreeParse(&parse); + return; + } + +#ifdef TCL_COMPILE_DEBUG + /* + * If tracing, print a line for each top level command compiled. + */ + + if ((tclTraceCompile >= 1) && (envPtr->procPtr == NULL)) { + int commandLength = parse.term - parse.commandStart; + fprintf(stdout, " Compiling: "); + TclPrintSource(stdout, parse.commandStart, + TclMin(commandLength, 55)); + fprintf(stdout, "\n"); + } +#endif + + /* + * TIP #280: Count newlines before the command start. + * (See test info-30.33). + */ + + TclAdvanceLines(&envPtr->line, p, parse.commandStart); + TclAdvanceContinuations(&envPtr->line, &envPtr->clNext, + parse.commandStart - envPtr->source); + + /* + * Advance parser to the next command in the script. + */ + + next = parse.commandStart + parse.commandSize; + numBytes -= next - p; + p = next; + + 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 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. + */ + continue; + } + + lastCmdIdx = CompileCommandTokens(interp, &parse, envPtr); + + /* + * TIP #280: Track lines in the just compiled command. + */ + + TclAdvanceLines(&envPtr->line, parse.commandStart, p); + TclAdvanceContinuations(&envPtr->line, &envPtr->clNext, + p - envPtr->source); + Tcl_FreeParse(&parse); + } + + 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. + */ + 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. + */ + envPtr->cmdMapPtr[lastCmdIdx].numCodeBytes--; + envPtr->codeNext--; + envPtr->currStackDepth++; + } +#else int lastTopLevelCmdIndex = -1; /* Index of most recent toplevel command in * the command location table. Initialized to @@ -2192,6 +2615,7 @@ TclCompileScript( if (envPtr->codeNext == entryCodeNext) { PushStringLiteral(envPtr, ""); } +#endif } /* |