From 7924f4a694c43ca8fe4260041d090795b0791a96 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