Added mechanism for pre-parsing built-in ensembles even when they are not going

to generate specific code. This provides a good speedup in some cases.

8 files changed, 333 insertions, 98 deletions

diff --git a/ChangeLog b/ChangeLog
index 289e10a..09a0199 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,11 @@
+2013-01-03  Donal K. Fellows  <dkf@users.sf.net>
+
+	* generic/tclExecute.c (TEBCresume:INST_INVOKE_REPLACE):
+	* generic/tclEnsemble.c (TclCompileEnsemble): Added new mechanism to
+	allow for more efficient dispatch of non-bytecode-compiled subcommands
+	of bytecode-compiled ensembles. This can provide substantial speed
+	benefits in some cases.
+
 2013-01-02  Miguel Sofer  <msofer@users.sf.net>
 
 	* generic/tclEnsemble.c:  Remove stray calls to Tcl_Alloc and
diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index 160fa3c..8fa191b 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -5791,7 +5791,7 @@ TclCompileVariableCmd(
      */
 
     valueTokenPtr = parsePtr->tokenPtr;
-    for (i=2; i<=numWords; i+=2) {
+    for (i=1; i<numWords; i+=2) {
 	varTokenPtr = TokenAfter(valueTokenPtr);
 	valueTokenPtr = TokenAfter(varTokenPtr);
 
@@ -5801,15 +5801,15 @@ TclCompileVariableCmd(
 	    return TCL_ERROR;
 	}
 
-	CompileWord(envPtr, varTokenPtr, interp, 1);
+	CompileWord(envPtr, varTokenPtr, interp, i);
 	TclEmitInstInt4(	INST_VARIABLE, localIndex,	envPtr);
 
-	if (i != numWords) {
+	if (i+1 < numWords) {
 	    /*
 	     * A value has been given: set the variable, pop the value
 	     */
 
-	    CompileWord(envPtr, valueTokenPtr, interp, 1);
+	    CompileWord(envPtr, valueTokenPtr, interp, i+1);
 	    Emit14Inst(		INST_STORE_SCALAR, localIndex,	envPtr);
 	    TclEmitOpcode(	INST_POP,			envPtr);
 	}
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index 309682d..45a74d7 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -529,6 +529,11 @@ InstructionDesc const tclInstructionTable[] = {
 	/* Forces the variable indexed by opnd to be an array. Does not touch
 	 * the stack. */
 
+    {"invokeReplace",	 6,	INT_MIN,  2,	{OPERAND_UINT4,OPERAND_UINT1}},
+	/* Invoke command named objv[0], replacing the first two words with
+	 * the word at the top of the stack;
+	 * <objc,objv> = <op4,top op4 after popping 1> */
+
     {NULL, 0, 0, 0, {OPERAND_NONE}}
 };
 
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index 3302f9b..4d8ed65 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -711,8 +711,10 @@ typedef struct ByteCode {
 #define INST_ARRAY_MAKE_STK		161
 #define INST_ARRAY_MAKE_IMM		162
 
+#define INST_INVOKE_REPLACE		163
+
 /* The last opcode */
-#define LAST_INST_OPCODE		162
+#define LAST_INST_OPCODE		163
 
 /*
  * Table describing the Tcl bytecode instructions: their name (for displaying
diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c
index d8fcf97..0cad216 100644
--- a/generic/tclEnsemble.c
+++ b/generic/tclEnsemble.c
@@ -4,7 +4,7 @@
  *	Contains support for ensembles (see TIP#112), which provide simple
  *	mechanism for creating composite commands on top of namespaces.
  *
- * Copyright (c) 2005-2010 Donal K. Fellows.
+ * Copyright (c) 2005-2013 Donal K. Fellows.
  *
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -35,6 +35,12 @@ 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);
 
 /*
  * The lists of subcommands and options for the [namespace ensemble] command.
@@ -78,6 +84,17 @@ const Tcl_ObjType tclEnsembleCmdType = {
     StringOfEnsembleCmdRep,	/* updateStringProc */
     NULL			/* setFromAnyProc */
 };
+
+/*
+ * Copied from tclCompCmds.c
+ */
+
+#define DefineLineInformation \
+    ExtCmdLoc *mapPtr = envPtr->extCmdMapPtr;				\
+    int eclIndex = mapPtr->nuloc - 1
+#define SetLineInformation(word) \
+    envPtr->line = mapPtr->loc[eclIndex].line[(word)];			\
+    envPtr->clNext = mapPtr->loc[eclIndex].next[(word)]
 
 static inline Tcl_Obj *
 NewNsObj(
@@ -1565,15 +1582,17 @@ TclMakeEnsemble(
 			    NULL);
 		}
 		cmdPtr->compileProc = map[i].compileProc;
-		if (map[i].compileProc != NULL) {
-		    ensembleFlags |= ENSEMBLE_COMPILE;
-		}
 	    }
 	}
 	Tcl_SetEnsembleMappingDict(interp, ensemble, mapDict);
-	if (ensembleFlags & ENSEMBLE_COMPILE) {
-	    Tcl_SetEnsembleFlags(interp, ensemble, ensembleFlags);
-	}
+
+	/*
+	 * Switch on compilation always for core ensembles now that we can do
+	 * nice bytecode things with them.
+	 */
+
+	Tcl_SetEnsembleFlags(interp, ensemble,
+		ensembleFlags | ENSEMBLE_COMPILE);
     }
 
     Tcl_DStringFree(&buf);
@@ -2731,25 +2750,33 @@ TclCompileEnsemble(
 				 * compiled. */
     CompileEnv *envPtr)		/* Holds resulting instructions. */
 {
-    Tcl_Token *tokenPtr;
+    Tcl_Token *tokenPtr = TokenAfter(parsePtr->tokenPtr);
     Tcl_Obj *mapObj, *subcmdObj, *targetCmdObj, *listObj, **elems;
+    Tcl_Obj *replaced = Tcl_NewObj(), *replacement;
     Tcl_Command ensemble = (Tcl_Command) cmdPtr;
-    Tcl_Parse synthetic;
-    int len, result, flags = 0, i;
+    Command *oldCmdPtr = cmdPtr, *newCmdPtr;
+    int len, result, flags = 0, i, depth = 1, invokeAnyway = 0;
+    int ourResult = TCL_ERROR;
     unsigned numBytes;
     const char *word;
 
-    if (parsePtr->numWords < 2) {
-	return TCL_ERROR;
-    }
+    Tcl_IncrRefCount(replaced);
+
+    /*
+     * This is where we return to if we are parsing multiple nested compiled
+     * ensembles. [info object] is such a beast.
+     */
 
-    tokenPtr = TokenAfter(parsePtr->tokenPtr);
+  checkNextWord:
+    if (parsePtr->numWords < depth + 1) {
+	goto failed;
+    }
     if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
 	/*
 	 * Too hard.
 	 */
 
-	return TCL_ERROR;
+	goto failed;
     }
 
     word = tokenPtr[1].start;
@@ -2768,7 +2795,7 @@ TclCompileEnsemble(
 	 * to proceed.
 	 */
 
-	return TCL_ERROR;
+	goto failed;
     }
 
     /*
@@ -2782,7 +2809,7 @@ TclCompileEnsemble(
 	 * Figuring out how to compile this has become too much. Bail out.
 	 */
 
-	return TCL_ERROR;
+	goto failed;
     }
 
     /*
@@ -2805,7 +2832,7 @@ TclCompileEnsemble(
 	Tcl_Obj *matchObj = NULL;
 
 	if (Tcl_ListObjGetElements(NULL, listObj, &len, &elems) != TCL_OK) {
-	    return TCL_ERROR;
+	    goto failed;
 	}
 	for (i=0 ; i<len ; i++) {
 	    str = Tcl_GetStringFromObj(elems[i], &sclen);
@@ -2816,8 +2843,9 @@ TclCompileEnsemble(
 
 		result = Tcl_DictObjGet(NULL, mapObj,elems[i], &targetCmdObj);
 		if (result != TCL_OK || targetCmdObj == NULL) {
-		    return TCL_ERROR;
+		    goto failed;
 		}
+		replacement = elems[i];
 		goto doneMapLookup;
 	    }
 
@@ -2833,18 +2861,19 @@ TclCompileEnsemble(
 	    if ((flags & TCL_ENSEMBLE_PREFIX)
 		    && strncmp(word, str, numBytes) == 0) {
 		if (matchObj != NULL) {
-		    return TCL_ERROR;
+		    goto failed;
 		}
 		matchObj = elems[i];
 	    }
 	}
 	if (matchObj == NULL) {
-	    return TCL_ERROR;
+	    goto failed;
 	}
 	result = Tcl_DictObjGet(NULL, mapObj, matchObj, &targetCmdObj);
 	if (result != TCL_OK || targetCmdObj == NULL) {
-	    return TCL_ERROR;
+	    goto failed;
 	}
+	replacement = matchObj;
     } else {
 	Tcl_DictSearch s;
 	int done, matched;
@@ -2856,14 +2885,15 @@ TclCompileEnsemble(
 
 	TclNewStringObj(subcmdObj, word, (int) numBytes);
 	result = Tcl_DictObjGet(NULL, mapObj, subcmdObj, &targetCmdObj);
-	TclDecrRefCount(subcmdObj);
 	if (result == TCL_OK && targetCmdObj != NULL) {
 	    /*
 	     * Got it. Skip the fiddling around with prefixes.
 	     */
 
