More refactoring into common code

1 files changed, 144 insertions, 94 deletions

diff --git a/generic/tclCkalloc.c b/generic/tclCkalloc.c
index 1539f4f..6aabf9f 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
@@ -1194,40 +1195,99 @@ Tcl_DbCkfree(
 }
 
 /*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_InitMemory --
+ *
+ *	Dummy initialization for memory command, which is only available if
+ *	TCL_MEM_DEBUG is on.
+ *
+ *----------------------------------------------------------------------
+ */
+void
+Tcl_InitMemory(
+    TCL_UNUSED(Tcl_Interp *) /*interp*/)
+{
+}
+
+int
+Tcl_DumpActiveMemory(
+    TCL_UNUSED(const char *) /*fileName*/)
+{
+    return TCL_OK;
+}
+
+void
+Tcl_ValidateAllMemory(
+    TCL_UNUSED(const char *) /*file*/,
+    TCL_UNUSED(int) /*line*/)
+{
+}
+
+int
+TclDumpMemoryInfo(
+    TCL_UNUSED(void *),
+    TCL_UNUSED(int) /*flags*/)
+{
+    return 1;
+}
+
+#endif	/* TCL_MEM_DEBUG */
+
+/*
  *------------------------------------------------------------------------
  *
- * TclAttemptOverAlloc --
+ * TclAttemptAllocElemsEx --
  *
- *    Attempts to allocates memory of the requested size plus some more for
- *    future growth.
+ *    Attempts to allocate memory of the requested size plus some more for
+ *    future growth. The amount of allocation 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.
+ *    Pointer to allocated memory block which is at least large enough
+ *    to hold elemCount elements or NULL if allocation failed.
  *
  *------------------------------------------------------------------------
  */
 void *
