diff options
Diffstat (limited to 'generic')
| -rw-r--r-- | generic/tclInt.h | 18 | ||||
| -rw-r--r-- | generic/tclListObj.c | 203 | ||||
| -rw-r--r-- | generic/tclStringObj.c | 19 | ||||
| -rw-r--r-- | generic/tclUtil.c | 23 |
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) { |