merge main dev branch

15 files changed, 365 insertions, 107 deletions

diff --git a/generic/tcl.h b/generic/tcl.h
index 7b3558a..3003abf 100644
--- a/generic/tcl.h
+++ b/generic/tcl.h
@@ -55,11 +55,11 @@ extern "C" {
 
 #define TCL_MAJOR_VERSION   8
 #define TCL_MINOR_VERSION   6
-#define TCL_RELEASE_LEVEL   TCL_BETA_RELEASE
-#define TCL_RELEASE_SERIAL  3
+#define TCL_RELEASE_LEVEL   TCL_FINAL_RELEASE
+#define TCL_RELEASE_SERIAL  0
 
 #define TCL_VERSION	    "8.6"
-#define TCL_PATCH_LEVEL	    "8.6b3"
+#define TCL_PATCH_LEVEL	    "8.6.0"
 
 /*
  *----------------------------------------------------------------------------
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 b76c603..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,21 +1582,23 @@ 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);
     Tcl_DStringFree(&hiddenBuf);
     if (nameParts != NULL) {
-	Tcl_Free((char *) nameParts);
+	ckfree((char *) nameParts);
     }
     return ensemble;
 }
@@ -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 2b5f713..9fcc8a5 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -1212,7 +1212,7 @@ TclStackFree(
     Tcl_Obj **markerPtr, *marker;
 
     if (iPtr == NULL || iPtr->execEnvPtr == NULL) {
-	Tcl_Free((char *) freePtr);
+	ckfree((char *) freePtr);
 	return;
     }
 
@@ -1272,7 +1272,7 @@ TclStackAlloc(
     int numWords = (numBytes + (sizeof(Tcl_Obj *) - 1))/sizeof(Tcl_Obj *);
 
     if (iPtr == NULL || iPtr->execEnvPtr == NULL) {
-	return (void *) Tcl_Alloc(numBytes);
+	return (void *) ckalloc(numBytes);
     }
 
     return (void *) StackAllocWords(interp, numWords);
@@ -1291,7 +1291,7 @@ TclStackRealloc(
     int numWords;
 
     if (iPtr == NULL || iPtr->execEnvPtr == NULL) {
-	return (void *) Tcl_Realloc((char *) ptr, numBytes);
+	return (void *) ckrealloc((char *) ptr, numBytes);
     }
 
     eePtr = iPtr->execEnvPtr;
@@ -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/generic/tclIORTrans.c b/generic/tclIORTrans.c
index 2b9efb9..1de635f 100644
--- a/generic/tclIORTrans.c
+++ b/generic/tclIORTrans.c
@@ -2942,7 +2942,7 @@ ResultClear(
 	return;
     }
 
-    Tcl_Free((char *) rPtr->buf);
+    ckfree((char *) rPtr->buf);
     rPtr->buf = NULL;
     rPtr->allocated = 0;
 }
@@ -2977,10 +2977,10 @@ ResultAdd(
 
 	if (rPtr->allocated == 0) {
 	    rPtr->allocated = toWrite + RB_INCREMENT;
-	    rPtr->buf = UCHARP(Tcl_Alloc(rPtr->allocated));
+	    rPtr->buf = UCHARP(ckalloc(rPtr->allocated));
 	} else {
 	    rPtr->allocated += toWrite + RB_INCREMENT;
-	    rPtr->buf = UCHARP(Tcl_Realloc((char *) rPtr->buf,
+	    rPtr->buf = UCHARP(ckrealloc((char *) rPtr->buf,
 		    rPtr->allocated));
 	}
     }
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 676aa65..a6b2c11 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -4011,7 +4011,7 @@ typedef const char *TclDTraceStr;
  */
 
 #  define TclAllocObjStorageEx(interp, objPtr) \
-	(objPtr) = (Tcl_Obj *) Tcl_Alloc(sizeof(Tcl_Obj))
+	(objPtr) = (Tcl_Obj *) ckalloc(sizeof(Tcl_Obj))
 
 #  define TclFreeObjStorageEx(interp, objPtr) \
 	ckfree((char *) (objPtr))
diff --git a/generic/tclListObj.c b/generic/tclListObj.c
index 3668b45..2d1defa 100644
--- a/generic/tclListObj.c
+++ b/generic/tclListObj.c
@@ -909,6 +909,10 @@ Tcl_ListObjReplace(
     isShared = (listRepPtr->refCount > 1);
     numRequired = numElems - count + objc;
 
+    for (i = 0;  i < objc;  i++) {
+	Tcl_IncrRefCount(objv[i]);
+    }
+
     if ((numRequired <= listRepPtr->maxElemCount) && !isShared) {
 	int shift;
 
@@ -963,6 +967,14 @@ Tcl_ListObjReplace(
 	    if (listRepPtr == NULL) {
 		listRepPtr = AttemptNewList(interp, numRequired, NULL);
 		if (listRepPtr == NULL) {
+		    for (i = 0;  i < objc;  i++) {
+			/* See bug 3598580 */
+#if TCL_MAJOR_VERSION > 8
+			Tcl_DecrRefCount(objv[i]);
+#else
+			objv[i]->refCount--;
+#endif
+		    }
 		    return TCL_ERROR;
 		}
 	    }
@@ -1027,14 +1039,11 @@ Tcl_ListObjReplace(
     }
 
     /*
-     * Insert the new elements into elemPtrs before "first". We don't do a
-     * memcpy here because we must increment the reference counts for the
-     * added elements, so we must explicitly loop anyway.
+     * Insert the new elements into elemPtrs before "first".
      */
 
     for (i=0,j=first ; i<objc ; i++,j++) {
 	elemPtrs[j] = objv[i];
-	Tcl_IncrRefCount(objv[i]);
     }
 
     /*
diff --git a/generic/tclOO.h b/generic/tclOO.h
index 280481c..cf253b1 100644
--- a/generic/tclOO.h
+++ b/generic/tclOO.h
@@ -39,7 +39,7 @@ extern const char *TclOOInitializeStubs(
  * win/tclooConfig.sh
  */
 
-#define TCLOO_VERSION "0.7"
+#define TCLOO_VERSION "1.0"
 #define TCLOO_PATCHLEVEL TCLOO_VERSION
 
 /*
diff --git a/generic/tclStubLib.c b/generic/tclStubLib.c
index a9d0f02..859cbf9 100644
--- a/generic/tclStubLib.c
+++ b/generic/tclStubLib.c
@@ -23,22 +23,8 @@ const TclPlatStubs *tclPlatStubsPtr = NULL;
 const TclIntStubs *tclIntStubsPtr = NULL;
 const TclIntPlatStubs *tclIntPlatStubsPtr = NULL;
 
-static const TclStubs *
-HasStubSupport(
-    Tcl_Interp *interp)
-{
-    Interp *iPtr = (Interp *) interp;
-
-    if (iPtr->stubTable && (iPtr->stubTable->magic == TCL_STUB_MAGIC)) {
-	return iPtr->stubTable;
-    }
-    iPtr->result = (char *) "interpreter uses an incompatible stubs mechanism";
-    iPtr->freeProc = TCL_STATIC;
-    return NULL;
-}
-
 /*
- * Use our own isdigit to avoid linking to libc on windows
+ * Use our own isDigit to avoid linking to libc on windows
  */
 
 static int isDigit(const int c)
@@ -70,9 +56,10 @@ Tcl_InitStubs(
     const char *version,
     int exact)
 {
+    Interp *iPtr = (Interp *) interp;
     const char *actualVersion = NULL;
     ClientData pkgData = NULL;
-    const TclStubs *stubsPtr;
+    const TclStubs *stubsPtr = iPtr->stubTable;
 
     /*
      * We can't optimize this check by caching tclStubsPtr because that
@@ -80,8 +67,9 @@ Tcl_InitStubs(
      * times. [Bug 615304]
      */
 
-    stubsPtr = HasStubSupport(interp);
-    if (!stubsPtr) {
+    if (!stubsPtr || (stubsPtr->magic != TCL_STUB_MAGIC)) {
+	iPtr->result = "interpreter uses an incompatible stubs mechanism";
+	iPtr->freeProc = TCL_STATIC;
 	return NULL;
     }
 
diff --git a/generic/tclTestObj.c b/generic/tclTestObj.c
index 7494beb..4bddc42 100644
--- a/generic/tclTestObj.c
+++ b/generic/tclTestObj.c
@@ -963,6 +963,17 @@ TestobjCmd(
 	}
 	SetVarToObj(varPtr, destIndex, varPtr[varIndex]);
 	Tcl_SetObjResult(interp, varPtr[destIndex]);
+    } else if (strcmp(subCmd, "bug3598580") == 0) {
+	Tcl_Obj *listObjPtr, *elemObjPtr;
+	if (objc != 2) {
+	    goto wrongNumArgs;
+	}
+	elemObjPtr = Tcl_NewIntObj(123);
+	listObjPtr = Tcl_NewListObj(1, &elemObjPtr);
+	/* Replace the single list element through itself, nonsense but legal. */
+	Tcl_ListObjReplace(interp, listObjPtr, 0, 1, 1, &elemObjPtr);
+	Tcl_SetObjResult(interp, listObjPtr);
+	return TCL_OK;
     } else if (strcmp(subCmd, "convert") == 0) {
 	const char *typeName;
 
diff --git a/generic/tclThreadTest.c b/generic/tclThreadTest.c
index 22b5995..b90e33d 100644
--- a/generic/tclThreadTest.c
+++ b/generic/tclThreadTest.c
@@ -513,7 +513,6 @@ ThreadCreate(
 	    TCL_THREAD_STACK_DEFAULT, joinable) != TCL_OK) {
 	Tcl_MutexUnlock(&threadMutex);
 	Tcl_AppendResult(interp, "can't create a new thread", NULL);
-	ckfree(ctrl.script);
 	return TCL_ERROR;
     }
 
diff --git a/generic/tclTomMathInterface.c b/generic/tclTomMathInterface.c
index 775e86b..48db8c3 100644
--- a/generic/tclTomMathInterface.c
+++ b/generic/tclTomMathInterface.c
@@ -111,7 +111,7 @@ extern void *
 TclBNAlloc(
     size_t x)
 {
-    return (void *) Tcl_Alloc((unsigned int) x);
+    return (void *) ckalloc((unsigned int) x);
 }
 
 /*
@@ -135,7 +135,7 @@ TclBNRealloc(
     void *p,
     size_t s)
 {
-    return (void *) Tcl_Realloc((char *) p, (unsigned int) s);
+    return (void *) ckrealloc((char *) p, (unsigned int) s);
 }
 
 /*
@@ -161,7 +161,7 @@ extern void
 TclBNFree(
     void *p)
 {
-    Tcl_Free((char *) p);
+    ckree((char *) p);
 }
 #endif
 
diff --git a/generic/tclUtil.c b/generic/tclUtil.c
index 13e54ec..ddf067b 100644
--- a/generic/tclUtil.c
+++ b/generic/tclUtil.c
@@ -2927,14 +2927,16 @@ TclDStringToObj(
 {
     Tcl_Obj *result;
 
-    if (dsPtr->length == 0) {
-	TclNewObj(result);
-    } else if (dsPtr->string == dsPtr->staticSpace) {
-	/*
-	 * Static buffer, so must copy.
-	 */
-
-	TclNewStringObj(result, dsPtr->string, dsPtr->length);
+    if (dsPtr->string == dsPtr->staticSpace) {
+	if (dsPtr->length == 0) {
+	    TclNewObj(result);
+	} else {
+	    /*
+	     * Static buffer, so must copy.
+	     */
+	    
+	    TclNewStringObj(result, dsPtr->string, dsPtr->length);
+	}
     } else {
 	/*
 	 * Dynamic buffer, so transfer ownership and reset.