From dc4782f5951c5d881c932ff0a4c194ca89193702 Mon Sep 17 00:00:00 2001 From: dgp Date: Tue, 25 Jun 2013 14:19:39 +0000 Subject: Branch for rewriting TclCompileScript() and related routines, with the intent to generally simplify and make more readable, as well as find and eliminate duplication with ensemble machinery and improve mergeability to other branches. Work in Progress. Doesn't work at all right now. --- generic/tclCompile.c | 124 +++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 124 insertions(+) diff --git a/generic/tclCompile.c b/generic/tclCompile.c index 8cb53f5..eafecbc 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.c @@ -1737,6 +1737,37 @@ FindCompiledCommandFromToken( *---------------------------------------------------------------------- */ +#if 1 +static void +CompileCommandTokens( + Tcl_Interp *interp, + Tcl_Parse *parsePtr, + CompileEnv *envPtr) +{ + Tcl_Obj *cmdObj; + Tcl_Token *cmdTokenPtr = parsePtr->tokenPtr; + + + if (parsePtr->numWords == 0) { + return 0; + } + + if (!TclWordKnownAtCompileTime(cmdTokenPtr, cmdObj)) { + /* + * Command is not known until runtime substitution is complete. + * Emit instructions to perform that substitution. + */ + CompileTokens(interp, cmdTokenPtr, envPtr); + + } + + + + TclEmitOpcode(INST_POP, envPtr); + +} +#endif + void TclCompileScript( Tcl_Interp *interp, /* Used for error and status reporting. Also @@ -1748,6 +1779,98 @@ TclCompileScript( * first null character. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { +#if 1 + unsigned char *entryCodeNext = envPtr->codeNext; + const char *p; + int cmdLine, *clNext; + + if (envPtr->iPtr == NULL) { + Tcl_Panic("TclCompileScript() called on uninitialized CompileEnv"); + } + + /* + * Each iteration through the following loop compiles the next command + * from the script. + */ + + p = script; + cmdLine = envPtr->line; + clNext = envPtr->clNext; + while (numBytes > 0) { + Tcl_Parse parse; + const char *next; + + /* TODO: can we relocate this to happen less frequently? */ + Tcl_ResetResult(interp); + 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 - parse.commandStart); + TclCompileSyntaxError(interp, envPtr); + break; + } + + /* + * TIP #280: Count newlines before the command start. + * (See test info-30.33). + */ + + TclAdvanceLines(&cmdLine, p, parse.commandStart); + TclAdvanceContinuations(&cmdLine, &clNext, + parse.commandStart - envPtr->source); + +#ifdef TCL_COMPILE_DEBUG + /* + * If tracing, print a line for each top level command compiled. + */ + + if ((tclTraceCompile >= 1) && (envPtr->procPtr == NULL)) { + fprintf(stdout, " Compiling: "); + TclPrintSource(stdout, parse.commandStart, + TclMin(parse.term - parse.commandStart, 55)); + fprintf(stdout, "\n"); + } +#endif + + CompileCommandTokens(interp, &parse, envPtr); + + /* + * Advance to the next command in the script. + */ + + next = parse.commandStart + parse.commandSize; + numBytes -= next - p; + p = next; + + /* + * TIP #280: Track lines in the just compiled command. + */ + + TclAdvanceLines(&cmdLine, parsePtr->commandStart, p); + TclAdvanceContinuations(&cmdLine, &clNext, p - envPtr->source); + Tcl_FreeParse(&parse); + } + + /* + * TIP #280: Bring the line counts in the CompEnv up to date. + * See tests info-30.33,34,35 . + */ + + envPtr->line = cmdLine; + envPtr->clNext = clNext; + + /* + * If the source script yielded no instructions (e.g., if it was empty), + * push an empty string as the command's result. + */ + + if (envPtr->codeNext == entryCodeNext) { + PushStringLiteral(envPtr, ""); + } +#else int lastTopLevelCmdIndex = -1; /* Index of most recent toplevel command in * the command location table. Initialized to @@ -2192,6 +2315,7 @@ TclCompileScript( if (envPtr->codeNext == entryCodeNext) { PushStringLiteral(envPtr, ""); } +#endif } /* -- cgit v0.12 From 11f1a88c1296f43cc886843ce15a820243ff2c12 Mon Sep 17 00:00:00 2001 From: dgp Date: Tue, 25 Jun 2013 20:22:31 +0000 Subject: Nearly functional now, but leaky and not yet as tidy as I'm hoping for. --- generic/tclCompile.c | 301 +++++++++++++++++++++++++++++++++++++++++++++++++-- 1 file changed, 289 insertions(+), 12 deletions(-) diff --git a/generic/tclCompile.c b/generic/tclCompile.c index 01320cf..2c6af46 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.c @@ -1744,27 +1744,295 @@ CompileCommandTokens( Tcl_Parse *parsePtr, CompileEnv *envPtr) { - Tcl_Obj *cmdObj; - Tcl_Token *cmdTokenPtr = parsePtr->tokenPtr; - + Interp *iPtr = (Interp *) interp; + Tcl_Obj *cmdObj = Tcl_NewObj(); + Tcl_Token *tokenPtr = parsePtr->tokenPtr; + Command *cmdPtr = NULL; + int wordIdx, cmdKnown, expand = 0, numWords = parsePtr->numWords; + ExtCmdLoc *eclPtr = envPtr->extCmdMapPtr; + int *wlines, wlineat; - if (parsePtr->numWords == 0) { - return 0; + if (numWords == 0) { + return; + } + + for (wordIdx = 0; wordIdx < numWords; + wordIdx++, tokenPtr += tokenPtr->numComponents + 1) { + if (tokenPtr->type == TCL_TOKEN_EXPAND_WORD) { + expand = 1; + break; + } } - if (!TclWordKnownAtCompileTime(cmdTokenPtr, cmdObj)) { + Tcl_IncrRefCount(cmdObj); + tokenPtr = parsePtr->tokenPtr; + cmdKnown = TclWordKnownAtCompileTime(tokenPtr, cmdObj); + + 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; + } + } + } + + /* Pre-Compile */ +int lastTopLevelCmdIndex, currCmdIndex, startCodeOffset; + +int cmdLine = envPtr->line; +int *clNext = envPtr->clNext; + + lastTopLevelCmdIndex = currCmdIndex = envPtr->numCommands; + envPtr->numCommands++; + startCodeOffset = envPtr->codeNext - envPtr->codeStart; + EnterCmdStartData(envPtr, currCmdIndex, + 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); + } + /* - * Command is not known until runtime substitution is complete. - * Emit instructions to perform that substitution. + * 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] */ - CompileTokens(interp, cmdTokenPtr, envPtr); + 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, currCmdIndex, + 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; } #endif @@ -1828,14 +2096,19 @@ TclCompileScript( */ if ((tclTraceCompile >= 1) && (envPtr->procPtr == NULL)) { + int commandLength = parse.term - parse.commandStart; fprintf(stdout, " Compiling: "); TclPrintSource(stdout, parse.commandStart, - TclMin(parse.term - parse.commandStart, 55)); + TclMin(commandLength, 55)); fprintf(stdout, "\n"); } #endif + envPtr->line = cmdLine; + envPtr->clNext = clNext; CompileCommandTokens(interp, &parse, envPtr); + cmdLine = envPtr->line; + clNext = envPtr->clNext; /* * Advance to the next command in the script. @@ -1849,7 +2122,7 @@ TclCompileScript( * TIP #280: Track lines in the just compiled command. */ - TclAdvanceLines(&cmdLine, parsePtr->commandStart, p); + TclAdvanceLines(&cmdLine, parse.commandStart, p); TclAdvanceContinuations(&cmdLine, &clNext, p - envPtr->source); Tcl_FreeParse(&parse); } @@ -1869,6 +2142,10 @@ TclCompileScript( if (envPtr->codeNext == entryCodeNext) { PushStringLiteral(envPtr, ""); + } else { + /* Remove the surplus INST_POP */ + envPtr->codeNext--; + TclAdjustStackDepth(1, envPtr); } #else int lastTopLevelCmdIndex = -1; -- cgit v0.12 From 5eecd400b721e762d5bb10f1582cf43b278f34b1 Mon Sep 17 00:00:00 2001 From: dgp Date: Wed, 26 Jun 2013 03:46:54 +0000 Subject: A few bug fixes from failing tests; still leaky. --- generic/tclCompile.c | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/generic/tclCompile.c b/generic/tclCompile.c index 955078c..626c5ae 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.c @@ -2076,7 +2076,10 @@ TclCompileScript( */ Tcl_LogCommandInfo(interp, script, parse.commandStart, - parse.term - parse.commandStart); + /* Drop the command terminator (";","]") if appropriate */ + (parse.term == + parse.commandStart + parse.commandSize - 1)? + parse.commandSize - 1 : parse.commandSize); TclCompileSyntaxError(interp, envPtr); break; } @@ -2142,7 +2145,7 @@ TclCompileScript( if (envPtr->codeNext == entryCodeNext) { PushStringLiteral(envPtr, ""); - } else { + } else if (envPtr->codeNext[-1] == INST_POP) { /* Remove the surplus INST_POP */ envPtr->codeNext--; TclAdjustStackDepth(1, envPtr); -- cgit v0.12 From ae7b32a706d7f69fc2e4ce06f546a99325f9716f Mon Sep 17 00:00:00 2001 From: dgp Date: Wed, 26 Jun 2013 16:06:44 +0000 Subject: Fix bytecode ranges in the cmdMapPtr. still leaky. --- generic/tclCompile.c | 13 +++++++++---- 1 file changed, 9 insertions(+), 4 deletions(-) diff --git a/generic/tclCompile.c b/generic/tclCompile.c index 626c5ae..62943b2 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.c @@ -1742,7 +1742,8 @@ static void CompileCommandTokens( Tcl_Interp *interp, Tcl_Parse *parsePtr, - CompileEnv *envPtr) + CompileEnv *envPtr, + int *lastPopPtr) { Interp *iPtr = (Interp *) interp; Tcl_Obj *cmdObj = Tcl_NewObj(); @@ -2017,6 +2018,8 @@ finishCommand: EnterCmdExtentData(envPtr, currCmdIndex, parsePtr->term - parsePtr->commandStart, (envPtr->codeNext-envPtr->codeStart) - startCodeOffset); + *lastPopPtr = currCmdIndex; + if (cmdKnown) { Tcl_DecrRefCount(cmdObj); @@ -2051,6 +2054,7 @@ TclCompileScript( unsigned char *entryCodeNext = envPtr->codeNext; const char *p; int cmdLine, *clNext; + int lastPop = -1; if (envPtr->iPtr == NULL) { Tcl_Panic("TclCompileScript() called on uninitialized CompileEnv"); @@ -2081,6 +2085,7 @@ TclCompileScript( parse.commandStart + parse.commandSize - 1)? parse.commandSize - 1 : parse.commandSize); TclCompileSyntaxError(interp, envPtr); + lastPop = -1; break; } @@ -2109,7 +2114,7 @@ TclCompileScript( envPtr->line = cmdLine; envPtr->clNext = clNext; - CompileCommandTokens(interp, &parse, envPtr); + CompileCommandTokens(interp, &parse, envPtr, &lastPop); cmdLine = envPtr->line; clNext = envPtr->clNext; @@ -2145,8 +2150,8 @@ TclCompileScript( if (envPtr->codeNext == entryCodeNext) { PushStringLiteral(envPtr, ""); - } else if (envPtr->codeNext[-1] == INST_POP) { - /* Remove the surplus INST_POP */ + } else if (lastPop >= 0) { + envPtr->cmdMapPtr[lastPop].numCodeBytes--; envPtr->codeNext--; TclAdjustStackDepth(1, envPtr); } -- cgit v0.12 From 7070acfea16b0c6906cd488877c1bb74afca5275 Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 27 Jun 2013 13:11:53 +0000 Subject: plug memory leaks --- generic/tclCompile.c | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/generic/tclCompile.c b/generic/tclCompile.c index 62943b2..416078c 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.c @@ -1746,7 +1746,7 @@ CompileCommandTokens( int *lastPopPtr) { Interp *iPtr = (Interp *) interp; - Tcl_Obj *cmdObj = Tcl_NewObj(); + Tcl_Obj *cmdObj; Tcl_Token *tokenPtr = parsePtr->tokenPtr; Command *cmdPtr = NULL; int wordIdx, cmdKnown, expand = 0, numWords = parsePtr->numWords; @@ -1765,6 +1765,7 @@ CompileCommandTokens( } } + cmdObj = Tcl_NewObj(); Tcl_IncrRefCount(cmdObj); tokenPtr = parsePtr->tokenPtr; cmdKnown = TclWordKnownAtCompileTime(tokenPtr, cmdObj); @@ -2085,6 +2086,7 @@ TclCompileScript( parse.commandStart + parse.commandSize - 1)? parse.commandSize - 1 : parse.commandSize); TclCompileSyntaxError(interp, envPtr); + Tcl_FreeParse(&parse); lastPop = -1; break; } -- cgit v0.12 From a47b03577bd612657a8cc1c7844231c00bc6d313 Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 27 Jun 2013 20:10:41 +0000 Subject: Stop the compileProc routines leaving behind error messages in interp. (Nicer way to solve [Bug 20a81392ec].) Make simplifications in TclCompileScript() make possible by the new structure. Still a work in progress. --- generic/tclAssembly.c | 32 +++++++++++++- generic/tclCompCmds.c | 5 ++- generic/tclCompCmdsGR.c | 1 + generic/tclCompile.c | 109 ++++++++++++++++++++++-------------------------- 4 files changed, 83 insertions(+), 64 deletions(-) diff --git a/generic/tclAssembly.c b/generic/tclAssembly.c index 62641e6..1a061f0 100644 --- a/generic/tclAssembly.c +++ b/generic/tclAssembly.c @@ -930,6 +930,12 @@ TclCompileAssembleCmd( { Tcl_Token *tokenPtr; /* Token in the input script */ +#if 0 + int numCommands = envPtr->numCommands; + int offset = envPtr->codeNext - envPtr->codeStart; + int depth = envPtr->currStackDepth; +#endif + /* * Make sure that the command has a single arg that is a simple word. */ @@ -943,10 +949,32 @@ TclCompileAssembleCmd( } /* - * Compile the code and return any error from the compilation. + * Compile the code and convert any error from the compilation into + * bytecode reporting the error; */ - return TclAssembleCode(envPtr, tokenPtr[1].start, tokenPtr[1].size, 0); + if (TCL_ERROR == TclAssembleCode(envPtr, tokenPtr[1].start, + tokenPtr[1].size, TCL_EVAL_DIRECT)) { + + /* + * TODO: Finish working out how to capture syntax errors captured + * during compile and make them bytecode reporting the error. + */ +#if 0 + Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( + "\n (\"%.*s\" body, line %d)", + parsePtr->tokenPtr->size, parsePtr->tokenPtr->start, + Tcl_GetErrorLine(interp))); + envPtr->numCommands = numCommands; + envPtr->codeNext = envPtr->codeStart + offset; + envPtr->currStackDepth = depth; + TclCompileSyntaxError(interp, envPtr); +#else + Tcl_ResetResult(interp); + return TCL_ERROR; +#endif + } + return TCL_OK; } /* diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c index fddf152..18295eb 100644 --- a/generic/tclCompCmds.c +++ b/generic/tclCompCmds.c @@ -2544,7 +2544,7 @@ CompileEachloopCmd( Tcl_DStringInit(&varList); TclDStringAppendToken(&varList, &tokenPtr[1]); - code = Tcl_SplitList(interp, Tcl_DStringValue(&varList), + code = Tcl_SplitList(NULL, Tcl_DStringValue(&varList), &varcList[loopIndex], &varvList[loopIndex]); Tcl_DStringFree(&varList); if (code != TCL_OK) { @@ -2988,7 +2988,8 @@ TclCompileFormatCmd( ckfree(objv); Tcl_DecrRefCount(formatObj); if (tmpObj == NULL) { - return TCL_ERROR; + TclCompileSyntaxError(interp, envPtr); + return TCL_OK; } /* diff --git a/generic/tclCompCmdsGR.c b/generic/tclCompCmdsGR.c index f7c15e6..4de8cf2 100644 --- a/generic/tclCompCmdsGR.c +++ b/generic/tclCompCmdsGR.c @@ -2534,6 +2534,7 @@ TclCompileSyntaxError( TclEmitPush(TclRegisterNewLiteral(envPtr, bytes, numBytes), envPtr); CompileReturnInternal(envPtr, INST_SYNTAX, TCL_ERROR, 0, TclNoErrorStack(interp, Tcl_GetReturnOptions(interp, TCL_ERROR))); + Tcl_ResetResult(interp); } /* diff --git a/generic/tclCompile.c b/generic/tclCompile.c index 416078c..5a8524c 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.c @@ -1738,24 +1738,25 @@ FindCompiledCommandFromToken( */ #if 1 -static void +static int CompileCommandTokens( Tcl_Interp *interp, Tcl_Parse *parsePtr, - CompileEnv *envPtr, - int *lastPopPtr) + CompileEnv *envPtr) { Interp *iPtr = (Interp *) interp; - Tcl_Obj *cmdObj; 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; - ExtCmdLoc *eclPtr = envPtr->extCmdMapPtr; int *wlines, wlineat; + int cmdLine = envPtr->line; + int *clNext = envPtr->clNext; + int cmdIdx = envPtr->numCommands; + int startCodeOffset = envPtr->codeNext - envPtr->codeStart; - if (numWords == 0) { - return; - } + assert (numWords > 0); for (wordIdx = 0; wordIdx < numWords; wordIdx++, tokenPtr += tokenPtr->numComponents + 1) { @@ -1765,7 +1766,6 @@ CompileCommandTokens( } } - cmdObj = Tcl_NewObj(); Tcl_IncrRefCount(cmdObj); tokenPtr = parsePtr->tokenPtr; cmdKnown = TclWordKnownAtCompileTime(tokenPtr, cmdObj); @@ -1787,15 +1787,9 @@ CompileCommandTokens( } /* Pre-Compile */ -int lastTopLevelCmdIndex, currCmdIndex, startCodeOffset; - -int cmdLine = envPtr->line; -int *clNext = envPtr->clNext; - lastTopLevelCmdIndex = currCmdIndex = envPtr->numCommands; envPtr->numCommands++; - startCodeOffset = envPtr->codeNext - envPtr->codeStart; - EnterCmdStartData(envPtr, currCmdIndex, + EnterCmdStartData(envPtr, cmdIdx, parsePtr->commandStart - envPtr->source, startCodeOffset); if (expand && !cmdPtr) { @@ -2016,11 +2010,9 @@ int *clNext = envPtr->clNext; finishCommand: TclEmitOpcode(INST_POP, envPtr); - EnterCmdExtentData(envPtr, currCmdIndex, + EnterCmdExtentData(envPtr, cmdIdx, parsePtr->term - parsePtr->commandStart, (envPtr->codeNext-envPtr->codeStart) - startCodeOffset); - *lastPopPtr = currCmdIndex; - if (cmdKnown) { Tcl_DecrRefCount(cmdObj); @@ -2037,6 +2029,8 @@ finishCommand: ckfree(eclPtr->loc[wlineat].next); eclPtr->loc[wlineat].line = wlines; eclPtr->loc[wlineat].next = NULL; + + return cmdIdx; } #endif @@ -2052,10 +2046,8 @@ TclCompileScript( CompileEnv *envPtr) /* Holds resulting instructions. */ { #if 1 - unsigned char *entryCodeNext = envPtr->codeNext; - const char *p; - int cmdLine, *clNext; - int lastPop = -1; + int lastCmdIdx = -1; + const char *p = script; if (envPtr->iPtr == NULL) { Tcl_Panic("TclCompileScript() called on uninitialized CompileEnv"); @@ -2066,40 +2058,34 @@ TclCompileScript( * from the script. */ - p = script; - cmdLine = envPtr->line; - clNext = envPtr->clNext; + /* TODO: Figure out when/why we need this */ +#if 0 +if (Tcl_GetStringResult(interp)[0] != '\0') { + fprintf(stdout, "INIT: '%s'\n", Tcl_GetStringResult(interp)); + fflush(stdout); +} +#endif + Tcl_ResetResult(interp); while (numBytes > 0) { Tcl_Parse parse; const char *next; - /* TODO: can we relocate this to happen less frequently? */ - Tcl_ResetResult(interp); 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, +/* TODO: Make this more sensible, f. ex. [eval {foo \$x(}] */ /* Drop the command terminator (";","]") if appropriate */ (parse.term == parse.commandStart + parse.commandSize - 1)? parse.commandSize - 1 : parse.commandSize); TclCompileSyntaxError(interp, envPtr); Tcl_FreeParse(&parse); - lastPop = -1; - break; + return; } - /* - * TIP #280: Count newlines before the command start. - * (See test info-30.33). - */ - - TclAdvanceLines(&cmdLine, p, parse.commandStart); - TclAdvanceContinuations(&cmdLine, &clNext, - parse.commandStart - envPtr->source); - #ifdef TCL_COMPILE_DEBUG /* * If tracing, print a line for each top level command compiled. @@ -2114,48 +2100,51 @@ TclCompileScript( } #endif - envPtr->line = cmdLine; - envPtr->clNext = clNext; - CompileCommandTokens(interp, &parse, envPtr, &lastPop); - cmdLine = envPtr->line; - clNext = envPtr->clNext; + /* + * 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 to the next command in the script. + * Advance parser to the next command in the script. */ next = parse.commandStart + parse.commandSize; numBytes -= next - p; p = next; + if (parse.numWords == 0) { + /* TODO: Document justification */ + continue; + } + + lastCmdIdx = CompileCommandTokens(interp, &parse, envPtr); + /* * TIP #280: Track lines in the just compiled command. */ - TclAdvanceLines(&cmdLine, parse.commandStart, p); - TclAdvanceContinuations(&cmdLine, &clNext, p - envPtr->source); + TclAdvanceLines(&envPtr->line, parse.commandStart, p); + TclAdvanceContinuations(&envPtr->line, &envPtr->clNext, + p - envPtr->source); Tcl_FreeParse(&parse); } /* - * TIP #280: Bring the line counts in the CompEnv up to date. - * See tests info-30.33,34,35 . - */ - - envPtr->line = cmdLine; - envPtr->clNext = clNext; - - /* * If the source script yielded no instructions (e.g., if it was empty), * push an empty string as the command's result. */ - if (envPtr->codeNext == entryCodeNext) { - PushStringLiteral(envPtr, ""); - } else if (lastPop >= 0) { - envPtr->cmdMapPtr[lastPop].numCodeBytes--; + if (lastCmdIdx >= 0) { + envPtr->cmdMapPtr[lastCmdIdx].numCodeBytes--; envPtr->codeNext--; - TclAdjustStackDepth(1, envPtr); + envPtr->currStackDepth++; + } else { + PushStringLiteral(envPtr, ""); } #else int lastTopLevelCmdIndex = -1; -- cgit v0.12 From 05fb0c0810d175e0affff7d4d7e507141aa0c5ff Mon Sep 17 00:00:00 2001 From: dgp Date: Fri, 28 Jun 2013 02:58:15 +0000 Subject: More elimination of error message litter to fix [Bug 20a81392ec]. --- generic/tclCompCmdsSZ.c | 3 +++ generic/tclCompile.c | 8 -------- generic/tclExecute.c | 18 +++++++----------- 3 files changed, 10 insertions(+), 19 deletions(-) diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c index 855dd8f..026b214 100644 --- a/generic/tclCompCmdsSZ.c +++ b/generic/tclCompCmdsSZ.c @@ -748,6 +748,9 @@ TclSubstCompile( Tcl_InterpState state = NULL; TclSubstParse(interp, bytes, numBytes, flags, &parse, &state); + if (state != NULL) { + Tcl_ResetResult(interp); + } /* * Tricky point! If the first token does not result in a *guaranteed* push diff --git a/generic/tclCompile.c b/generic/tclCompile.c index 5a8524c..1f72aa7 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.c @@ -2058,14 +2058,6 @@ TclCompileScript( * from the script. */ - /* TODO: Figure out when/why we need this */ -#if 0 -if (Tcl_GetStringResult(interp)[0] != '\0') { - fprintf(stdout, "INIT: '%s'\n", Tcl_GetStringResult(interp)); - fflush(stdout); -} -#endif - Tcl_ResetResult(interp); while (numBytes > 0) { Tcl_Parse parse; const char *next; diff --git a/generic/tclExecute.c b/generic/tclExecute.c index d3a0d32..37bf072 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -1426,17 +1426,12 @@ Tcl_NRExprObj( Tcl_Obj *resultPtr) { ByteCode *codePtr; + Tcl_InterpState state = Tcl_SaveInterpState(interp, TCL_OK); - /* TODO: consider saving whole state? */ - Tcl_Obj *saveObjPtr = Tcl_GetObjResult(interp); - - Tcl_IncrRefCount(saveObjPtr); - + Tcl_ResetResult(interp); codePtr = CompileExprObj(interp, objPtr); - /* TODO: Confirm reset not required? */ - /*Tcl_ResetResult(interp);*/ - Tcl_NRAddCallback(interp, ExprObjCallback, saveObjPtr, resultPtr, + Tcl_NRAddCallback(interp, ExprObjCallback, state, resultPtr, NULL, NULL); return TclNRExecuteByteCode(interp, codePtr); } @@ -1447,14 +1442,15 @@ ExprObjCallback( Tcl_Interp *interp, int result) { - Tcl_Obj *saveObjPtr = data[0]; + Tcl_InterpState state = data[0]; Tcl_Obj *resultPtr = data[1]; if (result == TCL_OK) { TclSetDuplicateObj(resultPtr, Tcl_GetObjResult(interp)); - Tcl_SetObjResult(interp, saveObjPtr); + (void) Tcl_RestoreInterpState(interp, state); + } else { + Tcl_DiscardInterpState(state); } - TclDecrRefCount(saveObjPtr); return result; } -- cgit v0.12 From aec5846c12ee4a0dc9b655a8e127c567b248d29f Mon Sep 17 00:00:00 2001 From: dgp Date: Mon, 1 Jul 2013 20:58:15 +0000 Subject: More Work In Progress. --- generic/tclCompile.c | 55 ++++++++++++++++++++++++++++++++-------------------- tests/misc.test | 7 +------ 2 files changed, 35 insertions(+), 27 deletions(-) diff --git a/generic/tclCompile.c b/generic/tclCompile.c index 1f72aa7..6f5ef50 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.c @@ -16,6 +16,8 @@ #include "tclCompile.h" #include +#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,7 +1743,7 @@ FindCompiledCommandFromToken( *---------------------------------------------------------------------- */ -#if 1 +#ifdef REWRITE static int CompileCommandTokens( Tcl_Interp *interp, @@ -2045,18 +2051,18 @@ TclCompileScript( * first null character. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { -#if 1 - int lastCmdIdx = -1; - const char *p = script; +#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 through the following loop compiles the next command - * from the script. - */ + /* Each iteration compiles one command from the script. */ while (numBytes > 0) { Tcl_Parse parse; @@ -2068,11 +2074,7 @@ TclCompileScript( */ Tcl_LogCommandInfo(interp, script, parse.commandStart, -/* TODO: Make this more sensible, f. ex. [eval {foo \$x(}] */ - /* Drop the command terminator (";","]") if appropriate */ - (parse.term == - parse.commandStart + parse.commandSize - 1)? - parse.commandSize - 1 : parse.commandSize); + parse.term + 1 - parse.commandStart); TclCompileSyntaxError(interp, envPtr); Tcl_FreeParse(&parse); return; @@ -2126,17 +2128,28 @@ TclCompileScript( Tcl_FreeParse(&parse); } - /* - * If the source script yielded no instructions (e.g., if it was empty), - * push an empty string as the command's result. - */ - - if (lastCmdIdx >= 0) { + 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. These code here removes that trailing INST_POP. + */ envPtr->cmdMapPtr[lastCmdIdx].numCodeBytes--; envPtr->codeNext--; envPtr->currStackDepth++; - } else { - PushStringLiteral(envPtr, ""); } #else int lastTopLevelCmdIndex = -1; diff --git a/tests/misc.test b/tests/misc.test index 6ddc718..d4ece74 100644 --- a/tests/misc.test +++ b/tests/misc.test @@ -59,12 +59,7 @@ test misc-1.2 {error in variable ref. in command in array reference} { missing close-brace for variable name missing close-brace for variable name while executing -"set tst $a([winfo name $\{zz) - # this is a bogus comment - # this is a bogus comment - # this is a bogus comment - # this is a bogus comment - # this is a ..." +"set tst $a([winfo name $\{" (procedure "tstProc" line 4) invoked from within "tstProc"}] -- cgit v0.12 From 88731d9d93913d8f5ce27cd5153be02c84e5eb7a Mon Sep 17 00:00:00 2001 From: dgp Date: Tue, 2 Jul 2013 10:36:32 +0000 Subject: comment improvements --- generic/tclCompile.c | 22 ++++++++++++++++++++-- 1 file changed, 20 insertions(+), 2 deletions(-) diff --git a/generic/tclCompile.c b/generic/tclCompile.c index 6f5ef50..05daabf 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.c @@ -1764,6 +1764,7 @@ CompileCommandTokens( 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) { @@ -1772,6 +1773,7 @@ CompileCommandTokens( } } + /* Do we know the command word? */ Tcl_IncrRefCount(cmdObj); tokenPtr = parsePtr->tokenPtr; cmdKnown = TclWordKnownAtCompileTime(tokenPtr, cmdObj); @@ -1791,6 +1793,7 @@ CompileCommandTokens( } } } + /* If cmdPtr != NULL, we will try to call cmdPtr->compileProc */ /* Pre-Compile */ @@ -2112,7 +2115,22 @@ TclCompileScript( p = next; if (parse.numWords == 0) { - /* TODO: Document justification */ + /* + * 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; } @@ -2145,7 +2163,7 @@ TclCompileScript( * 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. These code here removes that trailing INST_POP. + * the script. The code here removes that trailing INST_POP. */ envPtr->cmdMapPtr[lastCmdIdx].numCodeBytes--; envPtr->codeNext--; -- cgit v0.12 From d2b490f552aaf53f2f3d66b630c40a5db14157d1 Mon Sep 17 00:00:00 2001 From: dgp Date: Mon, 8 Jul 2013 14:31:14 +0000 Subject: The routines StartExpanding() and EnterCmdWordData() are orthogonal, so it's ok to reverse the order in which they are called. --- generic/tclCompile.c | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/generic/tclCompile.c b/generic/tclCompile.c index 5aab69c..0dc30e2 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.c @@ -1802,10 +1802,6 @@ CompileCommandTokens( 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 @@ -1823,6 +1819,9 @@ CompileCommandTokens( envPtr->line = eclPtr->loc[wlineat].line[0]; envPtr->clNext = eclPtr->loc[wlineat].next[0]; + if (expand && !cmdPtr) { + StartExpanding(envPtr); + } if (cmdPtr) { int savedNumCmds = envPtr->numCommands; int update = 0; -- cgit v0.12 From 0dec640514ea686e9617b9813107057e7972300d Mon Sep 17 00:00:00 2001 From: dgp Date: Mon, 8 Jul 2013 15:00:02 +0000 Subject: Consolidate the StartExpanding() calls. --- generic/tclCompile.c | 10 +++------- 1 file changed, 3 insertions(+), 7 deletions(-) diff --git a/generic/tclCompile.c b/generic/tclCompile.c index 0dc30e2..cbb93d9 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.c @@ -1819,9 +1819,6 @@ CompileCommandTokens( envPtr->line = eclPtr->loc[wlineat].line[0]; envPtr->clNext = eclPtr->loc[wlineat].next[0]; - if (expand && !cmdPtr) { - StartExpanding(envPtr); - } if (cmdPtr) { int savedNumCmds = envPtr->numCommands; int update = 0; @@ -1919,11 +1916,10 @@ CompileCommandTokens( 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); - } + if (expand) { + StartExpanding(envPtr); } /* -- cgit v0.12 From da4296c06f86f3d4ff58fb77959049d42698d52a Mon Sep 17 00:00:00 2001 From: dgp Date: Mon, 8 Jul 2013 15:24:56 +0000 Subject: Defer expansion request detection as much as possible. --- generic/tclCompile.c | 43 ++++++++++++++++++++++++++++++------------- 1 file changed, 30 insertions(+), 13 deletions(-) diff --git a/generic/tclCompile.c b/generic/tclCompile.c index cbb93d9..052dc8e 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.c @@ -1744,6 +1744,22 @@ FindCompiledCommandFromToken( */ #ifdef REWRITE + +static int +ExpandRequested( + Tcl_Token *tokenPtr, + int numWords) +{ + /* Determine whether any words of the command require expansion */ + while (numWords--) { + if (tokenPtr->type == TCL_TOKEN_EXPAND_WORD) { + return 1; + } + tokenPtr += tokenPtr->numComponents + 1; + } + return 0; +} + static int CompileCommandTokens( Tcl_Interp *interp, @@ -1755,7 +1771,7 @@ CompileCommandTokens( ExtCmdLoc *eclPtr = envPtr->extCmdMapPtr; Tcl_Obj *cmdObj = Tcl_NewObj(); Command *cmdPtr = NULL; - int wordIdx, cmdKnown, expand = 0, numWords = parsePtr->numWords; + int wordIdx, cmdKnown, expand = -1, numWords = parsePtr->numWords; int *wlines, wlineat; int cmdLine = envPtr->line; int *clNext = envPtr->clNext; @@ -1763,15 +1779,6 @@ CompileCommandTokens( 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); @@ -1783,13 +1790,19 @@ CompileCommandTokens( cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, cmdObj); if (cmdPtr) { /* - * Found a command. Test all the ways we can be told + * 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) - || (cmdPtr->flags & CMD_HAS_EXEC_TRACES) - || (expand && !(cmdPtr->flags & CMD_COMPILES_EXPANDED))) { + || (cmdPtr->flags & CMD_HAS_EXEC_TRACES)) { + cmdPtr = NULL; + } + } + if (cmdPtr && !(cmdPtr->flags & CMD_COMPILES_EXPANDED)) { + expand = ExpandRequested(parsePtr->tokenPtr, parsePtr->numWords); + if (expand) { + /* We need to expand, but compileProc cannot. */ cmdPtr = NULL; } } @@ -1918,6 +1931,10 @@ CompileCommandTokens( envPtr->clNext = eclPtr->loc[wlineat].next[0]; } + if (expand < 0) { + expand = ExpandRequested(parsePtr->tokenPtr, parsePtr->numWords); + } + if (expand) { StartExpanding(envPtr); } -- cgit v0.12 From 582824087ddfbdc099f0f7d8a8f0dc6a858de7d3 Mon Sep 17 00:00:00 2001 From: dgp Date: Mon, 8 Jul 2013 15:39:55 +0000 Subject: Move TIP 280 and command extent housekeeping to the periphery. --- generic/tclCompile.c | 54 ++++++++++++++++++++++++++-------------------------- 1 file changed, 27 insertions(+), 27 deletions(-) diff --git a/generic/tclCompile.c b/generic/tclCompile.c index 052dc8e..388b8a0 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.c @@ -1780,6 +1780,29 @@ CompileCommandTokens( assert (numWords > 0); + /* Pre-Compile */ + + envPtr->numCommands++; + EnterCmdStartData(envPtr, cmdIdx, + 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'. + */ + + 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]; + /* Do we know the command word? */ Tcl_IncrRefCount(cmdObj); tokenPtr = parsePtr->tokenPtr; @@ -1809,29 +1832,6 @@ CompileCommandTokens( } /* If cmdPtr != NULL, we will try to call cmdPtr->compileProc */ - /* Pre-Compile */ - - envPtr->numCommands++; - EnterCmdStartData(envPtr, cmdIdx, - 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'. - */ - - 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; @@ -2031,15 +2031,15 @@ CompileCommandTokens( } finishCommand: + if (cmdKnown) { + Tcl_DecrRefCount(cmdObj); + } + 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 -- cgit v0.12 From c10c796a466cd52d2fd3d2999801eb66a575388d Mon Sep 17 00:00:00 2001 From: dgp Date: Mon, 8 Jul 2013 18:08:01 +0000 Subject: Plug memory leak; Break three compilation mechanisms into routines. --- generic/tclCompile.c | 462 +++++++++++++++++++++++++++++---------------------- 1 file 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, -- cgit v0.12 From e10479f3d739f650bd4b5a041b973f66796f4e4b Mon Sep 17 00:00:00 2001 From: dgp Date: Mon, 8 Jul 2013 19:29:01 +0000 Subject: Factor out compiling the Command literal. --- generic/tclCompile.c | 41 +++++++++++++++++++---------------------- 1 file changed, 19 insertions(+), 22 deletions(-) diff --git a/generic/tclCompile.c b/generic/tclCompile.c index 1958d47..a1ad5c8 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.c @@ -1761,6 +1761,23 @@ ExpandRequested( } static void +CompileCmdLiteral( + Tcl_Interp *interp, + Tcl_Obj *cmdObj, + CompileEnv *envPtr) +{ + 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); +} + +static void CompileInvocation( Tcl_Interp *interp, Tcl_Token *tokenPtr, @@ -1773,17 +1790,7 @@ CompileInvocation( 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); - + CompileCmdLiteral(interp, cmdObj, envPtr); wordIdx = 1; tokenPtr += tokenPtr->numComponents + 1; } @@ -1839,17 +1846,7 @@ CompileExpanded( 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); - + CompileCmdLiteral(interp, cmdObj, envPtr); wordIdx = 1; tokenPtr += tokenPtr->numComponents + 1; } -- cgit v0.12 From ba3bf9b61fa445633a8699982aa8ef38bdd75e80 Mon Sep 17 00:00:00 2001 From: dgp Date: Mon, 8 Jul 2013 22:36:55 +0000 Subject: Use TIP 280 macros. --- generic/tclCompile.c | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/generic/tclCompile.c b/generic/tclCompile.c index a1ad5c8..656f700 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.c @@ -1906,11 +1906,10 @@ CompileCmdCompileProc( int startCodeOffset, CompileEnv *envPtr) { - ExtCmdLoc *eclPtr = envPtr->extCmdMapPtr; int savedNumCmds = envPtr->numCommands; int startStackDepth = envPtr->currStackDepth; - int wlineat = eclPtr->nuloc - 1; int update = 0; + DefineLineInformation; /* * Mark the start of the command; the proper bytecode @@ -2001,8 +2000,7 @@ CompileCmdCompileProc( envPtr->codeNext = envPtr->codeStart + startCodeOffset; envPtr->currStackDepth = startStackDepth; - envPtr->line = eclPtr->loc[wlineat].line[0]; - envPtr->clNext = eclPtr->loc[wlineat].next[0]; + SetLineInformation(0); return TCL_ERROR; } -- cgit v0.12 From c46c7741267cbbe91a195e2abbbc19a95b0f3b3a Mon Sep 17 00:00:00 2001 From: dgp Date: Mon, 8 Jul 2013 23:02:44 +0000 Subject: Use the TokenAfter() macro. --- generic/tclCompile.c | 12 +++++------- 1 file changed, 5 insertions(+), 7 deletions(-) diff --git a/generic/tclCompile.c b/generic/tclCompile.c index 656f700..afe34b0 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.c @@ -1755,7 +1755,7 @@ ExpandRequested( if (tokenPtr->type == TCL_TOKEN_EXPAND_WORD) { return 1; } - tokenPtr += tokenPtr->numComponents + 1; + tokenPtr = TokenAfter(tokenPtr); } return 0; } @@ -1792,11 +1792,10 @@ CompileInvocation( if (cmdObj) { CompileCmdLiteral(interp, cmdObj, envPtr); wordIdx = 1; - tokenPtr += tokenPtr->numComponents + 1; + tokenPtr = TokenAfter(tokenPtr); } - for (; wordIdx < numWords; - wordIdx++, tokenPtr += tokenPtr->numComponents + 1) { + for (; wordIdx < numWords; wordIdx++, tokenPtr = TokenAfter(tokenPtr)) { int objIdx; envPtr->line = eclPtr->loc[wlineat].line[wordIdx]; @@ -1848,11 +1847,10 @@ CompileExpanded( if (cmdObj) { CompileCmdLiteral(interp, cmdObj, envPtr); wordIdx = 1; - tokenPtr += tokenPtr->numComponents + 1; + tokenPtr = TokenAfter(tokenPtr); } - for (; wordIdx < numWords; - wordIdx++, tokenPtr += tokenPtr->numComponents + 1) { + for (; wordIdx < numWords; wordIdx++, tokenPtr = TokenAfter(tokenPtr)) { int objIdx; envPtr->line = eclPtr->loc[wlineat].line[wordIdx]; -- cgit v0.12 From d72d5f8b7a85e097e1e934c4a757301699d80266 Mon Sep 17 00:00:00 2001 From: dgp Date: Tue, 9 Jul 2013 20:37:37 +0000 Subject: Tentative Work In Progress unwinding TIP 280 line information. --- generic/tclCompile.c | 39 +++++++++++++++++++++++++++++---------- 1 file changed, 29 insertions(+), 10 deletions(-) diff --git a/generic/tclCompile.c b/generic/tclCompile.c index afe34b0..777c03e 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.c @@ -1787,7 +1787,8 @@ CompileInvocation( CompileEnv *envPtr) { int isnew, wordIdx = 0; - ExtCmdLoc *eclPtr = envPtr->extCmdMapPtr; +// ExtCmdLoc *eclPtr = envPtr->extCmdMapPtr; + DefineLineInformation; if (cmdObj) { CompileCmdLiteral(interp, cmdObj, envPtr); @@ -1798,8 +1799,9 @@ CompileInvocation( for (; wordIdx < numWords; wordIdx++, tokenPtr = TokenAfter(tokenPtr)) { int objIdx; - envPtr->line = eclPtr->loc[wlineat].line[wordIdx]; - envPtr->clNext = eclPtr->loc[wlineat].next[wordIdx]; +// envPtr->line = eclPtr->loc[wlineat].line[wordIdx]; +// envPtr->clNext = eclPtr->loc[wlineat].next[wordIdx]; + SetLineInformation(wordIdx); if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { CompileTokens(envPtr, tokenPtr, interp); @@ -1811,7 +1813,8 @@ CompileInvocation( if (envPtr->clNext) { TclContinuationsEnterDerived(TclFetchLiteral(envPtr, objIdx), tokenPtr[1].start - envPtr->source, - eclPtr->loc[wlineat].next[wordIdx]); +// eclPtr->loc[wlineat].next[wordIdx]); + mapPtr->loc[eclIndex].next[wordIdx]); } TclEmitPush(objIdx, envPtr); } @@ -1820,9 +1823,11 @@ CompileInvocation( * Save PC -> command map for the TclArgumentBC* functions. */ - Tcl_SetHashValue(Tcl_CreateHashEntry(&eclPtr->litInfo, +// Tcl_SetHashValue(Tcl_CreateHashEntry(&eclPtr->litInfo, + Tcl_SetHashValue(Tcl_CreateHashEntry(&mapPtr->litInfo, INT2PTR(envPtr->codeNext - envPtr->codeStart), &isnew), - INT2PTR(wlineat)); +// INT2PTR(wlineat)); + INT2PTR(eclIndex)); if (wordIdx <= 255) { TclEmitInstInt1(INST_INVOKE_STK1, wordIdx, envPtr); @@ -1841,7 +1846,9 @@ CompileExpanded( CompileEnv *envPtr) { int wordIdx = 0; - ExtCmdLoc *eclPtr = envPtr->extCmdMapPtr; + DefineLineInformation; +// ExtCmdLoc *eclPtr = envPtr->extCmdMapPtr; + StartExpanding(envPtr); if (cmdObj) { @@ -1853,8 +1860,9 @@ CompileExpanded( for (; wordIdx < numWords; wordIdx++, tokenPtr = TokenAfter(tokenPtr)) { int objIdx; - envPtr->line = eclPtr->loc[wlineat].line[wordIdx]; - envPtr->clNext = eclPtr->loc[wlineat].next[wordIdx]; + SetLineInformation(wordIdx); +// 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); @@ -1870,7 +1878,8 @@ CompileExpanded( if (envPtr->clNext) { TclContinuationsEnterDerived(TclFetchLiteral(envPtr, objIdx), tokenPtr[1].start - envPtr->source, - eclPtr->loc[wlineat].next[wordIdx]); +// eclPtr->loc[wlineat].next[wordIdx]); + mapPtr->loc[eclIndex].next[wordIdx]); } TclEmitPush(objIdx, envPtr); } @@ -1998,6 +2007,16 @@ CompileCmdCompileProc( envPtr->codeNext = envPtr->codeStart + startCodeOffset; envPtr->currStackDepth = startStackDepth; + /* + * Throw out any line information generated by the failed + * compile attempt. + */ + while (mapPtr->nuloc - 1 > eclIndex) { + mapPtr->nuloc--; + ckfree(mapPtr->loc[mapPtr->nuloc].line); + mapPtr->loc[mapPtr->nuloc].line = NULL; + } + SetLineInformation(0); return TCL_ERROR; } -- cgit v0.12 From afad6ffbb48761689faa9e08e8b9da7e5c63dca0 Mon Sep 17 00:00:00 2001 From: dgp Date: Wed, 10 Jul 2013 03:17:57 +0000 Subject: Revise the litInfo table so that it gets built later (in TclInitByteCodeObj) from a simpler store of data that can unwind. --- generic/tclCompile.c | 79 +++++++++++++--------------------------------------- generic/tclCompile.h | 1 + 2 files changed, 20 insertions(+), 60 deletions(-) diff --git a/generic/tclCompile.c b/generic/tclCompile.c index 777c03e..c31d256 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.c @@ -1786,8 +1786,7 @@ CompileInvocation( int wlineat, CompileEnv *envPtr) { - int isnew, wordIdx = 0; -// ExtCmdLoc *eclPtr = envPtr->extCmdMapPtr; + int wordIdx = 0; DefineLineInformation; if (cmdObj) { @@ -1799,8 +1798,6 @@ CompileInvocation( for (; wordIdx < numWords; wordIdx++, tokenPtr = TokenAfter(tokenPtr)) { int objIdx; -// envPtr->line = eclPtr->loc[wlineat].line[wordIdx]; -// envPtr->clNext = eclPtr->loc[wlineat].next[wordIdx]; SetLineInformation(wordIdx); if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { @@ -1813,7 +1810,6 @@ CompileInvocation( if (envPtr->clNext) { TclContinuationsEnterDerived(TclFetchLiteral(envPtr, objIdx), tokenPtr[1].start - envPtr->source, -// eclPtr->loc[wlineat].next[wordIdx]); mapPtr->loc[eclIndex].next[wordIdx]); } TclEmitPush(objIdx, envPtr); @@ -1823,11 +1819,7 @@ CompileInvocation( * Save PC -> command map for the TclArgumentBC* functions. */ -// Tcl_SetHashValue(Tcl_CreateHashEntry(&eclPtr->litInfo, - Tcl_SetHashValue(Tcl_CreateHashEntry(&mapPtr->litInfo, - INT2PTR(envPtr->codeNext - envPtr->codeStart), &isnew), -// INT2PTR(wlineat)); - INT2PTR(eclIndex)); + mapPtr->loc[eclIndex].invokePc = envPtr->codeNext - envPtr->codeStart; if (wordIdx <= 255) { TclEmitInstInt1(INST_INVOKE_STK1, wordIdx, envPtr); @@ -1847,7 +1839,6 @@ CompileExpanded( { int wordIdx = 0; DefineLineInformation; -// ExtCmdLoc *eclPtr = envPtr->extCmdMapPtr; StartExpanding(envPtr); @@ -1861,8 +1852,6 @@ CompileExpanded( int objIdx; SetLineInformation(wordIdx); -// 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); @@ -1878,7 +1867,6 @@ CompileExpanded( if (envPtr->clNext) { TclContinuationsEnterDerived(TclFetchLiteral(envPtr, objIdx), tokenPtr[1].start - envPtr->source, -// eclPtr->loc[wlineat].next[wordIdx]); mapPtr->loc[eclIndex].next[wordIdx]); } TclEmitPush(objIdx, envPtr); @@ -2015,6 +2003,7 @@ CompileCmdCompileProc( mapPtr->nuloc--; ckfree(mapPtr->loc[mapPtr->nuloc].line); mapPtr->loc[mapPtr->nuloc].line = NULL; + mapPtr->loc[mapPtr->nuloc].invokePc = -1; } SetLineInformation(0); @@ -3340,6 +3329,17 @@ TclInitByteCodeObj( * byte code object (internal rep), for use with the bc compiler. */ + for (i = 0; i < envPtr->extCmdMapPtr->nuloc; i++) { + int isnew, pc = envPtr->extCmdMapPtr->loc[i].invokePc; + + if (pc < 0) { + continue; + } + + Tcl_SetHashValue(Tcl_CreateHashEntry(&envPtr->extCmdMapPtr->litInfo, + INT2PTR(pc), &isnew), INT2PTR(i)); + } + Tcl_SetHashValue(Tcl_CreateHashEntry(iPtr->lineBCPtr, codePtr, &isNew), envPtr->extCmdMapPtr); envPtr->extCmdMapPtr = NULL; @@ -3710,6 +3710,7 @@ EnterCmdWordData( ePtr = &eclPtr->loc[eclPtr->nuloc]; ePtr->srcOffset = srcOffset; + ePtr->invokePc = -1; ePtr->line = ckalloc(numWords * sizeof(int)); ePtr->next = ckalloc(numWords * sizeof(int *)); ePtr->nline = numWords; @@ -4493,54 +4494,12 @@ TclFixupForwardJump( { ExtCmdLoc* eclPtr = envPtr->extCmdMapPtr; - - /* A helper structure */ - - typedef struct { - int pc; - int cmd; - } MAP; - - /* - * And the helper array. At most the whole hashtable is placed into - * this. - */ - - MAP *map = (MAP*) ckalloc (sizeof(MAP) * eclPtr->litInfo.numEntries); - - Tcl_HashSearch hSearch; - Tcl_HashEntry* hPtr; - int n, k, isnew; - - /* - * Phase I: Locate the affected entries, and save them in adjusted - * form to the array. This removes them from the hash. - */ - - for (n = 0, hPtr = Tcl_FirstHashEntry(&eclPtr->litInfo, &hSearch); - hPtr != NULL; - hPtr = Tcl_NextHashEntry(&hSearch)) { - - map [n].cmd = PTR2INT(Tcl_GetHashValue(hPtr)); - map [n].pc = PTR2INT(Tcl_GetHashKey (&eclPtr->litInfo,hPtr)); - - if (map[n].pc >= (jumpFixupPtr->codeOffset + 2)) { - Tcl_DeleteHashEntry(hPtr); - map [n].pc += 3; - n++; + for (k = eclPtr->nuloc - 1; k >= 0; k--) { + if (eclPtr->loc[k].invokePc < (jumpFixupPtr->codeOffset + 2)) { + continue; } + eclPtr->loc[k].invokePc += 3; } - - /* - * Phase II: Re-insert the modified entries into the hash. - */ - - for (k=0;klitInfo, INT2PTR(map[k].pc), &isnew); - Tcl_SetHashValue(hPtr, INT2PTR(map[k].cmd)); - } - - ckfree (map); } return 1; /* the jump was grown */ diff --git a/generic/tclCompile.h b/generic/tclCompile.h index 9af4911..cbe104c 100644 --- a/generic/tclCompile.h +++ b/generic/tclCompile.h @@ -175,6 +175,7 @@ typedef struct CmdLocation { typedef struct ECL { int srcOffset; /* Command location to find the entry. */ + int invokePc; int nline; /* Number of words in the command */ int *line; /* Line information for all words in the * command. */ -- cgit v0.12 From 1e62f5ac76864a8e1e5d388fa6ecdef2dff63ca6 Mon Sep 17 00:00:00 2001 From: dgp Date: Wed, 10 Jul 2013 03:28:37 +0000 Subject: Remove the (now unused) wlineat arguments. --- generic/tclCompile.c | 8 ++------ 1 file changed, 2 insertions(+), 6 deletions(-) diff --git a/generic/tclCompile.c b/generic/tclCompile.c index c31d256..5f4acff 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.c @@ -1783,7 +1783,6 @@ CompileInvocation( Tcl_Token *tokenPtr, Tcl_Obj *cmdObj, int numWords, - int wlineat, CompileEnv *envPtr) { int wordIdx = 0; @@ -1834,7 +1833,6 @@ CompileExpanded( Tcl_Token *tokenPtr, Tcl_Obj *cmdObj, int numWords, - int wlineat, CompileEnv *envPtr) { int wordIdx = 0; @@ -2095,12 +2093,10 @@ CompileCommandTokens( if (expand) { CompileExpanded(interp, parsePtr->tokenPtr, - cmdKnown ? cmdObj : NULL, parsePtr->numWords, wlineat, - envPtr); + cmdKnown ? cmdObj : NULL, parsePtr->numWords, envPtr); } else { CompileInvocation(interp, parsePtr->tokenPtr, - cmdKnown ? cmdObj : NULL, parsePtr->numWords, wlineat, - envPtr); + cmdKnown ? cmdObj : NULL, parsePtr->numWords, envPtr); } } -- cgit v0.12 From d860a2c3a49e049350838d0ee2e259e7f8b4c3e6 Mon Sep 17 00:00:00 2001 From: dgp Date: Mon, 15 Jul 2013 20:16:11 +0000 Subject: Build CompileBasicNArgCommand on top of TclCompileInvocation. --- generic/tclBasic.c | 22 ++++++++++++++++++---- generic/tclCompile.c | 6 +++--- generic/tclCompile.h | 3 +++ generic/tclEnsemble.c | 10 ++++++++++ 4 files changed, 34 insertions(+), 7 deletions(-) diff --git a/generic/tclBasic.c b/generic/tclBasic.c index b2a505a..963b53a 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -5633,6 +5633,24 @@ TclArgumentBCEnter( CFWordBC *lastPtr = NULL; /* + * ePtr->nline is the number of words originally parsed. + * + * objc is the number of elements getting invoked. + * + * If they are not the same, we arrived here by compiling an + * ensemble dispatch. Ensemble subcommands that lead to script + * evaluation are not supposed to get compiled, because a command + * such as [info level] in the script can expose some of the dispatch + * shenanigans. This means that we don't have to tend to the + * housekeeping, and can escape now. + */ + + if (ePtr->nline != objc) { + return; + } + + /* + * Having disposed of the ensemble cases, we can state... * A few truths ... * (1) ePtr->nline == objc * (2) (ePtr->line[word] < 0) => !literal, for all words @@ -5642,10 +5660,6 @@ TclArgumentBCEnter( * have to save them at compile time. */ - if (ePtr->nline != objc) { - Tcl_Panic ("TIP 280 data structure inconsistency"); - } - for (word = 1; word < objc; word++) { if (ePtr->line[word] >= 0) { int isnew; diff --git a/generic/tclCompile.c b/generic/tclCompile.c index 5f4acff..a2c7131 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.c @@ -1777,8 +1777,8 @@ CompileCmdLiteral( TclEmitPush(cmdLitIdx, envPtr); } -static void -CompileInvocation( +void +TclCompileInvocation( Tcl_Interp *interp, Tcl_Token *tokenPtr, Tcl_Obj *cmdObj, @@ -2095,7 +2095,7 @@ CompileCommandTokens( CompileExpanded(interp, parsePtr->tokenPtr, cmdKnown ? cmdObj : NULL, parsePtr->numWords, envPtr); } else { - CompileInvocation(interp, parsePtr->tokenPtr, + TclCompileInvocation(interp, parsePtr->tokenPtr, cmdKnown ? cmdObj : NULL, parsePtr->numWords, envPtr); } } diff --git a/generic/tclCompile.h b/generic/tclCompile.h index 0bcd84e..b94bd93 100644 --- a/generic/tclCompile.h +++ b/generic/tclCompile.h @@ -1003,6 +1003,9 @@ MODULE_SCOPE void TclCompileExpr(Tcl_Interp *interp, const char *script, MODULE_SCOPE void TclCompileExprWords(Tcl_Interp *interp, Tcl_Token *tokenPtr, int numWords, CompileEnv *envPtr); +MODULE_SCOPE void TclCompileInvocation(Tcl_Interp *interp, + Tcl_Token *tokenPtr, Tcl_Obj *cmdObj, int numWords, + CompileEnv *envPtr); MODULE_SCOPE void TclCompileScript(Tcl_Interp *interp, const char *script, int numBytes, CompileEnv *envPtr); diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c index 680ab45d..9b6ca92 100644 --- a/generic/tclEnsemble.c +++ b/generic/tclEnsemble.c @@ -3229,6 +3229,15 @@ CompileBasicNArgCommand( * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { +#if 1 + Tcl_Obj *objPtr = Tcl_NewObj(); + + Tcl_IncrRefCount(objPtr); + Tcl_GetCommandFullName(interp, (Tcl_Command) cmdPtr, objPtr); + TclCompileInvocation(interp, parsePtr->tokenPtr, objPtr, + parsePtr->numWords, envPtr); + Tcl_DecrRefCount(objPtr); +#else Tcl_Token *tokenPtr; Tcl_Obj *objPtr; char *bytes; @@ -3272,6 +3281,7 @@ CompileBasicNArgCommand( } else { TclEmitInstInt4(INST_INVOKE_STK4, i, envPtr); } +#endif return TCL_OK; } -- cgit v0.12 From d848f30c4545739e202b7df265b942a79b284fba Mon Sep 17 00:00:00 2001 From: dgp Date: Tue, 16 Jul 2013 14:07:41 +0000 Subject: Eliminate the litInfo table and all the code tending to its care and feeding. The pc -> command index mapping function it provided can be achieved using other data already in the ByteCode struct. --- generic/tclBasic.c | 134 +++++++++++++++++++++++++-------------------------- generic/tclCompile.c | 43 ----------------- generic/tclCompile.h | 8 --- generic/tclExecute.c | 44 ++++++++++++----- generic/tclInt.h | 2 +- 5 files changed, 97 insertions(+), 134 deletions(-) diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 963b53a..bd4f157 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -1609,8 +1609,6 @@ DeleteInterpProc( ckfree(eclPtr->loc); } - Tcl_DeleteHashTable(&eclPtr->litInfo); - ckfree(eclPtr); Tcl_DeleteHashEntry(hPtr); } @@ -5614,90 +5612,88 @@ TclArgumentBCEnter( int objc, void *codePtr, CmdFrame *cfPtr, + int cmd, int pc) { + ExtCmdLoc *eclPtr; + int word; + ECL *ePtr; + CFWordBC *lastPtr = NULL; Interp *iPtr = (Interp *) interp; Tcl_HashEntry *hePtr = Tcl_FindHashEntry(iPtr->lineBCPtr, (char *) codePtr); - ExtCmdLoc *eclPtr; if (!hePtr) { return; } eclPtr = Tcl_GetHashValue(hePtr); - hePtr = Tcl_FindHashEntry(&eclPtr->litInfo, INT2PTR(pc)); - if (hePtr) { - int word; - int cmd = PTR2INT(Tcl_GetHashValue(hePtr)); - ECL *ePtr = &eclPtr->loc[cmd]; - CFWordBC *lastPtr = NULL; + ePtr = &eclPtr->loc[cmd]; - /* - * ePtr->nline is the number of words originally parsed. - * - * objc is the number of elements getting invoked. - * - * If they are not the same, we arrived here by compiling an - * ensemble dispatch. Ensemble subcommands that lead to script - * evaluation are not supposed to get compiled, because a command - * such as [info level] in the script can expose some of the dispatch - * shenanigans. This means that we don't have to tend to the - * housekeeping, and can escape now. - */ + /* + * ePtr->nline is the number of words originally parsed. + * + * objc is the number of elements getting invoked. + * + * If they are not the same, we arrived here by compiling an + * ensemble dispatch. Ensemble subcommands that lead to script + * evaluation are not supposed to get compiled, because a command + * such as [info level] in the script can expose some of the dispatch + * shenanigans. This means that we don't have to tend to the + * housekeeping, and can escape now. + */ - if (ePtr->nline != objc) { - return; - } + if (ePtr->nline != objc) { + return; + } - /* - * Having disposed of the ensemble cases, we can state... - * A few truths ... - * (1) ePtr->nline == objc - * (2) (ePtr->line[word] < 0) => !literal, for all words - * (3) (word == 0) => !literal - * - * Item (2) is why we can use objv to get the literals, and do not - * have to save them at compile time. - */ + /* + * Having disposed of the ensemble cases, we can state... + * A few truths ... + * (1) ePtr->nline == objc + * (2) (ePtr->line[word] < 0) => !literal, for all words + * (3) (word == 0) => !literal + * + * Item (2) is why we can use objv to get the literals, and do not + * have to save them at compile time. + */ - for (word = 1; word < objc; word++) { - if (ePtr->line[word] >= 0) { - int isnew; - Tcl_HashEntry *hPtr = Tcl_CreateHashEntry(iPtr->lineLABCPtr, - objv[word], &isnew); - CFWordBC *cfwPtr = ckalloc(sizeof(CFWordBC)); - - cfwPtr->framePtr = cfPtr; - cfwPtr->obj = objv[word]; - cfwPtr->pc = pc; - cfwPtr->word = word; - cfwPtr->nextPtr = lastPtr; - lastPtr = cfwPtr; - - if (isnew) { - /* - * The word is not on the stack yet, remember the current - * location and initialize references. - */ - - cfwPtr->prevPtr = NULL; - } else { - /* - * The object is already on the stack, however it may have - * a different location now (literal sharing may map - * multiple location to a single Tcl_Obj*. Save the old - * information in the new structure. - */ - - cfwPtr->prevPtr = Tcl_GetHashValue(hPtr); - } + for (word = 1; word < objc; word++) { + if (ePtr->line[word] >= 0) { + int isnew; + Tcl_HashEntry *hPtr = Tcl_CreateHashEntry(iPtr->lineLABCPtr, + objv[word], &isnew); + CFWordBC *cfwPtr = ckalloc(sizeof(CFWordBC)); - Tcl_SetHashValue(hPtr, cfwPtr); + cfwPtr->framePtr = cfPtr; + cfwPtr->obj = objv[word]; + cfwPtr->pc = pc; + cfwPtr->word = word; + cfwPtr->nextPtr = lastPtr; + lastPtr = cfwPtr; + + if (isnew) { + /* + * The word is not on the stack yet, remember the current + * location and initialize references. + */ + + cfwPtr->prevPtr = NULL; + } else { + /* + * The object is already on the stack, however it may have + * a different location now (literal sharing may map + * multiple location to a single Tcl_Obj*. Save the old + * information in the new structure. + */ + + cfwPtr->prevPtr = Tcl_GetHashValue(hPtr); } - } /* for */ - cfPtr->litarg = lastPtr; - } /* if */ + Tcl_SetHashValue(hPtr, cfwPtr); + } + } /* for */ + + cfPtr->litarg = lastPtr; } /* diff --git a/generic/tclCompile.c b/generic/tclCompile.c index a2c7131..7e0be76 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.c @@ -1296,8 +1296,6 @@ ReleaseCmdWordData( ckfree((char *) eclPtr->loc); } - Tcl_DeleteHashTable (&eclPtr->litInfo); - ckfree((char *) eclPtr); } @@ -1382,7 +1380,6 @@ TclInitCompileEnv( envPtr->extCmdMapPtr->nloc = 0; envPtr->extCmdMapPtr->nuloc = 0; envPtr->extCmdMapPtr->path = NULL; - Tcl_InitHashTable(&envPtr->extCmdMapPtr->litInfo, TCL_ONE_WORD_KEYS); if ((invoker == NULL) || (invoker->type == TCL_LOCATION_EVAL_LIST)) { /* @@ -1814,12 +1811,6 @@ TclCompileInvocation( TclEmitPush(objIdx, envPtr); } - /* - * Save PC -> command map for the TclArgumentBC* functions. - */ - - mapPtr->loc[eclIndex].invokePc = envPtr->codeNext - envPtr->codeStart; - if (wordIdx <= 255) { TclEmitInstInt1(INST_INVOKE_STK1, wordIdx, envPtr); } else { @@ -2001,7 +1992,6 @@ CompileCmdCompileProc( mapPtr->nuloc--; ckfree(mapPtr->loc[mapPtr->nuloc].line); mapPtr->loc[mapPtr->nuloc].line = NULL; - mapPtr->loc[mapPtr->nuloc].invokePc = -1; } SetLineInformation(0); @@ -3325,17 +3315,6 @@ TclInitByteCodeObj( * byte code object (internal rep), for use with the bc compiler. */ - for (i = 0; i < envPtr->extCmdMapPtr->nuloc; i++) { - int isnew, pc = envPtr->extCmdMapPtr->loc[i].invokePc; - - if (pc < 0) { - continue; - } - - Tcl_SetHashValue(Tcl_CreateHashEntry(&envPtr->extCmdMapPtr->litInfo, - INT2PTR(pc), &isnew), INT2PTR(i)); - } - Tcl_SetHashValue(Tcl_CreateHashEntry(iPtr->lineBCPtr, codePtr, &isNew), envPtr->extCmdMapPtr); envPtr->extCmdMapPtr = NULL; @@ -3706,7 +3685,6 @@ EnterCmdWordData( ePtr = &eclPtr->loc[eclPtr->nuloc]; ePtr->srcOffset = srcOffset; - ePtr->invokePc = -1; ePtr->line = ckalloc(numWords * sizeof(int)); ePtr->next = ckalloc(numWords * sizeof(int *)); ePtr->nline = numWords; @@ -4477,27 +4455,6 @@ TclFixupForwardJump( } } - /* - * TIP #280: Adjust the mapping from PC values to the per-command - * information about arguments and their line numbers. - * - * Note: We cannot simply remove an out-of-date entry and then reinsert - * with the proper PC, because then we might overwrite another entry which - * was at that location. Therefore we pull (copy + delete) all effected - * entries (beyond the fixed PC) into an array, update them there, and at - * last reinsert them all. - */ - - { - ExtCmdLoc* eclPtr = envPtr->extCmdMapPtr; - for (k = eclPtr->nuloc - 1; k >= 0; k--) { - if (eclPtr->loc[k].invokePc < (jumpFixupPtr->codeOffset + 2)) { - continue; - } - eclPtr->loc[k].invokePc += 3; - } - } - return 1; /* the jump was grown */ } diff --git a/generic/tclCompile.h b/generic/tclCompile.h index b94bd93..f70f8f7 100644 --- a/generic/tclCompile.h +++ b/generic/tclCompile.h @@ -175,7 +175,6 @@ typedef struct CmdLocation { typedef struct ECL { int srcOffset; /* Command location to find the entry. */ - int invokePc; int nline; /* Number of words in the command */ int *line; /* Line information for all words in the * command. */ @@ -194,13 +193,6 @@ typedef struct ExtCmdLoc { ECL *loc; /* Command word locations (lines). */ int nloc; /* Number of allocated entries in 'loc'. */ int nuloc; /* Number of used entries in 'loc'. */ - Tcl_HashTable litInfo; /* Indexed by bytecode 'PC', to have the - * information accessible per command and - * argument, not per whole bytecode. Value is - * index of command in 'loc', giving us the - * literals to associate with line information - * as command argument, see - * TclArgumentBCEnter() */ } ExtCmdLoc; /* diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 37bf072..f8ed667 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -721,7 +721,7 @@ static ExceptionRange * GetExceptRangeForPc(const unsigned char *pc, int catchOnly, ByteCode *codePtr); static const char * GetSrcInfoForPc(const unsigned char *pc, ByteCode *codePtr, int *lengthPtr, - const unsigned char **pcBeg); + const unsigned char **pcBeg, int *cmdIdxPtr); static Tcl_Obj ** GrowEvaluationStack(ExecEnv *eePtr, int growth, int move); static void IllegalExprOperandType(Tcl_Interp *interp, @@ -2431,8 +2431,11 @@ TEBCresume( iPtr->cmdFramePtr = bcFramePtr; if (iPtr->flags & INTERP_DEBUG_FRAME) { - TclArgumentBCEnter((Tcl_Interp *) iPtr, objv, objc, - codePtr, bcFramePtr, pc - codePtr->codeStart); + int cmd; + if (GetSrcInfoForPc(pc, codePtr, NULL, NULL, &cmd)) { + TclArgumentBCEnter((Tcl_Interp *) iPtr, objv, objc, + codePtr, bcFramePtr, cmd, pc - codePtr->codeStart); + } } pc++; @@ -2885,8 +2888,11 @@ TEBCresume( iPtr->cmdFramePtr = bcFramePtr; if (iPtr->flags & INTERP_DEBUG_FRAME) { - TclArgumentBCEnter((Tcl_Interp *) iPtr, objv, objc, - codePtr, bcFramePtr, pc - codePtr->codeStart); + int cmd; + if (GetSrcInfoForPc(pc, codePtr, NULL, NULL, &cmd)) { + TclArgumentBCEnter((Tcl_Interp *) iPtr, objv, objc, + codePtr, bcFramePtr, cmd, pc - codePtr->codeStart); + } } DECACHE_STACK_INFO(); @@ -3031,8 +3037,11 @@ TEBCresume( bcFramePtr->data.tebc.pc = (char *) pc; iPtr->cmdFramePtr = bcFramePtr; if (iPtr->flags & INTERP_DEBUG_FRAME) { - TclArgumentBCEnter((Tcl_Interp *) iPtr, objv, objc, - codePtr, bcFramePtr, pc - codePtr->codeStart); + int cmd; + if (GetSrcInfoForPc(pc, codePtr, NULL, NULL, &cmd)) { + TclArgumentBCEnter((Tcl_Interp *) iPtr, objv, objc, + codePtr, bcFramePtr, cmd, pc - codePtr->codeStart); + } } iPtr->ensembleRewrite.sourceObjs = objv; iPtr->ensembleRewrite.numRemovedObjs = opnd; @@ -6967,7 +6976,7 @@ TEBCresume( if ((result == TCL_ERROR) && !(iPtr->flags & ERR_ALREADY_LOGGED)) { const unsigned char *pcBeg; - bytes = GetSrcInfoForPc(pc, codePtr, &length, &pcBeg); + bytes = GetSrcInfoForPc(pc, codePtr, &length, &pcBeg, NULL); DECACHE_STACK_INFO(); TclLogCommandInfo(interp, codePtr->source, bytes, bytes ? length : 0, pcBeg, tosPtr); @@ -7149,7 +7158,7 @@ TEBCresume( } codePtr->flags |= TCL_BYTECODE_RECOMPILE; - bytes = GetSrcInfoForPc(pc, codePtr, &length, NULL); + bytes = GetSrcInfoForPc(pc, codePtr, &length, NULL, NULL); opnd = TclGetUInt4AtPtr(pc+1); pc += (opnd-1); PUSH_OBJECT(Tcl_NewStringObj(bytes, length)); @@ -8642,7 +8651,7 @@ ValidatePcAndStackTop( if (checkStack && ((stackTop < 0) || (stackTop > stackUpperBound))) { int numChars; - const char *cmd = GetSrcInfoForPc(pc, codePtr, &numChars, NULL); + const char *cmd = GetSrcInfoForPc(pc, codePtr, &numChars, NULL, NULL); fprintf(stderr, "\nBad stack top %d at pc %u in TclNRExecuteByteCode (min 0, max %i)", stackTop, relativePc, stackUpperBound); @@ -8756,7 +8765,7 @@ TclGetSrcInfoForCmd( ByteCode *codePtr = (ByteCode *) cfPtr->data.tebc.codePtr; return GetSrcInfoForPc((unsigned char *) cfPtr->data.tebc.pc, - codePtr, lenPtr, NULL); + codePtr, lenPtr, NULL, NULL); } void @@ -8768,7 +8777,7 @@ TclGetSrcInfoForPc( if (cfPtr->cmd.str.cmd == NULL) { cfPtr->cmd.str.cmd = GetSrcInfoForPc( (unsigned char *) cfPtr->data.tebc.pc, codePtr, - &cfPtr->cmd.str.len, NULL); + &cfPtr->cmd.str.len, NULL, NULL); } if (cfPtr->cmd.str.cmd != NULL) { @@ -8828,9 +8837,12 @@ GetSrcInfoForPc( int *lengthPtr, /* If non-NULL, the location where the length * of the command's source should be stored. * If NULL, no length is stored. */ - const unsigned char **pcBeg)/* If non-NULL, the bytecode location + const unsigned char **pcBeg,/* If non-NULL, the bytecode location * where the current instruction starts. * If NULL; no pointer is stored. */ + int *cmdIdxPtr) /* If non-NULL, the location where the index + * of the command containing the pc should + * be stored. */ { register int pcOffset = (pc - codePtr->codeStart); int numCmds = codePtr->numCommands; @@ -8840,6 +8852,7 @@ GetSrcInfoForPc( int bestDist = INT_MAX; /* Distance of pc to best cmd's start pc. */ int bestSrcOffset = -1; /* Initialized to avoid compiler warning. */ int bestSrcLength = -1; /* Initialized to avoid compiler warning. */ + int bestCmdIdx = -1; if ((pcOffset < 0) || (pcOffset >= codePtr->numCodeBytes)) { if (pcBeg != NULL) *pcBeg = NULL; @@ -8907,6 +8920,7 @@ GetSrcInfoForPc( bestDist = dist; bestSrcOffset = srcOffset; bestSrcLength = srcLen; + bestCmdIdx = i; } } } @@ -8936,6 +8950,10 @@ GetSrcInfoForPc( *lengthPtr = bestSrcLength; } + if (cmdIdxPtr != NULL) { + *cmdIdxPtr = bestCmdIdx; + } + return (codePtr->source + bestSrcOffset); } diff --git a/generic/tclInt.h b/generic/tclInt.h index b940225..da09366 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -2828,7 +2828,7 @@ MODULE_SCOPE void TclArgumentRelease(Tcl_Interp *interp, Tcl_Obj *objv[], int objc); MODULE_SCOPE void TclArgumentBCEnter(Tcl_Interp *interp, Tcl_Obj *objv[], int objc, - void *codePtr, CmdFrame *cfPtr, int pc); + void *codePtr, CmdFrame *cfPtr, int cmd, int pc); MODULE_SCOPE void TclArgumentBCRelease(Tcl_Interp *interp, CmdFrame *cfPtr); MODULE_SCOPE void TclArgumentGet(Tcl_Interp *interp, Tcl_Obj *obj, -- cgit v0.12 From 3f126895fb9a9135480b18a16d017dfa39d90f3f Mon Sep 17 00:00:00 2001 From: dgp Date: Tue, 16 Jul 2013 14:52:33 +0000 Subject: Simplify arguments to TclContinuationsEnterDerived(). --- generic/tclCompile.c | 6 ++---- generic/tclEnsemble.c | 14 ++++++++------ 2 files changed, 10 insertions(+), 10 deletions(-) diff --git a/generic/tclCompile.c b/generic/tclCompile.c index 7e0be76..bc7501a 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.c @@ -1805,8 +1805,7 @@ TclCompileInvocation( tokenPtr[1].start, tokenPtr[1].size); if (envPtr->clNext) { TclContinuationsEnterDerived(TclFetchLiteral(envPtr, objIdx), - tokenPtr[1].start - envPtr->source, - mapPtr->loc[eclIndex].next[wordIdx]); + tokenPtr[1].start - envPtr->source, envPtr->clNext); } TclEmitPush(objIdx, envPtr); } @@ -1855,8 +1854,7 @@ CompileExpanded( tokenPtr[1].start, tokenPtr[1].size); if (envPtr->clNext) { TclContinuationsEnterDerived(TclFetchLiteral(envPtr, objIdx), - tokenPtr[1].start - envPtr->source, - mapPtr->loc[eclIndex].next[wordIdx]); + tokenPtr[1].start - envPtr->source, envPtr->clNext); } TclEmitPush(objIdx, envPtr); } diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c index 9b6ca92..864283b 100644 --- a/generic/tclEnsemble.c +++ b/generic/tclEnsemble.c @@ -3163,12 +3163,16 @@ CompileToInvokedCommand( */ Tcl_ListObjGetElements(NULL, replacements, &numWords, &words); - for (i=0,tokPtr=parsePtr->tokenPtr ; inumWords ; i++) { + for (i = 0, tokPtr = parsePtr->tokenPtr; i < parsePtr->numWords; + i++, tokPtr = TokenAfter(tokPtr)) { if (i > 0 && i < numWords+1) { bytes = Tcl_GetStringFromObj(words[i-1], &length); PushLiteral(envPtr, bytes, length); - } else if (tokPtr->type == TCL_TOKEN_SIMPLE_WORD) { - /* TODO: Check about registering Cmd Literals here */ + continue; + } + + SetLineInformation(i); + if (tokPtr->type == TCL_TOKEN_SIMPLE_WORD) { int literal = TclRegisterNewLiteral(envPtr, tokPtr[1].start, tokPtr[1].size); @@ -3176,14 +3180,12 @@ CompileToInvokedCommand( TclContinuationsEnterDerived( TclFetchLiteral(envPtr, literal), tokPtr[1].start - envPtr->source, - mapPtr->loc[eclIndex].next[i]); + envPtr->clNext); } TclEmitPush(literal, envPtr); } else { - SetLineInformation(i); CompileTokens(envPtr, tokPtr, interp); } - tokPtr = TokenAfter(tokPtr); } /* -- cgit v0.12 From c33f97005c30adcc8fbfafc81dc9d67913a4be43 Mon Sep 17 00:00:00 2001 From: dgp Date: Tue, 16 Jul 2013 17:21:12 +0000 Subject: Simplify the ensemble subcommand compile. There's no need to be crafting synthetic Tcl_Parse and copying tokens. Some pointer shifts will do. --- generic/tclCompile.c | 1 - generic/tclEnsemble.c | 70 +++++++++++---------------------------------------- 2 files changed, 15 insertions(+), 56 deletions(-) diff --git a/generic/tclCompile.c b/generic/tclCompile.c index bc7501a..d82d728 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.c @@ -1992,7 +1992,6 @@ CompileCmdCompileProc( mapPtr->loc[mapPtr->nuloc].line = NULL; } - SetLineInformation(0); return TCL_ERROR; } diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c index 864283b..e4f96c0 100644 --- a/generic/tclEnsemble.c +++ b/generic/tclEnsemble.c @@ -3029,12 +3029,6 @@ TclCompileEnsemble( return ourResult; } -/* - * How to compile a subcommand using its own command compiler. To do that, we - * have to perform some trickery to rewrite the arguments, as compilers *must* - * have parse tokens that refer to addresses in the original script. - */ - static int CompileToCompiledCommand( Tcl_Interp *interp, @@ -3043,10 +3037,8 @@ CompileToCompiledCommand( Command *cmdPtr, CompileEnv *envPtr) /* Holds resulting instructions. */ { - Tcl_Parse synthetic; - Tcl_Token *tokenPtr; int result, i; - int savedNumCmds = envPtr->numCommands; + Tcl_Token *saveTokenPtr = parsePtr->tokenPtr; int savedStackDepth = envPtr->currStackDepth; unsigned savedCodeNext = envPtr->codeNext - envPtr->codeStart; DefineLineInformation; @@ -3055,47 +3047,17 @@ CompileToCompiledCommand( return TCL_ERROR; } - TclParseInit(interp, NULL, 0, &synthetic); - synthetic.numWords = parsePtr->numWords - depth + 1; - TclGrowParseTokenArray(&synthetic, 2); - synthetic.numTokens = 2; - - /* - * Now we have the space to work in, install something rewritten. The - * first word will "officially" be the bytes of the structured ensemble - * name. That's technically wrong, but nobody will care; we just need - * *something* here... - */ - - synthetic.tokenPtr[0].type = TCL_TOKEN_SIMPLE_WORD; - synthetic.tokenPtr[0].start = parsePtr->tokenPtr[0].start; - synthetic.tokenPtr[0].numComponents = 1; - synthetic.tokenPtr[1].type = TCL_TOKEN_TEXT; - synthetic.tokenPtr[1].start = parsePtr->tokenPtr[0].start; - synthetic.tokenPtr[1].numComponents = 0; - for (i=0,tokenPtr=parsePtr->tokenPtr ; istart - synthetic.tokenPtr[0].start) - + tokenPtr->size; - - synthetic.tokenPtr[0].size = sclen; - synthetic.tokenPtr[1].size = sclen; - tokenPtr = TokenAfter(tokenPtr); - } - /* - * Copy over the real argument tokens. + * Advance parsePtr->tokenPtr so that it points at the last subcommand. + * This will be wrong, but it will not matter, and it will put the + * tokens for the arguments in the right place without the needed to + * allocate a synthetic Tcl_Parse struct, or copy tokens around. */ - for (i=1; inumComponents + 1; - TclGrowParseTokenArray(&synthetic, toCopy); - memcpy(synthetic.tokenPtr + synthetic.numTokens, tokenPtr, - sizeof(Tcl_Token) * toCopy); - synthetic.numTokens += toCopy; - tokenPtr = TokenAfter(tokenPtr); + for (i = 0; i < depth - 1; i++) { + parsePtr->tokenPtr = TokenAfter(parsePtr->tokenPtr); } + parsePtr->numWords -= (depth - 1); /* * Shift the line information arrays to account for different word @@ -3109,7 +3071,7 @@ CompileToCompiledCommand( * Hand off compilation to the subcommand compiler. At last! */ - result = cmdPtr->compileProc(interp, &synthetic, cmdPtr, envPtr); + result = cmdPtr->compileProc(interp, parsePtr, cmdPtr, envPtr); /* * Undo the shift. @@ -3118,22 +3080,20 @@ CompileToCompiledCommand( mapPtr->loc[eclIndex].line -= (depth - 1); mapPtr->loc[eclIndex].next -= (depth - 1); + parsePtr->numWords += (depth - 1); + parsePtr->tokenPtr = saveTokenPtr; + /* - * If our target fails to compile, revert the number of commands and the - * pointer to the place to issue the next instruction. [Bug 3600328] + * If our target failed to compile, revert any data from failed partial + * compiles. Note that envPtr->numCommands need not be checked because + * we avoid compiling subcommands that recursively call TclCompileScript(). */ if (result != TCL_OK) { - envPtr->numCommands = savedNumCmds; envPtr->currStackDepth = savedStackDepth; envPtr->codeNext = envPtr->codeStart + savedCodeNext; } - /* - * Clean up if necessary. - */ - - Tcl_FreeParse(&synthetic); return result; } -- cgit v0.12 From d383707870a66078dd83c9532e7dbcb1002e62ba Mon Sep 17 00:00:00 2001 From: dgp Date: Tue, 16 Jul 2013 20:48:37 +0000 Subject: Streamline the housekeeping on the operands of INST_START_CMD. For example, do only incr on success, not incr on attempt + decr on error. --- generic/tclCompile.c | 81 +++++++++++++++++++++------------------------------- 1 file changed, 32 insertions(+), 49 deletions(-) diff --git a/generic/tclCompile.c b/generic/tclCompile.c index d82d728..6ac5fb9 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.c @@ -1885,47 +1885,41 @@ CompileCmdCompileProc( Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, - int startCodeOffset, CompileEnv *envPtr) { int savedNumCmds = envPtr->numCommands; int startStackDepth = envPtr->currStackDepth; - int update = 0; + int startCodeOffset = envPtr->codeNext - envPtr->codeStart; + int incrOffset = -1; DefineLineInformation; /* - * 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] + * Emit of the INST_START_CMD instruction is controlled by + * the value of envPtr->atCmdStart: * - * Note that the environment is initialised with - * atCmdStart=1 to avoid emitting ISC for the first - * command. + * atCmdStart == 2 : We are not using the INST_START_CMD instruction. + * atCmdStart == 1 : INST_START_CMD was the last instruction emitted. + * : We do not need to emit another. Instead we + * : increment the number of cmds started at it (except + * : for the special case at the start of a script.) + * atCmdStart == 0 : The last instruction was something else. We need + * : to emit INST_START_CMD here. */ - 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) { + switch (envPtr->atCmdStart) { + case 0: TclEmitInstInt4(INST_START_CMD, 0, envPtr); - TclEmitInt4(1, envPtr); - update = 1; + incrOffset = envPtr->codeNext - envPtr->codeStart; + TclEmitInt4(0, envPtr); + break; + case 1: + if (envPtr->codeNext > envPtr->codeStart) { + incrOffset = envPtr->codeNext - 4 - envPtr->codeStart; + } + break; + case 2: + /* Nothing to do */ + ; } if (TCL_OK == cmdPtr->compileProc(interp, parsePtr, cmdPtr, envPtr)) { @@ -1947,30 +1941,20 @@ CompileCmdCompileProc( parsePtr->tokenPtr->start, diff); } #endif - if (update) { + if (incrOffset >= 0) { /* - * Fix the bytecode length. + * 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; - unsigned char *fixPtr = envPtr->codeStart + startCodeOffset + 1; - unsigned fixLen = envPtr->codeNext - fixPtr + 1; - - TclStoreInt4AtPtr(fixLen, fixPtr); + TclIncrUInt4AtPtr(incrPtr, 1); + TclStoreInt4AtPtr(envPtr->codeNext - startPtr, startPtr + 1); } 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 @@ -2069,8 +2053,7 @@ CompileCommandTokens( /* If cmdPtr != NULL, we will try to call cmdPtr->compileProc */ if (cmdPtr) { - code = CompileCmdCompileProc(interp, parsePtr, cmdPtr, - startCodeOffset, envPtr); + code = CompileCmdCompileProc(interp, parsePtr, cmdPtr, envPtr); } if (code == TCL_ERROR) { -- cgit v0.12 From c2d6c48dd921e7120d626f1a85977ae130dd109e Mon Sep 17 00:00:00 2001 From: dgp Date: Wed, 17 Jul 2013 13:57:23 +0000 Subject: Factor out the call to a compileProc into one place used by both ensemble subcommand compiles and toplevel command compiles in TclCompileScript. --- generic/tclCompile.c | 48 ++++++++++++++---------------------------------- generic/tclCompile.h | 3 +++ generic/tclEnsemble.c | 28 +++++++++++++++++++++------- 3 files changed, 38 insertions(+), 41 deletions(-) diff --git a/generic/tclCompile.c b/generic/tclCompile.c index 6ac5fb9..763e8f1 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.c @@ -1887,10 +1887,7 @@ CompileCmdCompileProc( Command *cmdPtr, CompileEnv *envPtr) { - int savedNumCmds = envPtr->numCommands; - int startStackDepth = envPtr->currStackDepth; - int startCodeOffset = envPtr->codeNext - envPtr->codeStart; - int incrOffset = -1; + int unwind = 0, incrOffset = -1; DefineLineInformation; /* @@ -1908,6 +1905,7 @@ CompileCmdCompileProc( switch (envPtr->atCmdStart) { case 0: + unwind = tclInstructionTable[INST_START_CMD].numBytes; TclEmitInstInt4(INST_START_CMD, 0, envPtr); incrOffset = envPtr->codeNext - envPtr->codeStart; TclEmitInt4(0, envPtr); @@ -1922,25 +1920,7 @@ CompileCmdCompileProc( ; } - 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 (TCL_OK == TclAttemptCompileProc(interp, parsePtr, 1, cmdPtr, envPtr)) { if (incrOffset >= 0) { /* * We successfully compiled a command. Increment the number @@ -1950,21 +1930,15 @@ CompileCmdCompileProc( unsigned char *startPtr = incrPtr - 5; TclIncrUInt4AtPtr(incrPtr, 1); - TclStoreInt4AtPtr(envPtr->codeNext - startPtr, startPtr + 1); + if (unwind) { + /* We started the INST_START_CMD. Record the code length. */ + TclStoreInt4AtPtr(envPtr->codeNext - startPtr, startPtr + 1); + } } return TCL_OK; } - /* - * 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->codeNext -= unwind; /* Unwind INST_START_CMD */ /* * Throw out any line information generated by the failed @@ -1976,6 +1950,12 @@ CompileCmdCompileProc( mapPtr->loc[mapPtr->nuloc].line = NULL; } + /* + * Reset the index of next command. + * Toss out any from failed nested partial compiles. + */ + envPtr->numCommands = mapPtr->nuloc; + return TCL_ERROR; } diff --git a/generic/tclCompile.h b/generic/tclCompile.h index f70f8f7..56315db 100644 --- a/generic/tclCompile.h +++ b/generic/tclCompile.h @@ -984,6 +984,9 @@ MODULE_SCOPE ByteCode * TclCompileObj(Tcl_Interp *interp, Tcl_Obj *objPtr, *---------------------------------------------------------------- */ +MODULE_SCOPE int TclAttemptCompileProc(Tcl_Interp *interp, + Tcl_Parse *parsePtr, int depth, Command *cmdPtr, + CompileEnv *envPtr); MODULE_SCOPE void TclCleanupByteCode(ByteCode *codePtr); MODULE_SCOPE void TclCleanupStackForBreakContinue(CompileEnv *envPtr, ExceptionAux *auxPtr); diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c index e4f96c0..bab63c9 100644 --- a/generic/tclEnsemble.c +++ b/generic/tclEnsemble.c @@ -35,9 +35,6 @@ static void MakeCachedEnsembleCommand(Tcl_Obj *objPtr, static void FreeEnsembleCmdRep(Tcl_Obj *objPtr); static void DupEnsembleCmdRep(Tcl_Obj *objPtr, Tcl_Obj *copyPtr); static void StringOfEnsembleCmdRep(Tcl_Obj *objPtr); -static int CompileToCompiledCommand(Tcl_Interp *interp, - Tcl_Parse *parsePtr, int depth, Command *cmdPtr, - CompileEnv *envPtr); static void CompileToInvokedCommand(Tcl_Interp *interp, Tcl_Parse *parsePtr, Tcl_Obj *replacements, Command *cmdPtr, CompileEnv *envPtr); @@ -2994,8 +2991,8 @@ TclCompileEnsemble( */ invokeAnyway = 1; - if (CompileToCompiledCommand(interp, parsePtr, depth, cmdPtr, - envPtr) == TCL_OK) { + if (TCL_OK == TclAttemptCompileProc(interp, parsePtr, depth, cmdPtr, + envPtr)) { ourResult = TCL_OK; goto cleanup; } @@ -3029,8 +3026,8 @@ TclCompileEnsemble( return ourResult; } -static int -CompileToCompiledCommand( +int +TclAttemptCompileProc( Tcl_Interp *interp, Tcl_Parse *parsePtr, int depth, @@ -3092,6 +3089,23 @@ CompileToCompiledCommand( if (result != TCL_OK) { envPtr->currStackDepth = savedStackDepth; envPtr->codeNext = envPtr->codeStart + savedCodeNext; +#ifdef TCL_COMPILE_DEBUG + } else { + /* + * 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 - savedStackDepth; + + if (diff != 1) { + Tcl_Panic("bad stack adjustment when compiling" + " %.*s (was %d instead of 1)", parsePtr->tokenPtr->size, + parsePtr->tokenPtr->start, diff); + } +#endif } return result; -- cgit v0.12 From 5e9e003379a72c3459d97b1931c3e8b8627541f8 Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 18 Jul 2013 18:25:24 +0000 Subject: [assemble] compile syntax error into bytecode reporting syntax error message. --- generic/tclAssembly.c | 10 +++------- 1 file changed, 3 insertions(+), 7 deletions(-) diff --git a/generic/tclAssembly.c b/generic/tclAssembly.c index 0722eb9..9b9b6f8 100644 --- a/generic/tclAssembly.c +++ b/generic/tclAssembly.c @@ -930,7 +930,7 @@ TclCompileAssembleCmd( { Tcl_Token *tokenPtr; /* Token in the input script */ -#if 0 +#if 1 int numCommands = envPtr->numCommands; int offset = envPtr->codeNext - envPtr->codeStart; int depth = envPtr->currStackDepth; @@ -956,11 +956,7 @@ TclCompileAssembleCmd( if (TCL_ERROR == TclAssembleCode(envPtr, tokenPtr[1].start, tokenPtr[1].size, TCL_EVAL_DIRECT)) { - /* - * TODO: Finish working out how to capture syntax errors captured - * during compile and make them bytecode reporting the error. - */ -#if 0 +#if 1 Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n (\"%.*s\" body, line %d)", parsePtr->tokenPtr->size, parsePtr->tokenPtr->start, @@ -1136,7 +1132,7 @@ NewAssemblyEnv( assemEnvPtr->envPtr = envPtr; assemEnvPtr->parsePtr = parsePtr; - assemEnvPtr->cmdLine = envPtr->line; + assemEnvPtr->cmdLine = 1; assemEnvPtr->clNext = envPtr->clNext; /* -- cgit v0.12