Nearly functional now, but leaky and not yet as tidy as I'm hoping for.

1 files 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;