-TclAttemptOverAlloc(
-	Tcl_Size needed,	/* Requested size */
-	Tcl_Size *allocatedPtr) /* OUTPUT: Actual allocation size is stored
-				   here if non-NULL. Only modified on success */
+TclAttemptAllocElemsEx(
+    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 attempt = TclUpsizeAlloc(0, needed, TCL_SIZE_MAX);
-    while (attempt > needed) {
-	ptr = Tcl_AttemptAlloc(attempt);
-	if (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) {
+	ptr = Tcl_AttemptAlloc(leadSize + attempt*elemSize);
+	if (ptr) {
 	    break;
-	attempt = TclUpsizeRetry(needed, attempt);
+	}
+	attempt = TclUpsizeRetry(elemCount, attempt);
     }
+    /* Try exact size as a last resort */
     if (ptr == NULL) {
-	/* Try exact size as a last resort */
-	attempt = needed;
-	ptr = Tcl_AttemptAlloc(attempt);
+	attempt = elemCount;
+	ptr = Tcl_AttemptAlloc(leadSize + attempt*elemSize);
     }
-    if (ptr && allocatedPtr) {
-	*allocatedPtr = attempt;
+    if (ptr && capacityPtr) {
+	*capacityPtr = attempt;
     }
     return ptr;
 }
@@ -1235,14 +1295,13 @@ TclAttemptOverAlloc(
 /*
  *------------------------------------------------------------------------
  *
- * TclOverAlloc --
+ * TclAllocElemsEx --
  *
- *    Allocates memory of the requested size plus some more for future
- *    growth.
+ *    See TclAttemptAllocElemsEx. This function differs in that it panics
+ *    on failure.
  *
  * Results:
- *    Non-NULL pointer to allocated memory block which is at least as large
- *    as the requested size.
+ *    Non-NULL pointer to allocated memory block.
  *
  * Side effects:
  *    Panics if memory of at least the requested size could not be
@@ -1251,11 +1310,20 @@ TclAttemptOverAlloc(
  *------------------------------------------------------------------------
  */
 void *
-TclOverAlloc(Tcl_Size needed, Tcl_Size *allocatedPtr)
+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 = TclAttemptOverAlloc(needed, allocatedPtr);
+    void *ptr = TclAttemptAllocElemsEx(
+	elemCount, elemSize, leadSize, capacityPtr);
     if (ptr == NULL) {
-	Tcl_Panic("Failed to allocate %" TCL_SIZE_MODIFIER "d bytes.", needed);
+	Tcl_Panic("Failed to allocate %" TCL_SIZE_MODIFIER
+		  "d elements of size %" TCL_SIZE_MODIFIER "d bytes.",
+		  elemCount,
+		  elemSize);
     }
     return ptr;
 }
@@ -1263,10 +1331,11 @@ TclOverAlloc(Tcl_Size needed, Tcl_Size *allocatedPtr)
 /*
  *------------------------------------------------------------------------
  *
- * TclAttemptOverRealloc --
+ * TclAttemptReallocElemsEx --
  *
  *    Attempts to reallocate memory of the requested size plus some more for
- *    future growth.
+ *    future growth. The amount of reallocation is adjusted depending on
+ *    on failure.
  *
  * Results:
  *    Pointer to allocated memory block which is at least as large
@@ -1275,28 +1344,45 @@ TclOverAlloc(Tcl_Size needed, Tcl_Size *allocatedPtr)
  *------------------------------------------------------------------------
  */
 void *
-TclAttemptOverRealloc(
-    Tcl_Size needed,        /* Requested size */
+TclAttemptReallocElemsEx(
     void *oldPtr,	    /* Pointer to memory block to reallocate */
-    Tcl_Size oldSize,       /* Old size if known, or 0 if unknown */
-    Tcl_Size *allocatedPtr) /* OUTPUT: Actual allocation size is stored
+    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 attempt = TclUpsizeAlloc(oldSize, needed, TCL_SIZE_MAX);
-    while (attempt > needed) {
-	ptr = Tcl_AttemptRealloc(oldPtr, attempt);
-	if (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) {
+	ptr = Tcl_AttemptRealloc(oldPtr, leadSize + attempt*elemSize);
+	if (ptr) {
 	    break;
-	attempt = TclUpsizeRetry(needed, attempt);
+	}
+	attempt = TclUpsizeRetry(elemCount, attempt);
     }
+    /* Try exact size as a last resort */
     if (ptr == NULL) {
-	/* Try exact size as a last resort */
-	attempt = needed;
-	ptr = Tcl_AttemptRealloc(oldPtr, attempt);
+	attempt = elemCount;
+	ptr = Tcl_AttemptRealloc(oldPtr, leadSize + attempt*elemSize);
     }
-    if (ptr && allocatedPtr) {
-	*allocatedPtr = attempt;
+    if (ptr && capacityPtr) {
+	*capacityPtr = attempt;
     }
     return ptr;
 }
@@ -1304,14 +1390,13 @@ TclAttemptOverRealloc(
 /*
  *------------------------------------------------------------------------
  *
- * TclOverRealloc --
+ * TclReallocElemsEx --
  *
- *    Reallocates memory of the requested size plus some more for future
- *    growth.
+ *    See TclAttemptReallocElemsEx. This function differs in that it panics
+ *    on failure.
  *
  * Results:
- *    Non-NULL pointer to allocated memory block which is at least as large
- *    as the requested size.
+ *    Non-NULL pointer to allocated memory block.
  *
  * Side effects:
  *    Panics if memory of at least the requested size could not be
@@ -1320,61 +1405,26 @@ TclAttemptOverRealloc(
  *------------------------------------------------------------------------
  */
 void *
-TclOverRealloc(
-    Tcl_Size needed,        /* Requested size */
+TclReallocElemsEx(
     void *oldPtr,	    /* Pointer to memory block to reallocate */
-    Tcl_Size oldSize,       /* Old size if known, or 0 if unknown */
-    Tcl_Size *allocatedPtr) /* OUTPUT: Actual allocation size is stored
+    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 = TclAttemptOverRealloc(needed, oldPtr, oldSize, allocatedPtr);
+    void *ptr = TclAttemptReallocElemsEx(
+	oldPtr, elemCount, elemSize, leadSize, capacityPtr);
     if (ptr == NULL) {
-	Tcl_Panic("Failed to reallocate %" TCL_SIZE_MODIFIER "d bytes.", needed);
+	Tcl_Panic("Failed to reallocate %" TCL_SIZE_MODIFIER
+		  "d elements of size %" TCL_SIZE_MODIFIER "d bytes.",
+		  elemCount,
+		  elemSize);
     }
     return ptr;
 }
 
 /*
- *----------------------------------------------------------------------
- *
- * Tcl_InitMemory --
- *
- *	Dummy initialization for memory command, which is only available if
- *	TCL_MEM_DEBUG is on.
- *
- *----------------------------------------------------------------------
- */
-void
-Tcl_InitMemory(
-    TCL_UNUSED(Tcl_Interp *) /*interp*/)
-{
-}
-
-int
-Tcl_DumpActiveMemory(
-    TCL_UNUSED(const char *) /*fileName*/)
-{
-    return TCL_OK;
-}
-
-void
-Tcl_ValidateAllMemory(
-    TCL_UNUSED(const char *) /*file*/,
-    TCL_UNUSED(int) /*line*/)
-{
-}
-
-int
-TclDumpMemoryInfo(
-    TCL_UNUSED(void *),
-    TCL_UNUSED(int) /*flags*/)
-{
-    return 1;
-}
-
-#endif	/* TCL_MEM_DEBUG */
-
-/*
  *---------------------------------------------------------------------------
  *
  * TclFinalizeMemorySubsystem --