1 files changed, 78 insertions, 1 deletions

diff --git a/generic/tclObj.c b/generic/tclObj.c
index 3a97534..44ca821 100644
--- a/generic/tclObj.c
+++ b/generic/tclObj.c
@@ -202,6 +202,7 @@ 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 void		SetDuplicatePureObj(Tcl_Obj *dupPtr, Tcl_Obj *objPtr);
 
 /*
  * Prototypes for the array hash key methods.
@@ -1560,6 +1561,13 @@ TclObjBeingDeleted(
  *	Create and return a new object that is a duplicate of the argument
  *	object.
  *
+ * TclDuplicatePureObj --
+ *	Like Tcl_DuplicateObj, except that it 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
@@ -1600,6 +1608,39 @@ TclObjBeingDeleted(
 	}								\
     }
 
+void SetDuplicatePureObj(Tcl_Obj *dupPtr, Tcl_Obj *objPtr) 
+{
+    const Tcl_ObjType *typePtr = objPtr->typePtr;		
+    const char *bytes = objPtr->bytes;
+
+    /* Unfortunately, it is not documented that dupIntRepProc() must assign
+     * null to Tcl_Obj.typePtr if it does not assign any other value, so it
+     * must be done here.  Maybe in the future it can be documented, and this
+     * assignment deleted */
+    dupPtr->typePtr = NULL;
+
+    if (typePtr) {
+	if (typePtr->dupIntRepProc) {
+	    typePtr->dupIntRepProc(objPtr, dupPtr);
+	} else {
+	    dupPtr->internalRep = objPtr->internalRep;
+	    dupPtr->typePtr = typePtr;
+	}
+	if (bytes && (
+	    dupPtr->typePtr == NULL
+	    || dupPtr->typePtr->updateStringProc == NULL)
+	) {
+	    TclInitStringRep(dupPtr, bytes, objPtr->length);
+	} else {
+	    dupPtr->bytes = NULL;
+	}
+    } else if (bytes) {
+	TclInitStringRep(dupPtr, bytes, objPtr->length);
+    }
+    return;
+}
+
+
 Tcl_Obj *
 Tcl_DuplicateObj(
     Tcl_Obj *objPtr)		/* The object to duplicate. */
@@ -1611,6 +1652,20 @@ Tcl_DuplicateObj(
     return dupPtr;
 }
 
+
+Tcl_Obj *
+TclDuplicatePureObj(
+    Tcl_Obj *objPtr)		/* The object to duplicate. */
+{
+    Tcl_Obj *dupPtr;
+
+    TclNewObj(dupPtr);
+    SetDuplicatePureObj(dupPtr, objPtr);
+    return dupPtr;
+}
+
+
+
 void
 TclSetDuplicateObj(
     Tcl_Obj *dupPtr,
@@ -3748,7 +3803,7 @@ Tcl_IncrRefCount(
  *	Decrements the reference count of the object.
  *
  * Results:
- *	None.
+ *	The storage for objPtr may be freed.
  *
  *----------------------------------------------------------------------
  */
@@ -3766,6 +3821,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.