* generic/tclBinary.c (TclAppendBytesToByteArray): [Bug 2992970]: Make

	* generic/tclStringObj.c (Tcl_AppendObjToObj): an append of a byte
	array to another into an efficent operation. The problem was the (lack
	of) a proper growth management strategy for the byte array.

3 files changed, 82 insertions, 6 deletions

diff --git a/generic/tclBinary.c b/generic/tclBinary.c
index 62f8f46..1d46902 100644
--- a/generic/tclBinary.c
+++ b/generic/tclBinary.c
@@ -10,7 +10,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclBinary.c,v 1.60 2010/03/05 14:34:03 dkf Exp $
+ * RCS: @(#) $Id: tclBinary.c,v 1.61 2010/04/29 15:08:05 dkf Exp $
  */
 
 #include "tclInt.h"
@@ -577,6 +577,81 @@ UpdateStringOfByteArray(
 /*
  *----------------------------------------------------------------------
  *
+ * TclAppendBytesToByteArray --
+ *
+ *	This function appends an array of bytes to a byte array object. Note
+ *	that the object *must* be unshared, and the array of bytes *must not*
+ *	refer to the object being appended to.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Allocates enough memory for an array of bytes of the requested total
+ *	size, or possibly larger. [Bug 2992970]
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclAppendBytesToByteArray(
+    Tcl_Obj *objPtr,
+    const unsigned char *bytes,
+    unsigned len)
+{
+    ByteArray *byteArrayPtr;
+
+    if (Tcl_IsShared(objPtr)) {
+	Tcl_Panic("%s called with shared object","TclAppendBytesToByteArray");
+    }
+    if (objPtr->typePtr != &tclByteArrayType) {
+	SetByteArrayFromAny(NULL, objPtr);
+    }
+    byteArrayPtr = GET_BYTEARRAY(objPtr);
+
+    /*
+     * If we need to, resize the allocated space in the byte array.
+     */
+
+    if (byteArrayPtr->used+len > byteArrayPtr->allocated) {
+	unsigned int attempt, used = byteArrayPtr->used;
+	ByteArray *tmpByteArrayPtr;
+
+	attempt = byteArrayPtr->allocated;
+	do {
+	    attempt *= 2;
+	} while (attempt < used+len);
+
+	tmpByteArrayPtr = (ByteArray *)
+		attemptckrealloc((char *) byteArrayPtr,
+			BYTEARRAY_SIZE(attempt));
+
+	if (tmpByteArrayPtr == NULL) {
+	    attempt = used + len;
+	    tmpByteArrayPtr = (ByteArray *) ckrealloc((char *) byteArrayPtr,
+		    BYTEARRAY_SIZE(attempt));
+	}
+
+	byteArrayPtr = tmpByteArrayPtr;
+	byteArrayPtr->allocated = attempt;
+	byteArrayPtr->used = used;
+	SET_BYTEARRAY(objPtr, byteArrayPtr);
+    }
+
+    /*
+     * Do the append if there's any point.
+     */
+
+    if (len > 0) {
+	memcpy(byteArrayPtr->bytes + byteArrayPtr->used, bytes, len);
+	byteArrayPtr->used += len;
+	Tcl_InvalidateStringRep(objPtr);
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * TclInitBinaryCmd --
  *
  *	This function is called to create the "binary" Tcl command. See the
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 3ca58d7..9c5ec7f 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -15,7 +15,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclInt.h,v 1.473 2010/04/28 11:50:53 nijtmans Exp $
+ * RCS: @(#) $Id: tclInt.h,v 1.474 2010/04/29 15:08:06 dkf Exp $
  */
 
 #ifndef _TCLINT
@@ -2801,6 +2801,8 @@ struct Tcl_LoadHandle_ {
  *----------------------------------------------------------------
  */
 
+MODULE_SCOPE void	TclAppendBytesToByteArray(Tcl_Obj *objPtr,
+			    const unsigned char *bytes, unsigned len);
 MODULE_SCOPE int	TclNREvalCmd(Tcl_Interp *interp, Tcl_Obj *objPtr,
 			    int flags);
 MODULE_SCOPE void	TclPushTailcallPoint(Tcl_Interp *interp);
diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c
index e075d77..e91b8a4 100644
--- a/generic/tclStringObj.c
+++ b/generic/tclStringObj.c
@@ -33,7 +33,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclStringObj.c,v 1.135 2010/03/29 21:58:58 dgp Exp $ */
+ * RCS: @(#) $Id: tclStringObj.c,v 1.136 2010/04/29 15:08:07 dkf Exp $ */
 
 #include "tclInt.h"
 #include "tommath.h"
@@ -1235,7 +1235,7 @@ Tcl_AppendObjToObj(
      */
 
     if (TclIsPureByteArray(objPtr) && TclIsPureByteArray(appendObjPtr)) {
-	unsigned char *bytesDst, *bytesSrc;
+	unsigned char *bytesSrc;
 	int lengthSrc, lengthTotal;
 
 	/*
@@ -1250,9 +1250,8 @@ Tcl_AppendObjToObj(
 	if (((length > lengthSrc) ? length : lengthSrc) > lengthTotal) {
 	    Tcl_Panic("overflow when calculating byte array size");
 	}
-	bytesDst = Tcl_SetByteArrayLength(objPtr, lengthTotal);
 	bytesSrc = Tcl_GetByteArrayFromObj(appendObjPtr, NULL);
-	memcpy(bytesDst + length, bytesSrc, lengthSrc);
+	TclAppendBytesToByteArray(objPtr, bytesSrc, (unsigned) lengthSrc);
 	return;
     }