summaryrefslogtreecommitdiffstats
path: root/generic/tclListObj.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclListObj.c')
-rw-r--r--generic/tclListObj.c178
1 files changed, 109 insertions, 69 deletions
diff --git a/generic/tclListObj.c b/generic/tclListObj.c
index e1c415b..ac87628 100644
--- a/generic/tclListObj.c
+++ b/generic/tclListObj.c
@@ -101,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;
}
@@ -168,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);
}
@@ -511,31 +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*/LIST_MAX, 0, objc, objv);
+ return Tcl_ListObjReplace(interp, listPtr, LIST_MAX, 0, objc, objv);
}
/*
@@ -571,12 +564,8 @@ 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;
+ register List *listRepPtr, *newPtr = NULL;
+ int numElems, numRequired, needGrow, isShared, attempt;
if (Tcl_IsShared(listPtr)) {
Tcl_Panic("%s called with shared object", "Tcl_ListObjAppendElement");
@@ -597,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;
@@ -640,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++;
@@ -652,7 +689,6 @@ Tcl_ListObjAppendElement(
Tcl_InvalidateStringRep(listPtr);
return TCL_OK;
-#endif
}
/*
@@ -1563,7 +1599,6 @@ TclListObjSetElement(
listRepPtr = ListRepPtr(listPtr);
elemCount = listRepPtr->elemCount;
- elemPtrs = &listRepPtr->elements;
/*
* Ensure that the index is in bounds.
@@ -1584,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.