Fix [c9663296fd]. Also refactor memory reallocation.

10 files changed, 344 insertions, 213 deletions

diff --git a/generic/tcl.h b/generic/tcl.h
index ddd9d9b..b43fcec 100644
--- a/generic/tcl.h
+++ b/generic/tcl.h
@@ -809,8 +809,8 @@ typedef struct {
 typedef struct Tcl_DString {
     char *string;		/* Points to beginning of string: either
 				 * staticSpace below or a malloced array. */
-    Tcl_Size length;		/* Number of non-NULL characters in the
-				 * string. */
+    Tcl_Size length;		/* Number of bytes in string excluding
+				 * terminating nul */
     Tcl_Size spaceAvl;		/* Total number of bytes available for the
 				 * string and its terminating NULL char. */
     char staticSpace[TCL_DSTRING_STATIC_SIZE];
diff --git a/generic/tclBinary.c b/generic/tclBinary.c
index dd8b292..81ea3f3 100644
--- a/generic/tclBinary.c
+++ b/generic/tclBinary.c
@@ -767,43 +767,14 @@ TclAppendBytesToByteArray(
     }
     needed = byteArrayPtr->used + len;
     if (needed > byteArrayPtr->allocated) {
-	ByteArray *ptr = NULL;
-
-        /*
-	 * Try to allocate double the total space that is needed.
-	 */
-
-	Tcl_Size attempt;
-
-	/* Make sure we do not wrap when doubling */
-	if (needed <= (BYTEARRAY_MAX_LEN - needed)) {
-	    attempt = 2 * needed;
-	    ptr = (ByteArray *) Tcl_AttemptRealloc(byteArrayPtr,
-		    BYTEARRAY_SIZE(attempt));
-	}
-
-	if (ptr == NULL) {
-	    /*
-	     * Try to allocate double the increment that is needed.
-	     * (Originally TCL_MIN_GROWTH was added as well but that would
-	     * need one more separate overflow check so forget it.)
-	     */
-	    if (len <= (BYTEARRAY_MAX_LEN - needed)) {
-		attempt = needed + len;
-		ptr = (ByteArray *)Tcl_AttemptRealloc(byteArrayPtr,
-						      BYTEARRAY_SIZE(attempt));
-	    }
-	}
-	if (ptr == NULL) {
-	    /*
-	     * Last chance: Try to allocate exactly what is needed.
-	     */
-
-	    attempt = needed;
-	    ptr = (ByteArray *)Tcl_Realloc(byteArrayPtr, BYTEARRAY_SIZE(attempt));
-	}
-	byteArrayPtr = ptr;
-	byteArrayPtr->allocated = attempt;
+	Tcl_Size newCapacity;
+	byteArrayPtr =
+	    (ByteArray *)TclReallocElemsEx(byteArrayPtr,
+					   needed,
+					   1,
+					   offsetof(ByteArray, bytes),
+					   &newCapacity);
+	byteArrayPtr->allocated = newCapacity;
 	SET_BYTEARRAY(irPtr, byteArrayPtr);
     }
 
diff --git a/generic/tclCkalloc.c b/generic/tclCkalloc.c
index 09e140a..106a62c 100644
--- a/generic/tclCkalloc.c
+++ b/generic/tclCkalloc.c
@@ -16,6 +16,7 @@
  */
 
 #include "tclInt.h"
+#include <assert.h>
 
 #define FALSE	0
 #define TRUE	1
@@ -1234,6 +1235,148 @@ TclDumpMemoryInfo(
 #endif	/* TCL_MEM_DEBUG */
 
 /*
+ *------------------------------------------------------------------------
+ *
+ * TclAllocElemsEx --
+ *
+ *    See TclAttemptAllocElemsEx. This function differs in that it panics
+ *    on failure.
+ *
+ * Results:
+ *    Non-NULL pointer to allocated memory block.
+ *
+ * Side effects:
+ *    Panics if memory of at least the requested size could not be
+ *    allocated.
+ *
+ *------------------------------------------------------------------------
+ */
+void *
+TclAllocElemsEx(
+    Tcl_Size elemCount,     /* Allocation will store at least these many... */
+    Tcl_Size elemSize,	    /* ...elements of this size */
+    Tcl_Size leadSize,      /* Additional leading space in bytes */
+    Tcl_Size *capacityPtr) /* OUTPUT: Actual capacity is stored
+			       here if non-NULL. Only modified on success */
+{
+    void *ptr = TclAttemptReallocElemsEx(
+	NULL, elemCount, elemSize, leadSize, capacityPtr);
+    if (ptr == NULL) {
+	Tcl_Panic("Failed to allocate %" TCL_SIZE_MODIFIER
+		  "d elements of size %" TCL_SIZE_MODIFIER "d bytes.",
+		  elemCount,
+		  elemSize);
+    }
+    return ptr;
+}
+
+/*
+ *------------------------------------------------------------------------
+ *
+ * TclAttemptReallocElemsEx --
+ *
+ *    Attempts to allocate (oldPtr == NULL) or reallocate memory of the
+ *    requested size plus some more for future growth. The amount of
+ *    reallocation is adjusted depending on on failure.
+ * 
+ *
+ * Results:
+ *    Pointer to allocated memory block which is at least as large
+ *    as the requested size or NULL if allocation failed.
+ *
+ *------------------------------------------------------------------------
+ */
+void *
+TclAttemptReallocElemsEx(
+    void *oldPtr,	    /* Pointer to memory block to reallocate or 
+			     * NULL to indicate this is a new allocation */
+    Tcl_Size elemCount,     /* Allocation will store at least these many... */
+    Tcl_Size elemSize,	    /* ...elements of this size */
+    Tcl_Size leadSize,      /* Additional leading space in bytes */
+    Tcl_Size *capacityPtr) /* OUTPUT: Actual capacity is stored
+			       here if non-NULL. Only modified on success */
+{
+    void *ptr;
+    Tcl_Size limit;
+    Tcl_Size attempt;
+
+    assert(elemCount > 0);
+    assert(elemSize > 0);
+    assert(elemSize < TCL_SIZE_MAX);
+    assert(leadSize > 0);
+    assert(leadSize < TCL_SIZE_MAX);
+
+    limit = (TCL_SIZE_MAX - leadSize) / elemSize;
+    if (elemCount > limit) {
+	return NULL;
+    }
+    /* Loop trying for extra space, reducing request each time */
+    attempt = TclUpsizeAlloc(0, elemCount, limit);
+    ptr = NULL;
+    while (attempt > elemCount) {
+	if (oldPtr) {
+	    ptr = Tcl_AttemptRealloc(oldPtr, leadSize + attempt * elemSize);
+	} else {
+	    ptr = Tcl_AttemptAlloc(leadSize + attempt * elemSize);
+	}
+	if (ptr) {
+	    break;
+	}
+	attempt = TclUpsizeRetry(elemCount, attempt);
+    }
+    /* Try exact size as a last resort */
+    if (ptr == NULL) {
+	attempt = elemCount;
+	if (oldPtr) {
+	    ptr = Tcl_AttemptRealloc(oldPtr, leadSize + attempt * elemSize);
+	} else {
+	    ptr = Tcl_AttemptAlloc(leadSize + attempt * elemSize);
+	}
+    }
+    if (ptr && capacityPtr) {
+	*capacityPtr = attempt;
+    }
+    return ptr;
+}
+
+/*
+ *------------------------------------------------------------------------
+ *
+ * TclReallocElemsEx --
+ *
+ *    See TclAttemptReallocElemsEx. This function differs in that it panics
+ *    on failure.
+ *
+ * Results:
+ *    Non-NULL pointer to allocated memory block.
+ *
+ * Side effects:
+ *    Panics if memory of at least the requested size could not be
+ *    allocated.
+ *
+ *------------------------------------------------------------------------
+ */
+void *
+TclReallocElemsEx(
+    void *oldPtr,	    /* Pointer to memory block to reallocate */
+    Tcl_Size elemCount,     /* Allocation will store at least these many... */
+    Tcl_Size elemSize,	    /* ...elements of this size */
+    Tcl_Size leadSize,      /* Additional leading space in bytes */
+    Tcl_Size *capacityPtr) /* OUTPUT: Actual capacity is stored
+			       here if non-NULL. Only modified on success */
+{
+    void *ptr = TclAttemptReallocElemsEx(
+	oldPtr, elemCount, elemSize, leadSize, capacityPtr);
+    if (ptr == NULL) {
+	Tcl_Panic("Failed to reallocate %" TCL_SIZE_MODIFIER
+		  "d elements of size %" TCL_SIZE_MODIFIER "d bytes.",
+		  elemCount,
+		  elemSize);
+    }
+    return ptr;
+}
+
+/*
  *---------------------------------------------------------------------------
  *
  * TclFinalizeMemorySubsystem --
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 28ec508..bf42f6a 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -2873,6 +2873,75 @@ typedef struct ProcessGlobalValue {
     } while (0)
 
 /*
+ *----------------------------------------------------------------------
+ * Common functions for calculating overallocation. Trivial but allows for
+ * experimenting with growth factors without having to change code in
+ * multiple places. See TclAttemptAllocElemsEx and similar for usage
+ * examples. Best to use those functions. Direct use of TclUpsizeAlloc /
+ * TclResizeAlloc is needed in special cases such as when total size of
+ * memory block is limited to less than TCL_SIZE_MAX.
+ *
+ *----------------------------------------------------------------------
+ */
+static inline Tcl_Size
+TclUpsizeAlloc(TCL_UNUSED(Tcl_Size) /* oldSize. For future experiments with
+				     * some growth algorithms that use this
+				     * information. */,
+	       Tcl_Size needed,
+	       Tcl_Size limit)
+{
+    /* assert (oldCapacity < needed <= limit) */
+    if (needed < (limit - needed/2)) {
+	return needed + needed / 2;
+    }
+    else {
+	return limit;
+    }
+}
+static inline Tcl_Size TclUpsizeRetry(Tcl_Size needed, Tcl_Size lastAttempt) {
+	/* assert (needed < lastAttempt) */
+    if (needed < lastAttempt - 1) {
+	/* (needed+lastAttempt)/2 but that formula may overflow Tcl_Size */
+	return needed + (lastAttempt - needed) / 2;
+    } else {
+	return needed;
+    }
+}
+MODULE_SCOPE void *TclAllocElemsEx(Tcl_Size elemCount, Tcl_Size elemSize,
+			Tcl_Size leadSize, Tcl_Size *capacityPtr);
+MODULE_SCOPE void *TclReallocElemsEx(void *oldPtr, Tcl_Size elemCount,
+			Tcl_Size elemSize, Tcl_Size leadSize, 
+			Tcl_Size *capacityPtr);
+MODULE_SCOPE void *TclAttemptReallocElemsEx(void *oldPtr,
+			Tcl_Size elemCount, Tcl_Size elemSize,
+			Tcl_Size leadSize, Tcl_Size *capacityPtr);
+/* Alloc elemCount elements of size elemSize with leadSize header
+ * returning actual capacity (in elements) in *capacityPtr. */
+static inline void *TclAttemptAllocElemsEx(Tcl_Size elemCount, Tcl_Size elemSize,
+			Tcl_Size leadSize, Tcl_Size *capacityPtr) {
+    return TclAttemptReallocElemsEx(
+	NULL, elemCount, elemSize, leadSize, capacityPtr);
+}
+/* Alloc numByte bytes, returning actual capacity in *capacityPtr. */
+static inline void *TclAllocEx(Tcl_Size numBytes, Tcl_Size *capacityPtr) {
+    return TclAllocElemsEx(numBytes, 1, 0, capacityPtr);
+}
+/* Alloc numByte bytes, returning actual capacity in *capacityPtr. */
+static inline void *
+TclAttemptAllocEx(Tcl_Size numBytes, Tcl_Size *capacityPtr)
+{
+    return TclAttemptAllocElemsEx(numBytes, 1, 0, capacityPtr);
+}
+/* Realloc numByte bytes, returning actual capacity in *capacityPtr. */
+static inline void *TclReallocEx(void *oldPtr, Tcl_Size numBytes, Tcl_Size *capacityPtr) {
+    return TclReallocElemsEx(oldPtr, numBytes, 1, 0, capacityPtr);
+}
+/* Realloc numByte bytes, returning actual capacity in *capacityPtr. */
+static inline void *TclAttemptReallocEx(void *oldPtr, Tcl_Size numBytes, Tcl_Size *capacityPtr) {
+    return TclAttemptReallocElemsEx(oldPtr, numBytes, 1, 0, capacityPtr);
+}
+
+/*
  *----------------------------------------------------------------
  * Variables shared among Tcl modules but not used by the outside world.
  *----------------------------------------------------------------
diff --git a/generic/tclListObj.c b/generic/tclListObj.c
index 0e8583b..6288ffb 100644
--- a/generic/tclListObj.c
+++ b/generic/tclListObj.c
@@ -328,30 +328,6 @@ ListSpanMerited(
 /*
  *------------------------------------------------------------------------
  *
- * ListStoreUpSize --
- *
- *    For reasons of efficiency, extra space is allocated for a ListStore
- *    compared to what was requested. This function calculates how many
- *    slots should actually be allocated for a given request size.
- *
- * Results:
- *    Number of slots to allocate.
- *
- * Side effects:
- *    None.
- *
- *------------------------------------------------------------------------
- */
-static inline Tcl_Size
-ListStoreUpSize(Tcl_Size numSlotsRequested) {
-    /* TODO -how much extra? May be double only for smaller requests? */
-    return numSlotsRequested < (LIST_MAX / 2) ? 2 * numSlotsRequested
-						 : LIST_MAX;
-}
-
-/*
- *------------------------------------------------------------------------
- *
  * ListRepFreeUnreferenced --
  *
  *    Inline wrapper for ListRepUnsharedFreeUnreferenced that does quick checks
@@ -769,23 +745,21 @@ ListStoreNew(
 	return NULL;
     }
 
+    storePtr = NULL;
     if (flags & LISTREP_SPACE_FLAGS) {
 	/* Caller requests extra space front, back or both */
-	capacity = ListStoreUpSize(objc);
+	storePtr = (ListStore *)TclAttemptAllocElemsEx(
+	    objc, sizeof(Tcl_Obj *), offsetof(ListStore, slots), &capacity);
     } else {
+	/* Exact allocation */
 	capacity = objc;
-    }
-
-    storePtr = (ListStore *)Tcl_AttemptAlloc(LIST_SIZE(capacity));
-    while (storePtr == NULL && (capacity > (objc+1))) {
-	/* Because of loop condition capacity won't overflow */
-	capacity = objc + ((capacity - objc) / 2);
 	storePtr = (ListStore *)Tcl_AttemptAlloc(LIST_SIZE(capacity));
     }
     if (storePtr == NULL) {
 	if (flags & LISTREP_PANIC_ON_FAIL) {
-	    Tcl_Panic("list creation failed: unable to alloc %" TCL_Z_MODIFIER "u bytes",
-		    LIST_SIZE(objc));
+	    Tcl_Panic("list creation failed: unable to alloc %" TCL_Z_MODIFIER
+		      "u bytes",
+		      LIST_SIZE(objc));
 	}
 	return NULL;
     }
@@ -844,38 +818,25 @@ ListStoreNew(
  *------------------------------------------------------------------------
  */
 ListStore *
-ListStoreReallocate (ListStore *storePtr, Tcl_Size numSlots)
+ListStoreReallocate (ListStore *storePtr, Tcl_Size needed)
 {
-    Tcl_Size newCapacity;
-    ListStore *newStorePtr;
-
-    newCapacity = ListStoreUpSize(numSlots);
-    newStorePtr =
-	(ListStore *)Tcl_AttemptRealloc(storePtr, LIST_SIZE(newCapacity));
+    Tcl_Size capacity;
 
-    /*
-     * In case above failed keep looping reducing the requested extra space
-     * by half every time.
-     */
-    while (newStorePtr == NULL && (newCapacity > (numSlots+1))) {
-	/* Because of loop condition newCapacity won't overflow */
-	newCapacity = numSlots + ((newCapacity - numSlots) / 2);
-	newStorePtr =
-	    (ListStore *)Tcl_AttemptRealloc(storePtr, LIST_SIZE(newCapacity));
-    }
-    if (newStorePtr == NULL) {
-	/* Last resort - allcate what was asked */
-	newCapacity = numSlots;
-	newStorePtr = (ListStore *)Tcl_AttemptRealloc(storePtr,
-						    LIST_SIZE(newCapacity));
-	if (newStorePtr == NULL)
-	    return NULL;
+    if (needed > LIST_MAX) {
+	return NULL;
     }
+    storePtr = (ListStore *)TclAttemptReallocElemsEx(storePtr,
+						     needed,
+						     sizeof(Tcl_Obj *),
+						     offsetof(ListStore, slots),
+						     &capacity);
     /* Only the capacity has changed, fix it in the header */
-    newStorePtr->numAllocated = newCapacity;
-    return newStorePtr;
+    if (storePtr) {
+	storePtr->numAllocated = capacity;
+    }
+    return storePtr;
 }
-
+
 /*
  *----------------------------------------------------------------------
  *
diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c
index ae94853..5864ebc 100644
--- a/generic/tclStringObj.c
+++ b/generic/tclStringObj.c
@@ -59,8 +59,8 @@ static void		ExtendUnicodeRepWithString(Tcl_Obj *objPtr,
 			    Tcl_Size numAppendChars);
 static void		FillUnicodeRep(Tcl_Obj *objPtr);
 static void		FreeStringInternalRep(Tcl_Obj *objPtr);
-static void		GrowStringBuffer(Tcl_Obj *objPtr, size_t needed, int flag);
-static void		GrowUnicodeBuffer(Tcl_Obj *objPtr, size_t needed);
+static void		GrowStringBuffer(Tcl_Obj *objPtr, Tcl_Size needed, int flag);
+static void		GrowUnicodeBuffer(Tcl_Obj *objPtr, Tcl_Size needed);
 static int		SetStringFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
 static void		SetUnicodeObj(Tcl_Obj *objPtr,
 			    const Tcl_UniChar *unicode, Tcl_Size numChars);
@@ -131,8 +131,8 @@ const Tcl_ObjType tclStringType = {
 static void
 GrowStringBuffer(
     Tcl_Obj *objPtr,
-    size_t needed,
-    int flag)
+    Tcl_Size needed, /* Not including terminating nul */
+    int flag)      /* If 0, try to overallocate */
 {
     /*
      * Preconditions:
@@ -142,45 +142,35 @@ GrowStringBuffer(
      */
 
     String *stringPtr = GET_STRING(objPtr);
-    char *ptr = NULL;
-    size_t attempt;
+    char *ptr;
+    Tcl_Size capacity;
+
+    assert(needed <= TCL_SIZE_MAX - 1);
+    needed += 1; /* Include terminating nul */
 
     if (objPtr->bytes == &tclEmptyString) {
 	objPtr->bytes = NULL;
     }
+    /* 
+     * In code below, note 'capacity' and 'needed' include terminating nul,
+     * while stringPtr->allocated does not.
+     */
     if (flag == 0 || stringPtr->allocated > 0) {
-	attempt = 2 * needed;
-	ptr = (char *)Tcl_AttemptRealloc(objPtr->bytes, attempt + 1U);
-	if (ptr == NULL) {
-	    /*
-	     * Take care computing the amount of modest growth to avoid
-	     * overflow into invalid argument values for attempt.
-	     */
-
-	    size_t limit = INT_MAX - needed;
-	    size_t extra = needed - objPtr->length + TCL_MIN_GROWTH;
-	    size_t growth = (extra > limit) ? limit : extra;
-
-	    attempt = needed + growth;
-	    ptr = (char *)Tcl_AttemptRealloc(objPtr->bytes, attempt + 1U);
-	}
+	ptr = (char *)TclReallocEx(objPtr->bytes, needed, &capacity);
+    } else {
+	/* Allocate exact size */
+	ptr = (char *)Tcl_Realloc(objPtr->bytes, needed);
+	capacity = needed;
     }
-    if (ptr == NULL) {
-	/*
-	 * First allocation - just big enough; or last chance fallback.
-	 */
 
-	attempt = needed;
-	ptr = (char *)Tcl_Realloc(objPtr->bytes, attempt + 1U);
-    }
     objPtr->bytes = ptr;
-    stringPtr->allocated = attempt;
+    stringPtr->allocated = capacity - 1; /* Does not include slot for end nul */
 }
 
 static void
 GrowUnicodeBuffer(
     Tcl_Obj *objPtr,
-    size_t needed)
+    Tcl_Size needed)
 {
     /*
      * Preconditions:
@@ -188,39 +178,32 @@ GrowUnicodeBuffer(
      *	needed > stringPtr->maxChars
      */
 
-    String *ptr = NULL, *stringPtr = GET_STRING(objPtr);
-    size_t attempt;
-
-    if (stringPtr->maxChars > 0) {
-	/*
-	 * Subsequent appends - apply the growth algorithm.
-	 */
-
-	attempt = 2 * needed;
-	ptr = stringAttemptRealloc(stringPtr, attempt);
-	if (ptr == NULL) {
-	    /*
-	     * Take care computing the amount of modest growth to avoid
-	     * overflow into invalid argument values for attempt.
-	     */
-
-	    size_t extra = needed - stringPtr->numChars
-		    + TCL_MIN_UNICHAR_GROWTH;
+    String *stringPtr = GET_STRING(objPtr);
+    Tcl_Size maxChars;
 
-	    attempt = needed + extra;
-	    ptr = stringAttemptRealloc(stringPtr, attempt);
-	}
+    /* Note STRING_MAXCHARS already takes into account space for nul */
+    if (needed > STRING_MAXCHARS) {
+	Tcl_Panic("max size for a Tcl unicode rep (%" TCL_Z_MODIFIER "d bytes) exceeded",
+		  STRING_MAXCHARS);
     }
-    if (ptr == NULL) {
-	/*
-	 * First allocation - just big enough; or last chance fallback.
+    if (stringPtr->maxChars > 0) {
+	/* Expansion - try allocating extra space */
+	stringPtr = (String *)TclReallocElemsEx(stringPtr,
+						needed + 1, /* +1 for nul */
+						sizeof(Tcl_UniChar),
+						offsetof(String, unicode),
+						&maxChars);
+	maxChars -= 1; /* End nul not included */
+    }
+    else {
+	/* 
+	 * First allocation - just big enough. Note needed does
+	 * not include terminating nul but STRING_SIZE does
 	 */
-
-	attempt = needed;
-	ptr = stringRealloc(stringPtr, attempt);
+	stringPtr = (String *)Tcl_Realloc(stringPtr, STRING_SIZE(needed));
+	maxChars = needed;
     }
-    stringPtr = ptr;
-    stringPtr->maxChars = attempt;
+    stringPtr->maxChars = maxChars;
     SET_STRING(objPtr, stringPtr);
 }
 
diff --git a/generic/tclStringRep.h b/generic/tclStringRep.h
index 768c1ee..6f3c2f1 100644
--- a/generic/tclStringRep.h
+++ b/generic/tclStringRep.h
@@ -34,9 +34,10 @@ typedef struct {
 				 * calculated. Any other means that there is a valid
 				 * Unicode rep, or that the number of UTF bytes ==
 				 * the number of chars. */
-    Tcl_Size allocated;		/* The amount of space actually allocated for
-				 * the UTF-8 string (minus 1 byte for the
-				 * termination char). */
+    Tcl_Size allocated;		/* The amount of space allocated for
+				 * the UTF-8 string. Does not include nul
+				 * terminator so actual allocation is
+				 * (allocated+1). */
     Tcl_Size maxChars;		/* Max number of chars that can fit in the
 				 * space allocated for the Unicode array. */
     int hasUnicode;		/* Boolean determining whether the string has
diff --git a/generic/tclUtil.c b/generic/tclUtil.c
index a195c10..67c7bc1 100644
--- a/generic/tclUtil.c
+++ b/generic/tclUtil.c
@@ -2606,34 +2606,35 @@ Tcl_DStringAppend(
     if (length < 0) {
 	length = strlen(bytes);
     }
-    newSize = length + dsPtr->length;
 
-    /*
-     * Allocate a larger buffer for the string if the current one isn't large
-     * enough. Allocate extra space in the new buffer so that there will be
-     * room to grow before we have to allocate again.
-     */
+    if (length > (TCL_SIZE_MAX - dsPtr->length - 1)) {
+	Tcl_Panic("max size for a Tcl value (%" TCL_SIZE_MODIFIER
+		  "d bytes) exceeded",
+		  TCL_SIZE_MAX);
+	return NULL; /* NOTREACHED */
+    }
+    newSize = length + dsPtr->length + 1;
 
-    if (newSize >= dsPtr->spaceAvl) {
-	dsPtr->spaceAvl = newSize * 2;
-	if (dsPtr->string == dsPtr->staticSpace) {
-	    char *newString = (char *)Tcl_Alloc(dsPtr->spaceAvl);
 
+    if (newSize > dsPtr->spaceAvl) {
+	if (dsPtr->string == dsPtr->staticSpace) {
+	    char *newString;
+	    newString = (char *) TclAllocEx(newSize, &dsPtr->spaceAvl);
 	    memcpy(newString, dsPtr->string, dsPtr->length);
 	    dsPtr->string = newString;
 	} else {
-	    Tcl_Size index = TCL_INDEX_NONE;
+	    Tcl_Size offset = -1;
 
 	    /* See [16896d49fd] */
 	    if (bytes >= dsPtr->string
 		    && bytes <= dsPtr->string + dsPtr->length) {
-		index = bytes - dsPtr->string;
+		/* Source string is within this DString. Note offset */
+		offset = bytes - dsPtr->string;
 	    }
-
-	    dsPtr->string = (char *)Tcl_Realloc(dsPtr->string, dsPtr->spaceAvl);
-
-	    if (index >= 0) {
-		bytes = dsPtr->string + index;
+	    dsPtr->string =
+		(char *)TclReallocEx(dsPtr->string, newSize, &dsPtr->spaceAvl);
+	    if (offset >= 0) {
+		bytes = dsPtr->string + offset;
 	    }
 	}
     }
@@ -2745,12 +2746,11 @@ Tcl_DStringAppendElement(
      * memcpy, not strcpy, to copy the string to a larger buffer, since there
      * may be embedded NULLs in the string in some cases.
      */
-
-    if (newSize >= dsPtr->spaceAvl) {
-	dsPtr->spaceAvl = newSize * 2;
+    newSize += 1; /* For terminating nul */
+    if (newSize > dsPtr->spaceAvl) {
 	if (dsPtr->string == dsPtr->staticSpace) {
-	    char *newString = (char *)Tcl_Alloc(dsPtr->spaceAvl);
-
+	    char *newString;
+	    newString = (char *) TclAllocEx(newSize, &dsPtr->spaceAvl);
 	    memcpy(newString, dsPtr->string, dsPtr->length);
 	    dsPtr->string = newString;
 	} else {
@@ -2759,11 +2759,11 @@ Tcl_DStringAppendElement(
 	    /* See [16896d49fd] */
 	    if (element >= dsPtr->string
 		    && element <= dsPtr->string + dsPtr->length) {
+		/* Source string is within this DString. Note offset */
 		offset = element - dsPtr->string;
 	    }
-
-	    dsPtr->string = (char *)Tcl_Realloc(dsPtr->string, dsPtr->spaceAvl);
-
+	    dsPtr->string =
+		(char *)TclReallocEx(dsPtr->string, newSize, &dsPtr->spaceAvl);
 	    if (offset >= 0) {
 		element = dsPtr->string + offset;
 	    }
@@ -2822,13 +2822,16 @@ Tcl_DStringSetLength(
 	 * would be wasteful to overallocate that buffer, so we just allocate
 	 * enough for the requested size plus the trailing null byte. In the
 	 * second case, we are growing the buffer incrementally, so we need
-	 * behavior similar to Tcl_DStringAppend. The requested length will
-	 * usually be a small delta above the current spaceAvl, so we'll end
-	 * up doubling the old size. This won't grow the buffer quite as
-	 * quickly, but it should be close enough.
+	 * behavior similar to Tcl_DStringAppend.
+	 * TODO - the above makes no sense to me. How does the code below
+	 * translate into distinguishing the two cases above? IMO, if caller
+	 * specifically sets the length, there is no cause for overallocation.
 	 */
 
-	newsize = dsPtr->spaceAvl * 2;
+	if (length >= TCL_SIZE_MAX) {
+	    Tcl_Panic("Tcl_Concat: max size of Tcl value exceeded");
+	}
+	newsize = TclUpsizeAlloc(dsPtr->spaceAvl, length + 1, TCL_SIZE_MAX);
 	if (length < newsize) {
 	    dsPtr->spaceAvl = newsize;
 	} else {
diff --git a/tests/listRep.test b/tests/listRep.test
index 02ff18f..11af9ad 100644
--- a/tests/listRep.test
+++ b/tests/listRep.test
@@ -221,7 +221,7 @@ test listrep-1.2 {
     set l [linsert [freeSpaceNone] $end 99]
     validate $l
     list $l [leadSpace $l] [tailSpace $l]
-} -result [list {0 1 2 3 4 5 6 7 99} 0 9]
+} -result [list {0 1 2 3 4 5 6 7 99} 0 4]
 
 test listrep-1.2.1 {
     Inserts at back of unshared list with no free space should allocate all
@@ -231,7 +231,7 @@ test listrep-1.2.1 {
     lset l $end+1 99
     validate $l
     list $l [leadSpace $l] [tailSpace $l]
-} -result [list {0 1 2 3 4 5 6 7 99} 0 9]
+} -result [list {0 1 2 3 4 5 6 7 99} 0 4]
 
 test listrep-1.2.2 {
     Inserts at back of unshared list with no free space should allocate all
@@ -241,7 +241,7 @@ test listrep-1.2.2 {
     lappend l 99
     validate $l
     list $l [leadSpace $l] [tailSpace $l]
-} -result [list {0 1 2 3 4 5 6 7 99} 0 9]
+} -result [list {0 1 2 3 4 5 6 7 99} 0 4]
 
 test listrep-1.3 {
     Inserts in middle of unshared list with no free space should reallocate with
@@ -1160,7 +1160,7 @@ test listrep-3.3 {
     set l [linsert [freeSpaceBoth 8 1 1] $zero -3 -2 -1]
     validate $l
     list $l [leadSpace $l] [tailSpace $l] [repStoreRefCount $l]
-} -result [list [irange -3 7] 6 5 1]
+} -result [list [irange -3 7] 3 2 1]
 
 test listrep-3.3.1 {
     Inserts in front of unshared spanned list with insufficient total freespace
@@ -1169,7 +1169,7 @@ test listrep-3.3.1 {
     set l [lreplace [freeSpaceBoth 8 1 1] $zero -1 -3 -2 -1]
     validate $l
     list $l [leadSpace $l] [tailSpace $l] [repStoreRefCount $l]
-} -result [list [irange -3 7] 6 5 1]
+} -result [list [irange -3 7] 3 2 1]
 
 test listrep-3.4 {
     Inserts at back of unshared spanned list with room at back should not
@@ -1255,7 +1255,7 @@ test listrep-3.6 {
     set l [linsert [freeSpaceBoth 8 1 1] $end 8 9 10]
     validate $l
     list $l [leadSpace $l] [tailSpace $l] [repStoreRefCount $l]
-} -result [list [irange 0 10] 1 10 1]
+} -result [list [irange 0 10] 1 4 1]
 
 test listrep-3.6.1 {
     Inserts in back of unshared spanned list with insufficient total freespace
@@ -1265,7 +1265,7 @@ test listrep-3.6.1 {
     set l [lreplace [freeSpaceBoth 8 1 1] $end+1 $end+1 8 9 10]
     validate $l
     list $l [leadSpace $l] [tailSpace $l] [repStoreRefCount $l]
-} -result [list [irange 0 10] 1 10 1]
+} -result [list [irange 0 10] 1 4 1]
 
 test listrep-3.6.2 {
     Inserts in back of unshared spanned list with insufficient total freespace
@@ -1276,7 +1276,7 @@ test listrep-3.6.2 {
     lappend l 8 9 10
     validate $l
     list $l [leadSpace $l] [tailSpace $l] [repStoreRefCount $l]
-} -result [list [irange 0 10] 1 10 1]
+} -result [list [irange 0 10] 1 4 1]
 
 test listrep-3.6.3 {
     Inserts in back of unshared spanned list with insufficient total freespace
@@ -1287,7 +1287,7 @@ test listrep-3.6.3 {
     lset l $end+1 8
     validate $l
     list $l [leadSpace $l] [tailSpace $l] [repStoreRefCount $l]
-} -result [list [irange 0 8] 0 9 1]
+} -result [list [irange 0 8] 0 4 1]
 
 test listrep-3.7 {
     Inserts in front half of unshared spanned list with room in front should not
@@ -1341,7 +1341,7 @@ test listrep-3.10 {
     set l [linsert [freeSpaceBoth 8 1 1] $one -3 -2 -1]
     validate $l
     list $l [leadSpace $l] [tailSpace $l] [repStoreRefCount $l]
-} -result [list {0 -3 -2 -1 1 2 3 4 5 6 7} 1 10 1]
+} -result [list {0 -3 -2 -1 1 2 3 4 5 6 7} 1 4 1]
 
 test listrep-3.10.1 {
     Inserts in front half of unshared spanned list with insufficient total space.
@@ -1350,7 +1350,7 @@ test listrep-3.10.1 {
     set l [lreplace [freeSpaceBoth 8 1 1] $one -1 -3 -2 -1]
     validate $l
     list $l [leadSpace $l] [tailSpace $l] [repStoreRefCount $l]
-} -result [list {0 -3 -2 -1 1 2 3 4 5 6 7} 1 10 1]
+} -result [list {0 -3 -2 -1 1 2 3 4 5 6 7} 1 4 1]
 
 test listrep-3.11 {
     Inserts in back half of unshared spanned list with room in back should not
@@ -1414,7 +1414,7 @@ test listrep-3.14 {
     set l [linsert [freeSpaceBoth 8 1 1] $end-$one 8 9 10]
     validate $l
     list $l [leadSpace $l] [tailSpace $l] [repStoreRefCount $l]
-} -result [list {0 1 2 3 4 5 6 8 9 10 7} 1 10 1]
+} -result [list {0 1 2 3 4 5 6 8 9 10 7} 1 4 1]
 
 test listrep-3.14.1 {
     Inserts in back half of unshared spanned list with insufficient
@@ -1424,7 +1424,7 @@ test listrep-3.14.1 {
     set l [lreplace [freeSpaceBoth 8 1 1] $end -1 8 9 10]
     validate $l
     list $l [leadSpace $l] [tailSpace $l] [repStoreRefCount $l]
-} -result [list {0 1 2 3 4 5 6 8 9 10 7} 1 10 1]
+} -result [list {0 1 2 3 4 5 6 8 9 10 7} 1 4 1]
 
 test listrep-3.15 {
     Deletes from front of small unshared span list results in elements
@@ -1714,7 +1714,7 @@ test listrep-3.27 {
     set l [lreplace [freeSpaceBoth 8 1 1] $zero $one 10 11 12 13 14]
     validate $l
     list $l [leadSpace $l] [tailSpace $l] [repStoreRefCount $l]
-} -result [list {10 11 12 13 14 2 3 4 5 6 7} 6 5 1]
+} -result [list {10 11 12 13 14 2 3 4 5 6 7} 3 2 1]
 
 test listrep-3.28 {
     Replacement of elements at back with same number of elements in unshared
@@ -1770,7 +1770,7 @@ test listrep-3.32 {
     set l [lreplace [freeSpaceBoth 8 1 1] $end-1 $end 10 11 12 13 14]
     validate $l
     list $l [leadSpace $l] [tailSpace $l]
-} -result [list {0 1 2 3 4 5 10 11 12 13 14} 1 10]
+} -result [list {0 1 2 3 4 5 10 11 12 13 14} 1 4]
 
 test listrep-3.33 {
     Replacement of elements in the middle in an unshared spanned list with
@@ -1864,7 +1864,7 @@ test listrep-3.41 {
     set l [lreplace [freeSpaceBoth 8 1 1] $one $one 8 9 10 11 12]
     validate $l
     list $l [leadSpace $l] [tailSpace $l]
-} -result [list {0 8 9 10 11 12 2 3 4 5 6 7} 1 11]
+} -result [list {0 8 9 10 11 12 2 3 4 5 6 7} 1 5]
 
 #
 # 4.* - tests on shared spanned lists
diff --git a/tests/stringObj.test b/tests/stringObj.test
index 5b6358a..71cf63e 100644
--- a/tests/stringObj.test
+++ b/tests/stringObj.test
@@ -78,7 +78,7 @@ test stringObj-4.3 {Tcl_SetObjLength procedure, string gets longer} testobj {
     teststringobj append 1 xyzq -1
     list [teststringobj length 1] [teststringobj length2 1] \
 	    [teststringobj get 1]
-} {10 20 abcdefxyzq}
+} {10 15 abcdefxyzq}
 test stringObj-4.4 {Tcl_SetObjLength procedure, "empty string", length 0} testobj {
     testobj freeallvars
     testobj newobj 1
@@ -111,7 +111,7 @@ test stringObj-5.3 {Tcl_AppendToObj procedure, reallocating space} testobj {
     teststringobj append 1 abcdef -1
     lappend result [teststringobj length 1] [teststringobj length2 1] \
 	    [teststringobj get 1]
-} {15 15 16 32 xy12345678abcdef}
+} {15 15 16 24 xy12345678abcdef}
 
 test stringObj-6.1 {Tcl_AppendStringsToObj procedure, type conversion} testobj {
     testobj freeallvars
@@ -142,7 +142,7 @@ test stringObj-6.5 {Tcl_AppendStringsToObj procedure, don't double space if init
     testobj newobj 1
     teststringobj appendstrings 1 123 abcdefg
     list [teststringobj length 1] [teststringobj length2 1] [teststringobj get 1]
-} {10 20 123abcdefg}
+} {10 15 123abcdefg}
 test stringObj-6.6 {Tcl_AppendStringsToObj procedure, space reallocation} testobj {
     testobj freeallvars
     teststringobj set 1 abc
@@ -160,7 +160,7 @@ test stringObj-6.7 {Tcl_AppendStringsToObj procedure, space reallocation} testob
     teststringobj appendstrings 1 34567890x
     list [teststringobj length 1] [teststringobj length2 1] \
 	    [teststringobj get 1]
-} {11 22 ab34567890x}
+} {11 17 ab34567890x}
 test stringObj-6.8 {Tcl_AppendStringsToObj procedure, object totally empty} testobj {
     testobj freeallvars
     testobj newobj 1
@@ -180,7 +180,7 @@ test stringObj-7.1 {SetStringFromAny procedure} testobj {
     teststringobj append 1 x -1
     list [teststringobj length 1] [teststringobj length2 1] \
 	    [teststringobj get 1]
-} {4 8 {a bx}}
+} {4 6 {a bx}}
 test stringObj-7.2 {SetStringFromAny procedure, null object} testobj {
     testobj freeallvars
     testobj newobj 1
@@ -208,7 +208,7 @@ test stringObj-8.1 {DupStringInternalRep procedure} testobj {
 	    [teststringobj maxchars 1] [teststringobj get 1] \
 	    [teststringobj length 2] [teststringobj length2 2] \
 	    [teststringobj maxchars 2] [teststringobj get 2]
-} {5 10 0 abcde 5 5 0 abcde}
+} {5 8 0 abcde 5 5 0 abcde}
 test stringObj-8.2 {DupUnicodeInternalRep, mixed width chars} testobj {
     set x abc\xEF\xBF\xAEghi
     string length $x