Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Changes In Branch apn-list-realloc Excluding Merge-Ins
This is equivalent to a diff from 6964e7e16a to b9d001ff67
|
2023-05-04
| ||
| 04:48 | Better fallback on list reallocation failure check-in: 66350977dd user: apnadkarni tags: trunk, main | |
|
2023-05-03
| ||
| 07:03 | Merge 9.0 check-in: 17486d3dce user: jan.nijtmans tags: tip-626 | |
|
2023-05-02
| ||
| 17:06 | Merge 8.7 fix [784befb0ba] - tailcall crash check-in: 480bcbe193 user: apnadkarni tags: trunk, main | |
| 15:51 | Merge trunk [6964e7e16a]. check-in: b062288090 user: pooryorick tags: unchained | |
| 13:39 | merge trunk check-in: ea70c42344 user: dgp tags: dgp-refactor | |
| 13:00 | merge trunk check-in: 64412d591d user: dgp tags: novem | |
| 12:47 | Fix issue [b3628609ad73a105], by allowing TclStringCat to assume that each Tcl_Obj.bytes value is co... Closed-Leaf check-in: 2ddc0c3fa9 user: pooryorick tags: pyk-b3628609ad | |
| 11:50 | Fix LISTREP_ASSERT Closed-Leaf check-in: b9d001ff67 user: apnadkarni tags: apn-list-realloc | |
| 11:28 | Merge trunk check-in: 3fd4e0d0b5 user: apnadkarni tags: apn-list-realloc | |
| 08:42 | Fix [bb69c8d17e] compiled string last check-in: 6964e7e16a user: apnadkarni tags: trunk, main | |
|
2023-05-01
| ||
| 15:50 | Add missing "deprecated" constraint check-in: 0723320477 user: jan.nijtmans tags: trunk, main | |
Changes to generic/tclListObj.c.
| ︙ | ︙ | |||
36 37 38 39 40 41 42 | # ifndef NDEBUG # define ENABLE_LIST_ASSERTS /* Always activate list asserts in debug mode */ # endif #endif #ifdef ENABLE_LIST_ASSERTS | | | 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 | # ifndef NDEBUG # define ENABLE_LIST_ASSERTS /* Always activate list asserts in debug mode */ # endif #endif #ifdef ENABLE_LIST_ASSERTS #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. */ #define LIST_INDEX_ASSERT(idxarg_) \ |
| ︙ | ︙ | |||
65 66 67 68 69 70 71 | #define LIST_INDEX_ASSERT(idx_) ((void) 0) #define LIST_COUNT_ASSERT(count_) ((void) 0) #endif /* Checks for when caller should have already converted to internal list type */ #define LIST_ASSERT_TYPE(listObj_) \ | | < | 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 |
#define LIST_INDEX_ASSERT(idx_) ((void) 0)
#define LIST_COUNT_ASSERT(count_) ((void) 0)
#endif
/* Checks for when caller should have already converted to internal list type */
#define LIST_ASSERT_TYPE(listObj_) \
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
* enabled and not part of assertions checking. However, the test suite does
* invoke ListRepValidate directly even without ENABLE_LIST_INVARIANTS.
|
| ︙ | ︙ | |||
301 302 303 304 305 306 307 |
static inline int
ListSpanMerited(
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 */
{
/*
| < > | | | | | | 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 |
static inline int
ListSpanMerited(
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 */
{
/*
* 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 */
}
if (length < (allocatedStorageLength / 2 - allocatedStorageLength / 8)) {
return 0; /* No span if less than 3/8 of allocation */
|
| ︙ | ︙ | |||
767 768 769 770 771 772 773 774 775 776 777 778 779 |
if (flags & LISTREP_PANIC_ON_FAIL) {
Tcl_Panic("max length of a Tcl list exceeded");
}
return NULL;
}
if (flags & LISTREP_SPACE_FLAGS) {
capacity = ListStoreUpSize(objc);
} else {
capacity = objc;
}
storePtr = (ListStore *)Tcl_AttemptAlloc(LIST_SIZE(capacity));
| > | > | | 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 |
if (flags & LISTREP_PANIC_ON_FAIL) {
Tcl_Panic("max length of a Tcl list exceeded");
}
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));
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",
LIST_SIZE(objc));
}
|
| ︙ | ︙ | |||
823 824 825 826 827 828 829 | } /* *------------------------------------------------------------------------ * * ListStoreReallocate -- * | | > | 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 | } /* *------------------------------------------------------------------------ * * ListStoreReallocate -- * * 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. * * * Side effects: |
| ︙ | ︙ | |||
852 853 854 855 856 857 858 |
(ListStore *)Tcl_AttemptRealloc(storePtr, LIST_SIZE(newCapacity));
/*
* In case above failed keep looping reducing the requested extra space
* by half every time.
*/
while (newStorePtr == NULL && (newCapacity > (numSlots+1))) {
| | | 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 |
(ListStore *)Tcl_AttemptRealloc(storePtr, LIST_SIZE(newCapacity));
/*
* 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 won't overflow */
newCapacity = numSlots + ((newCapacity - numSlots) / 2);
newStorePtr =
(ListStore *)Tcl_AttemptRealloc(storePtr, LIST_SIZE(newCapacity));
}
if (newStorePtr == NULL) {
/* Last resort - allcate what was asked */
newCapacity = numSlots;
|
| ︙ | ︙ | |||
1956 1957 1958 1959 1960 1961 1962 |
*
*----------------------------------------------------------------------
*/
int
Tcl_ListObjIndex(
Tcl_Interp *interp, /* Used to report errors if not NULL. */
Tcl_Obj *listObj, /* List object to index into. */
| | > > | | > | < < < < | 1958 1959 1960 1961 1962 1963 1964 1965 1966 1967 1968 1969 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 |
*
*----------------------------------------------------------------------
*/
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_Obj **objPtrPtr) /* The resulting Tcl_Obj* is stored here. */
{
Tcl_Obj **elemObjs;
Tcl_Size numElems;
/* 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) {
*objPtrPtr = NULL;
} else {
|
| ︙ | ︙ | |||
2012 2013 2014 2015 2016 2017 2018 2019 2020 2021 2022 2023 2024 2025 |
int
Tcl_ListObjLength(
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;
Tcl_Size (*lengthProc)(Tcl_Obj *obj) = ABSTRACTLIST_PROC(listObj, lengthProc);
if (lengthProc) {
*lenPtr = lengthProc(listObj);
return TCL_OK;
}
| > > > > > > | < < < < < < | 2013 2014 2015 2016 2017 2018 2019 2020 2021 2022 2023 2024 2025 2026 2027 2028 2029 2030 2031 2032 2033 2034 2035 2036 2037 2038 2039 2040 |
int
Tcl_ListObjLength(
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;
}
if (TclListObjGetRep(interp, listObj, &listRep) != TCL_OK) {
return TCL_ERROR;
}
*lenPtr = ListRepLength(&listRep);
return TCL_OK;
}
|
| ︙ | ︙ | |||
2090 2091 2092 2093 2094 2095 2096 |
Tcl_Size first, /* Index of first element to replace. */
Tcl_Size numToDelete, /* Number of elements to replace. */
Tcl_Size numToInsert, /* Number of objects to insert. */
Tcl_Obj *const insertObjs[])/* Tcl objects to insert */
{
ListRep listRep;
Tcl_Size origListLen;
| | | | | | < < | 2091 2092 2093 2094 2095 2096 2097 2098 2099 2100 2101 2102 2103 2104 2105 2106 2107 2108 2109 2110 2111 2112 2113 2114 2115 2116 2117 2118 2119 2120 |
Tcl_Size first, /* Index of first element to replace. */
Tcl_Size numToDelete, /* Number of elements to replace. */
Tcl_Size numToInsert, /* Number of objects to insert. */
Tcl_Obj *const insertObjs[])/* Tcl objects to insert */
{
ListRep listRep;
Tcl_Size origListLen;
Tcl_Size lenChange;
Tcl_Size leadSegmentLen;
Tcl_Size tailSegmentLen;
Tcl_Size numFreeSlots;
Tcl_Size leadShift;
Tcl_Size tailShift;
Tcl_Obj **listObjs;
int favor;
if (Tcl_IsShared(listObj)) {
Tcl_Panic("%s called with shared object", "Tcl_ListObjReplace");
}
if (TclListObjGetRep(interp, listObj, &listRep) != TCL_OK)
return TCL_ERROR; /* Cannot be converted to a list */
/* Make limits sane */
origListLen = ListRepLength(&listRep);
if (first < 0) {
first = 0;
}
if (first > origListLen) {
first = origListLen; /* So we'll insert after last element. */
|
| ︙ | ︙ | |||
2256 2257 2258 2259 2260 2261 2262 |
* later by not having to go through the ListRepInit and
* ListObjReplaceAndInvalidate below.
* 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.
*/
| | | 2255 2256 2257 2258 2259 2260 2261 2262 2263 2264 2265 2266 2267 2268 2269 |
* later by not having to go through the ListRepInit and
* ListObjReplaceAndInvalidate below.
* 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 (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,
LIST_SIZE(origListLen + lenChange));
}
|
| ︙ | ︙ | |||
2283 2284 2285 2286 2287 2288 2289 |
* Case (3) a new ListStore is required
* (a) The passed-in ListStore is shared
* (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 */
| | | 2282 2283 2284 2285 2286 2287 2288 2289 2290 2291 2292 2293 2294 2295 2296 |
* Case (3) a new ListStore is required
* (a) The passed-in ListStore is shared
* (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 */
numFreeSlots < lenChange || /* 3b */
(origListLen + lenChange) < (listRep.storePtr->numAllocated / 4) /* 3c */
) {
ListRep newRep;
Tcl_Obj **toObjs;
listObjs = &listRep.storePtr->slots[ListRepStart(&listRep)];
ListRepInit(origListLen + lenChange,
NULL,
|
| ︙ | ︙ | |||
2398 2399 2400 2401 2402 2403 2404 | /* * 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. */ | | | | | | | 2397 2398 2399 2400 2401 2402 2403 2404 2405 2406 2407 2408 2409 2410 2411 2412 2413 2414 2415 2416 2417 2418 2419 2420 2421 2422 2423 2424 2425 2426 2427 2428 2429 2430 2431 2432 2433 2434 2435 2436 2437 2438 2439 2440 2441 2442 2443 2444 2445 2446 2447 |
/*
* 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.
*/
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 */
/* T:listrep-3.25,36,38, */
leadShift = -lenChange;
tailShift = 0;
/*
* Redistribute the remaining free space between the front and
* back if either there is no tail space left or if the
* 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)) {
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 */
}
} /* else T:listrep-3.{7,12,25,38} */
LIST_ASSERT(leadShift >= 0 || leadSpace >= -leadShift);
} else if (tailSpace >= lenChange) {
/* Move only tail segment to the back to make more room. */
/* T:listrep-3.{8,10,11,14,26,27,30,32,37,39,41} */
leadShift = 0;
tailShift = lenChange;
/*
* See comments above. This is analogous.
*/
if (finalFreeSpace > 1 && (leadSpace == 0 || leadSegmentLen == 0)) {
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 */
}
}
|
| ︙ | ︙ | |||
2609 2610 2611 2612 2613 2614 2615 |
*/
indexListCopy = TclListObjCopy(NULL, argObj);
if (indexListCopy == NULL) {
/*
* The argument is neither an index nor a well-formed list.
* Report the error via TclLindexFlat.
| | | 2608 2609 2610 2611 2612 2613 2614 2615 2616 2617 2618 2619 2620 2621 2622 |
*/
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 code. why not directly return an error?
*/
return TclLindexFlat(interp, listObj, 1, &argObj);
}
ListObjGetElements(indexListCopy, numIndexObjs, indexObjs);
listObj = TclLindexFlat(interp, listObj, numIndexObjs, indexObjs);
Tcl_DecrRefCount(indexListCopy);
|
| ︙ | ︙ | |||
3553 3554 3555 3556 3557 3558 3559 |
if (capacity == 0) {
return listObj;
}
if (capacity > LIST_MAX) {
return NULL;
}
| | | 3552 3553 3554 3555 3556 3557 3558 3559 3560 3561 3562 3563 3564 3565 3566 |
if (capacity == 0) {
return listObj;
}
if (capacity > LIST_MAX) {
return NULL;
}
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);
Tcl_IncrRefCount(storePtr->slots[i + leadingSpace]);
}
|
| ︙ | ︙ |