+	    replacement = subcmdObj;
 	    goto doneMapLookup;
 	}
+	TclDecrRefCount(subcmdObj);
 
 	/*
 	 * We've not literally got a valid subcommand. But maybe we have a
@@ -2871,7 +2901,7 @@ TclCompileEnsemble(
 	 */
 
 	if (!(flags & TCL_ENSEMBLE_PREFIX)) {
-	    return TCL_ERROR;
+	    goto failed;
 	}
 
 	/*
@@ -2881,6 +2911,7 @@ TclCompileEnsemble(
 
 	Tcl_DictObjFirst(NULL, mapObj, &s, &subcmdObj, &tmpObj, &done);
 	matched = 0;
+	replacement = NULL;		/* Silence, fool compiler! */
 	while (!done) {
 	    if (strncmp(TclGetString(subcmdObj), word, numBytes) == 0) {
 		if (matched++) {
@@ -2891,6 +2922,7 @@ TclCompileEnsemble(
 
 		    break;
 		}
+		replacement = subcmdObj;
 		targetCmdObj = tmpObj;
 	    }
 	    Tcl_DictObjNext(&s, &subcmdObj, &tmpObj, &done);
@@ -2903,7 +2935,8 @@ TclCompileEnsemble(
 	 */
 
 	if (matched != 1) {
-	    return TCL_ERROR;
+	    invokeAnyway = 1;
+	    goto failed;
 	}
     }
 
@@ -2917,75 +2950,149 @@ TclCompileEnsemble(
      */
 
   doneMapLookup:
+    Tcl_ListObjAppendElement(NULL, replaced, replacement);
     if (Tcl_ListObjGetElements(NULL, targetCmdObj, &len, &elems) != TCL_OK) {
-	return TCL_ERROR;
+	goto failed;
     }
-    if (len > 1 && Tcl_IsSafe(interp)) {
-	return TCL_ERROR;
+    if (len != 1) {
+	goto failed;
     }
     targetCmdObj = elems[0];
 
+    oldCmdPtr = cmdPtr;
     Tcl_IncrRefCount(targetCmdObj);
-    cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, targetCmdObj);
+    newCmdPtr = (Command *) Tcl_GetCommandFromObj(interp, targetCmdObj);
     TclDecrRefCount(targetCmdObj);
-    if (cmdPtr == NULL || cmdPtr->compileProc == NULL
-	    || cmdPtr->nsPtr->flags & NS_SUPPRESS_COMPILATION
-	    || cmdPtr->flags * CMD_HAS_EXEC_TRACES
+    if (newCmdPtr == NULL || Tcl_IsSafe(interp)
+	    || newCmdPtr->nsPtr->flags & NS_SUPPRESS_COMPILATION
+	    || newCmdPtr->flags & CMD_HAS_EXEC_TRACES
 	    || ((Interp *)interp)->flags & DONT_COMPILE_CMDS_INLINE) {
 	/*
 	 * Maps to an undefined command or a command without a compiler.
 	 * Cannot compile.
 	 */
 
-	return TCL_ERROR;
+	goto cleanup;
+    }
+    cmdPtr = newCmdPtr;
+    depth++;
+
+    /*
+     * See whether we have a nested ensemble. If we do, we can go round the
+     * mulberry bush again, consuming the next word.
+     */
+
+    if (cmdPtr->compileProc == TclCompileEnsemble) {
+	tokenPtr = TokenAfter(tokenPtr);
+	ensemble = (Tcl_Command) cmdPtr;
+	goto checkNextWord;
     }
 
     /*
      * Now we've done the mapping process, can now actually try to compile.
-     * We do this by handing off to the subcommand's actual compiler. But to
-     * do that, we have to perform some trickery to rewrite the arguments.
+     * If there is a subcommand compiler and that successfully produces code,
+     * we'll use that. Otherwise, we fall back to generating opcodes to do the
+     * invoke at runtime.
      */
 
-    TclParseInit(interp, NULL, 0, &synthetic);
-    synthetic.numWords = parsePtr->numWords - 2 + len;
-    TclGrowParseTokenArray(&synthetic, 2*len);
-    synthetic.numTokens = 2*len;
+    invokeAnyway = 1;
+    if (CompileToCompiledCommand(interp, parsePtr, depth, cmdPtr,
+	    envPtr) == TCL_OK) {
+	ourResult = TCL_OK;
+	goto cleanup;
+    }
 
     /*
-     * Now we have the space to work in, install something rewritten. Note
-     * that we are here praying for all our might that none of these words are
-     * a script; the error detection code will crash if that happens and there
-     * is nothing we can do to avoid it!
+     * Failed to do a full compile for some reason. Try to do a direct invoke
+     * instead of going through the ensemble lookup process again.
      */
 
-    for (i=0 ; i<len ; i++) {
-	int sclen;
-	const char *str = Tcl_GetStringFromObj(elems[i], &sclen);
+  failed:
+    if (len == 1 && depth < 250) {
+	if (depth > 1) {
+	    if (!invokeAnyway) {
+		cmdPtr = oldCmdPtr;
+		depth--;
+	    }
+	    (void) Tcl_ListObjReplace(NULL, replaced, depth, 2, 0, NULL);
+	}
+	CompileToInvokedCommand(interp, parsePtr, replaced, cmdPtr, envPtr);
+	ourResult = TCL_OK;
+    }
+
+    /*
+     * Release the memory we allocated. If we've got here, we've either done
+     * something useful or we're in a case that we can't compile at all and
+     * we're just giving up.
+     */
 
-	synthetic.tokenPtr[2*i].type = TCL_TOKEN_SIMPLE_WORD;
-	synthetic.tokenPtr[2*i].start = str;
-	synthetic.tokenPtr[2*i].size = sclen;
-	synthetic.tokenPtr[2*i].numComponents = 1;
+  cleanup:
+    Tcl_DecrRefCount(replaced);
+    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,
+    Tcl_Parse *parsePtr,
+    int depth,
+    Command *cmdPtr,
+    CompileEnv *envPtr)		/* Holds resulting instructions. */
+{
+    Tcl_Parse synthetic;
+    Tcl_Token *tokenPtr;
+    int result, i;
+
+    if (cmdPtr->compileProc == NULL) {
+	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[2*i+1].type = TCL_TOKEN_TEXT;
-	synthetic.tokenPtr[2*i+1].start = str;
-	synthetic.tokenPtr[2*i+1].size = sclen;
-	synthetic.tokenPtr[2*i+1].numComponents = 0;
+    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 ; i<depth ; i++) {
+	int sclen = (tokenPtr->start - 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.
      */
 
-    for (i=len; i<synthetic.numWords; i++) {
+    for (i=1; i<synthetic.numWords; i++) {
 	int toCopy;
 
-	tokenPtr = TokenAfter(tokenPtr);
 	toCopy = tokenPtr->numComponents + 1;
 	TclGrowParseTokenArray(&synthetic, toCopy);
 	memcpy(synthetic.tokenPtr + synthetic.numTokens, tokenPtr,
 		sizeof(Tcl_Token) * toCopy);
 	synthetic.numTokens += toCopy;
+	tokenPtr = TokenAfter(tokenPtr);
     }
 
     /*
@@ -3001,6 +3108,78 @@ TclCompileEnsemble(
     Tcl_FreeParse(&synthetic);
     return result;
 }
+
+/*
+ * How to compile a subcommand to a _replacing_ invoke of its implementation
+ * command.
+ */
+
+static void
+CompileToInvokedCommand(
+    Tcl_Interp *interp,
+    Tcl_Parse *parsePtr,
+    Tcl_Obj *replacements,
+    Command *cmdPtr,
+    CompileEnv *envPtr)		/* Holds resulting instructions. */
+{
+    Tcl_Token *tokPtr;
+    Tcl_Obj *objPtr, **words;
+    char *bytes;
+    int length, i, numWords, cmdLit;
+    DefineLineInformation;
+
+    /*
+     * Push the words of the command. Take care; the command words may be
+     * scripts that have backslashes in them, and [info frame 0] can see the
+     * difference. Hence the call to TclContinuationsEnterDerived...
+     */
+
+    Tcl_ListObjGetElements(NULL, replacements, &numWords, &words);
+    for (i=0,tokPtr=parsePtr->tokenPtr ; i<parsePtr->numWords ; i++) {
+	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) {
+	    int literal = TclRegisterNewLiteral(envPtr,
+		    tokPtr[1].start, tokPtr[1].size);
+
+	    if (envPtr->clNext) {
+		TclContinuationsEnterDerived(
+			envPtr->literalArrayPtr[literal].objPtr,
+			tokPtr[1].start - envPtr->source,
+			mapPtr->loc[eclIndex].next[i]);
+	    }
+	    TclEmitPush(literal, envPtr);
+	} else {
+	    if (envPtr->clNext) {
+		SetLineInformation(i);
+	    }
+	    CompileTokens(envPtr, tokPtr, interp);
+	}
+	tokPtr = TokenAfter(tokPtr);
+    }
+
+    /*
+     * Push the name of the command we're actually dispatching to as part of
+     * the implementation.
+     */
+
+    objPtr = Tcl_NewObj();
+    Tcl_GetCommandFullName(interp, (Tcl_Command) cmdPtr, objPtr);
+    bytes = Tcl_GetStringFromObj(objPtr, &length);
+    cmdLit = TclRegisterNewCmdLiteral(envPtr, bytes, length);
+    TclSetCmdNameObj(interp, envPtr->literalArrayPtr[cmdLit].objPtr, cmdPtr);
+    TclEmitPush(cmdLit, envPtr);
+    TclDecrRefCount(objPtr);
+
+    /*
+     * Do the replacing dispatch.
+     */
+
+    TclEmitInstInt4(INST_INVOKE_REPLACE, parsePtr->numWords, envPtr);
+    TclEmitInt1(numWords+1, envPtr);
+    TclAdjustStackDepth(-1, envPtr);	/* Correction to stack depth calcs. */
+}
 
 /*
  * Local Variables:
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index a9b3fb4..9fcc8a5 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -2972,6 +2972,69 @@ TEBCresume(
 	Tcl_Panic("TclNRExecuteByteCode: obsolete INST_CALL_FUNC1 found");
 #endif
 
+    case INST_INVOKE_REPLACE:
+	objc = TclGetUInt4AtPtr(pc+1);
+	opnd = TclGetUInt1AtPtr(pc+5);
+	objPtr = POP_OBJECT();
+	objv = &OBJ_AT_DEPTH(objc-1);
+	cleanup = objc;
+#ifdef TCL_COMPILE_DEBUG
+	if (tclTraceExec >= 2) {
+	    int i;
+
+	    if (traceInstructions) {
+		strncpy(cmdNameBuf, TclGetString(objv[0]), 20);
+		TRACE(("%u => call (implementation %s) ", objc, O2S(objPtr)));
+	    } else {
+		fprintf(stdout,
+			"%d: (%u) invoking (using implementation %s) ",
+			iPtr->numLevels, (unsigned)(pc - codePtr->codeStart),
+			O2S(objPtr));
+	    }
+	    for (i = 0;  i < objc;  i++) {
+		if (i < opnd) {
+		    fprintf(stdout, "<");
+		    TclPrintObject(stdout, objv[i], 15);
+		    fprintf(stdout, ">");
+		} else {
+		    TclPrintObject(stdout, objv[i], 15);
+		}
+		fprintf(stdout, " ");
+	    }
+	    fprintf(stdout, "\n");
+	    fflush(stdout);
+	}
+#endif /*TCL_COMPILE_DEBUG*/
+	{
+	    Tcl_Obj *copyPtr = Tcl_NewListObj(objc - opnd + 1, NULL);
+	    register List *listRepPtr = copyPtr->internalRep.twoPtrValue.ptr1;
+	    Tcl_Obj **copyObjv = &listRepPtr->elements;
+	    int i;
+
+	    listRepPtr->elemCount = objc - opnd + 1;
+	    copyObjv[0] = objPtr;
+	    memcpy(copyObjv+1, objv+opnd, sizeof(Tcl_Obj *) * (objc - opnd));
+	    for (i=1 ; i<objc-opnd+1 ; i++) {
+		Tcl_IncrRefCount(copyObjv[i]);
+	    }
+	    objPtr = copyPtr;
+	}
+	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);
+	}
+	iPtr->ensembleRewrite.sourceObjs = objv;
+	iPtr->ensembleRewrite.numRemovedObjs = opnd;
+	iPtr->ensembleRewrite.numInsertedObjs = 1;
+	DECACHE_STACK_INFO();
+	pc += 6;
+	TEBC_YIELD();
+	TclNRAddCallback(interp, TclClearRootEnsemble, NULL,NULL,NULL,NULL);
+	iPtr->evalFlags |= TCL_EVAL_REDIRECT;
+	return TclNREvalObjEx(interp, objPtr, TCL_EVAL_INVOKE, NULL, INT_MIN);
+
     /*
      * -----------------------------------------------------------------
      *	   Start of INST_LOAD instructions.
diff --git a/tests/info.test b/tests/info.test
index 5078e11..ebc853a 100644
--- a/tests/info.test
+++ b/tests/info.test
@@ -692,31 +692,31 @@ test info-21.5 {miscellaneous error conditions} -returnCodes error -body {
 ##
 # ### ### ### ######### ######### #########
 ## info frame
+
 ## Helper
 # For the more complex results we cut the file name down to remove path
 # dependencies, and we use only part of the first line of the reported
 # command. The latter is required because otherwise the whole test case may
 # appear in some results, but the result is part of the testcase. An infinite
 # string would be required to describe that. The cutting-down breaks this.
+
 proc reduce {frame} {
-    set  pos [lsearch -exact $frame cmd]
-    incr pos
-    set  cmd [lindex $frame $pos]
+    set cmd [dict get $frame cmd]
     if {[regexp \n $cmd]} {
-	set first [string range [lindex [split $cmd \n] 0] 0 end-4]
-	set frame [lreplace $frame $pos $pos $first]
+	dict set frame cmd \
+	    [string range [lindex [split $cmd \n] 0] 0 end-4]
     }
-    set pos [lsearch -exact $frame file]
-    if {$pos >=0} {
-	incr pos
-	set tail  [file tail [lindex $frame $pos]]
-	set frame [lreplace $frame $pos $pos $tail]
+    if {[dict exists $frame file]} {
+	dict set frame file \
+	    [file tail [dict get $frame file]]
     }
-    set frame
+    return $frame
 }
+
 proc subinterp {} { interp create sub ; interp debug sub -frame 1;
     interp eval sub [list proc reduce [info args reduce] [info body reduce]]
 }
+
 ## Helper
 # Generate a stacktrace from the current location to top.  This code
 # not only depends on the exact location of things, but also on the
@@ -1454,9 +1454,9 @@ test info-30.1 {bs+nl in literal words, procedure body, compiled} -body {
 test info-30.2 {bs+nl in literal words, namespace script} {
     namespace eval xxx {
 	variable res \
-	    [reduce [info frame 0]];# line 1457
+	    [info frame 0];# line 1457
     }
-    return $xxx::res
+    return [reduce $xxx::res]
 } {type source line 1457 file info.test cmd {info frame 0} level 0}
 
 test info-30.3 {bs+nl in literal words, namespace multi-word script} {
diff --git a/tests/nre.test b/tests/nre.test
index b8ef2e0..b5eb032 100644
--- a/tests/nre.test
+++ b/tests/nre.test
@@ -74,7 +74,6 @@ test nre-1.1 {self-recursive procs} -setup {
 } -constraints {
     testnrelevels
 } -result {{0 1 1 1} 0}
-
 test nre-1.2 {self-recursive lambdas} -setup {
     set a [list i [makebody {apply $::a $i}]]
 } -body {
@@ -85,7 +84,6 @@ test nre-1.2 {self-recursive lambdas} -setup {
 } -constraints {
     testnrelevels
 } -result {{0 1 1 1} 0}
-
 test nre-1.3 {mutually recursive procs and lambdas} -setup {
     proc a i {
 	apply $::b [incr i]
@@ -164,8 +162,7 @@ test nre-5.1 {[namespace eval] is not recursive} -setup {
     namespace delete ::foo
 } -constraints {
     testnrelevels
-} -result {{0 3 2 2} 0}
-
+} -result {{0 2 2 2} 0}
 test nre-5.2 {[namespace eval] is not recursive} -setup {
     namespace eval ::foo {
 	setabs
@@ -177,7 +174,7 @@ test nre-5.2 {[namespace eval] is not recursive} -setup {
     namespace delete ::foo
 } -constraints {
     testnrelevels
-} -result {{0 3 2 2} 0}
+} -result {{0 2 2 2} 0}
 
 test nre-6.1 {[uplevel] is not recursive} -setup {
     proc a i [makebody {uplevel 1 [list a $i]}]
@@ -189,7 +186,6 @@ test nre-6.1 {[uplevel] is not recursive} -setup {
 } -constraints {
     testnrelevels
 } -result {{0 2 2 0} 0}
-
 test nre-6.2 {[uplevel] is not recursive} -setup {
     setabs
     proc a i [makebody {uplevel 1 "set x $i; a $i"}]
@@ -211,7 +207,6 @@ test nre-7.1 {[catch] is not recursive} -setup {
 } -constraints {
     testnrelevels
 } -result {{0 3 3 0} 0}
-
 test nre-7.2 {[if] is not recursive} -setup {
     setabs
     proc a i [makebody {uplevel 1 "if 1 {a $i}"}]
@@ -222,7 +217,6 @@ test nre-7.2 {[if] is not recursive} -setup {
 } -constraints {
     testnrelevels
 } -result {{0 2 2 0} 0}
-
 test nre-7.3 {[while] is not recursive} -setup {
     setabs
     proc a i [makebody {uplevel 1 "while 1 {set res \[a $i\]; break}; set res"}]
@@ -233,7 +227,6 @@ test nre-7.3 {[while] is not recursive} -setup {
 } -constraints {
     testnrelevels
 } -result {{0 2 2 0} 0}
-
 test nre-7.4 {[for] is not recursive} -setup {
     setabs
     proc a i [makebody {uplevel 1 "for {set j 0} {\$j < 10} {incr j} {set res \[a $i\]; break}; set res"}]
@@ -244,7 +237,6 @@ test nre-7.4 {[for] is not recursive} -setup {
 } -constraints {
     testnrelevels
 } -result {{0 2 2 0} 0}
-
 test nre-7.5 {[foreach] is not recursive} -setup {
     #
     # Enable once [foreach] is NR-enabled
@@ -258,7 +250,6 @@ test nre-7.5 {[foreach] is not recursive} -setup {
 } -constraints {
     testnrelevels
 } -result {{0 3 3 0} 0}
-
 test nre-7.6 {[eval] is not recursive} -setup {
     proc a i [makebody {eval [list a $i]}]
 } -body {
@@ -269,7 +260,6 @@ test nre-7.6 {[eval] is not recursive} -setup {
 } -constraints {
     testnrelevels
 } -result {{0 2 2 1} 0}
-
 test nre-7.7 {[eval] is not recursive} -setup {
     proc a i [makebody {eval "a $i"}]
 } -body {
@@ -280,7 +270,6 @@ test nre-7.7 {[eval] is not recursive} -setup {
 } -constraints {
     testnrelevels
 } -result {{0 2 2 1} 0}
-
 test nre-7.8 {bug #2910748: switch out of stale BC is not nre-aware} -setup {
     proc foo args {}
     foo
@@ -295,18 +284,15 @@ test nre-7.8 {bug #2910748: switch out of stale BC is not nre-aware} -setup {
 } -body {
     # if switching to plain eval is not nre aware, this will cause a "cannot
     # yield" error
-
     list [bar] [bar] [bar]
 } -cleanup {
     rename bar {}
     rename foo {}
 } -result {1 2 3}
 
-
 test nre-8.1 {nre and {*}} -body {
     # force an expansion that grows the evaluation stack, check that nre
     # adapts the TEBCdataPtr. This crashes on failure.
-
     proc inner {} {
 	set long [lrepeat 1000000 1]
 	list {*}$long
@@ -321,21 +307,18 @@ test nre-8.2 {nre and {*}, [Bug 2415422]} -body {
     # force an expansion that grows the evaluation stack, check that nre
     # adapts the bcFramePtr. This causes an NRE assertion to fail if it is not
     # done properly.
-
     proc nop {} {}
     proc crash {} {
 	foreach val [list {*}[lrepeat 100000 x]] {
 	    nop
 	}
     }
-
     crash
 } -cleanup {
     rename nop {}
     rename crash {}
 }
 
-
 #
 #  Basic TclOO tests
 #
@@ -351,7 +334,6 @@ test nre-oo.1 {really deep calls in oo - direct} -setup {
 } -constraints {
     testnrelevels
 } -result {{0 1 1 1} 0}
-
 test nre-oo.2 {really deep calls in oo - call via [self]} -setup {
     oo::object create foo
     oo::objdefine foo method bar i [makebody {[self] bar $i}]
@@ -363,7 +345,6 @@ test nre-oo.2 {really deep calls in oo - call via [self]} -setup {
 } -constraints {
     testnrelevels
 } -result {{0 1 1 1} 0}
-
 test nre-oo.3 {really deep calls in oo - private calls} -setup {
     oo::object create foo
     oo::objdefine foo method bar i [makebody {my bar $i}]
@@ -375,7 +356,6 @@ test nre-oo.3 {really deep calls in oo - private calls} -setup {
 } -constraints {
     testnrelevels
 } -result {{0 1 1 1} 0}
-
 test nre-oo.4 {really deep calls in oo - overriding} -setup {
     oo::class create foo {
 	method bar i [makebody {my bar $i}]
@@ -392,7 +372,6 @@ test nre-oo.4 {really deep calls in oo - overriding} -setup {
 } -constraints {
     testnrelevels
 } -result {{0 1 1 1} 0}
-
 test nre-oo.5 {really deep calls in oo - forwards} -setup {
     oo::object create foo
     set body [makebody {my boo $i}]
@@ -409,7 +388,6 @@ test nre-oo.5 {really deep calls in oo - forwards} -setup {
     testnrelevels
 } -result {{0 2 1 1} 0}
 
-
 #
 # NASTY BUG found by tcllib's interp package
 #