From b13a7c7f7e11cbd428004eef3a32e9f059af3183 Mon Sep 17 00:00:00 2001 From: dgp Date: Wed, 11 May 2011 20:33:14 +0000 Subject: First draft of bug fix. --- generic/tclListObj.c | 38 ++++++++++++++++++++++++++++---------- generic/tclUtil.c | 4 ++-- 2 files changed, 30 insertions(+), 12 deletions(-) diff --git a/generic/tclListObj.c b/generic/tclListObj.c index 506aa54..b623272 100644 --- a/generic/tclListObj.c +++ b/generic/tclListObj.c @@ -13,6 +13,10 @@ #include "tclInt.h" +#ifndef TCL_GROWTH_MIN_ALLOC +#define TCL_GROWTH_MIN_ALLOC 1024 +#endif + /* * Prototypes for functions defined later in this file: */ @@ -482,16 +486,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 @@ -516,10 +517,12 @@ Tcl_ListObjAppendList( 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) { @@ -531,7 +534,7 @@ Tcl_ListObjAppendList( * Delete zero existing elements. */ - return Tcl_ListObjReplace(interp, listPtr, listLen, 0, objc, objv); + return Tcl_ListObjReplace(interp, listPtr, /*listLen*/LIST_MAX, 0, objc, objv); } /* @@ -567,6 +570,9 @@ Tcl_ListObjAppendElement( Tcl_Obj *listPtr, /* List object to append objPtr to. */ Tcl_Obj *objPtr) /* Object to append to listPtr's list. */ { +#if 1 + return Tcl_ListObjReplace(interp, listPtr, LIST_MAX, 0, 1, &objPtr); +#else register List *listRepPtr; register Tcl_Obj **elemPtrs; int numElems, numRequired, newMax, newSize, i; @@ -645,6 +651,7 @@ Tcl_ListObjAppendElement( Tcl_InvalidateStringRep(listPtr); return TCL_OK; +#endif } /* @@ -898,9 +905,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 - listRepPtr->elemCount + + TCL_GROWTH_MIN_ALLOC/sizeof(Tcl_Obj *); + 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; diff --git a/generic/tclUtil.c b/generic/tclUtil.c index f7f4bf4..3b5b527 100644 --- a/generic/tclUtil.c +++ b/generic/tclUtil.c @@ -1786,7 +1786,7 @@ Tcl_ConcatObj( /* * 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 + * LIST_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. @@ -1799,7 +1799,7 @@ Tcl_ConcatObj( TclListObjGetElements(NULL, objPtr, &listc, &listv); if (listc) { if (resPtr) { - Tcl_ListObjReplace(NULL, resPtr, INT_MAX, 0, listc, listv); + Tcl_ListObjReplace(NULL, resPtr, LIST_MAX, 0, listc, listv); } else { resPtr = TclListObjCopy(NULL, objPtr); } -- cgit v0.12 From 3495bd2531b93a17421d6dc087527ef5fa111118 Mon Sep 17 00:00:00 2001 From: dgp Date: Wed, 11 May 2011 20:42:14 +0000 Subject: Oops! --- generic/tclListObj.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/generic/tclListObj.c b/generic/tclListObj.c index b623272..f1daf19 100644 --- a/generic/tclListObj.c +++ b/generic/tclListObj.c @@ -908,7 +908,7 @@ Tcl_ListObjReplace( listRepPtr = AttemptNewList(NULL, newMax, NULL); if (listRepPtr == NULL) { unsigned int limit = LIST_MAX - numRequired; - unsigned int extra = numRequired - listRepPtr->elemCount + unsigned int extra = numRequired - numElems + TCL_GROWTH_MIN_ALLOC/sizeof(Tcl_Obj *); int growth = (int) ((extra > limit) ? limit : extra); -- cgit v0.12 From a720a9f6e21c4c9afd7a4b125478dc9800db11c2 Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 12 May 2011 15:00:02 +0000 Subject: Set the defaults of all growth algorithm parameters based on one master value. --- generic/tclInt.h | 16 +++++++++++++++- generic/tclListObj.c | 11 ++++++----- generic/tclStringObj.c | 19 +++++++++---------- 3 files changed, 30 insertions(+), 16 deletions(-) diff --git a/generic/tclInt.h b/generic/tclInt.h index 8f003be..d010284 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -4097,8 +4097,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 f1daf19..e1c415b 100644 --- a/generic/tclListObj.c +++ b/generic/tclListObj.c @@ -13,10 +13,6 @@ #include "tclInt.h" -#ifndef TCL_GROWTH_MIN_ALLOC -#define TCL_GROWTH_MIN_ALLOC 1024 -#endif - /* * Prototypes for functions defined later in this file: */ @@ -49,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 + /* *---------------------------------------------------------------------- @@ -909,7 +910,7 @@ Tcl_ListObjReplace( if (listRepPtr == NULL) { unsigned int limit = LIST_MAX - numRequired; unsigned int extra = numRequired - numElems - + TCL_GROWTH_MIN_ALLOC/sizeof(Tcl_Obj *); + + TCL_MIN_ELEMENT_GROWTH; int growth = (int) ((extra > limit) ? limit : extra); listRepPtr = AttemptNewList(NULL, numRequired + growth, NULL); 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; -- cgit v0.12