New function TclAllocMaximize(). Let tclListObj.c find out the real allocated size, thus reducing the number of reallocs. It's good to avoid the interplay between List and Alloc both doubling just-in-case.

3 files changed, 84 insertions, 16 deletions

diff --git a/generic/tclAlloc.c b/generic/tclAlloc.c
index 782a12b..ff04c2b 100644
--- a/generic/tclAlloc.c
+++ b/generic/tclAlloc.c
@@ -197,7 +197,6 @@ typedef struct Block {
 #define magicNum1	u.s.magic1
 #define magicNum2	u.s.magic2
 #define MAGIC		0xEF
-#define blockReqSize	reqSize
 
 /*
  * The following defines the minimum and maximum block sizes and the number
@@ -385,7 +384,7 @@ Block2Ptr(
 
     blockPtr->magicNum1 = blockPtr->magicNum2 = MAGIC;
     blockPtr->sourceBucket = bucket;
-    blockPtr->blockReqSize = reqSize;
+    blockPtr->reqSize = reqSize;
     ptr = (void *) (((char *)blockPtr) + OFFSET);
 #if RCHECK
     ((unsigned char *)(ptr))[reqSize] = MAGIC;
@@ -405,10 +404,10 @@ Ptr2Block(
 		blockPtr, blockPtr->magicNum1, blockPtr->magicNum2);
     }
 #if RCHECK
-    if (((unsigned char *) ptr)[blockPtr->blockReqSize] != MAGIC) {
+    if (((unsigned char *) ptr)[blockPtr->reqSize] != MAGIC) {
 	Tcl_Panic("alloc: invalid block: %p: %x %x %x",
 		blockPtr, blockPtr->magicNum1, blockPtr->magicNum2,
-		((unsigned char *) ptr)[blockPtr->blockReqSize]);
+		((unsigned char *) ptr)[blockPtr->reqSize]);
     }
 #endif
     return blockPtr;
@@ -707,14 +706,14 @@ TclpFree(
     bucket = blockPtr->sourceBucket;
     if (bucket == nBuckets) {
 #ifdef ZIPPY_STATS
-	cachePtr->totalAssigned -= blockPtr->blockReqSize;
+	cachePtr->totalAssigned -= blockPtr->reqSize;
 #endif
 	free(blockPtr);
 	return;
     }
 
 #ifdef ZIPPY_STATS
-    cachePtr->buckets[bucket].totalAssigned -= blockPtr->blockReqSize;
+    cachePtr->buckets[bucket].totalAssigned -= blockPtr->reqSize;
 #endif
     blockPtr->nextBlock = cachePtr->buckets[bucket].firstPtr;
     cachePtr->buckets[bucket].firstPtr = blockPtr;
@@ -800,14 +799,14 @@ TclpRealloc(
 	}
 	if (size > min && size <= bucketInfo[bucket].blockSize) {
 #ifdef ZIPPY_STATS
-	    cachePtr->buckets[bucket].totalAssigned -= blockPtr->blockReqSize;
+	    cachePtr->buckets[bucket].totalAssigned -= blockPtr->reqSize;
 	    cachePtr->buckets[bucket].totalAssigned += reqSize;
 #endif
 	    return Block2Ptr(blockPtr, bucket, reqSize);
 	}
     } else if (size > MAXALLOC) {
 #ifdef ZIPPY_STATS
-	cachePtr->totalAssigned -= blockPtr->blockReqSize;
+	cachePtr->totalAssigned -= blockPtr->reqSize;
 	cachePtr->totalAssigned += reqSize;
 #endif
 	blockPtr = realloc(blockPtr, size);
@@ -823,14 +822,65 @@ TclpRealloc(
 
     newPtr = TclpAlloc(reqSize);
     if (newPtr != NULL) {
-	if (reqSize > blockPtr->blockReqSize) {
-	    reqSize = blockPtr->blockReqSize;
+	if (reqSize > blockPtr->reqSize) {
+	    reqSize = blockPtr->reqSize;
 	}
 	memcpy(newPtr, ptr, reqSize);
 	TclpFree(ptr);
     }
     return newPtr;
 }
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclAllocMaximize --
+ *
+ * Given a TclpAlloc'ed pointer, it returns the maximal size that can be used
+ * by the allocated memory. This is almost always larger than the requested
+ * size, as it corresponds to the bucket's size.
+ *
+ * Results:
+ *	New size.
+ *
+ *----------------------------------------------------------------------
+ */
+ unsigned int
+ TclAllocMaximize(
+     void *ptr)
+{
+    Block *blockPtr;
+    int bucket;
+    size_t oldSize, newSize;
+
+    if (allocator < aNONE) {
+	/*
+	 * No info, return UINT_MAX as a signal.
+	 */
+	
+	return UINT_MAX;
+    }
+    
+    blockPtr = Ptr2Block(ptr);
+    bucket = blockPtr->sourceBucket;
+    
+    if (bucket == nBuckets) {
+	/*
+	 * System malloc'ed: no info
+	 */
+	
+	return UINT_MAX;
+    }
+
+    oldSize = blockPtr->reqSize;
+    newSize = bucketInfo[bucket].blockSize - OFFSET - RCHECK;
+    blockPtr->reqSize = newSize;
+#if RCHECK
+    ((unsigned char *)(ptr))[newSize] = MAGIC;
+#endif    
+    return newSize;
+}
+
 #ifdef ZIPPY_STATS
 
 /*
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 45eaf7e..1f1e1d3 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -3864,10 +3864,12 @@ MODULE_SCOPE Tcl_Mutex *TclpNewAllocMutex(void);
 #    define TclpAlloc(size) ckalloc(size)
 #    define TclpRealloc(ptr, size) ckrealloc((ptr),(size))
 #    define TclpFree(size) ckfree(size)
+#    define TclAllocMaximize(ptr) UINT_MAX
 #else
    MODULE_SCOPE char * TclpAlloc(unsigned int size);
    MODULE_SCOPE char * TclpRealloc(char * ptr, unsigned int size);
    MODULE_SCOPE void   TclpFree(char * ptr);
+   MODULE_SCOPE unsigned int TclAllocMaximize(void *ptr);
 #endif
 
 #if TCL_ALLOCATOR == aPURIFY
diff --git a/generic/tclListObj.c b/generic/tclListObj.c
index 46710d6..814acd7 100644
--- a/generic/tclListObj.c
+++ b/generic/tclListObj.c
@@ -67,13 +67,23 @@ const Tcl_ObjType tclListType = {
  *----------------------------------------------------------------------
  */
 
+#define Elems2Size(n)					\
+    ((n > 1)						\
+	    ? (sizeof(List) + (n-1)*sizeof(Tcl_Obj *))	\
+	    : (sizeof(List)))
+#define Size2Elems(s)							\
+    ((s > sizeof(List) + sizeof(Tcl_Obj *) -1)				\
+	    ? (s - sizeof(List) + sizeof(Tcl_Obj *))/sizeof(Tcl_Obj *)	\
+	    : 1)
+
 static List *
 NewListIntRep(
     int objc,
     Tcl_Obj *const objv[])
 {
     List *listRepPtr;
-
+    unsigned int allocSize;
+    
     if (objc <= 0) {
 	return NULL;
     }
@@ -89,14 +99,17 @@ NewListIntRep(
 	return NULL;
     }
 
-    listRepPtr = attemptckalloc(sizeof(List) + ((objc-1) * sizeof(Tcl_Obj*)));
+    listRepPtr = attemptckalloc(Elems2Size(objc));
     if (listRepPtr == NULL) {
 	return NULL;
     }
-
+    allocSize = TclAllocMaximize(listRepPtr);
+    
     listRepPtr->canonicalFlag = 0;
     listRepPtr->refCount = 0;
-    listRepPtr->maxElemCount = objc;
+    listRepPtr->maxElemCount = (allocSize == UINT_MAX)
+	? objc
+	: Size2Elems(allocSize);
 
     if (objv) {
 	Tcl_Obj **elemPtrs;
@@ -576,7 +589,7 @@ Tcl_ListObjAppendElement(
 
     if (numRequired > listRepPtr->maxElemCount){
 	newMax = 2 * numRequired;
-	newSize = sizeof(List) + ((newMax-1) * sizeof(Tcl_Obj *));
+	newSize = Elems2Size(newMax);
     } else {
 	newMax = listRepPtr->maxElemCount;
 	newSize = 0;
@@ -601,7 +614,10 @@ Tcl_ListObjAppendElement(
 	oldListRepPtr->refCount--;
     } else if (newSize) {
 	listRepPtr = ckrealloc(listRepPtr, newSize);
-	listRepPtr->maxElemCount = newMax;
+	newSize = TclAllocMaximize(listRepPtr);
+	listRepPtr->maxElemCount = (newSize == UINT_MAX)
+	    ? newMax
+	    : Size2Elems(newSize);
     }
     listPtr->internalRep.twoPtrValue.ptr1 = listRepPtr;