summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
authordgp <dgp@users.sourceforge.net>2011-05-31 20:36:31 (GMT)
committerdgp <dgp@users.sourceforge.net>2011-05-31 20:36:31 (GMT)
commit9d5b29a8051a1ca0b93a8fcdb7058920dad2a883 (patch)
treed04f46f284569671adefc78cfe80a141947431be /generic
parentba5939ea3bf47fc00db9172391b3d68e24539921 (diff)
parentcd7e1651b17ee97ef7188b3771fb7d8291a9449a (diff)
downloadtcl-9d5b29a8051a1ca0b93a8fcdb7058920dad2a883.zip
tcl-9d5b29a8051a1ca0b93a8fcdb7058920dad2a883.tar.gz
tcl-9d5b29a8051a1ca0b93a8fcdb7058920dad2a883.tar.bz2
Fix bug 3293874
Diffstat (limited to 'generic')
-rw-r--r--generic/tclInt.h18
-rw-r--r--generic/tclListObj.c203
-rw-r--r--generic/tclStringObj.c19
-rw-r--r--generic/tclUtil.c23
4 files changed, 161 insertions, 102 deletions
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 8f003be..cde46ac 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -2443,6 +2443,8 @@ typedef struct List {
#define LIST_MAX \
(1 + (int)(((size_t)UINT_MAX - sizeof(List))/sizeof(Tcl_Obj *)))
+#define LIST_SIZE(numElems) \
+ (unsigned)(sizeof(List) + (((numElems) - 1) * sizeof(Tcl_Obj *)))
/*
* Macro used to get the elements of a list object.
@@ -4097,8 +4099,22 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr, const char *file,
*----------------------------------------------------------------
*/
+/* General tuning for minimum growth in Tcl growth algorithms */
+#ifndef TCL_MIN_GROWTH
+# ifdef TCL_GROWTH_MIN_ALLOC
+ /* Support for any legacy tuners */
+# define TCL_MIN_GROWTH TCL_GROWTH_MIN_ALLOC
+# else
+# define TCL_MIN_GROWTH 1024
+# endif
+#endif
+
+/* Token growth tuning, default to the general value. */
+#ifndef TCL_MIN_TOKEN_GROWTH
+#define TCL_MIN_TOKEN_GROWTH TCL_MIN_GROWTH/sizeof(Tcl_Token)
+#endif
+
#define TCL_MAX_TOKENS (int)(UINT_MAX / sizeof(Tcl_Token))
-#define TCL_MIN_TOKEN_GROWTH 50
#define TclGrowTokenArray(tokenPtr, used, available, append, staticPtr) \
do { \
int needed = (used) + (append); \
diff --git a/generic/tclListObj.c b/generic/tclListObj.c
index 506aa54..ac87628 100644
--- a/generic/tclListObj.c
+++ b/generic/tclListObj.c
@@ -45,6 +45,11 @@ const Tcl_ObjType tclListType = {
UpdateStringOfList, /* updateStringProc */
SetListFromAny /* setFromAnyProc */
};
+
+#ifndef TCL_MIN_ELEMENT_GROWTH
+#define TCL_MIN_ELEMENT_GROWTH TCL_MIN_GROWTH/sizeof(Tcl_Obj *)
+#endif
+
/*
*----------------------------------------------------------------------
@@ -96,11 +101,11 @@ NewListIntRep(
return NULL;
}
- listRepPtr = attemptckalloc(sizeof(List) + ((objc-1) * sizeof(Tcl_Obj*)));
+ listRepPtr = attemptckalloc(LIST_SIZE(objc));
if (listRepPtr == NULL) {
if (p) {
Tcl_Panic("list creation failed: unable to alloc %u bytes",
- (unsigned)(sizeof(List) + ((objc-1) * sizeof(Tcl_Obj *))));
+ LIST_SIZE(objc));
}
return NULL;
}
@@ -163,7 +168,7 @@ AttemptNewList(
} else {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"list creation failed: unable to alloc %u bytes",
- (unsigned)(sizeof(List) + ((objc-1) * sizeof(Tcl_Obj *)))));
+ LIST_SIZE(objc)));
}
Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
}
@@ -482,16 +487,13 @@ Tcl_ListObjGetElements(
*
* Tcl_ListObjAppendList --
*
- * This function appends the objects in the list referenced by
- * elemListPtr to the list object referenced by listPtr. If listPtr is
- * not already a list object, an attempt will be made to convert it to
- * one.
+ * This function appends the elements in the list value referenced by
+ * elemListPtr to the list value referenced by listPtr.
*
* Results:
* The return value is normally TCL_OK. If listPtr or elemListPtr do not
- * refer to list objects and they can not be converted to one, TCL_ERROR
- * is returned and an error message is left in the interpreter's result
- * if interp is not NULL.
+ * refer to list values, TCL_ERROR is returned and an error message is
+ * left in the interpreter's result if interp is not NULL.
*
* Side effects:
* The reference counts of the elements in elemListPtr are incremented
@@ -509,29 +511,24 @@ Tcl_ListObjAppendList(
register Tcl_Obj *listPtr, /* List object to append elements to. */
Tcl_Obj *elemListPtr) /* List obj with elements to append. */
{
- int listLen, objc, result;
+ int objc;
Tcl_Obj **objv;
if (Tcl_IsShared(listPtr)) {
Tcl_Panic("%s called with shared object", "Tcl_ListObjAppendList");
}
- result = TclListObjLength(interp, listPtr, &listLen);
- if (result != TCL_OK) {
- return result;
- }
-
- result = TclListObjGetElements(interp, elemListPtr, &objc, &objv);
- if (result != TCL_OK) {
- return result;
+ /* Pull the elements to append from elemListPtr */
+ if (TCL_OK != TclListObjGetElements(interp, elemListPtr, &objc, &objv)) {
+ return TCL_ERROR;
}
/*
- * Insert objc new elements starting after the lists's last element.
+ * Insert the new elements starting after the lists's last element.
* Delete zero existing elements.
*/
- return Tcl_ListObjReplace(interp, listPtr, listLen, 0, objc, objv);
+ return Tcl_ListObjReplace(interp, listPtr, LIST_MAX, 0, objc, objv);
}
/*
@@ -567,9 +564,8 @@ Tcl_ListObjAppendElement(
Tcl_Obj *listPtr, /* List object to append objPtr to. */
Tcl_Obj *objPtr) /* Object to append to listPtr's list. */
{
- register List *listRepPtr;
- register Tcl_Obj **elemPtrs;
- int numElems, numRequired, newMax, newSize, i;
+ register List *listRepPtr, *newPtr = NULL;
+ int numElems, numRequired, needGrow, isShared, attempt;
if (Tcl_IsShared(listPtr)) {
Tcl_Panic("%s called with shared object", "Tcl_ListObjAppendElement");
@@ -590,41 +586,90 @@ Tcl_ListObjAppendElement(
listRepPtr = ListRepPtr(listPtr);
numElems = listRepPtr->elemCount;
numRequired = numElems + 1 ;
+ needGrow = (numRequired > listRepPtr->maxElemCount);
+ isShared = (listRepPtr->refCount > 1);
- /*
- * If there is no room in the current array of element pointers, allocate
- * a new, larger array and copy the pointers to it. If the List struct is
- * shared, allocate a new one.
- */
-
- if (numRequired > listRepPtr->maxElemCount){
- newMax = 2 * numRequired;
- newSize = sizeof(List) + ((newMax-1) * sizeof(Tcl_Obj *));
- } else {
- newMax = listRepPtr->maxElemCount;
- newSize = 0;
+ if (numRequired > LIST_MAX) {
+ if (interp != NULL) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "max length of a Tcl list (%d elements) exceeded",
+ LIST_MAX));
+ Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
+ }
+ return TCL_ERROR;
}
- if (listRepPtr->refCount > 1) {
- List *oldListRepPtr = listRepPtr;
- Tcl_Obj **oldElems;
+ if (needGrow && !isShared) {
+ /* Need to grow + unshared intrep => try to realloc */
+ attempt = 2 * numRequired;
+ if (attempt <= LIST_MAX) {
+ newPtr = attemptckrealloc(listRepPtr, LIST_SIZE(attempt));
+ }
+ if (newPtr == NULL) {
+ attempt = numRequired + 1 + TCL_MIN_ELEMENT_GROWTH;
+ if (attempt > LIST_MAX) {
+ attempt = LIST_MAX;
+ }
+ newPtr = attemptckrealloc(listRepPtr, LIST_SIZE(attempt));
+ }
+ if (newPtr == NULL) {
+ attempt = numRequired;
+ newPtr = attemptckrealloc(listRepPtr, LIST_SIZE(attempt));
+ }
+ if (newPtr) {
+ listRepPtr = newPtr;
+ listRepPtr->maxElemCount = attempt;
+ needGrow = 0;
+ }
+ }
+ if (isShared || needGrow) {
+ Tcl_Obj **dst, **src = &listRepPtr->elements;
- listRepPtr = AttemptNewList(interp, newMax, NULL);
- if (listRepPtr == NULL) {
+ /*
+ * Either we have a shared intrep and we must copy to write,
+ * or we need to grow and realloc attempts failed.
+ * Attempt intrep copy.
+ */
+ attempt = 2 * numRequired;
+ newPtr = AttemptNewList(NULL, attempt, NULL);
+ if (newPtr == NULL) {
+ attempt = numRequired + 1 + TCL_MIN_ELEMENT_GROWTH;
+ if (attempt > LIST_MAX) {
+ attempt = LIST_MAX;
+ }
+ newPtr = AttemptNewList(NULL, attempt, NULL);
+ }
+ if (newPtr == NULL) {
+ attempt = numRequired;
+ newPtr = AttemptNewList(interp, attempt, NULL);
+ }
+ if (newPtr == NULL) {
+ /* All growth attempts failed; throw the error */
return TCL_ERROR;
}
- oldElems = &oldListRepPtr->elements;
- elemPtrs = &listRepPtr->elements;
- for (i=0; i<numElems; i++) {
- elemPtrs[i] = oldElems[i];
- Tcl_IncrRefCount(elemPtrs[i]);
+
+ dst = &newPtr->elements;
+ newPtr->refCount++;
+ newPtr->canonicalFlag = listRepPtr->canonicalFlag;
+ newPtr->elemCount = listRepPtr->elemCount;
+
+ if (isShared) {
+ /*
+ * The original intrep must remain undisturbed.
+ * Copy into the new one and bump refcounts
+ */
+ while (numElems--) {
+ *dst = *src++;
+ Tcl_IncrRefCount(*dst++);
+ }
+ listRepPtr->refCount--;
+ } else {
+ /* Old intrep to be freed, re-use refCounts */
+ memcpy(dst, src, (size_t) numElems * sizeof(Tcl_Obj *));
+
+ ckfree(listRepPtr);
}
- listRepPtr->elemCount = numElems;
- listRepPtr->refCount++;
- oldListRepPtr->refCount--;
- } else if (newSize) {
- listRepPtr = ckrealloc(listRepPtr, newSize);
- listRepPtr->maxElemCount = newMax;
+ listRepPtr = newPtr;
}
listPtr->internalRep.twoPtrValue.ptr1 = listRepPtr;
@@ -633,8 +678,7 @@ Tcl_ListObjAppendElement(
* the ref count for the (now shared) objPtr.
*/
- elemPtrs = &listRepPtr->elements;
- elemPtrs[numElems] = objPtr;
+ *(&listRepPtr->elements + listRepPtr->elemCount) = objPtr;
Tcl_IncrRefCount(objPtr);
listRepPtr->elemCount++;
@@ -898,9 +942,20 @@ Tcl_ListObjReplace(
newMax = listRepPtr->maxElemCount;
}
- listRepPtr = AttemptNewList(interp, newMax, NULL);
+ listRepPtr = AttemptNewList(NULL, newMax, NULL);
if (listRepPtr == NULL) {
- return TCL_ERROR;
+ unsigned int limit = LIST_MAX - numRequired;
+ unsigned int extra = numRequired - numElems
+ + TCL_MIN_ELEMENT_GROWTH;
+ int growth = (int) ((extra > limit) ? limit : extra);
+
+ listRepPtr = AttemptNewList(NULL, numRequired + growth, NULL);
+ if (listRepPtr == NULL) {
+ listRepPtr = AttemptNewList(interp, numRequired, NULL);
+ if (listRepPtr == NULL) {
+ return TCL_ERROR;
+ }
+ }
}
listPtr->internalRep.twoPtrValue.ptr1 = listRepPtr;
@@ -1544,7 +1599,6 @@ TclListObjSetElement(
listRepPtr = ListRepPtr(listPtr);
elemCount = listRepPtr->elemCount;
- elemPtrs = &listRepPtr->elements;
/*
* Ensure that the index is in bounds.
@@ -1565,25 +1619,30 @@ TclListObjSetElement(
*/
if (listRepPtr->refCount > 1) {
- List *oldListRepPtr = listRepPtr;
- Tcl_Obj **oldElemPtrs = elemPtrs;
- int i;
+ Tcl_Obj **dst, **src = &listRepPtr->elements;
+ List *newPtr = AttemptNewList(NULL, listRepPtr->maxElemCount, NULL);
- listRepPtr = AttemptNewList(interp, listRepPtr->maxElemCount, NULL);
- if (listRepPtr == NULL) {
- return TCL_ERROR;
+ if (newPtr == NULL) {
+ newPtr = AttemptNewList(interp, elemCount, NULL);
+ if (newPtr == NULL) {
+ return TCL_ERROR;
+ }
}
- listRepPtr->canonicalFlag = oldListRepPtr->canonicalFlag;
- elemPtrs = &listRepPtr->elements;
- for (i=0; i < elemCount; i++) {
- elemPtrs[i] = oldElemPtrs[i];
- Tcl_IncrRefCount(elemPtrs[i]);
+ newPtr->refCount++;
+ newPtr->elemCount = elemCount;
+ newPtr->canonicalFlag = listRepPtr->canonicalFlag;
+
+ dst = &newPtr->elements;
+ while (elemCount--) {
+ *dst = *src++;
+ Tcl_IncrRefCount(*dst++);
}
- listRepPtr->refCount++;
- listRepPtr->elemCount = elemCount;
- listPtr->internalRep.twoPtrValue.ptr1 = listRepPtr;
- oldListRepPtr->refCount--;
+
+ listRepPtr->refCount--;
+
+ listPtr->internalRep.twoPtrValue.ptr1 = listRepPtr = newPtr;
}
+ elemPtrs = &listRepPtr->elements;
/*
* Add a reference to the new list element.
diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c
index 0f6eff7..ab62359 100644
--- a/generic/tclStringObj.c
+++ b/generic/tclStringObj.c
@@ -152,8 +152,7 @@ typedef struct String {
*
* Attempt to allocate 2 * (originalLength + appendLength)
* On failure:
- * attempt to allocate originalLength + 2*appendLength +
- * TCL_GROWTH_MIN_ALLOC
+ * attempt to allocate originalLength + 2*appendLength + TCL_MIN_GROWTH
*
* This algorithm allows very good performance, as it rapidly increases the
* memory allocated for a given string, which minimizes the number of
@@ -166,20 +165,20 @@ typedef struct String {
* cover the request, but which hopefully will be less than the total
* available memory.
*
- * The addition of TCL_GROWTH_MIN_ALLOC allows for efficient handling of very
+ * The addition of TCL_MIN_GROWTH allows for efficient handling of very
* small appends. Without this extra slush factor, a sequence of several small
* appends would cause several memory allocations. As long as
- * TCL_GROWTH_MIN_ALLOC is a reasonable size, we can avoid that behavior.
+ * TCL_MIN_GROWTH is a reasonable size, we can avoid that behavior.
*
* The growth algorithm can be tuned by adjusting the following parameters:
*
- * TCL_GROWTH_MIN_ALLOC Additional space, in bytes, to allocate when
+ * TCL_MIN_GROWTH Additional space, in bytes, to allocate when
* the double allocation has failed. Default is
- * 1024 (1 kilobyte).
+ * 1024 (1 kilobyte). See tclInt.h.
*/
-#ifndef TCL_GROWTH_MIN_ALLOC
-#define TCL_GROWTH_MIN_ALLOC 1024
+#ifndef TCL_MIN_UNICHAR_GROWTH
+#define TCL_MIN_UNICHAR_GROWTH TCL_MIN_GROWTH/sizeof(Tcl_UniChar)
#endif
static void
@@ -214,7 +213,7 @@ GrowStringBuffer(
*/
unsigned int limit = INT_MAX - needed;
- unsigned int extra = needed - objPtr->length + TCL_GROWTH_MIN_ALLOC;
+ unsigned int extra = needed - objPtr->length + TCL_MIN_GROWTH;
int growth = (int) ((extra > limit) ? limit : extra);
attempt = needed + growth;
@@ -265,7 +264,7 @@ GrowUnicodeBuffer(
unsigned int limit = STRING_MAXCHARS - needed;
unsigned int extra = needed - stringPtr->numChars
- + TCL_GROWTH_MIN_ALLOC/sizeof(Tcl_UniChar);
+ + TCL_MIN_UNICHAR_GROWTH;
int growth = (int) ((extra > limit) ? limit : extra);
attempt = needed + growth;
diff --git a/generic/tclUtil.c b/generic/tclUtil.c
index f7f4bf4..ce66096 100644
--- a/generic/tclUtil.c
+++ b/generic/tclUtil.c
@@ -1778,31 +1778,16 @@ Tcl_ConcatObj(
}
}
if (i == objc) {
- Tcl_Obj **listv;
- int listc;
-
resPtr = NULL;
for (i = 0; i < objc; i++) {
- /*
- * Tcl_ListObjAppendList could be used here, but this saves us a
- * bit of type checking (since we've already done it). Use of
- * INT_MAX tells us to always put the new stuff on the end. It
- * will be set right in Tcl_ListObjReplace.
- * Note that all objs at this point are either lists or have an
- * empty string rep.
- */
-
objPtr = objv[i];
if (objPtr->bytes && objPtr->length == 0) {
continue;
}
- TclListObjGetElements(NULL, objPtr, &listc, &listv);
- if (listc) {
- if (resPtr) {
- Tcl_ListObjReplace(NULL, resPtr, INT_MAX, 0, listc, listv);
- } else {
- resPtr = TclListObjCopy(NULL, objPtr);
- }
+ if (resPtr) {
+ Tcl_ListObjAppendList(NULL, resPtr, objPtr);
+ } else {
+ resPtr = TclListObjCopy(NULL, objPtr);
}
}
if (!resPtr) {