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.

From: dgp <[email-masked]>
Date: Thu, 27 Jun 2013 20:10:41 +0000

---
 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