Index: generic/tclListObj.c ================================================================== --- generic/tclListObj.c +++ generic/tclListObj.c @@ -38,11 +38,11 @@ # endif #endif #ifdef ENABLE_LIST_ASSERTS -#define LIST_ASSERT(cond_) assert(cond_) /* TODO - is there a Tcl-specific one? */ +#define LIST_ASSERT(cond_) assert(cond_) /* * LIST_INDEX_ASSERT is to catch errors with negative indices and counts * being passed AFTER validation. On Tcl9 length types are unsigned hence * the checks against LIST_MAX. On Tcl8 length types are signed hence the * also checks against 0. @@ -67,12 +67,11 @@ #endif /* Checks for when caller should have already converted to internal list type */ #define LIST_ASSERT_TYPE(listObj_) \ - LIST_ASSERT((listObj_)->typePtr == &tclListType.objType); - + LIST_ASSERT(TclHasInternalRep((listObj_), &tclListType.objType)) /* * If ENABLE_LIST_INVARIANTS is enabled (-DENABLE_LIST_INVARIANTS from the * command line), the entire list internal representation is checked for * inconsistencies. This has a non-trivial cost so has to be separately @@ -303,16 +302,16 @@ Tcl_Size length, /* Length of the proposed span */ Tcl_Size usedStorageLength, /* Number of slots currently in used */ Tcl_Size allocatedStorageLength) /* Length of the currently allocation */ { /* - TODO - - heuristics thresholds need to be determined - - currently, information about the sharing (ref count) of existing - storage is not passed. Perhaps it should be. For example if the - existing storage has a "large" ref count, then it might make sense - to do even a small span. + * Possible optimizations for future consideration + * - heuristic LIST_SPAN_THRESHOLD + * - currently, information about the sharing (ref count) of existing + * storage is not passed. Perhaps it should be. For example if the + * existing storage has a "large" ref count, then it might make sense + * to do even a small span. */ if (length < LIST_SPAN_THRESHOLD) { return 0;/* No span for small lists */ } @@ -769,18 +768,20 @@ } return NULL; } if (flags & LISTREP_SPACE_FLAGS) { + /* Caller requests extra space front, back or both */ capacity = ListStoreUpSize(objc); } else { capacity = objc; } storePtr = (ListStore *)Tcl_AttemptAlloc(LIST_SIZE(capacity)); - if (storePtr == NULL && capacity != objc) { - capacity = objc; /* Try allocating exact size */ + while (storePtr == NULL && (capacity > (objc+1))) { + /* Because of loop condition capacity won't overflow */ + capacity = objc + ((capacity - objc) / 2); storePtr = (ListStore *)Tcl_AttemptAlloc(LIST_SIZE(capacity)); } if (storePtr == NULL) { if (flags & LISTREP_PANIC_ON_FAIL) { Tcl_Panic("list creation failed: unable to alloc %" TCL_Z_MODIFIER "u bytes", @@ -825,11 +826,12 @@ /* *------------------------------------------------------------------------ * * ListStoreReallocate -- * - * Reallocates the memory for a ListStore. + * Reallocates the memory for a ListStore allocating extra for + * possible future growth. * * Results: * Pointer to the ListStore which may be the same as storePtr or pointer * to a new block of memory. On reallocation failure, NULL is returned. * @@ -854,11 +856,11 @@ /* * In case above failed keep looping reducing the requested extra space * by half every time. */ while (newStorePtr == NULL && (newCapacity > (numSlots+1))) { - /* Because of loop condition newCapacity can't overflow */ + /* Because of loop condition newCapacity won't overflow */ newCapacity = numSlots + ((newCapacity - numSlots) / 2); newStorePtr = (ListStore *)Tcl_AttemptRealloc(storePtr, LIST_SIZE(newCapacity)); } if (newStorePtr == NULL) { @@ -1958,23 +1960,22 @@ */ int Tcl_ListObjIndex( Tcl_Interp *interp, /* Used to report errors if not NULL. */ Tcl_Obj *listObj, /* List object to index into. */ - Tcl_Size index, /* Index of element to return. */ + Tcl_Size index, /* Index of element to return. */ Tcl_Obj **objPtrPtr) /* The resulting Tcl_Obj* is stored here. */ { Tcl_Obj **elemObjs; Tcl_Size numElems; - /* - * TODO - * Unlike the original list code, this does not optimize for lindex'ing - * an empty string when the internal rep is not already a list. On the - * other hand, this code will be faster for the case where the object - * is currently a dict. Benchmark the two cases. - */ + /* Empty string => empty list. Avoid unnecessary shimmering */ + if (listObj->bytes == &tclEmptyString) { + *objPtrPtr = NULL; + return TCL_OK; + } + if (TclListObjGetElementsM(interp, listObj, &numElems, &elemObjs) != TCL_OK) { return TCL_ERROR; } if (index < 0 || index >= numElems) { @@ -2014,24 +2015,24 @@ Tcl_Interp *interp, /* Used to report errors if not NULL. */ Tcl_Obj *listObj, /* List object whose #elements to return. */ Tcl_Size *lenPtr) /* The resulting length is stored here. */ { ListRep listRep; + + /* Empty string => empty list. Avoid unnecessary shimmering */ + if (listObj->bytes == &tclEmptyString) { + *lenPtr = 0; + return TCL_OK; + } Tcl_Size (*lengthProc)(Tcl_Obj *obj) = ABSTRACTLIST_PROC(listObj, lengthProc); if (lengthProc) { *lenPtr = lengthProc(listObj); return TCL_OK; } - /* - * TODO - * Unlike the original list code, this does not optimize for lindex'ing - * an empty string when the internal rep is not already a list. On the - * other hand, this code will be faster for the case where the object - * is currently a dict. Benchmark the two cases. - */ + if (TclListObjGetRep(interp, listObj, &listRep) != TCL_OK) { return TCL_ERROR; } *lenPtr = ListRepLength(&listRep); return TCL_OK; @@ -2092,16 +2093,16 @@ Tcl_Size numToInsert, /* Number of objects to insert. */ Tcl_Obj *const insertObjs[])/* Tcl objects to insert */ { ListRep listRep; Tcl_Size origListLen; - ptrdiff_t lenChange; - ptrdiff_t leadSegmentLen; - ptrdiff_t tailSegmentLen; + Tcl_Size lenChange; + Tcl_Size leadSegmentLen; + Tcl_Size tailSegmentLen; Tcl_Size numFreeSlots; - ptrdiff_t leadShift; - ptrdiff_t tailShift; + Tcl_Size leadShift; + Tcl_Size tailShift; Tcl_Obj **listObjs; int favor; if (Tcl_IsShared(listObj)) { Tcl_Panic("%s called with shared object", "Tcl_ListObjReplace"); @@ -2108,12 +2109,10 @@ } if (TclListObjGetRep(interp, listObj, &listRep) != TCL_OK) return TCL_ERROR; /* Cannot be converted to a list */ - /* TODO - will need modification if Tcl9 sticks to unsigned indices */ - /* Make limits sane */ origListLen = ListRepLength(&listRep); if (first < 0) { first = 0; } @@ -2258,11 +2257,11 @@ * TODO - we could be smarter about the reallocate. Use of realloc * means all new free space is at the back. Instead, the realloc could * be an explicit alloc and memmove which would let us redistribute * free space. */ - if ((ptrdiff_t)numFreeSlots < lenChange && !ListRepIsShared(&listRep)) { + if (numFreeSlots < lenChange && !ListRepIsShared(&listRep)) { /* T:listrep-1.{1,3,14,18,21},3.{3,10,11,14,27,32,41} */ ListStore *newStorePtr = ListStoreReallocate(listRep.storePtr, origListLen + lenChange); if (newStorePtr == NULL) { return MemoryAllocationError(interp, @@ -2285,11 +2284,11 @@ * (b) There is not enough free space in the unshared passed-in ListStore * (c) The new unshared size is much "smaller" (TODO) than the allocated space * TODO - for unshared case ONLY, consider a "move" based implementation */ if (ListRepIsShared(&listRep) || /* 3a */ - (ptrdiff_t)numFreeSlots < lenChange || /* 3b */ + numFreeSlots < lenChange || /* 3b */ (origListLen + lenChange) < (listRep.storePtr->numAllocated / 4) /* 3c */ ) { ListRep newRep; Tcl_Obj **toObjs; listObjs = &listRep.storePtr->slots[ListRepStart(&listRep)]; @@ -2400,13 +2399,13 @@ * We need to make room for the insertions. Again we have multiple * possibilities. We may be able to get by just shifting one segment * or need to shift both. In the former case, favor shifting the * smaller segment. */ - ptrdiff_t leadSpace = ListRepNumFreeHead(&listRep); - ptrdiff_t tailSpace = ListRepNumFreeTail(&listRep); - ptrdiff_t finalFreeSpace = leadSpace + tailSpace - lenChange; + Tcl_Size leadSpace = ListRepNumFreeHead(&listRep); + Tcl_Size tailSpace = ListRepNumFreeTail(&listRep); + Tcl_Size finalFreeSpace = leadSpace + tailSpace - lenChange; LIST_ASSERT((leadSpace + tailSpace) >= lenChange); if (leadSpace >= lenChange && (leadSegmentLen < tailSegmentLen || tailSpace < lenChange)) { /* Move only lead to the front to make more room */ @@ -2419,11 +2418,11 @@ * entire list is the head anyways. This is an important * optimization for further operations like further asymmetric * insertions. */ if (finalFreeSpace > 1 && (tailSpace == 0 || tailSegmentLen == 0)) { - ptrdiff_t postShiftLeadSpace = leadSpace - lenChange; + Tcl_Size postShiftLeadSpace = leadSpace - lenChange; if (postShiftLeadSpace > (finalFreeSpace/2)) { Tcl_Size extraShift = postShiftLeadSpace - (finalFreeSpace / 2); leadShift -= extraShift; tailShift = -extraShift; /* Move tail to the front as well */ } @@ -2436,11 +2435,11 @@ tailShift = lenChange; /* * See comments above. This is analogous. */ if (finalFreeSpace > 1 && (leadSpace == 0 || leadSegmentLen == 0)) { - ptrdiff_t postShiftTailSpace = tailSpace - lenChange; + Tcl_Size postShiftTailSpace = tailSpace - lenChange; if (postShiftTailSpace > (finalFreeSpace/2)) { /* T:listrep-1.{1,3,14,18,21},3.{2,3,26,27} */ Tcl_Size extraShift = postShiftTailSpace - (finalFreeSpace / 2); tailShift += extraShift; leadShift = extraShift; /* Move head to the back as well */ @@ -2611,11 +2610,11 @@ indexListCopy = TclListObjCopy(NULL, argObj); if (indexListCopy == NULL) { /* * The argument is neither an index nor a well-formed list. * Report the error via TclLindexFlat. - * TODO - This is as original. why not directly return an error? + * TODO - This is as original code. why not directly return an error? */ return TclLindexFlat(interp, listObj, 1, &argObj); } ListObjGetElements(indexListCopy, numIndexObjs, indexObjs); @@ -3555,11 +3554,11 @@ } if (capacity > LIST_MAX) { return NULL; } - ListRepInit(capacity, NULL, 0, &listRep); + ListRepInit(capacity, NULL, LISTREP_PANIC_ON_FAIL, &listRep); ListStore *storePtr = listRep.storePtr; size_t i; for (i = 0; i < length; ++i) { TclNewUIntObj(storePtr->slots[i + leadingSpace], i);