Merge trunk

27 files changed, 1758 insertions, 248 deletions

diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 02940e7..20248a9 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -6152,7 +6152,11 @@ TclNREvalObjEx(
 	 */
 
 	Tcl_IncrRefCount(objPtr);
-	listPtr = TclListObjCopy(interp, objPtr);
+	listPtr = TclDuplicatePureObj(interp, objPtr, &tclListType.objType);
+	if (!listPtr) {
+	    Tcl_DecrRefCount(objPtr);
+	    return TCL_ERROR;
+	}
 	Tcl_IncrRefCount(listPtr);
 
 	if (word != INT_MIN) {
diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c
index ea0b772..0a24d88 100644
--- a/generic/tclCmdAH.c
+++ b/generic/tclCmdAH.c
@@ -2356,8 +2356,6 @@ StoreStatData(
     }
 
     /*
-     * Assume Tcl_ObjSetVar2() does not keep a copy of the field name!
-     *
      * Might be a better idea to call Tcl_SetVar2Ex() instead, except we want
      * to have an object (i.e. possibly cached) array variable name but a
      * string element name, so no API exists. Messy.
@@ -2784,13 +2782,18 @@ EachloopCmd(
     for (i=0 ; i<numLists ; i++) {
 	/* List */
 	/* Variables */
-	statePtr->vCopyList[i] = TclListObjCopy(interp, objv[1+i*2]);
-	if (statePtr->vCopyList[i] == NULL) {
+	statePtr->vCopyList[i] = TclDuplicatePureObj(
+	    interp, objv[1+i*2], &tclListType.objType);
+	if (!statePtr->vCopyList[i]) {
 	    result = TCL_ERROR;
 	    goto done;
 	}
-	TclListObjLengthM(NULL, statePtr->vCopyList[i],
+	result = TclListObjLengthM(interp, statePtr->vCopyList[i],
 	    &statePtr->varcList[i]);
+	if (result != TCL_OK) {
+	    result = TCL_ERROR;
+	    goto done;
+	}
 	if (statePtr->varcList[i] < 1) {
 	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
 		"%s varlist is empty",
@@ -2816,13 +2819,17 @@ EachloopCmd(
 	    statePtr->argcList[i] = ABSTRACTLIST_PROC(statePtr->aCopyList[i], lengthProc)(statePtr->aCopyList[i]);
 	} else {
 	    /* List values */
-	    statePtr->aCopyList[i] = TclListObjCopy(interp, objv[2+i*2]);
-	    if (statePtr->aCopyList[i] == NULL) {
+	    statePtr->aCopyList[i] = TclDuplicatePureObj(
+		interp, objv[2+i*2], &tclListType.objType);
+	    if (!statePtr->aCopyList[i]) {
 		result = TCL_ERROR;
 		goto done;
 	    }
-	    TclListObjGetElementsM(NULL, statePtr->aCopyList[i],
+	    result = TclListObjGetElementsM(interp, statePtr->aCopyList[i],
 		&statePtr->argcList[i], &statePtr->argvList[i]);
+	    if (result != TCL_OK) {
+		goto done;
+	    }
 	}
 	/* account for variable <> value mismatch */
 	j = statePtr->argcList[i] / statePtr->varcList[i];
diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c
index 7beb60a..3fc1d2a 100644
--- a/generic/tclCmdIL.c
+++ b/generic/tclCmdIL.c
@@ -2327,20 +2327,25 @@ Tcl_LassignObjCmd(
     Tcl_Obj **listObjv;		/* The contents of the list. */
     Tcl_Size listObjc;		/* The length of the list. */
     Tcl_Size origListObjc;	/* Original length */
-    int code = TCL_OK;
+    int code;
 
     if (objc < 2) {
 	Tcl_WrongNumArgs(interp, 1, objv, "list ?varName ...?");
 	return TCL_ERROR;
     }
 
-    listCopyPtr = TclListObjCopy(interp, objv[1]);
-    if (listCopyPtr == NULL) {
+    listCopyPtr = TclDuplicatePureObj(interp, objv[1], &tclListType.objType);
+    if (!listCopyPtr) {
 	return TCL_ERROR;
     }
     Tcl_IncrRefCount(listCopyPtr); /* Important! fs */
 
-    TclListObjGetElementsM(NULL, listCopyPtr, &listObjc, &listObjv);
+    code = TclListObjGetElementsM(
+	interp, listCopyPtr, &listObjc, &listObjv);
+    if (code != TCL_OK) {
+	Tcl_DecrRefCount(listCopyPtr);
+	return code;
+    }
     origListObjc = listObjc;
 
     objc -= 2;
@@ -2466,7 +2471,7 @@ Tcl_LinsertObjCmd(
 {
     Tcl_Obj *listPtr;
     Tcl_Size len, index;
-    int result;
+    int copied = 0, result;
 
     if (objc < 3) {
 	Tcl_WrongNumArgs(interp, 1, objv, "list index ?element ...?");
@@ -2499,7 +2504,11 @@ Tcl_LinsertObjCmd(
 
     listPtr = objv[1];
     if (Tcl_IsShared(listPtr)) {
-	listPtr = TclListObjCopy(NULL, listPtr);
+	listPtr = TclDuplicatePureObj(interp, listPtr, &tclListType.objType);
+	if (!listPtr) {
+	    return TCL_ERROR;
+	}
+	copied = 1;
     }
 
     if ((objc == 4) && (index == len)) {
@@ -2507,10 +2516,19 @@ Tcl_LinsertObjCmd(
 	 * Special case: insert one element at the end of the list.
 	 */
 
-	Tcl_ListObjAppendElement(NULL, listPtr, objv[3]);
+	result = Tcl_ListObjAppendElement(NULL, listPtr, objv[3]);
+	if (result != TCL_OK) {
+	    if (copied) {
+		Tcl_DecrRefCount(listPtr);
+	    }
+	    return result;
+	}
     } else {
 	if (TCL_OK != Tcl_ListObjReplace(interp, listPtr, index, 0,
 		(objc-3), &(objv[3]))) {
+	    if (copied) {
+		Tcl_DecrRefCount(listPtr);
+	    }
 	    return TCL_ERROR;
 	}
     }
@@ -2634,7 +2652,7 @@ Tcl_LpopObjCmd(
 				/* Argument objects. */
 {
     Tcl_Size listLen;
-    int result;
+    int copied = 0, result;
     Tcl_Obj *elemPtr, *stored;
     Tcl_Obj *listPtr, **elemPtrs;
 
@@ -2686,23 +2704,33 @@ Tcl_LpopObjCmd(
 
     if (objc == 2) {
 	if (Tcl_IsShared(listPtr)) {
-	    listPtr = TclListObjCopy(NULL, listPtr);
+	    listPtr = TclDuplicatePureObj(interp, listPtr, &tclListType.objType);
+	    if (!listPtr) {
+		return TCL_ERROR;
+	    }
+	    copied = 1;
 	}
 	result = Tcl_ListObjReplace(interp, listPtr, listLen - 1, 1, 0, NULL);
 	if (result != TCL_OK) {
+	    if (copied) {
+		Tcl_DecrRefCount(listPtr);
+	    }
 	    return result;
 	}
-	Tcl_IncrRefCount(listPtr);
     } else {
-	listPtr = TclLsetFlat(interp, listPtr, objc-2, objv+2, NULL);
-
-	if (listPtr == NULL) {
+	Tcl_Obj *newListPtr = TclLsetFlat(interp, listPtr, objc-2, objv+2, NULL);
+	if (newListPtr == NULL) {
+	    if (copied) {
+		Tcl_DecrRefCount(listPtr);
+	    }
 	    return TCL_ERROR;
+	} else {
+	    listPtr = newListPtr;
+	    TclUndoRefCount(listPtr);
 	}
     }
 
     stored = Tcl_ObjSetVar2(interp, objv[1], NULL, listPtr, TCL_LEAVE_ERR_MSG);
-    Tcl_DecrRefCount(listPtr);
     if (stored == NULL) {
 	return TCL_ERROR;
     }
@@ -2819,6 +2847,7 @@ Tcl_LremoveObjCmd(
     Tcl_Size i, idxc, prevIdx, first, num;
     Tcl_Size *idxv, listLen;
     Tcl_Obj *listObj;
+    int copied = 0, status = TCL_OK;
 
     /*
      * Parse the arguments.
@@ -2841,10 +2870,10 @@ Tcl_LremoveObjCmd(
     }
     idxv = (Tcl_Size *)Tcl_Alloc((objc - 2) * sizeof(*idxv));
     for (i = 2; i < objc; i++) {
-	if (TclGetIntForIndexM(interp, objv[i], /*endValue*/ listLen - 1,
-		&idxv[i - 2]) != TCL_OK) {
-	    Tcl_Free(idxv);
-	    return TCL_ERROR;
+	status = (TclGetIntForIndexM(interp, objv[i], /*endValue*/ listLen - 1,
+		&idxv[i - 2]) != TCL_OK);
+	if (status != TCL_OK) {
+	    goto done;
 	}
     }
 
@@ -2862,7 +2891,12 @@ Tcl_LremoveObjCmd(
      */
 
     if (Tcl_IsShared(listObj)) {
-	listObj = TclListObjCopy(NULL, listObj);
+	listObj = TclDuplicatePureObj(interp, listObj, &tclListType.objType);
+	if (!listObj) {
+	    status = TCL_ERROR;
+	    goto done;
+	}
+	copied = 1;
     }
     num = 0;
     first = listLen;
@@ -2897,18 +2931,28 @@ Tcl_LremoveObjCmd(
 	     * and we're only ever contracting that list.
 	     */
 
-	    (void) Tcl_ListObjReplace(interp, listObj, first, num, 0, NULL);
+	    status = Tcl_ListObjReplace(interp, listObj, first, num, 0, NULL);
+	    if (status != TCL_OK) {
+		goto done;
+	    }
 	    listLen -= num;
 	    num = 1;
 	    first = idx;
 	}
     }
     if (num != 0) {
-	(void) Tcl_ListObjReplace(interp, listObj, first, num, 0, NULL);
+	status = Tcl_ListObjReplace(interp, listObj, first, num, 0, NULL);
+	if (status != TCL_OK) {
+	    if (copied) {
+		Tcl_DecrRefCount(listObj);
+	    }
+	    goto done;
+	}
     }
-    Tcl_Free(idxv);
     Tcl_SetObjResult(interp, listObj);
-    return TCL_OK;
+done:
+    Tcl_Free(idxv);
+    return status;
 }
 
 /*
@@ -3102,7 +3146,10 @@ Tcl_LreplaceObjCmd(
 
     listPtr = objv[1];
     if (Tcl_IsShared(listPtr)) {
-	listPtr = TclListObjCopy(NULL, listPtr);
+	listPtr = TclDuplicatePureObj(interp, listPtr, &tclListType.objType);
+	if (!listPtr) {
+	    return TCL_ERROR;
+	}
     }
 
     /*
@@ -3115,6 +3162,7 @@ Tcl_LreplaceObjCmd(
 
     if (TCL_OK != Tcl_ListObjReplace(interp, listPtr, first, numToDelete,
 	    objc-4, objv+4)) {
+	Tcl_DecrRefCount(listPtr);
 	return TCL_ERROR;
     }
 
@@ -4722,7 +4770,7 @@ Tcl_LsortObjCmd(
 	 * 1675116]
 	 */
 
-	listObj = TclListObjCopy(interp, listObj);
+	listObj = TclDuplicatePureObj(interp ,listObj, &tclListType.objType);
 	if (listObj == NULL) {
 	    sortInfo.resultCode = TCL_ERROR;
 	    goto done;
@@ -4739,8 +4787,6 @@ Tcl_LsortObjCmd(
 	if (Tcl_ListObjAppendElement(interp, newCommandPtr, newObjPtr)
 		!= TCL_OK) {
 	    TclDecrRefCount(newCommandPtr);
-	    TclDecrRefCount(listObj);
-	    Tcl_IncrRefCount(newObjPtr);
 	    TclDecrRefCount(newObjPtr);
 	    sortInfo.resultCode = TCL_ERROR;
 	    goto done;
@@ -5080,7 +5126,10 @@ Tcl_LeditObjCmd(
     }
 
     if (Tcl_IsShared(listPtr)) {
-	listPtr = TclListObjCopy(NULL, listPtr);
+	listPtr = TclDuplicatePureObj(interp, listPtr, &tclListType.objType);
+	if (!listPtr) {
+	    return TCL_ERROR;
+	}
 	createdNewObj = 1;
     } else {
 	createdNewObj = 0;
@@ -5097,18 +5146,10 @@ Tcl_LeditObjCmd(
 
     /*
      * Tcl_ObjSetVar2 may return a value different from listPtr in the
-     * presence of traces etc.. Note that finalValuePtr will always have a
-     * reference count of at least 1 corresponding to the reference from the
-     * var. If it is same as listPtr, then ref count will be at least 2
-     * since we are incr'ing the latter below (safer when calling
-     * Tcl_ObjSetVar2 which can release it in some cases). Note that we
-     * leave the incrref of listPtr this late because we want to pass it as
-     * unshared to Tcl_ListObjReplace above if possible.
+     * presence of traces etc.
      */
-    Tcl_IncrRefCount(listPtr);
     finalValuePtr =
 	Tcl_ObjSetVar2(interp, objv[1], NULL, listPtr, TCL_LEAVE_ERR_MSG);
-    Tcl_DecrRefCount(listPtr); /* safe irrespective of createdNewObj */
     if (finalValuePtr == NULL) {
 	return TCL_ERROR;
     }
diff --git a/generic/tclCompExpr.c b/generic/tclCompExpr.c
index a8d60dd..69b69b2 100644
--- a/generic/tclCompExpr.c
+++ b/generic/tclCompExpr.c
@@ -2093,9 +2093,9 @@ ParseLexeme(
 	if (end < start + numBytes && !TclIsBareword(*end)) {
 
 	number:
-	    TclInitStringRep(literal, start, end-start);
 	    *lexemePtr = NUMBER;
 	    if (literalPtr) {
+		TclInitStringRep(literal, start, end-start);
 		*literalPtr = literal;
 	    } else {
 		Tcl_DecrRefCount(literal);
@@ -2168,7 +2168,7 @@ ParseLexeme(
     }
     *lexemePtr = BAREWORD;
     if (literalPtr) {
-	Tcl_SetStringObj(literal, start, (int) (end-start));
+	Tcl_SetStringObj(literal, start, end-start);
 	*literalPtr = literal;
     } else {
 	Tcl_DecrRefCount(literal);
diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c
index f996f4b..c4ff0fa 100644
--- a/generic/tclDictObj.c
+++ b/generic/tclDictObj.c
@@ -1048,6 +1048,26 @@ Tcl_DictObjRemove(
 /*
  *----------------------------------------------------------------------
  *
+ * Tcl_DictGetSize
+ *
+ *	Returns the size of dictPtr.  Caller must ensure that dictPtr has type
+ *	'tclDicttype'.
+ *
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Size 
+TclDictGetSize(Tcl_Obj *dictPtr)
+{
+    Dict *dict;
+    DictGetInternalRep(dictPtr, dict);
+    return dict->table.numEntries;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * Tcl_DictObjSize --
  *
  *	How many key,value pairs are there in the dictionary?
diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c
index 1a2fa14..7c4c5f4 100644
--- a/generic/tclEnsemble.c
+++ b/generic/tclEnsemble.c
@@ -312,7 +312,17 @@ TclNamespaceEnsembleCmd(
 			Tcl_AppendObjToObj(newCmd, listv[0]);
 			Tcl_ListObjReplace(NULL, newList, 0, 1, 1, &newCmd);
 			if (patchedDict == NULL) {
-			    patchedDict = Tcl_DuplicateObj(objv[1]);
+			    patchedDict = TclDuplicatePureObj(
+				interp, objv[1], &tclDictType);
+			    if (!patchedDict) {
+				if (allocatedMapFlag) {
+				    Tcl_DecrRefCount(mapObj);
+				}
+				Tcl_DecrRefCount(newList);
+				Tcl_DecrRefCount(newCmd);
+				Tcl_DecrRefCount(patchedDict);
+				return TCL_ERROR;
+			    }
 			}
 			Tcl_DictObjPut(NULL, patchedDict, subcmdWordsObj,
 				newList);
@@ -596,7 +606,14 @@ TclNamespaceEnsembleCmd(
 			}
 			cmd = TclGetString(listv[0]);
 			if (!(cmd[0] == ':' && cmd[1] == ':')) {
-			    Tcl_Obj *newList = Tcl_DuplicateObj(listObj);
+			    Tcl_Obj *newList = TclDuplicatePureObj(
+				interp, listObj, &tclListType.objType);
+			    if (!newList) {
+				if (patchedDict) {
+				    Tcl_DecrRefCount(patchedDict);
+				}
+				goto freeMapAndError;
+			    }
 			    Tcl_Obj *newCmd = NewNsObj((Tcl_Namespace*)nsPtr);
 
 			    if (nsPtr->parentPtr) {
@@ -606,7 +623,11 @@ TclNamespaceEnsembleCmd(
 			    Tcl_ListObjReplace(NULL, newList, 0, 1, 1,
 				    &newCmd);
 			    if (patchedDict == NULL) {
-				patchedDict = Tcl_DuplicateObj(objv[1]);
+				patchedDict = TclDuplicatePureObj(
+				    interp, objv[1], &tclListType.objType);
+				if (!patchedDict) {
+				    goto freeMapAndError;
+				}
 			    }
 			    Tcl_DictObjPut(NULL, patchedDict, subcmdWordsObj,
 				    newList);
@@ -1904,7 +1925,11 @@ NsEnsembleImplementationCmdNR(
 	TclListObjLengthM(NULL, prefixObj, &prefixObjc);
 
 	if (objc == 2) {
-	    copyPtr = TclListObjCopy(NULL, prefixObj);
+	    copyPtr = TclDuplicatePureObj(
+		interp, prefixObj, &tclListType.objType);
+	    if (!copyPtr) {
+		return TCL_ERROR;
+	    }
 	} else {
 	    copyPtr = Tcl_NewListObj(objc - 2 + prefixObjc, NULL);
 	    Tcl_ListObjAppendList(NULL, copyPtr, prefixObj);
@@ -2304,7 +2329,11 @@ EnsembleUnknownCallback(
      * Create the "unknown" command callback to determine what to do.
      */
 
-    unknownCmd = Tcl_DuplicateObj(ensemblePtr->unknownHandler);
+    unknownCmd = TclDuplicatePureObj(
+	interp, ensemblePtr->unknownHandler, &tclListType.objType);
+    if (!unknownCmd) {
+	return TCL_ERROR;
+    }
     TclNewObj(ensObj);
     Tcl_GetCommandFullName(interp, ensemblePtr->token, ensObj);
     Tcl_ListObjAppendElement(NULL, unknownCmd, ensObj);
diff --git a/generic/tclEvent.c b/generic/tclEvent.c
index 68a2c97..680750e 100644
--- a/generic/tclEvent.c
+++ b/generic/tclEvent.c
@@ -232,7 +232,11 @@ HandleBgErrors(
 	 * support one handler setting another handler.
 	 */
 
-	Tcl_Obj *copyObj = TclListObjCopy(NULL, assocPtr->cmdPrefix);
+	Tcl_Obj *copyObj = TclDuplicatePureObj(
+	    interp, assocPtr->cmdPrefix, &tclListType.objType);
+	if (!copyObj) {
+	    return;
+	}
 
 	errPtr = assocPtr->firstBgPtr;
 
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 9b733b3..96de435 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -3374,7 +3374,12 @@ TEBCresume(
 	    goto gotError;
 	}
 	if (Tcl_IsShared(objResultPtr)) {
-	    Tcl_Obj *newValue = Tcl_DuplicateObj(objResultPtr);
+	    Tcl_Obj *newValue = TclDuplicatePureObj(
+		    interp, objResultPtr, &tclListType.objType);
+	    if (!newValue) {
+		TRACE_ERROR(interp);
+		goto gotError;
+	    }
 
 	    TclDecrRefCount(objResultPtr);
 	    varPtr->value.objPtr = objResultPtr = newValue;
@@ -3433,7 +3438,11 @@ TEBCresume(
 		goto gotError;
 	    } else {
 		if (Tcl_IsShared(objResultPtr)) {
-		    valueToAssign = Tcl_DuplicateObj(objResultPtr);
+		    valueToAssign = TclDuplicatePureObj(
+			interp, objResultPtr, &tclListType.objType);
+		    if (!valueToAssign) {
+			goto errorInLappendListPtr;
+		    }
 		    createdNewObj = 1;
 		} else {
 		    valueToAssign = objResultPtr;
@@ -4682,23 +4691,45 @@ TEBCresume(
 	 * Extract the desired list element.
 	 */
 
-	if ((TclListObjGetElementsM(interp, valuePtr, &objc, &objv) == TCL_OK)
-		&& !TclHasInternalRep(value2Ptr, &tclListType.objType)) {
-	    int code;
+	{
+	    Tcl_Size value2Length;
+	    Tcl_Obj *indexListPtr = value2Ptr;
+	    if ((TclListObjGetElementsM(interp, valuePtr, &objc, &objv) == TCL_OK)
+		&& (
+		    !TclHasInternalRep(value2Ptr, &tclListType.objType)
+		    || 
+		    ((Tcl_ListObjLength(interp,value2Ptr,&value2Length),
+			value2Length == 1
+			    ? (indexListPtr = TclListObjGetElement(value2Ptr, 0), 1)
+			    : 0
+		    ))
+		)
+	    ) {
+		int code;
+
+		/* increment the refCount of value2Ptr because TclListObjGetElement may
+		 * have just extracted it from a list in the condition for this block.
+		 */
+		Tcl_IncrRefCount(indexListPtr);
 
-	    DECACHE_STACK_INFO();
-	    code = TclGetIntForIndexM(interp, value2Ptr, objc-1, &index);
-	    CACHE_STACK_INFO();
-	    if (code == TCL_OK) {
-		TclDecrRefCount(value2Ptr);
-		tosPtr--;
-		pcAdjustment = 1;
-		goto lindexFastPath;
+		DECACHE_STACK_INFO();
+		code = TclGetIntForIndexM(interp, indexListPtr, objc-1, &index);
+		TclDecrRefCount(indexListPtr);
+		CACHE_STACK_INFO();
+		if (code == TCL_OK) {
+		    Tcl_DecrRefCount(value2Ptr);
+		    tosPtr--;
+		    pcAdjustment = 1;
+		    goto lindexFastPath;
+		}
+		Tcl_ResetResult(interp);
 	    }
-	    Tcl_ResetResult(interp);
 	}
 
+
+	DECACHE_STACK_INFO();
 	objResultPtr = TclLindexList(interp, valuePtr, value2Ptr);
+	CACHE_STACK_INFO();
 
     lindexDone:
 	if (!objResultPtr) {
@@ -6405,7 +6436,11 @@ TEBCresume(
 		goto gotError;
 	    }
 	    if (Tcl_IsShared(listPtr)) {
-		objPtr = TclListObjCopy(NULL, listPtr);
+		objPtr = TclDuplicatePureObj(
+		    interp, listPtr, &tclListType.objType);
+		if (!objPtr) {
+		    goto gotError;
+		}
 		Tcl_IncrRefCount(objPtr);
 		Tcl_DecrRefCount(listPtr);
 		OBJ_AT_DEPTH(listTmpDepth) = objPtr;
@@ -6467,6 +6502,7 @@ TEBCresume(
 	 */
 
 	if (iterNum < iterMax) {
+	    int status;
 	    /*
 	     * Set the variables and jump back to run the body
 	     */
@@ -6480,7 +6516,12 @@ TEBCresume(
 		numVars = varListPtr->numVars;
 
 		listPtr = OBJ_AT_DEPTH(listTmpDepth);
-		TclListObjGetElementsM(interp, listPtr, &listLen, &elements);
+		status = TclListObjGetElementsM(
+		    interp, listPtr, &listLen, &elements);
+		if (status != TCL_OK) {
+		    goto gotError;
+		}
+
 
 		valIndex = (iterNum * numVars);
 		for (j = 0;  j < numVars;  j++) {
diff --git a/generic/tclIO.c b/generic/tclIO.c
index 44202a9..965a395 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -205,7 +205,7 @@ static int		FlushChannel(Tcl_Interp *interp, Channel *chanPtr,
 			    int calledFromAsyncFlush);
 static int		TclGetsObjBinary(Tcl_Channel chan, Tcl_Obj *objPtr);
 static Tcl_Encoding	GetBinaryEncoding(void);
-static Tcl_ExitProc	FreeBinaryEncoding;
+static void		FreeBinaryEncoding(void);
 static Tcl_HashTable *	GetChannelTable(Tcl_Interp *interp);
 static int		GetInput(Channel *chanPtr);
 static void		PeekAhead(Channel *chanPtr, char **dstEndPtr,
@@ -695,6 +695,7 @@ TclFinalizeIOSubsystem(void)
 	}
     }
 
+    FreeBinaryEncoding();
     TclpFinalizeSockets();
     TclpFinalizePipes();
 }
@@ -5290,8 +5291,7 @@ TclGetsObjBinary(
  */
 
 static void
-FreeBinaryEncoding(
-    TCL_UNUSED(void *))
+FreeBinaryEncoding(void)
 {
     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
 
@@ -5308,7 +5308,6 @@ GetBinaryEncoding(void)
 
     if (tsdPtr->binaryEncoding == NULL) {
 	tsdPtr->binaryEncoding = Tcl_GetEncoding(NULL, "iso8859-1");
-	Tcl_CreateThreadExitHandler(FreeBinaryEncoding, NULL);
     }
     if (tsdPtr->binaryEncoding == NULL) {
 	Tcl_Panic("binary encoding is not available");
diff --git a/generic/tclIOGT.c b/generic/tclIOGT.c
index 98a1dd3..3206a4f 100644
--- a/generic/tclIOGT.c
+++ b/generic/tclIOGT.c
@@ -379,7 +379,11 @@ ExecuteCallback(
     unsigned char *resBuf;
     Tcl_InterpState state = NULL;
     int res = TCL_OK;
-    Tcl_Obj *command = TclListObjCopy(NULL, dataPtr->command);
+    Tcl_Obj *command = TclDuplicatePureObj(
+	interp, dataPtr->command, &tclListType.objType);
+    if (!command) {
+	return TCL_ERROR;
+    }
     Tcl_Interp *eval = dataPtr->interp;
 
     Tcl_Preserve(eval);
@@ -397,7 +401,12 @@ ExecuteCallback(
     }
 
     Tcl_IncrRefCount(command);
-    Tcl_ListObjAppendElement(NULL, command, Tcl_NewStringObj((char *) op, -1));
+    res = Tcl_ListObjAppendElement(NULL, command, Tcl_NewStringObj((char *) op, -1));
+    if (res != TCL_OK) {
+	Tcl_DecrRefCount(command);
+	Tcl_Release(eval);
+	return res;
+    }
 
     /*
      * Use a byte-array to prevent the misinterpretation of binary data coming
diff --git a/generic/tclIORChan.c b/generic/tclIORChan.c
index f2138c4..c7cbfe5 100644
--- a/generic/tclIORChan.c
+++ b/generic/tclIORChan.c
@@ -580,6 +580,9 @@ TclChanCreateObjCmd(
 
     rcId = NextHandle();
     rcPtr = NewReflectedChannel(interp, cmdObj, mode, rcId);
+    if (!rcPtr) {
+	return TCL_ERROR;
+    }
 
     /*
      * Invoke 'initialize' and validate that the handler is present and ok.
@@ -2258,8 +2261,10 @@ NewReflectedChannel(
     rcPtr->mode = mode;
     rcPtr->interest = 0;		/* Initially no interest registered */
 
-    /* ASSERT: cmdpfxObj is a Tcl List */
-    rcPtr->cmd = TclListObjCopy(NULL, cmdpfxObj);
+    rcPtr->cmd = TclDuplicatePureObj(interp, cmdpfxObj, &tclListType.objType);
+    if (!rcPtr->cmd) {
+	return NULL;
+    }
     Tcl_IncrRefCount(rcPtr->cmd);
     rcPtr->methods = Tcl_NewListObj(METH_WRITE + 1, NULL);
     while (mn <= (int)METH_WRITE) {
@@ -2396,8 +2401,10 @@ InvokeTclMethod(
      * before the channel id.
      */
 
-    cmd = TclListObjCopy(NULL, rcPtr->cmd);
-
+    cmd = TclDuplicatePureObj(NULL, rcPtr->cmd, &tclListType.objType);
+    if (!cmd) {
+	return TCL_ERROR;
+    }
     Tcl_ListObjIndex(NULL, rcPtr->methods, method, &methObj);
     Tcl_ListObjAppendElement(NULL, cmd, methObj);
     Tcl_ListObjAppendElement(NULL, cmd, rcPtr->name);
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 5a7c397..f2123b5 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -2504,7 +2504,7 @@ typedef struct ListStore {
 typedef struct ListSpan {
     Tcl_Size spanStart;    /* Starting index of the span */
     Tcl_Size spanLength;   /* Number of elements in the span */
-    Tcl_Size refCount;     /* Count of references to this span record */
+    size_t refCount;     /* Count of references to this span record */
 } ListSpan;
 #ifndef LIST_SPAN_THRESHOLD /* May be set on build line */
 #define LIST_SPAN_THRESHOLD 101
@@ -2584,6 +2584,7 @@ typedef struct ListRep {
     (((objv_) = &ListObjStorePtr(listObj_)->slots[ListObjStart(listObj_)]), \
      (ListObjLength(listObj_, (objc_))))
 
+
 /*
  * Returns 1/0 whether the internal representation (not the Tcl_Obj itself)
  * is shared.  Note by intent this only checks for sharing of ListStore,
@@ -3173,6 +3174,9 @@ MODULE_SCOPE Tcl_Command TclCreateEnsembleInNs(Tcl_Interp *interp,
 			    Tcl_Namespace *ensembleNamespacePtr, int flags);
 MODULE_SCOPE void	TclDeleteNamespaceVars(Namespace *nsPtr);
 MODULE_SCOPE void	TclDeleteNamespaceChildren(Namespace *nsPtr);
+MODULE_SCOPE Tcl_Size	TclDictGetSize(Tcl_Obj *dictPtr);
+MODULE_SCOPE Tcl_Obj*	TclDuplicatePureObj(Tcl_Interp *interp,
+			    Tcl_Obj * objPtr, const Tcl_ObjType *typPtr);
 MODULE_SCOPE int	TclFindDictElement(Tcl_Interp *interp,
 			    const char *dict, Tcl_Size dictLength,
 			    const char **elementPtr, const char **nextPtr,
@@ -3299,10 +3303,10 @@ MODULE_SCOPE Tcl_Obj *	TclLindexList(Tcl_Interp *interp,
 			    Tcl_Obj *listPtr, Tcl_Obj *argPtr);
 MODULE_SCOPE Tcl_Obj *	TclLindexFlat(Tcl_Interp *interp, Tcl_Obj *listPtr,
 			    Tcl_Size indexCount, Tcl_Obj *const indexArray[]);
+MODULE_SCOPE Tcl_Obj *	TclListObjGetElement(Tcl_Obj *listObj, Tcl_Size index);
 /* TIP #280 */
 MODULE_SCOPE void	TclListLines(Tcl_Obj *listObj, Tcl_Size line, int n,
 			    int *lines, Tcl_Obj *const *elems);
-MODULE_SCOPE Tcl_Obj *	TclListObjCopy(Tcl_Interp *interp, Tcl_Obj *listPtr);
 MODULE_SCOPE int	TclListObjAppendElements(Tcl_Interp *interp,
 			    Tcl_Obj *toObj, Tcl_Size elemCount,
 			    Tcl_Obj *const elemObjv[]);
@@ -3345,6 +3349,7 @@ MODULE_SCOPE void	TclParseInit(Tcl_Interp *interp, const char *string,
 MODULE_SCOPE Tcl_Size	TclParseAllWhiteSpace(const char *src, Tcl_Size numBytes);
 MODULE_SCOPE int	TclProcessReturn(Tcl_Interp *interp,
 			    int code, int level, Tcl_Obj *returnOpts);
+MODULE_SCOPE void 	TclUndoRefCount(Tcl_Obj *objPtr);
 MODULE_SCOPE int	TclpObjLstat(Tcl_Obj *pathPtr, Tcl_StatBuf *buf);
 MODULE_SCOPE Tcl_Obj *	TclpTempFileName(void);
 MODULE_SCOPE Tcl_Obj *  TclpTempFileNameForLibrary(Tcl_Interp *interp,
@@ -4527,9 +4532,6 @@ MODULE_SCOPE void	TclDbInitNewObj(Tcl_Obj *objPtr, const char *file,
 # define TclDecrRefCount(objPtr) \
     Tcl_DbDecrRefCount(objPtr, __FILE__, __LINE__)
 
-# define TclNewListObjDirect(objc, objv) \
-    TclDbNewListObjDirect(objc, objv, __FILE__, __LINE__)
-
 #undef USE_THREAD_ALLOC
 #endif /* TCL_MEM_DEBUG */
 
diff --git a/generic/tclListObj.c b/generic/tclListObj.c
index c8464d5..6288ffb 100644
--- a/generic/tclListObj.c
+++ b/generic/tclListObj.c
@@ -1317,50 +1317,6 @@ Tcl_SetListObj(
 }
 
 /*
- *----------------------------------------------------------------------
- *
- * TclListObjCopy --
- *
- *	Makes a "pure list" copy of a list value. This provides for the C
- *	level a counterpart of the [lrange $list 0 end] command, while using
- *	internals details to be as efficient as possible.
- *
- * Results:
- *	Normally returns a pointer to a new Tcl_Obj, that contains the same
- *	list value as *listPtr does. The returned Tcl_Obj has a refCount of
- *	zero. If *listPtr does not hold a list, NULL is returned, and if
- *	interp is non-NULL, an error message is recorded there.
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
-
-Tcl_Obj *
-TclListObjCopy(
-    Tcl_Interp *interp,		/* Used to report errors if not NULL. */
-    Tcl_Obj *listObj)		/* List object for which an element array is
-				 * to be returned. */
-{
-    Tcl_Obj *copyObj;
-
-    if (!TclHasInternalRep(listObj, &tclListType.objType)) {
-	if (TclHasInternalRep(listObj,&tclArithSeriesType.objType)) {
-	    return Tcl_DuplicateObj(listObj);
-	}
-	if (SetListFromAny(interp, listObj) != TCL_OK) {
-	    return NULL;
-	}
-    }
-
-    TclNewObj(copyObj);
-    TclInvalidateStringRep(copyObj);
-    DupListInternalRep(listObj, copyObj);
-    return copyObj;
-}
-
-/*
  *------------------------------------------------------------------------
  *
  * ListRepRange --
@@ -1603,6 +1559,29 @@ TclListObjRange(
 /*
  *----------------------------------------------------------------------
  *
+ * TclListObjGetElement --
+ *
+ *	Returns a single element from the array of the elements in a list
+ *	object, without doing doing any bounds checking.  Caller must ensure
+ *	that ObjPtr of of type 'tclListType' and that  index is valid for the
+ *	list.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+TclListObjGetElement(
+    Tcl_Obj *objPtr,		/* List object for which an element array is
+				 * to be returned. */
+    Tcl_Size index
+)
+{
+    return ListObjStorePtr(objPtr)->slots[ListObjStart(objPtr) + index];
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * Tcl_ListObjGetElements --
  *
  *	This function returns an (objc,objv) array of the elements in a list
@@ -2540,6 +2519,7 @@ TclLindexList(
     Tcl_Obj *indexListCopy;
     Tcl_Obj **indexObjs;
     Tcl_Size numIndexObjs;
+    int status;
 
     /*
      * Determine whether argPtr designates a list or a single index. We have
@@ -2557,19 +2537,30 @@ TclLindexList(
     }
 
     /*
-     * Here we make a private copy of the index list argument to avoid any
-     * shimmering issues that might invalidate the indices array below while
-     * we are still using it. This is probably unnecessary. It does not appear
-     * that any damaging shimmering is possible, and no test has been devised
-     * to show any error when this private copy is not made. But it's cheap,
-     * and it offers some future-proofing insurance in case the TclLindexFlat
-     * implementation changes in some unexpected way, or some new form of
-     * trace or callback permits things to happen that the current
-     * implementation does not.
+     * Make a private copy of the index list argument to keep the internal
+     * representation of th indices array unchanged while it is in use.  This
+     * is probably unnecessary. It does not appear that any damaging change to
+     * the internal representation is possible, and no test has been devised to
+     * show any error when this private copy is not made, But it's cheap, and
+     * it offers some future-proofing insurance in case the TclLindexFlat
+     * implementation changes in some unexpected way, or some new form of trace
+     * or callback permits things to happen that the current implementation
+     * does not.
      */
 
-    indexListCopy = TclListObjCopy(NULL, argObj);
-    if (indexListCopy == NULL) {
+    indexListCopy = TclDuplicatePureObj(interp, argObj, &tclListType.objType);
+    if (!indexListCopy) {
+	/*
+	 * The argument is neither an index nor a well-formed list.
+	 * Report the error via TclLindexFlat.
+	 * TODO - This is as original code. why not directly return an error?
+	 */
+	return TclLindexFlat(interp, listObj, 1, &argObj);
+    }
+    status = TclListObjGetElementsM(
+	interp, indexListCopy, &numIndexObjs, &indexObjs);
+    if (status != TCL_OK) {
+	Tcl_DecrRefCount(indexListCopy);
 	/*
 	 * The argument is neither an index nor a well-formed list.
 	 * Report the error via TclLindexFlat.
@@ -2577,8 +2568,6 @@ TclLindexList(
 	 */
 	return TclLindexFlat(interp, listObj, 1, &argObj);
     }
-
-    ListObjGetElements(indexListCopy, numIndexObjs, indexObjs);
     listObj = TclLindexFlat(interp, listObj, numIndexObjs, indexObjs);
     Tcl_DecrRefCount(indexListCopy);
     return listObj;
@@ -2759,23 +2748,30 @@ TclLsetList(
 	return TclLsetFlat(interp, listObj, 1, &indexArgObj, valueObj);
     }
 
-    indexListCopy = TclListObjCopy(NULL, indexArgObj);
-    if (indexListCopy == NULL) {
+    indexListCopy = TclDuplicatePureObj(
+	    interp, indexArgObj, &tclListType.objType);
+    if (!indexListCopy) {
+	/*
+	 * indexArgPtr designates something that is neither an index nor a
+	 * well formed list. Report the error via TclLsetFlat.
+	 */
+	return TclLsetFlat(interp, listObj, 1, &indexArgObj, valueObj);
+    }
+    if (TCL_OK != TclListObjGetElementsM(
+	interp, indexListCopy, &indexCount, &indices)) {
+	Tcl_DecrRefCount(indexListCopy);
 	/*
 	 * indexArgPtr designates something that is neither an index nor a
 	 * well formed list. Report the error via TclLsetFlat.
 	 */
 	return TclLsetFlat(interp, listObj, 1, &indexArgObj, valueObj);
     }
-    LIST_ASSERT_TYPE(indexListCopy);
-    ListObjGetElements(indexListCopy, indexCount, indices);
 
     /*
      * Let TclLsetFlat perform the actual lset operation.
      */
 
     retValueObj = TclLsetFlat(interp, listObj, indexCount, indices, valueObj);
-
     Tcl_DecrRefCount(indexListCopy);
     return retValueObj;
 }
@@ -2826,7 +2822,7 @@ TclLsetFlat(
     Tcl_Obj *valueObj)		/* Value arg to 'lset' or NULL to 'lpop'. */
 {
     Tcl_Size index, len;
-    int result;
+    int copied = 0, result;
     Tcl_Obj *subListObj, *retValueObj;
     Tcl_Obj *pendingInvalidates[10];
     Tcl_Obj **pendingInvalidatesPtr = pendingInvalidates;
@@ -2846,17 +2842,15 @@ TclLsetFlat(
     }
 
     /*
-     * If the list is shared, make a copy we can modify (copy-on-write).  We
-     * use Tcl_DuplicateObj() instead of TclListObjCopy() for a few reasons:
-     * 1) we have not yet confirmed listObj is actually a list; 2) We make a
-     * verbatim copy of any existing string rep, and when we combine that with
-     * the delayed invalidation of string reps of modified Tcl_Obj's
-     * implemented below, the outcome is that any error condition that causes
-     * this routine to return NULL, will leave the string rep of listObj and
-     * all elements to be unchanged.
+     * If the list is shared, make a copy to modify (copy-on-write). The string
+     * representation and internal representation of listObj remains unchanged.
      */
 
-    subListObj = Tcl_IsShared(listObj) ? Tcl_DuplicateObj(listObj) : listObj;
+    subListObj = Tcl_IsShared(listObj)
+	? TclDuplicatePureObj(interp, listObj, &tclListType.objType) : listObj;
+    if (!subListObj) {
+	return NULL;
+    }
 
     /*
      * Anchor the linked list of Tcl_Obj's whose string reps must be
@@ -2926,10 +2920,9 @@ TclLsetFlat(
 	}
 
 	/*
-	 * No error conditions.  As long as we're not yet on the last index,
-	 * determine the next sublist for the next pass through the loop,
-	 * and take steps to make sure it is an unshared copy, as we intend
-	 * to modify it.
+	 * No error conditions.  If this is not the last index, determine the
+	 * next sublist for the next pass through the loop, and take steps to
+	 * make sure it is unshared in order to modify it.
 	 */
 
 	if (--indexCount) {
@@ -2940,7 +2933,12 @@ TclLsetFlat(
 		subListObj = elemPtrs[index];
 	    }
 	    if (Tcl_IsShared(subListObj)) {
-		subListObj = Tcl_DuplicateObj(subListObj);
+		subListObj = TclDuplicatePureObj(
+		    interp, subListObj, &tclListType.objType);
+		if (!subListObj) {
+		    return NULL;
+		}
+		copied = 1;
 	    }
 
 	    /*
@@ -2958,7 +2956,17 @@ TclLsetFlat(
 		TclListObjSetElement(NULL, parentList, index, subListObj);
 	    }
 	    if (Tcl_IsShared(subListObj)) {
-		subListObj = Tcl_DuplicateObj(subListObj);
+		Tcl_Obj * newSubListObj;
+		newSubListObj = TclDuplicatePureObj(
+		    interp, subListObj, &tclListType.objType);
+		if (copied) {
+		    Tcl_DecrRefCount(subListObj);
+		}
+		if (newSubListObj) {
+		    subListObj = newSubListObj;
+		} else {
+		    return NULL;
+		}
 		TclListObjSetElement(NULL, parentList, index, subListObj);
 	    }
 
@@ -3307,6 +3315,7 @@ SetListFromAny(
 	    if (elemPtrs[j] == NULL) {
 		return TCL_ERROR;
 	    }
+	    Tcl_IncrRefCount(elemPtrs[j]);
 	}
 
     } else {
diff --git a/generic/tclOO.c b/generic/tclOO.c
index b05fe1f..d9cabe6 100644
--- a/generic/tclOO.c
+++ b/generic/tclOO.c
@@ -3,7 +3,7 @@
  *
  *	This file contains the object-system core (NB: not Tcl_Obj, but ::oo)
  *
- * Copyright © 2005-2012 Donal K. Fellows
+ * Copyright © 2005-2019 Donal K. Fellows
  * Copyright © 2017 Nathan Coulter
  *
  * See the file "license.terms" for information on usage and redistribution of
@@ -327,6 +327,7 @@ InitFoundation(
 	    DeletedObjdefNamespace);
     fPtr->helpersNs = Tcl_CreateNamespace(interp, "::oo::Helpers", fPtr,
 	    DeletedHelpersNamespace);
+    Tcl_CreateNamespace(interp, "::oo::configuresupport", NULL, NULL);
     fPtr->epoch = 1;
     fPtr->tsdPtr = tsdPtr;
     TclNewLiteralStringObj(fPtr->unknownMethodNameObj, "unknown");
@@ -964,7 +965,7 @@ TclOOReleaseClassContents(
     Class *clsPtr = oPtr->classPtr, *tmpClsPtr;
     Method *mPtr;
     Foundation *fPtr = oPtr->fPtr;
-    Tcl_Obj *variableObj;
+    Tcl_Obj *variableObj, *propertyObj;
     PrivateVariableMapping *privateVariable;
 
     /*
@@ -1018,6 +1019,29 @@ TclOOReleaseClassContents(
     }
 
     /*
+     * Squelch the property lists.
+     */
+
+    if (clsPtr->properties.allReadableCache) {
+	Tcl_DecrRefCount(clsPtr->properties.allReadableCache);
+    }
+    if (clsPtr->properties.allWritableCache) {
+	Tcl_DecrRefCount(clsPtr->properties.allWritableCache);
+    }
+    if (clsPtr->properties.readable.num) {
+	FOREACH(propertyObj, clsPtr->properties.readable) {
+	    Tcl_DecrRefCount(propertyObj);
+	}
+	Tcl_Free(clsPtr->properties.readable.list);
+    }
+    if (clsPtr->properties.writable.num) {
+	FOREACH(propertyObj, clsPtr->properties.writable) {
+	    Tcl_DecrRefCount(propertyObj);
+	}
+	Tcl_Free(clsPtr->properties.writable.list);
+    }
+
+    /*
      * Squelch our filter list.
      */
 
@@ -1118,7 +1142,7 @@ ObjectNamespaceDeleted(
     FOREACH_HASH_DECLS;
     Class *mixinPtr;
     Method *mPtr;
-    Tcl_Obj *filterObj, *variableObj;
+    Tcl_Obj *filterObj, *variableObj, *propertyObj;
     PrivateVariableMapping *privateVariable;
     Tcl_Interp *interp = oPtr->fPtr->interp;
     Tcl_Size i;
@@ -1272,6 +1296,29 @@ ObjectNamespaceDeleted(
     }
 
     /*
+     * Squelch the property lists.
+     */
+
+    if (oPtr->properties.allReadableCache) {
+	Tcl_DecrRefCount(oPtr->properties.allReadableCache);
+    }
+    if (oPtr->properties.allWritableCache) {
+	Tcl_DecrRefCount(oPtr->properties.allWritableCache);
+    }
+    if (oPtr->properties.readable.num) {
+	FOREACH(propertyObj, oPtr->properties.readable) {
+	    Tcl_DecrRefCount(propertyObj);
+	}
+	Tcl_Free(oPtr->properties.readable.list);
+    }
+    if (oPtr->properties.writable.num) {
+	FOREACH(propertyObj, oPtr->properties.writable) {
+	    Tcl_DecrRefCount(propertyObj);
+	}
+	Tcl_Free(oPtr->properties.writable.list);
+    }
+
+    /*
      * Because an object can be a class that is an instance of itself, the
      * class object's class structure should only be cleaned after most of
      * the cleanup on the object is done.
diff --git a/generic/tclOOCall.c b/generic/tclOOCall.c
index 5c9c986..39fd020 100644
--- a/generic/tclOOCall.c
+++ b/generic/tclOOCall.c
@@ -2,9 +2,10 @@
  * tclOOCall.c --
  *
  *	This file contains the method call chain management code for the
- *	object-system core.
+ *	object-system core. It also contains everything else that does
+ *	inheritance hierarchy traversal.
  *
- * Copyright © 2005-2012 Donal K. Fellows
+ * Copyright © 2005-2019 Donal K. Fellows
  *
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -58,6 +59,7 @@ typedef struct {
 #define BUILDING_MIXINS	   0x400000
 #define TRAVERSED_MIXIN	   0x800000
 #define OBJECT_MIXIN	   0x1000000
+#define DEFINE_FOR_CLASS   0x2000000
 #define MIXIN_CONSISTENT(flags) \
     (((flags) & OBJECT_MIXIN) ||					\
 	!((flags) & BUILDING_MIXINS) == !((flags) & TRAVERSED_MIXIN))
@@ -1907,7 +1909,7 @@ TclOOGetDefineContextNamespace(
     DefineEntry staticSpace[DEFINE_CHAIN_STATIC_SIZE];
     DefineEntry *entryPtr;
     Tcl_Namespace *nsPtr = NULL;
-    int i;
+    int i, flags = (forClass ? DEFINE_FOR_CLASS : 0);
 
     define.list = staticSpace;
     define.num = 0;
@@ -1918,8 +1920,8 @@ TclOOGetDefineContextNamespace(
      * class mixins right.
      */
 
-    AddSimpleDefineNamespaces(oPtr, &define, forClass | BUILDING_MIXINS);
-    AddSimpleDefineNamespaces(oPtr, &define, forClass);
+    AddSimpleDefineNamespaces(oPtr, &define, flags | BUILDING_MIXINS);
+    AddSimpleDefineNamespaces(oPtr, &define, flags);
 
     /*
      * Go through the list until we find a namespace whose name we can
@@ -2003,7 +2005,7 @@ AddSimpleClassDefineNamespaces(
 		flags | TRAVERSED_MIXIN);
     }
 
-    if (flags & ~(TRAVERSED_MIXIN | BUILDING_MIXINS)) {
+    if (flags & DEFINE_FOR_CLASS) {
 	AddDefinitionNamespaceToChain(classPtr, classPtr->clsDefinitionNs,
 		definePtr, flags);
     } else {
@@ -2113,6 +2115,259 @@ AddDefinitionNamespaceToChain(
 }
 
 /*
+ * ----------------------------------------------------------------------
+ *
+ * FindClassProps --
+ *
+ *	Discover the properties known to a class and its superclasses.
+ *	The property names become the keys in the accumulator hash table
+ *	(which is used as a set).
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static void
+FindClassProps(
+    Class *clsPtr,		/* The object to inspect. Must exist. */
+    int writable,		/* Whether we're after the readable or writable
+				 * property set. */
+    Tcl_HashTable *accumulator)	/* Where to gather the names. */
+{
+    int i, dummy;
+    Tcl_Obj *propName;
+    Class *mixin, *sup;
+
+  tailRecurse:
+    if (writable) {
+	FOREACH(propName, clsPtr->properties.writable) {
+	    Tcl_CreateHashEntry(accumulator, (void *) propName, &dummy);
+	}
+    } else {
+	FOREACH(propName, clsPtr->properties.readable) {
+	    Tcl_CreateHashEntry(accumulator, (void *) propName, &dummy);
+	}
+    }
+    if (clsPtr->thisPtr->flags & ROOT_OBJECT) {
+	/*
+	 * We do *not* traverse upwards from the root!
+	 */
+	return;
+    }
+    FOREACH(mixin, clsPtr->mixins) {
+	FindClassProps(mixin, writable, accumulator);
+    }
+    if (clsPtr->superclasses.num == 1) {
+	clsPtr = clsPtr->superclasses.list[0];
+	goto tailRecurse;
+    }
+    FOREACH(sup, clsPtr->superclasses) {
+	FindClassProps(sup, writable, accumulator);
+    }
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * FindObjectProps --
+ *
+ *	Discover the properties known to an object and all its classes.
+ *	The property names become the keys in the accumulator hash table
+ *	(which is used as a set).
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static void
+FindObjectProps(
+    Object *oPtr,		/* The object to inspect. Must exist. */
+    int writable,		/* Whether we're after the readable or writable
+				 * property set. */
+    Tcl_HashTable *accumulator)	/* Where to gather the names. */
+{
+    int i, dummy;
+    Tcl_Obj *propName;
+    Class *mixin;
+
+    if (writable) {
+	FOREACH(propName, oPtr->properties.writable) {
+	    Tcl_CreateHashEntry(accumulator, (void *) propName, &dummy);
+	}
+    } else {
+	FOREACH(propName, oPtr->properties.readable) {
+	    Tcl_CreateHashEntry(accumulator, (void *) propName, &dummy);
+	}
+    }
+    FOREACH(mixin, oPtr->mixins) {
+	FindClassProps(mixin, writable, accumulator);
+    }
+    FindClassProps(oPtr->selfCls, writable, accumulator);
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TclOOGetAllClassProperties --
+ *
+ *	Get the list of all properties known to a class, including to its
+ *	superclasses. Manages a cache so this operation is usually cheap.
+ *	The order of properties in the resulting list is undefined.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+TclOOGetAllClassProperties(
+    Class *clsPtr,		/* The class to inspect. Must exist. */
+    int writable,		/* Whether to get writable properties. If
+				 * false, readable properties will be returned
+				 * instead. */
+    int *allocated)		/* Address of variable to set to true if a
+				 * Tcl_Obj was allocated and may be safely
+				 * modified by the caller. */
+{
+    Tcl_HashTable hashTable;
+    FOREACH_HASH_DECLS;
+    Tcl_Obj *propName, *result;
+    void *dummy;
+
+    /*
+     * Look in the cache.
+     */
+
+    if (clsPtr->properties.epoch == clsPtr->thisPtr->fPtr->epoch) {
+	if (writable) {
+	    if (clsPtr->properties.allWritableCache) {
+		*allocated = 0;
+		return clsPtr->properties.allWritableCache;
+	    }
+	} else {
+	    if (clsPtr->properties.allReadableCache) {
+		*allocated = 0;
+		return clsPtr->properties.allReadableCache;
+	    }
+	}
+    }
+
+    /*
+     * Gather the information. Unsorted! (Caller will sort.)
+     */
+
+    *allocated = 1;
+    Tcl_InitObjHashTable(&hashTable);
+    FindClassProps(clsPtr, writable, &hashTable);
+    result = Tcl_NewObj();
+    FOREACH_HASH(propName, dummy, &hashTable) {
+	Tcl_ListObjAppendElement(NULL, result, propName);
+    }
+    Tcl_DeleteHashTable(&hashTable);
+
+    /*
+     * Cache the information. Also purges the cache.
+     */
+
+    if (clsPtr->properties.epoch != clsPtr->thisPtr->fPtr->epoch) {
+	if (clsPtr->properties.allWritableCache) {
+	    Tcl_DecrRefCount(clsPtr->properties.allWritableCache);
+	    clsPtr->properties.allWritableCache = NULL;
+	}
+	if (clsPtr->properties.allReadableCache) {
+	    Tcl_DecrRefCount(clsPtr->properties.allReadableCache);
+	    clsPtr->properties.allReadableCache = NULL;
+	}
+    }
+    clsPtr->properties.epoch = clsPtr->thisPtr->fPtr->epoch;
+    if (writable) {
+	clsPtr->properties.allWritableCache = result;
+    } else {
+	clsPtr->properties.allReadableCache = result;
+    }
+    Tcl_IncrRefCount(result);
+    return result;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TclOOGetAllObjectProperties --
+ *
+ *	Get the list of all properties known to a object, including to its
+ *	classes. Manages a cache so this operation is usually cheap.
+ *	The order of properties in the resulting list is undefined.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+TclOOGetAllObjectProperties(
+    Object *oPtr,		/* The object to inspect. Must exist. */
+    int writable,		/* Whether to get writable properties. If
+				 * false, readable properties will be returned
+				 * instead. */
+    int *allocated)		/* Address of variable to set to true if a
+				 * Tcl_Obj was allocated and may be safely
+				 * modified by the caller. */
+{
+    Tcl_HashTable hashTable;
+    FOREACH_HASH_DECLS;
+    Tcl_Obj *propName, *result;
+    void *dummy;
+
+    /*
+     * Look in the cache.
+     */
+
+    if (oPtr->properties.epoch == oPtr->fPtr->epoch) {
+	if (writable) {
+	    if (oPtr->properties.allWritableCache) {
+		*allocated = 0;
+		return oPtr->properties.allWritableCache;
+	    }
+	} else {
+	    if (oPtr->properties.allReadableCache) {
+		*allocated = 0;
+		return oPtr->properties.allReadableCache;
+	    }
+	}
+    }
+
+    /*
+     * Gather the information. Unsorted! (Caller will sort.)
+     */
+
+    *allocated = 1;
+    Tcl_InitObjHashTable(&hashTable);
+    FindObjectProps(oPtr, writable, &hashTable);
+    result = Tcl_NewObj();
+    FOREACH_HASH(propName, dummy, &hashTable) {
+	Tcl_ListObjAppendElement(NULL, result, propName);
+    }
+    Tcl_DeleteHashTable(&hashTable);
+
+    /*
+     * Cache the information.
+     */
+
+    if (oPtr->properties.epoch != oPtr->fPtr->epoch) {
+	if (oPtr->properties.allWritableCache) {
+	    Tcl_DecrRefCount(oPtr->properties.allWritableCache);
+	    oPtr->properties.allWritableCache = NULL;
+	}
+	if (oPtr->properties.allReadableCache) {
+	    Tcl_DecrRefCount(oPtr->properties.allReadableCache);
+	    oPtr->properties.allReadableCache = NULL;
+	}
+    }
+    oPtr->properties.epoch = oPtr->fPtr->epoch;
+    if (writable) {
+	oPtr->properties.allWritableCache = result;
+    } else {
+	oPtr->properties.allReadableCache = result;
+    }
+    Tcl_IncrRefCount(result);
+    return result;
+}
+
+/*
  * Local Variables:
  * mode: c
  * c-basic-offset: 4
diff --git a/generic/tclOODefineCmds.c b/generic/tclOODefineCmds.c
index 84204f9..a3bdddf 100644
--- a/generic/tclOODefineCmds.c
+++ b/generic/tclOODefineCmds.c
@@ -4,7 +4,7 @@
  *	This file contains the implementation of the ::oo::define command,
  *	part of the object-system core (NB: not Tcl_Obj, but ::oo).
  *
- * Copyright © 2006-2013 Donal K. Fellows
+ * Copyright © 2006-2019 Donal K. Fellows
  *
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -60,6 +60,7 @@ struct DeclaredSlot {
  */
 
 static inline void	BumpGlobalEpoch(Tcl_Interp *interp, Class *classPtr);
+static inline void	BumpInstanceEpoch(Object *oPtr);
 static Tcl_Command	FindCommand(Tcl_Interp *interp, Tcl_Obj *stringObj,
 			    Tcl_Namespace *const namespacePtr);
 static inline void	GenerateErrorInfo(Tcl_Interp *interp, Object *oPtr,
@@ -102,6 +103,8 @@ static int		ClassVarsGet(void *clientData,
 static int		ClassVarsSet(void *clientData,
 			    Tcl_Interp *interp, Tcl_ObjectContext context,
 			    int objc, Tcl_Obj *const *objv);
+static Tcl_MethodCallProc ClassRPropsGet, ClassRPropsSet;
+static Tcl_MethodCallProc ClassWPropsGet, ClassWPropsSet;
 static int		ObjFilterGet(void *clientData,
 			    Tcl_Interp *interp, Tcl_ObjectContext context,
 			    int objc, Tcl_Obj *const *objv);
@@ -120,6 +123,8 @@ static int		ObjVarsGet(void *clientData,
 static int		ObjVarsSet(void *clientData,
 			    Tcl_Interp *interp, Tcl_ObjectContext context,
 			    int objc, Tcl_Obj *const *objv);
+static Tcl_MethodCallProc ObjRPropsGet, ObjRPropsSet;
+static Tcl_MethodCallProc ObjWPropsGet, ObjWPropsSet;
 static int		ResolveClass(void *clientData,
 			    Tcl_Interp *interp, Tcl_ObjectContext context,
 			    int objc, Tcl_Obj *const *objv);
@@ -136,6 +141,14 @@ static const struct DeclaredSlot slots[] = {
     SLOT("objdefine::filter",   ObjFilterGet,   ObjFilterSet, NULL),
     SLOT("objdefine::mixin",    ObjMixinGet,    ObjMixinSet, ResolveClass),
     SLOT("objdefine::variable", ObjVarsGet,     ObjVarsSet, NULL),
+    SLOT("configuresupport::readableproperties",
+	    ClassRPropsGet, ClassRPropsSet, NULL),
+    SLOT("configuresupport::writableproperties",
+	    ClassWPropsGet, ClassWPropsSet, NULL),
+    SLOT("configuresupport::objreadableproperties",
+	    ObjRPropsGet, ObjRPropsSet, NULL),
+    SLOT("configuresupport::objwritableproperties",
+	    ObjWPropsGet, ObjWPropsSet, NULL),
     {NULL, {0, 0, 0, 0, 0}, {0, 0, 0, 0, 0}, {0, 0, 0, 0, 0}}
 };
 
@@ -201,13 +214,26 @@ BumpGlobalEpoch(
 
 	if (classPtr->thisPtr->mixins.num > 0) {
 	    classPtr->thisPtr->epoch++;
+
+	    /*
+	     * Invalidate the property caches directly.
+	     */
+
+	    if (classPtr->properties.allReadableCache) {
+		Tcl_DecrRefCount(classPtr->properties.allReadableCache);
+		classPtr->properties.allReadableCache = NULL;
+	    }
+	    if (classPtr->properties.allWritableCache) {
+		Tcl_DecrRefCount(classPtr->properties.allWritableCache);
+		classPtr->properties.allWritableCache = NULL;
+	    }
 	}
 	return;
     }
 
     /*
      * Either there's no class (?!) or we're reconfiguring something that is
-     * in use. Force regeneration of call chains.
+     * in use. Force regeneration of call chains and properties.
      */
 
     TclOOGetFoundation(interp)->epoch++;
@@ -216,6 +242,33 @@ BumpGlobalEpoch(
 /*
  * ----------------------------------------------------------------------
  *
+ * BumpInstanceEpoch --
+ *
+ *	Advances the epoch and clears the property cache of an object. The
+ *	equivalent for classes is BumpGlobalEpoch(), as classes have a more
+ *	complex set of relationships to other entities.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static inline void
+BumpInstanceEpoch(
+    Object *oPtr)
+{
+    oPtr->epoch++;
+    if (oPtr->properties.allReadableCache) {
+	Tcl_DecrRefCount(oPtr->properties.allReadableCache);
+	oPtr->properties.allReadableCache = NULL;
+    }
+    if (oPtr->properties.allWritableCache) {
+	Tcl_DecrRefCount(oPtr->properties.allWritableCache);
+	oPtr->properties.allWritableCache = NULL;
+    }
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
  * RecomputeClassCacheFlag --
  *
  *	Determine whether the object is prototypical of its class, and hence
@@ -292,7 +345,7 @@ TclOOObjectSetFilters(
 	oPtr->filters.num = numFilters;
 	oPtr->flags &= ~USE_CLASS_CACHE;
     }
-    oPtr->epoch++;		/* Only this object can be affected. */
+    BumpInstanceEpoch(oPtr);	/* Only this object can be affected. */
 }
 
 /*
@@ -415,7 +468,7 @@ TclOOObjectSetMixins(
 	    }
 	}
     }
-    oPtr->epoch++;
+    BumpInstanceEpoch(oPtr);
 }
 
 /*
@@ -482,6 +535,7 @@ TclOOClassSetMixins(
  *
  * ----------------------------------------------------------------------
  */
+
 static inline void
 InstallStandardVariableMapping(
     VariableNameList *vnlPtr,
@@ -1507,7 +1561,7 @@ TclOODefineClassObjCmd(
 	if (oPtr->classPtr != NULL) {
 	    BumpGlobalEpoch(interp, oPtr->classPtr);
 	} else {
-	    oPtr->epoch++;
+	    BumpInstanceEpoch(oPtr);
 	}
     }
     return TCL_OK;
@@ -1717,7 +1771,7 @@ TclOODefineDeleteMethodObjCmd(
     }
 
     if (isInstanceDeleteMethod) {
-	oPtr->epoch++;
+	BumpInstanceEpoch(oPtr);
     } else {
 	BumpGlobalEpoch(interp, oPtr->classPtr);
     }
@@ -1877,7 +1931,7 @@ TclOODefineExportObjCmd(
 
     if (changed) {
 	if (isInstanceExport) {
-	    oPtr->epoch++;
+	    BumpInstanceEpoch(oPtr);
 	} else {
 	    BumpGlobalEpoch(interp, clsPtr);
 	}
@@ -2095,7 +2149,7 @@ TclOODefineRenameMethodObjCmd(
     }
 
     if (isInstanceRenameMethod) {
-	oPtr->epoch++;
+	BumpInstanceEpoch(oPtr);
     } else {
 	BumpGlobalEpoch(interp, oPtr->classPtr);
     }
@@ -2189,7 +2243,7 @@ TclOODefineUnexportObjCmd(
 
     if (changed) {
 	if (isInstanceUnexport) {
-	    oPtr->epoch++;
+	    BumpInstanceEpoch(oPtr);
 	} else {
 	    BumpGlobalEpoch(interp, clsPtr);
 	}
@@ -3082,6 +3136,400 @@ ResolveClass(
 }
 
 /*
+ * ----------------------------------------------------------------------
+ *
+ * ClassRPropsGet, ClassRPropsSet, ObjRPropsGet, ObjRPropsSet --
+ *
+ *	Implementations of the "readableproperties" slot accessors for classes
+ *	and instances.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static void
+InstallReadableProps(
+    PropertyStorage *props,
+    Tcl_Size objc,
+    Tcl_Obj *const objv[])
+{
+    Tcl_Obj *propObj;
+    Tcl_Size i, n;
+    int created;
+    Tcl_HashTable uniqueTable;
+
+    if (props->allReadableCache) {
+	Tcl_DecrRefCount(props->allReadableCache);
+	props->allReadableCache = NULL;
+    }
+
+    for (i=0 ; i<objc ; i++) {
+	Tcl_IncrRefCount(objv[i]);
+    }
+    FOREACH(propObj, props->readable) {
+	Tcl_DecrRefCount(propObj);
+    }
+    if (i != objc) {
+	if (objc == 0) {
+	    Tcl_Free(props->readable.list);
+	} else if (i) {
+	    props->readable.list = (Tcl_Obj **)Tcl_Realloc(props->readable.list,
+		    sizeof(Tcl_Obj *) * objc);
+	} else {
+	    props->readable.list = (Tcl_Obj **)Tcl_Alloc(sizeof(Tcl_Obj *) * objc);
+	}
+    }
+    props->readable.num = 0;
+    if (objc > 0) {
+	Tcl_InitObjHashTable(&uniqueTable);
+	for (i=n=0 ; i<objc ; i++) {
+	    Tcl_CreateHashEntry(&uniqueTable, objv[i], &created);
+	    if (created) {
+		props->readable.list[n++] = objv[i];
+	    } else {
+		Tcl_DecrRefCount(objv[i]);
+	    }
+	}
+	props->readable.num = n;
+
+	/*
+	 * Shouldn't be necessary, but maintain num/list invariant.
+	 */
+
+	if (n != objc) {
+	    props->readable.list = (Tcl_Obj **)Tcl_Realloc(props->readable.list,
+		    sizeof(Tcl_Obj *) * n);
+	}
+	Tcl_DeleteHashTable(&uniqueTable);
+    }
+}
+
+static int
+ClassRPropsGet(
+    TCL_UNUSED(void *),
+    Tcl_Interp *interp,
+    Tcl_ObjectContext context,
+    int objc,
+    Tcl_Obj *const *objv)
+{
+    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
+    Tcl_Obj *resultObj, *propNameObj;
+    int i;
+
+    if (Tcl_ObjectContextSkippedArgs(context) != objc) {
+	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
+		NULL);
+	return TCL_ERROR;
+    }
+    if (oPtr == NULL) {
+	return TCL_ERROR;
+    } else if (!oPtr->classPtr) {
+	Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		"attempt to misuse API", -1));
+	Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
+	return TCL_ERROR;
+    }
+
+    resultObj = Tcl_NewObj();
+    FOREACH(propNameObj, oPtr->classPtr->properties.readable) {
+	Tcl_ListObjAppendElement(NULL, resultObj, propNameObj);
+    }
+    Tcl_SetObjResult(interp, resultObj);
+    return TCL_OK;
+}
+
+static int
+ClassRPropsSet(
+    TCL_UNUSED(void *),
+    Tcl_Interp *interp,
+    Tcl_ObjectContext context,
+    int objc,
+    Tcl_Obj *const *objv)
+{
+    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
+    Tcl_Size varc;
+    Tcl_Obj **varv;
+
+    if (Tcl_ObjectContextSkippedArgs(context) + 1 != objc) {
+	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
+		"filterList");
+	return TCL_ERROR;
+    }
+    objv += Tcl_ObjectContextSkippedArgs(context);
+
+    if (oPtr == NULL) {
+	return TCL_ERROR;
+    } else if (!oPtr->classPtr) {
+	Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		"attempt to misuse API", -1));
+	Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
+	return TCL_ERROR;
+    } else if (Tcl_ListObjGetElements(interp, objv[0], &varc,
+	    &varv) != TCL_OK) {
+	return TCL_ERROR;
+    }
+
+    InstallReadableProps(&oPtr->classPtr->properties, varc, varv);
+    BumpGlobalEpoch(interp, oPtr->classPtr);
+    return TCL_OK;
+}
+
+static int
+ObjRPropsGet(
+    TCL_UNUSED(void *),
+    Tcl_Interp *interp,
+    Tcl_ObjectContext context,
+    int objc,
+    Tcl_Obj *const *objv)
+{
+    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
+    Tcl_Obj *resultObj, *propNameObj;
+    int i;
+
+    if (Tcl_ObjectContextSkippedArgs(context) != objc) {
+	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
+		NULL);
+	return TCL_ERROR;
+    }
+    if (oPtr == NULL) {
+	return TCL_ERROR;
+    }
+
+    resultObj = Tcl_NewObj();
+    FOREACH(propNameObj, oPtr->properties.readable) {
+	Tcl_ListObjAppendElement(NULL, resultObj, propNameObj);
+    }
+    Tcl_SetObjResult(interp, resultObj);
+    return TCL_OK;
+}
+
+static int
+ObjRPropsSet(
+    TCL_UNUSED(void *),
+    Tcl_Interp *interp,
+    Tcl_ObjectContext context,
+    int objc,
+    Tcl_Obj *const *objv)
+{
+    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
+    Tcl_Size varc;
+    Tcl_Obj **varv;
+
+    if (Tcl_ObjectContextSkippedArgs(context) + 1 != objc) {
+	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
+		"filterList");
+	return TCL_ERROR;
+    }
+    objv += Tcl_ObjectContextSkippedArgs(context);
+
+    if (oPtr == NULL) {
+	return TCL_ERROR;
+    } else if (Tcl_ListObjGetElements(interp, objv[0], &varc,
+	    &varv) != TCL_OK) {
+	return TCL_ERROR;
+    }
+
+    InstallReadableProps(&oPtr->properties, varc, varv);
+    return TCL_OK;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * ClassWPropsGet, ClassWPropsSet, ObjWPropsGet, ObjWPropsSet --
+ *
+ *	Implementations of the "writableproperties" slot accessors for classes
+ *	and instances.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static void
+InstallWritableProps(
+    PropertyStorage *props,
+    Tcl_Size objc,
+    Tcl_Obj *const objv[])
+{
+    Tcl_Obj *propObj;
+    Tcl_Size i, n;
+    int created;
+    Tcl_HashTable uniqueTable;
+
+    if (props->allWritableCache) {
+	Tcl_DecrRefCount(props->allWritableCache);
+	props->allWritableCache = NULL;
+    }
+
+    for (i=0 ; i<objc ; i++) {
+	Tcl_IncrRefCount(objv[i]);
+    }
+    FOREACH(propObj, props->writable) {
+	Tcl_DecrRefCount(propObj);
+    }
+    if (i != objc) {
+	if (objc == 0) {
+	    Tcl_Free(props->writable.list);
+	} else if (i) {
+	    props->writable.list = (Tcl_Obj **)Tcl_Realloc(props->writable.list,
+		    sizeof(Tcl_Obj *) * objc);
+	} else {
+	    props->writable.list = (Tcl_Obj **)Tcl_Alloc(sizeof(Tcl_Obj *) * objc);
+	}
+    }
+    props->writable.num = 0;
+    if (objc > 0) {
+	Tcl_InitObjHashTable(&uniqueTable);
+	for (i=n=0 ; i<objc ; i++) {
+	    Tcl_CreateHashEntry(&uniqueTable, objv[i], &created);
+	    if (created) {
+		props->writable.list[n++] = objv[i];
+	    } else {
+		Tcl_DecrRefCount(objv[i]);
+	    }
+	}
+	props->writable.num = n;
+
+	/*
+	 * Shouldn't be necessary, but maintain num/list invariant.
+	 */
+
+	if (n != objc) {
+	    props->writable.list = (Tcl_Obj **)Tcl_Realloc(props->writable.list,
+		    sizeof(Tcl_Obj *) * n);
+	}
+	Tcl_DeleteHashTable(&uniqueTable);
+    }
+}
+
+static int
+ClassWPropsGet(
+    TCL_UNUSED(void *),
+    Tcl_Interp *interp,
+    Tcl_ObjectContext context,
+    int objc,
+    Tcl_Obj *const *objv)
+{
+    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
+    Tcl_Obj *resultObj, *propNameObj;
+    int i;
+
+    if (Tcl_ObjectContextSkippedArgs(context) != objc) {
+	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
+		NULL);
+	return TCL_ERROR;
+    }
+    if (oPtr == NULL) {
+	return TCL_ERROR;
+    } else if (!oPtr->classPtr) {
+	Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		"attempt to misuse API", -1));
+	Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
+	return TCL_ERROR;
+    }
+
+    resultObj = Tcl_NewObj();
+    FOREACH(propNameObj, oPtr->classPtr->properties.writable) {
+	Tcl_ListObjAppendElement(NULL, resultObj, propNameObj);
+    }
+    Tcl_SetObjResult(interp, resultObj);
+    return TCL_OK;
+}
+
+static int
+ClassWPropsSet(
+    TCL_UNUSED(void *),
+    Tcl_Interp *interp,
+    Tcl_ObjectContext context,
+    int objc,
+    Tcl_Obj *const *objv)
+{
+    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
+    Tcl_Size varc;
+    Tcl_Obj **varv;
+
+    if (Tcl_ObjectContextSkippedArgs(context) + 1 != objc) {
+	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
+		"propertyList");
+	return TCL_ERROR;
+    }
+    objv += Tcl_ObjectContextSkippedArgs(context);
+
+    if (oPtr == NULL) {
+	return TCL_ERROR;
+    } else if (!oPtr->classPtr) {
+	Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		"attempt to misuse API", -1));
+	Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
+	return TCL_ERROR;
+    } else if (Tcl_ListObjGetElements(interp, objv[0], &varc,
+	    &varv) != TCL_OK) {
+	return TCL_ERROR;
+    }
+
+    InstallWritableProps(&oPtr->classPtr->properties, varc, varv);
+    BumpGlobalEpoch(interp, oPtr->classPtr);
+    return TCL_OK;
+}
+
+static int
+ObjWPropsGet(
+    TCL_UNUSED(void *),
+    Tcl_Interp *interp,
+    Tcl_ObjectContext context,
+    int objc,
+    Tcl_Obj *const *objv)
+{
+    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
+    Tcl_Obj *resultObj, *propNameObj;
+    int i;
+
+    if (Tcl_ObjectContextSkippedArgs(context) != objc) {
+	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
+		NULL);
+	return TCL_ERROR;
+    }
+    if (oPtr == NULL) {
+	return TCL_ERROR;
+    }
+
+    resultObj = Tcl_NewObj();
+    FOREACH(propNameObj, oPtr->properties.writable) {
+	Tcl_ListObjAppendElement(NULL, resultObj, propNameObj);
+    }
+    Tcl_SetObjResult(interp, resultObj);
+    return TCL_OK;
+}
+
+static int
+ObjWPropsSet(
+    TCL_UNUSED(void *),
+    Tcl_Interp *interp,
+    Tcl_ObjectContext context,
+    int objc,
+    Tcl_Obj *const *objv)
+{
+    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
+    Tcl_Size varc;
+    Tcl_Obj **varv;
+
+    if (Tcl_ObjectContextSkippedArgs(context) + 1 != objc) {
+	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
+		"propertyList");
+	return TCL_ERROR;
+    }
+    objv += Tcl_ObjectContextSkippedArgs(context);
+
+    if (oPtr == NULL) {
+	return TCL_ERROR;
+    } else if (Tcl_ListObjGetElements(interp, objv[0], &varc,
+	    &varv) != TCL_OK) {
+	return TCL_ERROR;
+    }
+
+    InstallWritableProps(&oPtr->properties, varc, varv);
+    return TCL_OK;
+}
+
+/*
  * Local Variables:
  * mode: c
  * c-basic-offset: 4
diff --git a/generic/tclOOInfo.c b/generic/tclOOInfo.c
index 1f27b41..ab17a35 100644
--- a/generic/tclOOInfo.c
+++ b/generic/tclOOInfo.c
@@ -4,7 +4,7 @@
  *	This file contains the implementation of the ::oo-related [info]
  *	subcommands.
  *
- * Copyright © 2006-2011 Donal K. Fellows
+ * Copyright © 2006-2019 Donal K. Fellows
  *
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -17,6 +17,7 @@
 #include "tclOOInt.h"
 
 static inline Class *	GetClassFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr);
+static void		SortPropList(Tcl_Obj *list);
 static Tcl_ObjCmdProc InfoObjectCallCmd;
 static Tcl_ObjCmdProc InfoObjectClassCmd;
 static Tcl_ObjCmdProc InfoObjectDefnCmd;
@@ -28,6 +29,7 @@ static Tcl_ObjCmdProc InfoObjectMethodsCmd;
 static Tcl_ObjCmdProc InfoObjectMethodTypeCmd;
 static Tcl_ObjCmdProc InfoObjectMixinsCmd;
 static Tcl_ObjCmdProc InfoObjectNsCmd;
+static Tcl_ObjCmdProc InfoObjectPropCmd;
 static Tcl_ObjCmdProc InfoObjectVarsCmd;
 static Tcl_ObjCmdProc InfoObjectVariablesCmd;
 static Tcl_ObjCmdProc InfoClassCallCmd;
@@ -41,6 +43,7 @@ static Tcl_ObjCmdProc InfoClassInstancesCmd;
 static Tcl_ObjCmdProc InfoClassMethodsCmd;
 static Tcl_ObjCmdProc InfoClassMethodTypeCmd;
 static Tcl_ObjCmdProc InfoClassMixinsCmd;
+static Tcl_ObjCmdProc InfoClassPropCmd;
 static Tcl_ObjCmdProc InfoClassSubsCmd;
 static Tcl_ObjCmdProc InfoClassSupersCmd;
 static Tcl_ObjCmdProc InfoClassVariablesCmd;
@@ -61,6 +64,7 @@ static const EnsembleImplMap infoObjectCmds[] = {
     {"methodtype", InfoObjectMethodTypeCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0},
     {"mixins",	   InfoObjectMixinsCmd,	    TclCompileBasic1ArgCmd, NULL, NULL, 0},
     {"namespace",  InfoObjectNsCmd,	    TclCompileInfoObjectNamespaceCmd, NULL, NULL, 0},
+    {"properties", InfoObjectPropCmd,	    TclCompileBasicMin1ArgCmd, NULL, NULL, 0},
     {"variables",  InfoObjectVariablesCmd,  TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
     {"vars",	   InfoObjectVarsCmd,	    TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
     {NULL, NULL, NULL, NULL, NULL, 0}
@@ -82,6 +86,7 @@ static const EnsembleImplMap infoClassCmds[] = {
     {"methods",	     InfoClassMethodsCmd,	TclCompileBasicMin1ArgCmd, NULL, NULL, 0},
     {"methodtype",   InfoClassMethodTypeCmd,	TclCompileBasic2ArgCmd, NULL, NULL, 0},
     {"mixins",	     InfoClassMixinsCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0},
+    {"properties",   InfoClassPropCmd,		TclCompileBasicMin1ArgCmd, NULL, NULL, 0},
     {"subclasses",   InfoClassSubsCmd,		TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
     {"superclasses", InfoClassSupersCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0},
     {"variables",    InfoClassVariablesCmd,	TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
@@ -1717,6 +1722,184 @@ InfoClassCallCmd(
 }
 
 /*
+ * ----------------------------------------------------------------------
+ *
+ * InfoClassPropCmd, InfoObjectPropCmd --
+ *
+ *	Implements [info class properties $clsName ?$option...?] and
+ *	[info object properties $objName ?$option...?]
+ *
+ * ----------------------------------------------------------------------
+ */
+
+enum PropOpt {
+    PROP_ALL, PROP_READABLE, PROP_WRITABLE
+};
+static const char *const propOptNames[] = {
+    "-all", "-readable", "-writable",
+    NULL
+};
+
+static int
+InfoClassPropCmd(
+    TCL_UNUSED(void *),
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const objv[])
+{
+    Class *clsPtr;
+    int i, idx, all = 0, writable = 0, allocated = 0;
+    Tcl_Obj *result, *propObj;
+
+    if (objc < 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "className ?options...?");
+	return TCL_ERROR;
+    }
+    clsPtr = GetClassFromObj(interp, objv[1]);
+    if (clsPtr == NULL) {
+	return TCL_ERROR;
+    }
+    for (i = 2; i < objc; i++) {
+	if (Tcl_GetIndexFromObj(interp, objv[i], propOptNames, "option", 0,
+		&idx) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+	switch (idx) {
+	case PROP_ALL:
+	    all = 1;
+	    break;
+	case PROP_READABLE:
+	    writable = 0;
+	    break;
+	case PROP_WRITABLE:
+	    writable = 1;
+	    break;
+	}
+    }
+
+    /*
+     * Get the properties.
+     */
+
+    if (all) {
+	result = TclOOGetAllClassProperties(clsPtr, writable, &allocated);
+	if (allocated) {
+	    SortPropList(result);
+	}
+    } else {
+	result = Tcl_NewObj();
+	if (writable) {
+	    FOREACH(propObj, clsPtr->properties.writable) {
+		Tcl_ListObjAppendElement(NULL, result, propObj);
+	    }
+	} else {
+	    FOREACH(propObj, clsPtr->properties.readable) {
+		Tcl_ListObjAppendElement(NULL, result, propObj);
+	    }
+	}
+	SortPropList(result);
+    }
+    Tcl_SetObjResult(interp, result);
+    return TCL_OK;
+}
+
+static int
+InfoObjectPropCmd(
+    TCL_UNUSED(void *),
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const objv[])
+{
+    Object *oPtr;
+    int i, idx, all = 0, writable = 0, allocated = 0;
+    Tcl_Obj *result, *propObj;
+
+    if (objc < 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "objName ?options...?");
+	return TCL_ERROR;
+    }
+    oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[1]);
+    if (oPtr == NULL) {
+	return TCL_ERROR;
+    }
+    for (i = 2; i < objc; i++) {
+	if (Tcl_GetIndexFromObj(interp, objv[i], propOptNames, "option", 0,
+		&idx) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+	switch (idx) {
+	case PROP_ALL:
+	    all = 1;
+	    break;
+	case PROP_READABLE:
+	    writable = 0;
+	    break;
+	case PROP_WRITABLE:
+	    writable = 1;
+	    break;
+	}
+    }
+
+    /*
+     * Get the properties.
+     */
+
+    if (all) {
+	result = TclOOGetAllObjectProperties(oPtr, writable, &allocated);
+	if (allocated) {
+	    SortPropList(result);
+	}
+    } else {
+	result = Tcl_NewObj();
+	if (writable) {
+	    FOREACH(propObj, oPtr->properties.writable) {
+		Tcl_ListObjAppendElement(NULL, result, propObj);
+	    }
+	} else {
+	    FOREACH(propObj, oPtr->properties.readable) {
+		Tcl_ListObjAppendElement(NULL, result, propObj);
+	    }
+	}
+	SortPropList(result);
+    }
+    Tcl_SetObjResult(interp, result);
+    return TCL_OK;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * SortPropList --
+ *	Sort a list of names of properties. Simple support function. Assumes
+ *	that the list Tcl_Obj is unshared and doesn't have a string
+ *	representation.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static int
+PropNameCompare(
+    const void *a,
+    const void *b)
+{
+    Tcl_Obj *first = *(Tcl_Obj **) a;
+    Tcl_Obj *second = *(Tcl_Obj **) b;
+
+    return strcmp(Tcl_GetString(first), Tcl_GetString(second));
+}
+
+static void
+SortPropList(
+    Tcl_Obj *list)
+{
+    Tcl_Size ec;
+    Tcl_Obj **ev;
+
+    Tcl_ListObjGetElements(NULL, list, &ec, &ev);
+    qsort(ev, ec, sizeof(Tcl_Obj *), PropNameCompare);
+}
+
+/*
  * Local Variables:
  * mode: c
  * c-basic-offset: 4
diff --git a/generic/tclOOInt.h b/generic/tclOOInt.h
index 0e666e9..031b910 100644
--- a/generic/tclOOInt.h
+++ b/generic/tclOOInt.h
@@ -161,6 +161,26 @@ typedef LIST_STATIC(Tcl_Obj *) VariableNameList;
 typedef LIST_STATIC(PrivateVariableMapping) PrivateVariableList;
 
 /*
+ * This type is used in various places.
+ */
+
+typedef struct {
+    LIST_STATIC(Tcl_Obj *) readable;
+				/* The readable properties slot. */
+    LIST_STATIC(Tcl_Obj *) writable;
+				/* The writable properties slot. */
+    Tcl_Obj *allReadableCache;	/* The cache of all readable properties
+				 * exposed by this object or class (in its
+				 * stereotypical instancs). Contains a sorted
+				 * unique list if not NULL. */
+    Tcl_Obj *allWritableCache;	/* The cache of all writable properties
+				 * exposed by this object or class (in its
+				 * stereotypical instances). Contains a sorted
+				 * unique list if not NULL. */
+    int epoch;			/* The epoch that the caches are valid for. */
+} PropertyStorage;
+
+/*
  * Now, the definition of what an object actually is.
  */
 
@@ -182,8 +202,8 @@ typedef struct Object {
     LIST_STATIC(Tcl_Obj *) filters;
 				/* List of filter names. */
     struct Class *classPtr;	/* This is non-NULL for all classes, and NULL
-				 *  for everything else. It points to the class
-				 *  structure. */
+				 * for everything else. It points to the class
+				 * structure. */
     Tcl_Size refCount;		/* Number of strong references to this object.
 				 * Note that there may be many more weak
 				 * references; this mechanism exists to
@@ -211,12 +231,15 @@ typedef struct Object {
 				 * used inside methods. */
     Tcl_Command myclassCommand;	/* Reference to this object's class dispatcher
 				 * command. */
+    PropertyStorage properties;	/* Information relating to the lists of
+				 * properties that this object *claims* to
+				 * support. */
 } Object;
 
-#define OBJECT_DESTRUCTING	1	/* Indicates that an object is being or has
-								 *  been destroyed  */
-#define DESTRUCTOR_CALLED 2	/* Indicates that evaluation of destructor script for the
-							   object has began */
+#define OBJECT_DESTRUCTING 1	/* Indicates that an object is being or has
+				 *  been destroyed  */
+#define DESTRUCTOR_CALLED 2	/* Indicates that evaluation of destructor
+				 * script for the object has began */
 #define OO_UNUSED_4	4	/* No longer used.  */
 #define ROOT_OBJECT 0x1000	/* Flag to say that this object is the root of
 				 * the class hierarchy and should be treated
@@ -319,6 +342,9 @@ typedef struct Class {
 				 * namespace is defined but doesn't exist; we
 				 * also check at setting time but don't check
 				 * between times. */
+    PropertyStorage properties;	/* Information relating to the lists of
+				 * properties that this class *claims* to
+				 * support. */
 } Class;
 
 /*
@@ -521,6 +547,10 @@ MODULE_SCOPE void	TclOODeleteContext(CallContext *contextPtr);
 MODULE_SCOPE void	TclOODeleteDescendants(Tcl_Interp *interp,
 			    Object *oPtr);
 MODULE_SCOPE void	TclOODelMethodRef(Method *method);
+MODULE_SCOPE Tcl_Obj *	TclOOGetAllClassProperties(Class *clsPtr,
+			    int writable, int *allocated);
+MODULE_SCOPE Tcl_Obj *	TclOOGetAllObjectProperties(Object *oPtr,
+			    int writable, int *allocated);
 MODULE_SCOPE CallContext *TclOOGetCallContext(Object *oPtr,
 			    Tcl_Obj *methodNameObj, int flags,
 			    Object *contextObjPtr, Class *contextClsPtr,
diff --git a/generic/tclOOScript.h b/generic/tclOOScript.h
index f2e99b0..407e919 100644
--- a/generic/tclOOScript.h
+++ b/generic/tclOOScript.h
@@ -29,7 +29,7 @@ static const char *tclOOSetupScript =
 "::namespace eval ::oo {\n"
 "\t::namespace path {}\n"
 "\tnamespace eval Helpers {\n"
-"\t\t::namespace path {}\n"
+"\t\tnamespace path {}\n"
 "\t\tproc callback {method args} {\n"
 "\t\t\tlist [uplevel 1 {::namespace which my}] $method {*}$args\n"
 "\t\t}\n"
@@ -98,9 +98,9 @@ static const char *tclOOSetupScript =
 "\t\t\tif {![info object isa class $d]} {\n"
 "\t\t\t\tcontinue\n"
 "\t\t\t}\n"
-"\t\t\tdefine $delegate ::oo::define::superclass -append $d\n"
+"\t\t\tdefine $delegate ::oo::define::superclass -appendifnew $d\n"
 "\t\t}\n"
-"\t\tobjdefine $class ::oo::objdefine::mixin -append $delegate\n"
+"\t\tobjdefine $class ::oo::objdefine::mixin -appendifnew $delegate\n"
 "\t}\n"
 "\tproc UpdateClassDelegatesAfterClone {originObject targetObject} {\n"
 "\t\tset originDelegate [DelegateName $originObject]\n"
@@ -141,34 +141,44 @@ static const char *tclOOSetupScript =
 "\t\t::namespace delete tmp\n"
 "\t}\n"
 "\tdefine Slot {\n"
-"\t\tmethod Get {} {\n"
+"\t\tmethod Get -unexport {} {\n"
 "\t\t\treturn -code error -errorcode {TCLOO ABSTRACT_SLOT} \"unimplemented\"\n"
 "\t\t}\n"
-"\t\tmethod Set list {\n"
+"\t\tmethod Set -unexport list {\n"
 "\t\t\treturn -code error -errorcode {TCLOO ABSTRACT_SLOT} \"unimplemented\"\n"
 "\t\t}\n"
-"\t\tmethod Resolve list {\n"
+"\t\tmethod Resolve -unexport list {\n"
 "\t\t\treturn $list\n"
 "\t\t}\n"
-"\t\tmethod -set args {\n"
+"\t\tmethod -set -export args {\n"
 "\t\t\tset my [namespace which my]\n"
 "\t\t\tset args [lmap a $args {uplevel 1 [list $my Resolve $a]}]\n"
 "\t\t\ttailcall my Set $args\n"
 "\t\t}\n"
-"\t\tmethod -append args {\n"
+"\t\tmethod -append -export args {\n"
 "\t\t\tset my [namespace which my]\n"
 "\t\t\tset args [lmap a $args {uplevel 1 [list $my Resolve $a]}]\n"
 "\t\t\tset current [uplevel 1 [list $my Get]]\n"
 "\t\t\ttailcall my Set [list {*}$current {*}$args]\n"
 "\t\t}\n"
-"\t\tmethod -clear {} {tailcall my Set {}}\n"
-"\t\tmethod -prepend args {\n"
+"\t\tmethod -appendifnew -export args {\n"
+"\t\t\tset my [namespace which my]\n"
+"\t\t\tset current [uplevel 1 [list $my Get]]\n"
+"\t\t\tset args [lmap a $args {\n"
+"\t\t\t\tset a [uplevel 1 [list $my Resolve $a]]\n"
+"\t\t\t\tif {$a in $current} continue\n"
+"\t\t\t\tset a\n"
+"\t\t\t}]\n"
+"\t\t\ttailcall my Set [list {*}$current {*}$args]\n"
+"\t\t}\n"
+"\t\tmethod -clear -export {} {tailcall my Set {}}\n"
+"\t\tmethod -prepend -export args {\n"
 "\t\t\tset my [namespace which my]\n"
 "\t\t\tset args [lmap a $args {uplevel 1 [list $my Resolve $a]}]\n"
 "\t\t\tset current [uplevel 1 [list $my Get]]\n"
 "\t\t\ttailcall my Set [list {*}$args {*}$current]\n"
 "\t\t}\n"
-"\t\tmethod -remove args {\n"
+"\t\tmethod -remove -export args {\n"
 "\t\t\tset my [namespace which my]\n"
 "\t\t\tset args [lmap a $args {uplevel 1 [list $my Resolve $a]}]\n"
 "\t\t\tset current [uplevel 1 [list $my Get]]\n"
@@ -177,7 +187,7 @@ static const char *tclOOSetupScript =
 "\t\t\t}]\n"
 "\t\t}\n"
 "\t\tforward --default-operation my -append\n"
-"\t\tmethod unknown {args} {\n"
+"\t\tmethod unknown -unexport {args} {\n"
 "\t\t\tset def --default-operation\n"
 "\t\t\tif {[llength $args] == 0} {\n"
 "\t\t\t\ttailcall my $def\n"
@@ -186,13 +196,12 @@ static const char *tclOOSetupScript =
 "\t\t\t}\n"
 "\t\t\tnext {*}$args\n"
 "\t\t}\n"
-"\t\texport -set -append -clear -prepend -remove\n"
-"\t\tunexport unknown destroy\n"
+"\t\tunexport destroy\n"
 "\t}\n"
 "\tobjdefine define::superclass forward --default-operation my -set\n"
 "\tobjdefine define::mixin forward --default-operation my -set\n"
 "\tobjdefine objdefine::mixin forward --default-operation my -set\n"
-"\tdefine object method <cloned> {originObject} {\n"
+"\tdefine object method <cloned> -unexport {originObject} {\n"
 "\t\tforeach p [info procs [info object namespace $originObject]::*] {\n"
 "\t\t\tset args [info args $p]\n"
 "\t\t\tset idx -1\n"
@@ -219,7 +228,7 @@ static const char *tclOOSetupScript =
 "\t\t\t}\n"
 "\t\t}\n"
 "\t}\n"
-"\tdefine class method <cloned> {originObject} {\n"
+"\tdefine class method <cloned> -unexport {originObject} {\n"
 "\t\tnext $originObject\n"
 "\t\t::oo::UpdateClassDelegatesAfterClone $originObject [self]\n"
 "\t}\n"
@@ -235,7 +244,7 @@ static const char *tclOOSetupScript =
 "\t\t\t\t\t\t::return -code error -errorcode {TCLOO SINGLETON} \\\n"
 "\t\t\t\t\t\t\t\"may not destroy a singleton object\"\n"
 "\t\t\t\t\t}\n"
-"\t\t\t\t\tmethod <cloned> {originObject} {\n"
+"\t\t\t\t\tmethod <cloned> -unexport {originObject} {\n"
 "\t\t\t\t\t\t::return -code error -errorcode {TCLOO SINGLETON} \\\n"
 "\t\t\t\t\t\t\t\"may not clone a singleton object\"\n"
 "\t\t\t\t\t}\n"
@@ -248,6 +257,226 @@ static const char *tclOOSetupScript =
 "\t\tsuperclass class\n"
 "\t\tunexport create createWithNamespace new\n"
 "\t}\n"
+"\t::namespace eval configuresupport {\n"
+"\t\tnamespace path ::tcl\n"
+"\t\tproc PropertyImpl {readslot writeslot args} {\n"
+"\t\t\tfor {set i 0} {$i < [llength $args]} {incr i} {\n"
+"\t\t\t\tset prop [lindex $args $i]\n"
+"\t\t\t\tif {[string match \"-*\" $prop]} {\n"
+"\t\t\t\t\treturn -code error -level 2 \\\n"
+"\t\t\t\t\t\t-errorcode {TCLOO PROPERTY_FORMAT} \\\n"
+"\t\t\t\t\t\t\"bad property name \\\"$prop\\\": must not begin with -\"\n"
+"\t\t\t\t}\n"
+"\t\t\t\tif {$prop ne [list $prop]} {\n"
+"\t\t\t\t\treturn -code error -level 2 \\\n"
+"\t\t\t\t\t\t-errorcode {TCLOO PROPERTY_FORMAT} \\\n"
+"\t\t\t\t\t\t\"bad property name \\\"$prop\\\": must be a simple word\"\n"
+"\t\t\t\t}\n"
+"\t\t\t\tif {[string first \"::\" $prop] != -1} {\n"
+"\t\t\t\t\treturn -code error -level 2 \\\n"
+"\t\t\t\t\t\t-errorcode {TCLOO PROPERTY_FORMAT} \\\n"
+"\t\t\t\t\t\t\"bad property name \\\"$prop\\\": must not contain namespace separators\"\n"
+"\t\t\t\t}\n"
+"\t\t\t\tif {[string match {*[()]*} $prop]} {\n"
+"\t\t\t\t\treturn -code error -level 2 \\\n"
+"\t\t\t\t\t\t-errorcode {TCLOO PROPERTY_FORMAT} \\\n"
+"\t\t\t\t\t\t\"bad property name \\\"$prop\\\": must not contain parentheses\"\n"
+"\t\t\t\t}\n"
+"\t\t\t\tset realprop [string cat \"-\" $prop]\n"
+"\t\t\t\tset getter [format {::set [my varname %s]} $prop]\n"
+"\t\t\t\tset setter [format {::set [my varname %s] $value} $prop]\n"
+"\t\t\t\tset kind readwrite\n"
+"\t\t\t\twhile {[set next [lindex $args [expr {$i + 1}]]\n"
+"\t\t\t\t\t\tstring match \"-*\" $next]} {\n"
+"\t\t\t\t\tset arg [lindex $args [incr i 2]]\n"
+"\t\t\t\t\tswitch [prefix match -error [list -level 2 -errorcode \\\n"
+"\t\t\t\t\t\t\t[list TCL LOOKUP INDEX option $next]] {-get -kind -set} $next] {\n"
+"\t\t\t\t\t\t-get {\n"
+"\t\t\t\t\t\t\tif {$i >= [llength $args]} {\n"
+"\t\t\t\t\t\t\t\treturn -code error -level 2 \\\n"
+"\t\t\t\t\t\t\t\t\t-errorcode {TCL WRONGARGS} \\\n"
+"\t\t\t\t\t\t\t\t\t\"missing body to go with -get option\"\n"
+"\t\t\t\t\t\t\t}\n"
+"\t\t\t\t\t\t\tset getter $arg\n"
+"\t\t\t\t\t\t}\n"
+"\t\t\t\t\t\t-set {\n"
+"\t\t\t\t\t\t\tif {$i >= [llength $args]} {\n"
+"\t\t\t\t\t\t\t\treturn -code error -level 2 \\\n"
+"\t\t\t\t\t\t\t\t\t-errorcode {TCL WRONGARGS} \\\n"
+"\t\t\t\t\t\t\t\t\t\"missing body to go with -set option\"\n"
+"\t\t\t\t\t\t\t}\n"
+"\t\t\t\t\t\t\tset setter $arg\n"
+"\t\t\t\t\t\t}\n"
+"\t\t\t\t\t\t-kind {\n"
+"\t\t\t\t\t\t\tif {$i >= [llength $args]} {\n"
+"\t\t\t\t\t\t\t\treturn -code error -level 2\\\n"
+"\t\t\t\t\t\t\t\t\t-errorcode {TCL WRONGARGS} \\\n"
+"\t\t\t\t\t\t\t\t\t\"missing kind value to go with -kind option\"\n"
+"\t\t\t\t\t\t\t}\n"
+"\t\t\t\t\t\t\tset kind [prefix match -message \"kind\" -error [list \\\n"
+"\t\t\t\t\t\t\t\t\t-level 2 \\\n"
+"\t\t\t\t\t\t\t\t\t-errorcode [list TCL LOOKUP INDEX kind $arg]] {\n"
+"\t\t\t\t\t\t\t\treadable readwrite writable\n"
+"\t\t\t\t\t\t\t} $arg]\n"
+"\t\t\t\t\t\t}\n"
+"\t\t\t\t\t}\n"
+"\t\t\t\t}\n"
+"\t\t\t\tset reader <ReadProp$realprop>\n"
+"\t\t\t\tset writer <WriteProp$realprop>\n"
+"\t\t\t\tswitch $kind {\n"
+"\t\t\t\t\treadable {\n"
+"\t\t\t\t\t\tuplevel 2 [list $readslot -append $realprop]\n"
+"\t\t\t\t\t\tuplevel 2 [list $writeslot -remove $realprop]\n"
+"\t\t\t\t\t\tuplevel 2 [list method $reader -unexport {} $getter]\n"
+"\t\t\t\t\t}\n"
+"\t\t\t\t\twritable {\n"
+"\t\t\t\t\t\tuplevel 2 [list $readslot -remove $realprop]\n"
+"\t\t\t\t\t\tuplevel 2 [list $writeslot -append $realprop]\n"
+"\t\t\t\t\t\tuplevel 2 [list method $writer -unexport {value} $setter]\n"
+"\t\t\t\t\t}\n"
+"\t\t\t\t\treadwrite {\n"
+"\t\t\t\t\t\tuplevel 2 [list $readslot -append $realprop]\n"
+"\t\t\t\t\t\tuplevel 2 [list $writeslot -append $realprop]\n"
+"\t\t\t\t\t\tuplevel 2 [list method $reader -unexport {} $getter]\n"
+"\t\t\t\t\t\tuplevel 2 [list method $writer -unexport {value} $setter]\n"
+"\t\t\t\t\t}\n"
+"\t\t\t\t}\n"
+"\t\t\t}\n"
+"\t\t}\n"
+"\t\tnamespace eval configurableclass {\n"
+"\t\t\t::proc property args {\n"
+"\t\t\t\t::oo::configuresupport::PropertyImpl \\\n"
+"\t\t\t\t\t::oo::configuresupport::readableproperties \\\n"
+"\t\t\t\t\t::oo::configuresupport::writableproperties {*}$args\n"
+"\t\t\t}\n"
+"\t\t\t::proc properties args {::tailcall property {*}$args}\n"
+"\t\t\t::namespace path ::oo::define\n"
+"\t\t\t::namespace export property\n"
+"\t\t}\n"
+"\t\tnamespace eval configurableobject {\n"
+"\t\t\t::proc property args {\n"
+"\t\t\t\t::oo::configuresupport::PropertyImpl \\\n"
+"\t\t\t\t\t::oo::configuresupport::objreadableproperties \\\n"
+"\t\t\t\t\t::oo::configuresupport::objwritableproperties {*}$args\n"
+"\t\t\t}\n"
+"\t\t\t::proc properties args {::tailcall property {*}$args}\n"
+"\t\t\t::namespace path ::oo::objdefine\n"
+"\t\t\t::namespace export property\n"
+"\t\t}\n"
+"\t\tproc ReadAll {object my} {\n"
+"\t\t\tset result {}\n"
+"\t\t\tforeach prop [info object properties $object -all -readable] {\n"
+"\t\t\t\ttry {\n"
+"\t\t\t\t\tdict set result $prop [$my <ReadProp$prop>]\n"
+"\t\t\t\t} on error {msg opt} {\n"
+"\t\t\t\t\tdict set opt -level 2\n"
+"\t\t\t\t\treturn -options $opt $msg\n"
+"\t\t\t\t} on return {msg opt} {\n"
+"\t\t\t\t\tdict incr opt -level 2\n"
+"\t\t\t\t\treturn -options $opt $msg\n"
+"\t\t\t\t} on break {} {\n"
+"\t\t\t\t\treturn -code error -level 2 -errorcode {TCLOO SHENANIGANS} \\\n"
+"\t\t\t\t\t\t\"property getter for $prop did a break\"\n"
+"\t\t\t\t} on continue {} {\n"
+"\t\t\t\t\treturn -code error -level 2 -errorcode {TCLOO SHENANIGANS} \\\n"
+"\t\t\t\t\t\t\"property getter for $prop did a continue\"\n"
+"\t\t\t\t}\n"
+"\t\t\t}\n"
+"\t\t\treturn $result\n"
+"\t\t}\n"
+"\t\tproc ReadOne {object my propertyName} {\n"
+"\t\t\tset props [info object properties $object -all -readable]\n"
+"\t\t\ttry {\n"
+"\t\t\t\tset prop [prefix match -message \"property\" $props $propertyName]\n"
+"\t\t\t} on error {msg} {\n"
+"\t\t\t\tcatch {\n"
+"\t\t\t\t\tset wps [info object properties $object -all -writable]\n"
+"\t\t\t\t\tset wprop [prefix match $wps $propertyName]\n"
+"\t\t\t\t\tset msg \"property \\\"$wprop\\\" is write only\"\n"
+"\t\t\t\t}\n"
+"\t\t\t\treturn -code error -level 2 -errorcode [list \\\n"
+"\t\t\t\t\t\tTCL LOOKUP INDEX property $propertyName] $msg\n"
+"\t\t\t}\n"
+"\t\t\ttry {\n"
+"\t\t\t\tset value [$my <ReadProp$prop>]\n"
+"\t\t\t} on error {msg opt} {\n"
+"\t\t\t\tdict set opt -level 2\n"
+"\t\t\t\treturn -options $opt $msg\n"
+"\t\t\t} on return {msg opt} {\n"
+"\t\t\t\tdict incr opt -level 2\n"
+"\t\t\t\treturn -options $opt $msg\n"
+"\t\t\t} on break {} {\n"
+"\t\t\t\treturn -code error -level 2 -errorcode {TCLOO SHENANIGANS} \\\n"
+"\t\t\t\t\t\"property getter for $prop did a break\"\n"
+"\t\t\t} on continue {} {\n"
+"\t\t\t\treturn -code error -level 2 -errorcode {TCLOO SHENANIGANS} \\\n"
+"\t\t\t\t\t\"property getter for $prop did a continue\"\n"
+"\t\t\t}\n"
+"\t\t\treturn $value\n"
+"\t\t}\n"
+"\t\tproc WriteMany {object my setterMap} {\n"
+"\t\t\tset props [info object properties $object -all -writable]\n"
+"\t\t\tforeach {prop value} $setterMap {\n"
+"\t\t\t\ttry {\n"
+"\t\t\t\t\tset prop [prefix match -message \"property\" $props $prop]\n"
+"\t\t\t\t} on error {msg} {\n"
+"\t\t\t\t\tcatch {\n"
+"\t\t\t\t\t\tset rps [info object properties $object -all -readable]\n"
+"\t\t\t\t\t\tset rprop [prefix match $rps $prop]\n"
+"\t\t\t\t\t\tset msg \"property \\\"$rprop\\\" is read only\"\n"
+"\t\t\t\t\t}\n"
+"\t\t\t\t\treturn -code error -level 2 -errorcode [list \\\n"
+"\t\t\t\t\t\t\tTCL LOOKUP INDEX property $prop] $msg\n"
+"\t\t\t\t}\n"
+"\t\t\t\ttry {\n"
+"\t\t\t\t\t$my <WriteProp$prop> $value\n"
+"\t\t\t\t} on error {msg opt} {\n"
+"\t\t\t\t\tdict set opt -level 2\n"
+"\t\t\t\t\treturn -options $opt $msg\n"
+"\t\t\t\t} on return {msg opt} {\n"
+"\t\t\t\t\tdict incr opt -level 2\n"
+"\t\t\t\t\treturn -options $opt $msg\n"
+"\t\t\t\t} on break {} {\n"
+"\t\t\t\t\treturn -code error -level 2 -errorcode {TCLOO SHENANIGANS} \\\n"
+"\t\t\t\t\t\t\"property setter for $prop did a break\"\n"
+"\t\t\t\t} on continue {} {\n"
+"\t\t\t\t\treturn -code error -level 2 -errorcode {TCLOO SHENANIGANS} \\\n"
+"\t\t\t\t\t\t\"property setter for $prop did a continue\"\n"
+"\t\t\t\t}\n"
+"\t\t\t}\n"
+"\t\t\treturn\n"
+"\t\t}\n"
+"\t\t::oo::class create configurable {\n"
+"\t\t\tprivate variable my\n"
+"\t\t\tmethod configure -export args {\n"
+"\t\t\t\t::if {![::info exists my]} {\n"
+"\t\t\t\t\t::set my [::namespace which my]\n"
+"\t\t\t\t}\n"
+"\t\t\t\t::if {[::llength $args] == 0} {\n"
+"\t\t\t\t\t::oo::configuresupport::ReadAll [self] $my\n"
+"\t\t\t\t} elseif {[::llength $args] == 1} {\n"
+"\t\t\t\t\t::oo::configuresupport::ReadOne [self] $my \\\n"
+"\t\t\t\t\t\t[::lindex $args 0]\n"
+"\t\t\t\t} elseif {[::llength $args] % 2 == 0} {\n"
+"\t\t\t\t\t::oo::configuresupport::WriteMany [self] $my $args\n"
+"\t\t\t\t} else {\n"
+"\t\t\t\t\t::return -code error -errorcode {TCL WRONGARGS} \\\n"
+"\t\t\t\t\t\t[::format {wrong # args: should be \"%s\"} \\\n"
+"\t\t\t\t\t\t\t\"[self] configure \?-option value ...\?\"]\n"
+"\t\t\t\t}\n"
+"\t\t\t}\n"
+"\t\t\tdefinitionnamespace -instance configurableobject\n"
+"\t\t\tdefinitionnamespace -class configurableclass\n"
+"\t\t}\n"
+"\t}\n"
+"\tclass create configurable {\n"
+"\t\tsuperclass class\n"
+"\t\tconstructor {{definitionScript \"\"}} {\n"
+"\t\t\tnext {mixin ::oo::configuresupport::configurable}\n"
+"\t\t\tnext $definitionScript\n"
+"\t\t}\n"
+"\t\tdefinitionnamespace -class configuresupport::configurableclass\n"
+"\t}\n"
 "}\n"
 /* !END!: Do not edit above this line. */
 ;
diff --git a/generic/tclObj.c b/generic/tclObj.c
index 0c9c405..cdd3b5d 100644
--- a/generic/tclObj.c
+++ b/generic/tclObj.c
@@ -202,6 +202,9 @@ static void		DupBignum(Tcl_Obj *objPtr, Tcl_Obj *copyPtr);
 static void		UpdateStringOfBignum(Tcl_Obj *objPtr);
 static int		GetBignumFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
 			    int copy, mp_int *bignumValue);
+static int		SetDuplicatePureObj(Tcl_Interp *interp,
+			    Tcl_Obj *dupPtr, Tcl_Obj *objPtr,
+			    const Tcl_ObjType *typePtr);
 
 /*
  * Prototypes for the array hash key methods.
@@ -1523,6 +1526,14 @@ TclObjBeingDeleted(
  *	Create and return a new object that is a duplicate of the argument
  *	object.
  *
+ * TclDuplicatePureObj --
+ *	Like Tcl_DuplicateObj, except that it converts the duplicate to the
+ *	specifid typ, does not duplicate the 'bytes'
+ *	field unless it is necessary, i.e. the duplicated Tcl_Obj provides no
+ *	updateStringProc.  This can avoid an expensive memory allocation since
+ *	the data in the 'bytes' field of each Tcl_Obj must reside in allocated
+ *	memory.
+ *
  * Results:
  *	The return value is a pointer to a newly created Tcl_Obj. This object
  *	has reference count 0 and the same type, if any, as the source object
@@ -1574,6 +1585,104 @@ Tcl_DuplicateObj(
     return dupPtr;
 }
 
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_DuplicatePureObj --
+ *
+ *	Duplicates a Tcl_Obj and converts the internal representation of the
+ *	duplicate to the given type, changing neither the 'bytes' field
+ *	nor the internal representation of the original object, and without
+ *	duplicating the bytes field unless necessary, i.e. unless the
+ *	duplicate provides no updateStringProc after conversion.  This can
+ *	avoid an expensive memory allocation since the data in the 'bytes'
+ *	field of each Tcl_Obj must reside in allocated memory.
+ *
+ * Results:
+ *	A pointer to a newly-created Tcl_Obj or NULL if there was an error.
+ *	This object has reference count 0.  Also:
+ *
+ *----------------------------------------------------------------------
+ */
+int SetDuplicatePureObj(
+    Tcl_Interp *interp,
+    Tcl_Obj *dupPtr,
+    Tcl_Obj *objPtr,
+    const Tcl_ObjType *typePtr)
+{
+    char *bytes = objPtr->bytes;
+    int status = TCL_OK;
+
+    TclInvalidateStringRep(dupPtr);
+    assert(dupPtr->typePtr == NULL);
+
+    if (objPtr->typePtr && objPtr->typePtr->dupIntRepProc) {
+	objPtr->typePtr->dupIntRepProc(objPtr, dupPtr);
+    } else {
+	dupPtr->internalRep = objPtr->internalRep;
+	dupPtr->typePtr = objPtr->typePtr;
+    }
+
+    if (typePtr != NULL && dupPtr->typePtr != typePtr) {
+	if (bytes) {
+	    dupPtr->bytes = bytes;
+	    dupPtr->length = objPtr->length;
+	}
+	/* borrow bytes from original object */
+	status = Tcl_ConvertToType(interp, dupPtr, typePtr);
+	if (bytes) {
+	    dupPtr->bytes = NULL;
+	    dupPtr->length = 0;
+	}
+	if (status != TCL_OK) {
+	    return status;
+	}
+    }
+
+    /* tclStringType is treated as a special case because a Tcl_Obj having this
+     * type can not always update the string representation.  This happens, for
+     * example, when Tcl_GetCharLength() converts the internal representation
+     * to tclStringType in order to store the number of characters, but does
+     * not store enough information to generate the string representation.
+     *
+     * Perhaps in the future this can be remedied and this special treatment
+     * removed.
+     */
+
+
+    if (bytes && (dupPtr->typePtr == NULL
+	|| dupPtr->typePtr->updateStringProc == NULL
+	|| typePtr == &tclStringType
+	)
+    ) {
+	TclInitStringRep(dupPtr, bytes, objPtr->length);
+    }
+    return status;
+}
+
+Tcl_Obj *
+TclDuplicatePureObj(
+    Tcl_Interp *interp,
+    Tcl_Obj *objPtr,
+    const Tcl_ObjType *typePtr
+)		/* The object to duplicate. */
+{
+    int status;
+    Tcl_Obj *dupPtr;
+
+    TclNewObj(dupPtr);
+    status = SetDuplicatePureObj(interp, dupPtr, objPtr, typePtr);
+    if (status == TCL_OK) {
+	return dupPtr;
+    } else {
+	Tcl_DecrRefCount(dupPtr);
+	return NULL;
+    }
+}
+
+
+
 void
 TclSetDuplicateObj(
     Tcl_Obj *dupPtr,
@@ -3707,7 +3816,7 @@ Tcl_IncrRefCount(
  *	Decrements the reference count of the object.
  *
  * Results:
- *	None.
+ *	The storage for objPtr may be freed.
  *
  *----------------------------------------------------------------------
  */
@@ -3725,6 +3834,28 @@ Tcl_DecrRefCount(
 /*
  *----------------------------------------------------------------------
  *
+ * TclUndoRefCount --
+ *
+ *	Decrement the refCount of objPtr without causing it to be freed if it
+ *	drops from 1 to 0.  This allows a function increment a refCount but
+ *	then decrement it and still be able to pass return it to a caller,
+ *	possibly with a refCount of 0.  The caller must have previously
+ *	incremented the refCount.
+ *
+ *----------------------------------------------------------------------
+ */
+void
+TclUndoRefCount(
+    Tcl_Obj *objPtr)	/* The object we are releasing a reference to. */
+{
+    if (objPtr->refCount > 0) {
+	--objPtr->refCount;
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * Tcl_IsShared --
  *
  *	Tests if the object has a ref count greater than one.
diff --git a/generic/tclPathObj.c b/generic/tclPathObj.c
index abf9d6b..d7d8d33 100644
--- a/generic/tclPathObj.c
+++ b/generic/tclPathObj.c
@@ -2330,10 +2330,15 @@ UpdateStringOfFsPath(
     Tcl_Obj *copy;
 
     if (PATHFLAGS(pathPtr) == 0 || fsPathPtr->cwdPtr == NULL) {
-	Tcl_Panic("Called UpdateStringOfFsPath with invalid object");
+	if (fsPathPtr->translatedPathPtr == NULL) {
+	    Tcl_Panic("Called UpdateStringOfFsPath with invalid object");
+	} else {
+	    copy = Tcl_DuplicateObj(fsPathPtr->translatedPathPtr);
+	}
+    } else {
+	    copy = AppendPath(fsPathPtr->cwdPtr, fsPathPtr->normPathPtr);
     }
 
-    copy = AppendPath(fsPathPtr->cwdPtr, fsPathPtr->normPathPtr);
     if (Tcl_IsShared(copy)) {
 	copy = Tcl_DuplicateObj(copy);
     }
diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c
index b846320..0da5f04 100644
--- a/generic/tclStringObj.c
+++ b/generic/tclStringObj.c
@@ -2536,7 +2536,7 @@ Tcl_AppendFormatToObj(
 		goto errorMsg;
 	    }
 	    bytes = TclGetString(segment);
-	    if (!Tcl_AttemptSetObjLength(segment, sprintf(bytes, spec, d))) {
+	    if (!Tcl_AttemptSetObjLength(segment, snprintf(bytes, length, spec, d))) {
 		msg = overflow;
 		errCode = "OVERFLOW";
 		goto errorMsg;
@@ -4302,7 +4302,6 @@ DupStringInternalRep(
 	 * bother copying it. Don't even bother allocating space in which to
 	 * copy it. Just let the copy be untyped.
 	 */
-
 	return;
     }
 
diff --git a/generic/tclTest.c b/generic/tclTest.c
index b35abe0..ec2f4a3 100644
--- a/generic/tclTest.c
+++ b/generic/tclTest.c
@@ -1164,11 +1164,8 @@ TestcmdinfoObjCmd(
 	    return info.objProc2(info.objClientData2, interp, cmdObjc, cmdObjv);
 	}
     case CMDINFO_CREATE:
-	Tcl_CreateCommand(interp,
-			  Tcl_GetString(objv[2]),
-			  CmdProc1,
-			  (void *)"original",
-			  CmdDelProc1);
+	Tcl_CreateCommand(interp, Tcl_GetString(objv[2]), CmdProc1,
+		(void *)"original", CmdDelProc1);
 	break;
     case CMDINFO_DELETE:
 	Tcl_DStringInit(&delString);
@@ -1206,10 +1203,8 @@ TestcmdinfoObjCmd(
 	} else if (info.isNativeObjectProc == 2) {
 	    Tcl_AppendResult(interp, " nativeObjectProc2", NULL);
 	} else {
-	    Tcl_SetObjResult(
-		interp,
-		Tcl_ObjPrintf("Invalid isNativeObjectProc value %d",
-			      info.isNativeObjectProc));
+	    Tcl_SetObjResult(interp, Tcl_ObjPrintf("Invalid isNativeObjectProc value %d",
+		    info.isNativeObjectProc));
 	    return TCL_ERROR;
 	}
 	break;
@@ -3732,7 +3727,7 @@ TestlinkarrayCmd(
     static const char *LinkOption[] = {
         "update", "remove", "create", NULL
     };
-    enum LinkOptionEnum {LINK_UPDATE, LINK_REMOVE, LINK_CREATE} optionIndex;
+    enum LinkOptionEnum { LINK_UPDATE, LINK_REMOVE, LINK_CREATE } optionIndex;
     static const char *LinkType[] = {
 	"char", "uchar", "short", "ushort", "int", "uint", "long", "ulong",
 	"wide", "uwide", "float", "double", "string", "char*", "binary", NULL
@@ -4214,7 +4209,7 @@ PrintParse(
     Tcl_Size i;
 
     objPtr = Tcl_GetObjResult(interp);
-    if (parsePtr->commentSize + 1 > 1) {
+    if (parsePtr->commentSize > 0) {
 	Tcl_ListObjAppendElement(NULL, objPtr,
 		Tcl_NewStringObj(parsePtr->commentStart,
 			parsePtr->commentSize));
@@ -4652,15 +4647,15 @@ TestregexpObjCmd(
 		end--;
 	    }
 
-	    objs[0] = Tcl_NewWideIntObj((Tcl_WideInt)((Tcl_WideUInt)(start + 1U)) - 1);
-	    objs[1] = Tcl_NewWideIntObj((Tcl_WideInt)((Tcl_WideUInt)(end + 1U)) - 1);
+	    objs[0] = Tcl_NewWideIntObj(start);
+	    objs[1] = Tcl_NewWideIntObj(end);
 
 	    newPtr = Tcl_NewListObj(2, objs);
 	} else {
 	    if (ii == TCL_INDEX_NONE) {
 		TclRegExpRangeUniChar(regExpr, ii, &start, &end);
 		newPtr = Tcl_GetRange(objPtr, start, end);
-	    } else if (ii > info.nsubs || info.matches[ii].end + 1 <= 1) {
+	    } else if (ii > info.nsubs || info.matches[ii].end <= 0) {
 		newPtr = Tcl_NewObj();
 	    } else {
 		newPtr = Tcl_GetRange(objPtr, info.matches[ii].start,
@@ -5764,6 +5759,9 @@ TestbytestringObjCmd(
 {
     struct {
 #if !defined(TCL_NO_DEPRECATED)
+#   if defined(_MSC_VER) && !defined(NDEBUG)
+#	pragma warning(disable:4133)
+#   endif
 	int n; /* On purpose, not Tcl_Size, in order to demonstrate what happens */
 #else
 	Tcl_Size n;
@@ -7518,7 +7516,7 @@ TestUtfNextCmd(
     }
 	bytes = Tcl_GetStringFromObj(objv[1], &numBytes);
 
-    if (numBytes + 4 > (Tcl_Size) sizeof(buffer)) {
+    if ((size_t)numBytes > sizeof(buffer) - 4) {
 	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
 		"\"testutfnext\" can only handle %" TCL_Z_MODIFIER "u bytes",
 		sizeof(buffer) - 4));
@@ -7689,8 +7687,7 @@ TestGetIntForIndexCmd(
     if (Tcl_GetIntForIndex(interp, objv[1], endvalue, &result) != TCL_OK) {
 	return TCL_ERROR;
     }
-    /* Make sure that (size_t)-2 is output as "-2" and (size_t)-3 as "-3", even for 32-bit */
-    Tcl_SetObjResult(interp, Tcl_NewWideIntObj((Tcl_WideInt)((Tcl_WideUInt)(result + 3U)) - 3));
+    Tcl_SetObjResult(interp, Tcl_NewWideIntObj(result));
     return TCL_OK;
 }
 
@@ -7930,7 +7927,7 @@ TestNRELevels(
     static ptrdiff_t *refDepth = NULL;
     ptrdiff_t depth;
     Tcl_Obj *levels[6];
-    size_t i = 0;
+    Tcl_Size i = 0;
     NRE_callback *cbPtr = iPtr->execEnvPtr->callbackPtr;
 
     if (refDepth == NULL) {
@@ -7940,9 +7937,9 @@ TestNRELevels(
     depth = (refDepth - &depth);
 
     levels[0] = Tcl_NewWideIntObj(depth);
-    levels[1] = Tcl_NewWideIntObj((Tcl_WideInt)((Tcl_WideUInt)(iPtr->numLevels + 1U)) - 1);
-    levels[2] = Tcl_NewWideIntObj((Tcl_WideInt)((Tcl_WideUInt)(iPtr->cmdFramePtr->level + 1U)) - 1);
-    levels[3] = Tcl_NewWideIntObj((Tcl_WideInt)((Tcl_WideUInt)(iPtr->varFramePtr->level + 1U)) - 1);
+    levels[1] = Tcl_NewWideIntObj(iPtr->numLevels);
+    levels[2] = Tcl_NewWideIntObj(iPtr->cmdFramePtr->level);
+    levels[3] = Tcl_NewWideIntObj(iPtr->varFramePtr->level);
     levels[4] = Tcl_NewWideIntObj(iPtr->execEnvPtr->execStackPtr->tosPtr
 	    - iPtr->execEnvPtr->execStackPtr->stackWords);
 
diff --git a/generic/tclTestObj.c b/generic/tclTestObj.c
index e801a2d..14c7c70 100644
--- a/generic/tclTestObj.c
+++ b/generic/tclTestObj.c
@@ -596,7 +596,7 @@ TestindexobjCmd(
 	result = Tcl_GetIndexFromObj(NULL, objv[1],
 		tablePtr, "token", 0, &index);
 	if (result == TCL_OK) {
-	    Tcl_SetWideIntObj(Tcl_GetObjResult(interp), (Tcl_WideInt)((Tcl_WideUInt)(index + 1U)) - 1);
+	    Tcl_SetWideIntObj(Tcl_GetObjResult(interp), index);
 	}
 	return result;
     }
@@ -624,7 +624,7 @@ TestindexobjCmd(
 	    &index);
     Tcl_Free((void *)argv);
     if (result == TCL_OK) {
-	Tcl_SetWideIntObj(Tcl_GetObjResult(interp), (Tcl_WideInt)((Tcl_WideUInt)(index + 1U)) - 1);
+	Tcl_SetWideIntObj(Tcl_GetObjResult(interp), index);
     }
     return result;
 }
@@ -1203,7 +1203,7 @@ TestobjCmd(
 	if (objc != 3) {
 	    goto wrongNumArgs;
 	}
-	Tcl_SetObjResult(interp, Tcl_NewWideIntObj((Tcl_WideInt)((Tcl_WideUInt)(varPtr[varIndex]->refCount + 1U)) - 1));
+	Tcl_SetObjResult(interp, Tcl_NewWideIntObj(varPtr[varIndex]->refCount));
 	break;
     case TESTOBJ_TYPE:
 	if (objc != 3) {
@@ -1424,7 +1424,7 @@ TeststringobjCmd(
 	    } else {
 		length = TCL_INDEX_NONE;
 	    }
-	    Tcl_SetWideIntObj(Tcl_GetObjResult(interp), (Tcl_WideInt)((Tcl_WideUInt)(length + 1U)) - 1);
+	    Tcl_SetWideIntObj(Tcl_GetObjResult(interp), length);
 	    break;
 	case 10: {				/* range */
 	    Tcl_Size first, last;
@@ -1757,10 +1757,10 @@ CheckIfVarUnset(
     Tcl_Obj ** varPtr,
     Tcl_Size varIndex)		/* Index of the test variable to check. */
 {
-    if (varPtr[varIndex] == NULL) {
+    if (varIndex < 0 || varPtr[varIndex] == NULL) {
 	char buf[32 + TCL_INTEGER_SPACE];
 
-	snprintf(buf, sizeof(buf), "variable %" TCL_Z_MODIFIER "u is unset (NULL)", varIndex);
+	snprintf(buf, sizeof(buf), "variable %" TCL_SIZE_MODIFIER "d is unset (NULL)", varIndex);
 	Tcl_ResetResult(interp);
 	Tcl_AppendToObj(Tcl_GetObjResult(interp), buf, -1);
 	return 1;
diff --git a/generic/tclTomMathDecls.h b/generic/tclTomMathDecls.h
index 10f1a6a..35eb9f8 100644
--- a/generic/tclTomMathDecls.h
+++ b/generic/tclTomMathDecls.h
@@ -35,22 +35,22 @@
 /* Define custom memory allocation for libtommath */
 
 /* MODULE_SCOPE void* TclBNAlloc( size_t ); */
-#define TclBNAlloc(s) ((void*)Tcl_Alloc(s))
+#define TclBNAlloc(s) Tcl_AttemptAlloc((size_t)(s))
 /* MODULE_SCOPE void* TclBNCalloc( size_t, size_t ); */
-#define TclBNCalloc(m,s) memset(Tcl_Alloc((size_t)(m)*(size_t)(s)),0,(size_t)(m)*(size_t)(s))
+#define TclBNCalloc(m,s) memset(Tcl_AttemptAlloc((size_t)(m)*(size_t)(s)),0,(size_t)(m)*(size_t)(s))
 /* MODULE_SCOPE void* TclBNRealloc( void*, size_t ); */
-#define TclBNRealloc(x,s) ((void*)Tcl_Realloc((char*)(x),(size_t)(s)))
+#define TclBNRealloc(x,s) Tcl_AttemptRealloc((x),(size_t)(s))
 /* MODULE_SCOPE void  TclBNFree( void* ); */
-#define TclBNFree(x) (Tcl_Free((char*)(x)))
+#define TclBNFree(x) Tcl_Free(x)
 
 #undef MP_MALLOC
 #undef MP_CALLOC
 #undef MP_REALLOC
 #undef MP_FREE
 #define MP_MALLOC(size)                   TclBNAlloc(size)
-#define MP_CALLOC(nmemb, size)            TclBNCalloc(nmemb, size)
-#define MP_REALLOC(mem, oldsize, newsize) TclBNRealloc(mem, newsize)
-#define MP_FREE(mem, size)                TclBNFree(mem)
+#define MP_CALLOC(nmemb, size)            TclBNCalloc((nmemb), (size))
+#define MP_REALLOC(mem, oldsize, newsize) TclBNRealloc((mem), ((void)(oldsize), (newsize)))
+#define MP_FREE(mem, size)                TclBNFree(((void)(size), (mem)))
 
 #ifndef MODULE_SCOPE
 #   ifdef __cplusplus
diff --git a/generic/tclUtil.c b/generic/tclUtil.c
index 046ba00..67c7bc1 100644
--- a/generic/tclUtil.c
+++ b/generic/tclUtil.c
@@ -2004,7 +2004,11 @@ Tcl_ConcatObj(
 		    goto slow;
 		}
 	    } else {
-		resPtr = TclListObjCopy(NULL, objPtr);
+		resPtr = TclDuplicatePureObj(
+		    NULL, objPtr, &tclListType.objType);
+		if (!resPtr) {
+		    return NULL;
+		}
 	    }
 	}
 	if (!resPtr) {
diff --git a/generic/tclVar.c b/generic/tclVar.c
index 550d7a6..32ee631 100644
--- a/generic/tclVar.c
+++ b/generic/tclVar.c
@@ -3097,7 +3097,10 @@ ArrayForNRCmd(
      * loop) don't vanish.
      */
 
-    varListObj = TclListObjCopy(NULL, objv[1]);
+    varListObj = TclDuplicatePureObj(interp, objv[1], &tclListType.objType);
+    if (!varListObj) {
+	return TCL_ERROR;
+    }
     scriptObj = objv[3];
     Tcl_IncrRefCount(scriptObj);
 
@@ -3176,7 +3179,10 @@ ArrayForLoopCallback(
 	goto arrayfordone;
     }
 
-    TclListObjGetElementsM(NULL, varListObj, &varc, &varv);
+    result = TclListObjGetElementsM(NULL, varListObj, &varc, &varv);
+    if (result != TCL_OK) {
+	goto arrayfordone;
+    }
     if (Tcl_ObjSetVar2(interp, varv[0], NULL, keyObj,
 	    TCL_LEAVE_ERR_MSG) == NULL) {
 	result = TCL_ERROR;
@@ -4067,7 +4073,11 @@ ArraySetCmd(
 	 * the loop and return an error.
 	 */
 
-	copyListObj = TclListObjCopy(NULL, arrayElemObj);
+	copyListObj =
+	    TclDuplicatePureObj(interp, arrayElemObj, &tclListType.objType);
+	if (!copyListObj) {
+	    return TCL_ERROR;
+	}
 	for (i=0 ; i<elemLen ; i+=2) {
 	    Var *elemVarPtr = TclLookupArrayElement(interp, arrayNameObj,
 		    elemPtrs[i], TCL_LEAVE_ERR_MSG, "set", 1, 1, varPtr, -1);