Attachment "listPatch" to
ticket [1158008fff]
added by
msofer
2005-03-07 08:05:59.
Index: generic/tclBasic.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclBasic.c,v
retrieving revision 1.141
diff -u -r1.141 tclBasic.c
--- generic/tclBasic.c 10 Feb 2005 19:08:12 -0000 1.141
+++ generic/tclBasic.c 7 Mar 2005 00:52:04 -0000
@@ -3755,26 +3755,31 @@
*/
if ((objPtr->typePtr == &tclListType) && /* is a list... */
(objPtr->bytes == NULL) /* ...without a string rep */) {
- List *listRepPtr =
- (List *) objPtr->internalRep.twoPtrValue.ptr1;
- int i, objc = listRepPtr->elemCount;
- Tcl_Obj **objv;
+ List *listRepPtr;
/*
- * Copy the list elements here, to avoid a segfault if objPtr
- * loses its List internal rep [Bug 1119369]
+ * Increase the reference count of the List structure, to avoid a
+ * segfault if objPtr loses its List internal rep [Bug 1119369]
*/
- objv = (Tcl_Obj **) TclStackAlloc(interp, objc*sizeof(Tcl_Obj *));
- for (i=0; i < objc; i++) {
- objv[i] = listRepPtr->elements[i];
- Tcl_IncrRefCount(objv[i]);
- }
- result = Tcl_EvalObjv(interp, objc, objv, flags);
- for (i=0; i < objc; i++) {
- TclDecrRefCount(objv[i]);
+ listRepPtr = (List *) objPtr->internalRep.twoPtrValue.ptr1;
+ listRepPtr->refCount++;
+
+ result = Tcl_EvalObjv(interp, listRepPtr->elemCount,
+ &listRepPtr->elements, flags);
+
+ /*
+ * If we are the last users of listRepPtr, free it.
+ */
+
+ if (--listRepPtr->refCount <= 0) {
+ int i, elemCount = listRepPtr->elemCount;
+ Tcl_Obj **elements = &listRepPtr->elements;
+ for (i=0; i<elemCount; i++) {
+ Tcl_DecrRefCount(elements[i]);
+ }
+ ckfree((char *) listRepPtr);
}
- TclStackFree(interp);
} else {
script = Tcl_GetStringFromObj(objPtr, &numSrcBytes);
result = Tcl_EvalEx(interp, script, numSrcBytes, flags);
Index: generic/tclCmdIL.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclCmdIL.c,v
retrieving revision 1.71
diff -u -r1.71 tclCmdIL.c
--- generic/tclCmdIL.c 14 Dec 2004 21:11:45 -0000 1.71
+++ generic/tclCmdIL.c 7 Mar 2005 00:52:06 -0000
@@ -2866,8 +2866,9 @@
register Tcl_Obj *CONST objv[]; /* The argument objects. */
{
int elementCount, i, result;
- Tcl_Obj **dataArray;
-
+ Tcl_Obj *listPtr, **dataArray;
+ List *listRepPtr;
+
/*
* Check arguments for legality:
* lrepeat posInt value ?value ...?
@@ -2896,33 +2897,14 @@
objv += 2;
/*
- * Create workspace array large enough to hold each init value
- * elementCount times. Note that we don't bother with stack
- * allocation for this, as we expect this function to be used
- * mainly when stack allocation would be inappropriate anyway.
- * First check to see if we'd overflow and try to allocate an
- * object larger than our memory allocator allows. Note that this
- * is actually a fairly small value when you're on a serious
- * 64-bit machine, but that requires API changes to fix.
- *
- * We allocate using attemptckalloc() because if we ask for
- * something big but can't get it, we've still got a high chance
- * of having a proper failover strategy. If *that* fails to get
- * memory, Tcl_Panic() will happen just a few lines lower...
+ * Get an empty list object that is allocated large enough to hold each
+ * init value elementCount times.
*/
- if ((unsigned)elementCount > INT_MAX/sizeof(Tcl_Obj *)/objc) {
- Tcl_AppendResult(interp, "overflow of maximum list length", NULL);
- return TCL_ERROR;
- }
-
- dataArray = (Tcl_Obj **)
- attemptckalloc(elementCount * objc * sizeof(Tcl_Obj *));
-
- if (dataArray == NULL) {
- Tcl_AppendResult(interp, "insufficient memory to create list", NULL);
- return TCL_ERROR;
- }
+ listPtr = Tcl_NewListObj(elementCount*objc, NULL);
+ listRepPtr = (List *) listPtr->internalRep.twoPtrValue.ptr1;
+ listRepPtr->elemCount = elementCount*objc;
+ dataArray = &listRepPtr->elements;
/*
* Set the elements. Note that we handle the common degenerate
@@ -2934,6 +2916,7 @@
if (objc == 1) {
register Tcl_Obj *tmpPtr = objv[0];
+ tmpPtr->refCount += elementCount;
for (i=0 ; i<elementCount ; i++) {
dataArray[i] = tmpPtr;
}
@@ -2942,16 +2925,13 @@
for (i=0 ; i<elementCount ; i++) {
for (j=0 ; j<objc ; j++) {
+ Tcl_IncrRefCount(objv[j]);
dataArray[k++] = objv[j];
}
}
}
- /*
- * Build the result list, clean up and return.
- */
-
- Tcl_SetObjResult(interp, TclNewListObjDirect(elementCount*objc,dataArray));
+ Tcl_SetObjResult(interp, listPtr);
return TCL_OK;
}
Index: generic/tclConfig.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclConfig.c,v
retrieving revision 1.6
diff -u -r1.6 tclConfig.c
--- generic/tclConfig.c 29 Oct 2004 15:39:05 -0000 1.6
+++ generic/tclConfig.c 7 Mar 2005 00:52:06 -0000
@@ -196,7 +196,7 @@
struct Tcl_Obj * CONST *objv;
{
Tcl_Obj *pkgName = (Tcl_Obj*) clientData;
- Tcl_Obj *pDB, *pkgDict, *val;
+ Tcl_Obj *pDB, *pkgDict, *val, *listPtr;
Tcl_DictSearch s;
int n, i, res, done, index;
Tcl_Obj *key, **vals;
@@ -248,19 +248,29 @@
}
Tcl_DictObjSize(interp, pkgDict, &n);
- if (n == 0) {
- Tcl_SetObjResult(interp, Tcl_NewListObj(0, NULL));
- return TCL_OK;
+ listPtr = Tcl_NewListObj(n, NULL);
+
+ if (!listPtr) {
+ Tcl_SetObjResult(interp,
+ Tcl_NewStringObj("insufficient memory to create list", -1));
+ return TCL_ERROR;
}
-
- vals = (Tcl_Obj**) ckalloc(n * sizeof(Tcl_Obj*));
-
- for (i=0, Tcl_DictObjFirst(interp, pkgDict, &s, &key, NULL, &done);
- !done; Tcl_DictObjNext(&s, &key, NULL, &done), i++) {
- vals[i] = key;
+
+ if (n) {
+ List *listRepPtr =
+ (List *) listPtr->internalRep.twoPtrValue.ptr1;
+
+ listRepPtr->elemCount = n;
+ vals = &listRepPtr->elements;
+
+ for (i=0, Tcl_DictObjFirst(interp, pkgDict, &s, &key, NULL, &done);
+ !done; Tcl_DictObjNext(&s, &key, NULL, &done), i++) {
+ vals[i] = key;
+ Tcl_IncrRefCount(key);
+ }
}
- Tcl_SetObjResult(interp, TclNewListObjDirect(n, vals));
+ Tcl_SetObjResult(interp, listPtr);
return TCL_OK;
default:
Index: generic/tclExecute.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclExecute.c,v
retrieving revision 1.170
diff -u -r1.170 tclExecute.c
--- generic/tclExecute.c 1 Feb 2005 17:27:27 -0000 1.170
+++ generic/tclExecute.c 7 Mar 2005 00:52:09 -0000
@@ -4635,7 +4635,7 @@
ForeachVarList *varListPtr;
int numLists;
Tcl_Obj *listPtr,*valuePtr, *value2Ptr;
- List *listRepPtr;
+ Tcl_Obj **elements;
Var *iterVarPtr, *listVarPtr;
int iterNum, listTmpIndex, listLen, numVars;
int varIndex, valIndex, continueLoop, j;
@@ -4697,8 +4697,7 @@
listVarPtr = &(compiledLocals[listTmpIndex]);
listPtr = listVarPtr->value.objPtr;
- listRepPtr = (List *) listPtr->internalRep.twoPtrValue.ptr1;
- listLen = listRepPtr->elemCount;
+ TclListObjGetElements(listPtr, listLen, elements);
valIndex = (iterNum * numVars);
for (j = 0; j < numVars; j++) {
@@ -4707,7 +4706,7 @@
setEmptyStr = 1;
TclNewObj(valuePtr);
} else {
- valuePtr = listRepPtr->elements[valIndex];
+ valuePtr = elements[valIndex];
}
varIndex = varListPtr->varIndexes[j];
Index: generic/tclInt.decls
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclInt.decls,v
retrieving revision 1.85
diff -u -r1.85 tclInt.decls
--- generic/tclInt.decls 15 Dec 2004 20:44:38 -0000 1.85
+++ generic/tclInt.decls 7 Mar 2005 00:52:10 -0000
@@ -734,14 +734,15 @@
Tcl_Obj *Tcl_GetStartupScript(CONST char **encodingNamePtr)
}
+# REMOVED
# Allocate lists without copying arrays
-declare 180 generic {
- Tcl_Obj *TclNewListObjDirect(int objc, Tcl_Obj **objv)
-}
-declare 181 generic {
- Tcl_Obj *TclDbNewListObjDirect(int objc, Tcl_Obj **objv,
- CONST char *file, int line)
-}
+# declare 180 generic {
+# Tcl_Obj *TclNewListObjDirect(int objc, Tcl_Obj **objv)
+# }
+#declare 181 generic {
+# Tcl_Obj *TclDbNewListObjDirect(int objc, Tcl_Obj **objv,
+# CONST char *file, int line)
+#}
# TclpGmtime and TclpLocaltime promoted to the generic interface from unix
Index: generic/tclInt.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclInt.h,v
retrieving revision 1.214
diff -u -r1.214 tclInt.h
--- generic/tclInt.h 27 Jan 2005 00:23:26 -0000 1.214
+++ generic/tclInt.h 7 Mar 2005 00:52:13 -0000
@@ -1602,20 +1602,34 @@
/*
* The structure used as the internal representation of Tcl list
- * objects. This is an array of pointers to the element objects. This array
- * is grown (reallocated and copied) as necessary to hold all the list's
- * element pointers. The array might contain more slots than currently used
- * to hold all element pointers. This is done to make append operations
- * faster.
+ * objects. This struct is grown (reallocated and copied) as necessary to hold
+ * all the list's element pointers. The struct might contain more slots than
+ * currently used to hold all element pointers. This is done to make append
+ * operations faster.
*/
typedef struct List {
+ int refCount;
int maxElemCount; /* Total number of element array slots. */
int elemCount; /* Current number of list elements. */
- Tcl_Obj **elements; /* Array of pointers to element objects. */
+ Tcl_Obj *elements; /* First list element; the struct is grown to
+ * accomodate all elements. */
} List;
/*
+ * Macro used to get the elements of a list object - do NOT forget to verify
+ * that it is of list type before using!
+ */
+
+#define TclListObjGetElements(listPtr, objc, objv) \
+ { \
+ List *listRepPtr = \
+ (List *) (listPtr)->internalRep.twoPtrValue.ptr1;\
+ (objc) = listRepPtr->elemCount;\
+ (objv) = &listRepPtr->elements;\
+ }
+
+/*
*----------------------------------------------------------------
* Data structures related to the filesystem internals
*----------------------------------------------------------------
Index: generic/tclIntDecls.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclIntDecls.h,v
retrieving revision 1.76
diff -u -r1.76 tclIntDecls.h
--- generic/tclIntDecls.h 15 Dec 2004 20:44:39 -0000 1.76
+++ generic/tclIntDecls.h 7 Mar 2005 00:52:13 -0000
@@ -917,18 +917,8 @@
EXTERN Tcl_Obj * Tcl_GetStartupScript _ANSI_ARGS_((
CONST char ** encodingNamePtr));
#endif
-#ifndef TclNewListObjDirect_TCL_DECLARED
-#define TclNewListObjDirect_TCL_DECLARED
-/* 180 */
-EXTERN Tcl_Obj * TclNewListObjDirect _ANSI_ARGS_((int objc,
- Tcl_Obj ** objv));
-#endif
-#ifndef TclDbNewListObjDirect_TCL_DECLARED
-#define TclDbNewListObjDirect_TCL_DECLARED
-/* 181 */
-EXTERN Tcl_Obj * TclDbNewListObjDirect _ANSI_ARGS_((int objc,
- Tcl_Obj ** objv, CONST char * file, int line));
-#endif
+/* Slot 180 is reserved */
+/* Slot 181 is reserved */
#ifndef TclpLocaltime_TCL_DECLARED
#define TclpLocaltime_TCL_DECLARED
/* 182 */
@@ -1342,8 +1332,8 @@
void (*tclVarErrMsg) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * part1, CONST char * part2, CONST char * operation, CONST char * reason)); /* 177 */
void (*tcl_SetStartupScript) _ANSI_ARGS_((Tcl_Obj * pathPtr, CONST char* encodingName)); /* 178 */
Tcl_Obj * (*tcl_GetStartupScript) _ANSI_ARGS_((CONST char ** encodingNamePtr)); /* 179 */
- Tcl_Obj * (*tclNewListObjDirect) _ANSI_ARGS_((int objc, Tcl_Obj ** objv)); /* 180 */
- Tcl_Obj * (*tclDbNewListObjDirect) _ANSI_ARGS_((int objc, Tcl_Obj ** objv, CONST char * file, int line)); /* 181 */
+ void *reserved180;
+ void *reserved181;
struct tm * (*tclpLocaltime) _ANSI_ARGS_((CONST time_t * clock)); /* 182 */
struct tm * (*tclpGmtime) _ANSI_ARGS_((CONST time_t * clock)); /* 183 */
void (*tclThreadStorageLockInit) _ANSI_ARGS_((void)); /* 184 */
@@ -1988,14 +1978,8 @@
#define Tcl_GetStartupScript \
(tclIntStubsPtr->tcl_GetStartupScript) /* 179 */
#endif
-#ifndef TclNewListObjDirect
-#define TclNewListObjDirect \
- (tclIntStubsPtr->tclNewListObjDirect) /* 180 */
-#endif
-#ifndef TclDbNewListObjDirect
-#define TclDbNewListObjDirect \
- (tclIntStubsPtr->tclDbNewListObjDirect) /* 181 */
-#endif
+/* Slot 180 is reserved */
+/* Slot 181 is reserved */
#ifndef TclpLocaltime
#define TclpLocaltime \
(tclIntStubsPtr->tclpLocaltime) /* 182 */
Index: generic/tclListObj.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclListObj.c,v
retrieving revision 1.20
diff -u -r1.20 tclListObj.c
--- generic/tclListObj.c 11 Nov 2004 01:17:51 -0000 1.20
+++ generic/tclListObj.c 7 Mar 2005 00:52:14 -0000
@@ -20,6 +20,8 @@
* Prototypes for procedures defined later in this file:
*/
+static List* NewListIntRep _ANSI_ARGS_((int objc,
+ Tcl_Obj *CONST objv[]));
static void DupListInternalRep _ANSI_ARGS_((Tcl_Obj *srcPtr,
Tcl_Obj *copyPtr));
static void FreeListInternalRep _ANSI_ARGS_((Tcl_Obj *listPtr));
@@ -48,6 +50,110 @@
UpdateStringOfList, /* updateStringProc */
SetListFromAny /* setFromAnyProc */
};
+
+/*
+ * We define one empty List struct per thread, so that it can be shared.
+ */
+
+typedef struct ThreadSpecificData {
+ List emptyList;
+} ThreadSpecificData;
+
+static Tcl_ThreadDataKey dataKey;
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * NewListIntRep --
+ *
+ * If objc>0 and objv!=NULL, this procedure creates a list internal rep
+ * with objc elements given in the array objv.
+ * If objc<=0 or objv==NULL, it creates the list internal rep of a list
+ * with 0 elements, where enough space has been preallocated to store
+ * objc elements.
+ *
+ * Results:
+ * A new List struct is returned. If the allocation fails for lack of
+ * memory, NULL is returned.
+ * If objc<=0 a shared empty list is returned; this list is shared within
+ * a thread. Otherwise, the list returned has refCount 0.
+ *
+ * Side effects:
+ * The ref counts of the elements in objv are incremented since the
+ * resulting list now refers to them.
+ *
+ *----------------------------------------------------------------------
+ */
+
+List*
+NewListIntRep(objc, objv)
+ int objc;
+ Tcl_Obj *CONST objv[];
+{
+ Tcl_Obj **elemPtrs;
+ List *listRepPtr;
+ int i;
+
+ if (objc <= 0) {
+#if 0
+ objc = 1;
+ objv = NULL;
+#else
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+
+ if (tsdPtr == NULL) {
+ /* this should probably be a panic(). */
+ Tcl_Panic("failed to get thread specific empty list");
+ }
+ listRepPtr = &tsdPtr->emptyList;
+
+ if (listRepPtr->refCount == 0) {
+ /*
+ * First time through; initialise the empty list. Note that we set
+ * the refCount to 2 to insure that this is never overwritten nor
+ * freed.
+ */
+
+ listRepPtr->refCount = 2;
+ listRepPtr->maxElemCount = 0;
+ listRepPtr->elemCount = 0;
+ }
+ return listRepPtr;
+#endif
+ }
+
+ /* First check to see if we'd overflow and try to allocate an
+ * object larger than our memory allocator allows. Note that this
+ * is actually a fairly small value when you're on a serious
+ * 64-bit machine, but that requires API changes to fix.
+ */
+
+ if (objc > INT_MAX/sizeof(Tcl_Obj *)) {
+ return NULL;
+ }
+
+ listRepPtr = (List *) attemptckalloc(sizeof(List) +
+ ((objc-1) * sizeof(Tcl_Obj *)));
+ if (listRepPtr == NULL) {
+ return NULL;
+ }
+
+ listRepPtr->refCount = 0;
+ listRepPtr->maxElemCount = objc;
+
+ if (objv) {
+ listRepPtr->elemCount = objc;
+ elemPtrs = &listRepPtr->elements;
+ for (i = 0; i < objc; i++) {
+ elemPtrs[i] = objv[i];
+ Tcl_IncrRefCount(elemPtrs[i]);
+ }
+ } else {
+ listRepPtr->elemCount = 0;
+ }
+ return listRepPtr;
+}
/*
*----------------------------------------------------------------------
@@ -93,32 +199,29 @@
int objc; /* Count of objects referenced by objv. */
Tcl_Obj *CONST objv[]; /* An array of pointers to Tcl objects. */
{
- register Tcl_Obj *listPtr;
- register Tcl_Obj **elemPtrs;
- register List *listRepPtr;
- int i;
-
- TclNewObj(listPtr);
+ List *listRepPtr;
+ Tcl_Obj *listPtr;
- if (objc > 0) {
- Tcl_InvalidateStringRep(listPtr);
+ /*
+ * Create the internal rep.
+ */
- elemPtrs = (Tcl_Obj **)
- ckalloc((unsigned) (objc * sizeof(Tcl_Obj *)));
- for (i = 0; i < objc; i++) {
- elemPtrs[i] = objv[i];
- Tcl_IncrRefCount(elemPtrs[i]);
- }
+ listRepPtr = NewListIntRep(objc, objv);
+ if (!listRepPtr) {
+ Tcl_Panic("Not enough memory to create the list\n");
+ }
- listRepPtr = (List *) ckalloc(sizeof(List));
- listRepPtr->maxElemCount = objc;
- listRepPtr->elemCount = objc;
- listRepPtr->elements = elemPtrs;
+ /*
+ * Now create the object.
+ */
+
+ TclNewObj(listPtr);
+ Tcl_InvalidateStringRep(listPtr);
+ listPtr->internalRep.twoPtrValue.ptr1 = (VOID *) listRepPtr;
+ listPtr->internalRep.twoPtrValue.ptr2 = NULL;
+ listPtr->typePtr = &tclListType;
+ listRepPtr->refCount++;
- listPtr->internalRep.twoPtrValue.ptr1 = (VOID *) listRepPtr;
- listPtr->internalRep.twoPtrValue.ptr2 = NULL;
- listPtr->typePtr = &tclListType;
- }
return listPtr;
}
#endif /* if TCL_MEM_DEBUG */
@@ -163,32 +266,29 @@
int line; /* Line number in the source file; used
* for debugging. */
{
- register Tcl_Obj *listPtr;
- register Tcl_Obj **elemPtrs;
- register List *listRepPtr;
- int i;
-
- TclDbNewObj(listPtr, file, line);
+ Tcl_Obj *listPtr;
+ List *listRepPtr;
- if (objc > 0) {
- Tcl_InvalidateStringRep(listPtr);
+ /*
+ * Create the internal rep.
+ */
- elemPtrs = (Tcl_Obj **)
- ckalloc((unsigned) (objc * sizeof(Tcl_Obj *)));
- for (i = 0; i < objc; i++) {
- elemPtrs[i] = objv[i];
- Tcl_IncrRefCount(elemPtrs[i]);
- }
+ listRepPtr = NewListIntRep(objc, objv);
+ if (!listRepPtr) {
+ Tcl_Panic("Not enough memory to create the list\n");
+ }
- listRepPtr = (List *) ckalloc(sizeof(List));
- listRepPtr->maxElemCount = objc;
- listRepPtr->elemCount = objc;
- listRepPtr->elements = elemPtrs;
+ /*
+ * Now create the object.
+ */
+
+ TclDbNewObj(listPtr, file, line);
+ Tcl_InvalidateStringRep(listPtr);
+ listPtr->internalRep.twoPtrValue.ptr1 = (VOID *) listRepPtr;
+ listPtr->internalRep.twoPtrValue.ptr2 = NULL;
+ listPtr->typePtr = &tclListType;
+ listRepPtr->refCount++;
- listPtr->internalRep.twoPtrValue.ptr1 = (VOID *) listRepPtr;
- listPtr->internalRep.twoPtrValue.ptr2 = NULL;
- listPtr->typePtr = &tclListType;
- }
return listPtr;
}
@@ -210,120 +310,6 @@
/*
*----------------------------------------------------------------------
*
- * TclNewListObjDirect, TclDbNewListObjDirect --
- *
- * Version of Tcl_NewListOb/Tcl_DbNewListObj that does not copy
- * the array of Tcl_Objs. It still scans it though to update the
- * reference counts.
- *
- * Results:
- * A new list object is returned that is initialized from the object
- * pointers in objv. If objc is less than or equal to zero, an empty
- * object is returned (and "ownership" of the array of objects is
- * not transferred.) The new object's string representation is left
- * NULL. The resulting new list object has ref count 0.
- *
- * Side effects:
- * The ref counts of the elements in objv are incremented since the
- * resulting list now refers to them.
- *
- *----------------------------------------------------------------------
- */
-
-#ifdef TCL_MEM_DEBUG
-#undef TclNewListObjDirect
-Tcl_Obj *
-TclNewListObjDirect(objc, objv)
- int objc; /* Count of objects referenced by objv. */
- Tcl_Obj **objv; /* An array of pointers to Tcl objects. */
-{
- return TclDbNewListObjDirect(objc, objv, "unknown", 0);
-}
-#else /* !TCL_MEM_DEBUG */
-Tcl_Obj *
-TclNewListObjDirect(objc, objv)
- int objc; /* Count of objects referenced by objv. */
- Tcl_Obj **objv; /* An array of pointers to Tcl objects. */
-{
- register Tcl_Obj *listPtr;
-
- TclNewObj(listPtr);
-
- if (objc > 0) {
- register List *listRepPtr;
- int i;
-
- Tcl_InvalidateStringRep(listPtr);
-
- for (i=0 ; i<objc ; i++) {
- Tcl_IncrRefCount(objv[i]);
- }
-
- listRepPtr = (List *) ckalloc(sizeof(List));
- listRepPtr->maxElemCount = objc;
- listRepPtr->elemCount = objc;
- listRepPtr->elements = objv;
-
- listPtr->internalRep.twoPtrValue.ptr1 = (VOID *) listRepPtr;
- listPtr->internalRep.twoPtrValue.ptr2 = NULL;
- listPtr->typePtr = &tclListType;
- }
- return listPtr;
-}
-#endif /* TCL_MEM_DEBUG */
-
-#ifdef TCL_MEM_DEBUG
-Tcl_Obj *
-TclDbNewListObjDirect(objc, objv, file, line)
- int objc; /* Count of objects referenced by objv. */
- Tcl_Obj **objv; /* An array of pointers to Tcl objects. */
- CONST char *file; /* The name of the source file calling this
- * procedure; used for debugging. */
- int line; /* Line number in the source file; used
- * for debugging. */
-{
- register Tcl_Obj *listPtr;
-
- TclDbNewObj(listPtr, file, line);
-
- if (objc > 0) {
- register List *listRepPtr;
- int i;
-
- Tcl_InvalidateStringRep(listPtr);
-
- for (i=0 ; i<objc ; i++) {
- Tcl_IncrRefCount(objv[i]);
- }
-
- listRepPtr = (List *) ckalloc(sizeof(List));
- listRepPtr->maxElemCount = objc;
- listRepPtr->elemCount = objc;
- listRepPtr->elements = objv;
-
- listPtr->internalRep.twoPtrValue.ptr1 = (VOID *) listRepPtr;
- listPtr->internalRep.twoPtrValue.ptr2 = NULL;
- listPtr->typePtr = &tclListType;
- }
- return listPtr;
-}
-#else /* !TCL_MEM_DEBUG */
-Tcl_Obj *
-TclDbNewListObjDirect(objc, objv, file, line)
- int objc; /* Count of objects referenced by objv. */
- Tcl_Obj **objv; /* An array of pointers to Tcl objects. */
- CONST char *file; /* The name of the source file calling this
- * procedure; used for debugging. */
- int line; /* Line number in the source file; used
- * for debugging. */
-{
- return TclNewListObjDirect(objc, objv);
-}
-#endif /* TCL_MEM_DEBUG */
-
-/*
- *----------------------------------------------------------------------
- *
* Tcl_SetListObj --
*
* Modify an object to be a list containing each of the objc elements
@@ -349,9 +335,7 @@
int objc; /* Count of objects referenced by objv. */
Tcl_Obj *CONST objv[]; /* An array of pointers to Tcl objects. */
{
- register Tcl_Obj **elemPtrs;
- register List *listRepPtr;
- int i;
+ List *listRepPtr;
if (Tcl_IsShared(objPtr)) {
Tcl_Panic("Tcl_SetListObj called with shared object");
@@ -372,21 +356,14 @@
*/
if (objc > 0) {
- elemPtrs = (Tcl_Obj **)
- ckalloc((unsigned) (objc * sizeof(Tcl_Obj *)));
- for (i = 0; i < objc; i++) {
- elemPtrs[i] = objv[i];
- Tcl_IncrRefCount(elemPtrs[i]);
+ listRepPtr = NewListIntRep(objc, objv);
+ if (!listRepPtr) {
+ Tcl_Panic("Cannot allocate enough memory for Tcl_SetListObj");
}
-
- listRepPtr = (List *) ckalloc(sizeof(List));
- listRepPtr->maxElemCount = objc;
- listRepPtr->elemCount = objc;
- listRepPtr->elements = elemPtrs;
-
objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) listRepPtr;
objPtr->internalRep.twoPtrValue.ptr2 = NULL;
objPtr->typePtr = &tclListType;
+ listRepPtr->refCount++;
} else {
objPtr->bytes = tclEmptyStringRep;
objPtr->length = 0;
@@ -443,7 +420,7 @@
}
listRepPtr = (List *) listPtr->internalRep.twoPtrValue.ptr1;
*objcPtr = listRepPtr->elemCount;
- *objvPtr = listRepPtr->elements;
+ *objvPtr = &listRepPtr->elements;
return TCL_OK;
}
@@ -479,21 +456,17 @@
register Tcl_Obj *listPtr; /* List object to append elements to. */
Tcl_Obj *elemListPtr; /* List obj with elements to append. */
{
- register List *listRepPtr;
int listLen, objc, result;
Tcl_Obj **objv;
if (Tcl_IsShared(listPtr)) {
Tcl_Panic("Tcl_ListObjAppendList called with shared object");
}
- if (listPtr->typePtr != &tclListType) {
- result = SetListFromAny(interp, listPtr);
- if (result != TCL_OK) {
- return result;
- }
+
+ result = Tcl_ListObjLength(interp, listPtr, &listLen);
+ if (result != TCL_OK) {
+ return result;
}
- listRepPtr = (List *) listPtr->internalRep.twoPtrValue.ptr1;
- listLen = listRepPtr->elemCount;
result = Tcl_ListObjGetElements(interp, elemListPtr, &objc, &objv);
if (result != TCL_OK) {
@@ -543,7 +516,7 @@
{
register List *listRepPtr;
register Tcl_Obj **elemPtrs;
- int numElems, numRequired;
+ int numElems, numRequired, newMax, newSize, i;
if (Tcl_IsShared(listPtr)) {
Tcl_Panic("Tcl_ListObjAppendElement called with shared object");
@@ -556,27 +529,45 @@
}
listRepPtr = (List *) listPtr->internalRep.twoPtrValue.ptr1;
- elemPtrs = listRepPtr->elements;
numElems = listRepPtr->elemCount;
numRequired = numElems + 1 ;
/*
* If there is no room in the current array of element pointers,
- * allocate a new, larger array and copy the pointers to it.
+ * 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) {
- int newMax = (2 * numRequired);
- Tcl_Obj **newElemPtrs = (Tcl_Obj **)
- ckalloc((unsigned) (newMax * sizeof(Tcl_Obj *)));
-
- memcpy((VOID *) newElemPtrs, (VOID *) elemPtrs,
- (size_t) (numElems * sizeof(Tcl_Obj *)));
+ if (numRequired > listRepPtr->maxElemCount){
+ newMax = (2 * numRequired);
+ newSize = sizeof(List)+((newMax-1)*sizeof(Tcl_Obj*));
+ } else {
+ newMax = listRepPtr->maxElemCount;
+ newSize = 0;
+ }
+ if (listRepPtr->refCount > 1) {
+ List *oldListRepPtr = listRepPtr;
+ Tcl_Obj **oldElems;
+
+ listRepPtr = NewListIntRep(newMax, NULL);
+ if (!listRepPtr) {
+ Tcl_Panic("Not enough memory to allocate list");
+ }
+ oldElems = &oldListRepPtr->elements;
+ elemPtrs = &listRepPtr->elements;
+ for (i=0; i<numElems; i++) {
+ elemPtrs[i] = oldElems[i];
+ Tcl_IncrRefCount(elemPtrs[i]);
+ }
+ listRepPtr->elemCount = numElems;
+ listRepPtr->refCount++;
+ oldListRepPtr->refCount--;
+ listPtr->internalRep.twoPtrValue.ptr1 = (VOID *) listRepPtr;
+ } else if (newSize) {
+ listRepPtr = (List *) ckrealloc((char *)listRepPtr, newSize);
listRepPtr->maxElemCount = newMax;
- listRepPtr->elements = newElemPtrs;
- ckfree((char *) elemPtrs);
- elemPtrs = newElemPtrs;
+ listPtr->internalRep.twoPtrValue.ptr1 = (VOID *) listRepPtr;
}
/*
@@ -584,6 +575,7 @@
* pointers. Increment the ref count for the (now shared) objPtr.
*/
+ elemPtrs = &listRepPtr->elements;
elemPtrs[numElems] = objPtr;
Tcl_IncrRefCount(objPtr);
listRepPtr->elemCount++;
@@ -643,7 +635,7 @@
if ((index < 0) || (index >= listRepPtr->elemCount)) {
*objPtrPtr = NULL;
} else {
- *objPtrPtr = listRepPtr->elements[index];
+ *objPtrPtr = (&listRepPtr->elements)[index];
}
return TCL_OK;
@@ -740,11 +732,12 @@
* to insert. */
{
List *listRepPtr;
- register Tcl_Obj **elemPtrs, **newPtrs;
+ register Tcl_Obj **elemPtrs;
Tcl_Obj *victimPtr;
int numElems, numRequired, numAfterLast;
int start, shift, newMax, i, j, result;
-
+ int isShared;
+
if (Tcl_IsShared(listPtr)) {
Tcl_Panic("Tcl_ListObjReplace called with shared object");
}
@@ -754,8 +747,9 @@
return result;
}
}
+
listRepPtr = (List *) listPtr->internalRep.twoPtrValue.ptr1;
- elemPtrs = listRepPtr->elements;
+ elemPtrs = &listRepPtr->elements;
numElems = listRepPtr->elemCount;
if (first < 0) {
@@ -768,14 +762,17 @@
count = 0;
}
+ isShared = (listRepPtr->refCount > 1);
numRequired = (numElems - count + objc);
- if (numRequired <= listRepPtr->maxElemCount) {
+
+ if ((numRequired <= listRepPtr->maxElemCount)
+ && !isShared) {
/*
- * Enough room in the current array. First "delete" count
+ * Can use the current List struct. First "delete" count
* elements starting at first.
*/
- for (i = 0, j = first; i < count; i++, j++) {
+ for (j = first; j < first + count; j++) {
victimPtr = elemPtrs[j];
TclDecrRefCount(victimPtr);
}
@@ -795,79 +792,100 @@
memmove((VOID*) dst, (VOID*) src,
(size_t) (numAfterLast * sizeof(Tcl_Obj*)));
}
-
- /*
- * Insert the new elements into elemPtrs before "first".
- */
-
- for (i=0,j=first ; i<objc ; i++,j++) {
- elemPtrs[j] = objv[i];
- Tcl_IncrRefCount(objv[i]);
- }
-
- /*
- * Update the count of elements.
- */
-
- listRepPtr->elemCount = numRequired;
} else {
/*
- * Not enough room in the current array. Allocate a larger array and
- * insert elements into it.
+ * Cannot use the current List struct - it is shared, too small,
+ * or both. Allocate a new struct and insert elements into it.
*/
- newMax = (2 * numRequired);
- newPtrs = (Tcl_Obj **)
- ckalloc((unsigned) (newMax * sizeof(Tcl_Obj *)));
-
- /*
- * Copy over the elements before "first".
- */
+ List *oldListRepPtr = listRepPtr;
+ Tcl_Obj **oldPtrs = elemPtrs;
- if (first > 0) {
- memcpy((VOID *) newPtrs, (VOID *) elemPtrs,
- (size_t) (first * sizeof(Tcl_Obj *)));
+ if (numRequired > listRepPtr->maxElemCount){
+ newMax = (2 * numRequired);
+ } else {
+ newMax = listRepPtr->maxElemCount;
+ }
+
+ listRepPtr = NewListIntRep(newMax, NULL);
+ if (!listRepPtr) {
+ Tcl_Panic("Not enough memory to allocate list");
}
- /*
- * "Delete" count elements starting at first.
- */
+ listPtr->internalRep.twoPtrValue.ptr1 = (VOID *) listRepPtr;
+ listRepPtr->refCount++;
- for (i = 0, j = first; i < count; i++, j++) {
- victimPtr = elemPtrs[j];
- TclDecrRefCount(victimPtr);
- }
+ elemPtrs = &listRepPtr->elements;
+
+ if (isShared) {
+ /*
+ * The old struct will remain in place; need new refCounts for the
+ * new List struct references. Copy over only the surviving elements.
+ */
- /*
- * Copy the elements after the last one removed, shifted to
- * their new locations.
- */
+ for (i=0; i < first; i++) {
+ elemPtrs[i] = oldPtrs[i];
+ Tcl_IncrRefCount(elemPtrs[i]);
+ }
+ for (i= first + count, j = first + objc;
+ j < numRequired; i++, j++) {
+ elemPtrs[j] = oldPtrs[i];
+ Tcl_IncrRefCount(elemPtrs[j]);
+ }
- start = (first + count);
- numAfterLast = (numElems - start);
- if (numAfterLast > 0) {
- memcpy((VOID *) &(newPtrs[first + objc]),
- (VOID *) &(elemPtrs[start]),
- (size_t) (numAfterLast * sizeof(Tcl_Obj *)));
- }
+ oldListRepPtr->refCount--;
+ } else {
+ /*
+ * The old struct will be removed; use its inherited refCounts.
+ */
- /*
- * Insert the new elements before "first" and update the
- * count of elements.
- */
+ if (first > 0) {
+ memcpy((VOID *) elemPtrs, (VOID *) oldPtrs,
+ (size_t) (first * sizeof(Tcl_Obj *)));
+ }
- for (i = 0, j = first; i < objc; i++, j++) {
- newPtrs[j] = objv[i];
- Tcl_IncrRefCount(objv[i]);
- }
+ /*
+ * "Delete" count elements starting at first.
+ */
+
+ for (j = first; j < first + count; j++) {
+ victimPtr = oldPtrs[j];
+ TclDecrRefCount(victimPtr);
+ }
+
+ /*
+ * Copy the elements after the last one removed, shifted to
+ * their new locations.
+ */
+
+ start = (first + count);
+ numAfterLast = (numElems - start);
+ if (numAfterLast > 0) {
+ memcpy((VOID *) &(elemPtrs[first + objc]),
+ (VOID *) &(oldPtrs[start]),
+ (size_t) (numAfterLast * sizeof(Tcl_Obj *)));
+ }
- listRepPtr->elemCount = numRequired;
- listRepPtr->maxElemCount = newMax;
- listRepPtr->elements = newPtrs;
- ckfree((char *) elemPtrs);
+ ckfree((char *) oldListRepPtr);
+ }
}
/*
+ * Insert the new elements into elemPtrs before "first".
+ */
+
+ for (i=0,j=first ; i<objc ; i++,j++) {
+ elemPtrs[j] = objv[i];
+ Tcl_IncrRefCount(objv[i]);
+ }
+
+ /*
+ * Update the count of elements.
+ */
+
+ listRepPtr->elemCount = numRequired;
+
+ /*
* Invalidate and free any old string representation since it no longer
* reflects the list's internal representation.
*/
@@ -932,18 +950,11 @@
{
int indexCount; /* Number of indices in the index list */
Tcl_Obj** indices; /* Vector of indices in the index list*/
- int duplicated; /* Flag == 1 if the obj has been
- * duplicated, 0 otherwise */
Tcl_Obj* retValuePtr; /* Pointer to the list to be returned */
int index; /* Current index in the list - discarded */
- int result; /* Status return from library calls */
- Tcl_Obj* subListPtr; /* Pointer to the current sublist */
- int elemCount; /* Count of elements in the current sublist */
- Tcl_Obj** elemPtrs; /* Pointers to elements of current sublist */
- Tcl_Obj* chainPtr; /* Pointer to the enclosing sublist
- * of the current sublist */
int i;
-
+ List *indexListRepPtr;
+
/*
* Determine whether the index arg designates a list or a single
* index. We have to be careful about the order of the checks to
@@ -971,165 +982,32 @@
/*
* At this point, we know that argPtr designates a well formed list,
* and the 'else if' above has parsed it into indexCount and indices.
- * If there are no indices, simply return 'valuePtr', counting the
- * returned pointer as a reference.
+ * Increase the reference count of the internal rep of indexArgPtr,
+ * in order to insure the validity of pointers even if indexArgPtr
+ * shimmers to another type.
*/
- if (indexCount == 0) {
- Tcl_IncrRefCount(valuePtr);
- return valuePtr;
- }
+ indexListRepPtr = (List *) indexArgPtr->internalRep.twoPtrValue.ptr1;
+ indexListRepPtr->refCount++;
/*
- * Duplicate the list arg if necessary.
+ * Let TclLsetFlat handle the actual lset'ting.
*/
- if (Tcl_IsShared(listPtr)) {
- duplicated = 1;
- listPtr = Tcl_DuplicateObj(listPtr);
- Tcl_IncrRefCount(listPtr);
- } else {
- duplicated = 0;
- }
-
- /*
- * It would be tempting simply to go off to TclLsetFlat to finish the
- * processing. Alas, it is also incorrect! The problem is that
- * 'indexArgPtr' may designate a sublist of 'listPtr' whose value
- * is to be manipulated. The fact that 'listPtr' is itself unshared
- * does not guarantee that no sublist is. Therefore, it's necessary
- * to replicate all the work here, expanding the index list on each
- * trip through the loop.
- */
-
- /*
- * Anchor the linked list of Tcl_Obj's whose string reps must be
- * invalidated if the operation succeeds.
- */
-
- retValuePtr = listPtr;
- chainPtr = NULL;
-
- /*
- * Handle each index arg by diving into the appropriate sublist
- */
-
- for (i=0 ; ; i++) {
- /*
- * Take the sublist apart.
- */
-
- result = Tcl_ListObjGetElements(interp, listPtr, &elemCount, &elemPtrs);
- if (result != TCL_OK) {
- break;
- }
- listPtr->internalRep.twoPtrValue.ptr2 = (VOID *) chainPtr;
-
- /*
- * Reconstitute the index array
- */
-
- result = Tcl_ListObjGetElements(interp, indexArgPtr, &indexCount,
- &indices);
- if (result != TCL_OK) {
- /*
- * Shouldn't be able to get here, because we already
- * parsed the thing successfully once.
- */
- break;
- }
-
- /*
- * Determine the index of the requested element.
- */
-
- result = TclGetIntForIndex(interp, indices[i], elemCount-1, &index);
- if (result != TCL_OK) {
- break;
- }
-
- /*
- * Check that the index is in range.
- */
-
- if (index<0 || index>=elemCount) {
- Tcl_SetObjResult(interp,
- Tcl_NewStringObj("list index out of range", -1));
- result = TCL_ERROR;
- break;
- }
-
- /*
- * Break the loop after extracting the innermost sublist
- */
-
- if (i >= indexCount-1) {
- result = TCL_OK;
- break;
- }
-
- /*
- * Extract the appropriate sublist, and make sure that it is unshared.
- */
-
- subListPtr = elemPtrs[index];
- if (Tcl_IsShared(subListPtr)) {
- subListPtr = Tcl_DuplicateObj(subListPtr);
- result = TclListObjSetElement(interp, listPtr, index, subListPtr);
- if (result != TCL_OK) {
- /*
- * We actually shouldn't be able to get here, because
- * we've already checked everything that TclListObjSetElement
- * checks. If we were to get here, it would result in leaking
- * subListPtr.
- */
- break;
- }
- }
-
- /*
- * Chain the current sublist onto the linked list of Tcl_Obj's
- * whose string reps must be spoilt.
- */
-
- chainPtr = listPtr;
- listPtr = subListPtr;
- }
+ retValuePtr = TclLsetFlat(interp, listPtr, indexCount, indices, valuePtr);
/*
- * Store the new element into the correct slot in the innermost sublist.
+ * If we are the only users of indexListRepPtr, we free it before
+ * returning.
*/
-
- if (result == TCL_OK) {
- result = TclListObjSetElement(interp, listPtr, index, valuePtr);
- }
-
- if (result == TCL_OK) {
- listPtr->internalRep.twoPtrValue.ptr2 = (VOID *) chainPtr;
-
- /* Spoil all the string reps */
-
- while (listPtr != NULL) {
- subListPtr = (Tcl_Obj *) listPtr->internalRep.twoPtrValue.ptr2;
- Tcl_InvalidateStringRep(listPtr);
- listPtr->internalRep.twoPtrValue.ptr2 = NULL;
- listPtr = subListPtr;
- }
-
- /* Return the new list if everything worked. */
-
- if (!duplicated) {
- Tcl_IncrRefCount(retValuePtr);
+
+ if (--indexListRepPtr->refCount <= 0) {
+ for (i=0; i<indexCount; i++) {
+ Tcl_DecrRefCount(indices[i]);
}
- return retValuePtr;
- }
-
- /* Clean up the one dangling reference otherwise */
-
- if (duplicated) {
- Tcl_DecrRefCount(retValuePtr);
+ ckfree((char *) indexListRepPtr);
}
- return NULL;
+ return retValuePtr;
}
/*
@@ -1200,7 +1078,7 @@
* the current sublist. */
int result; /* Status return from library calls */
int i;
-
+
/*
* If there are no indices, then simply return the new value,
* counting the returned pointer as a reference
@@ -1358,10 +1236,10 @@
* Side effects:
*
* Tcl_Panic if listPtr designates a shared object. Otherwise,
- * attempts to convert it to a list. Decrements the ref count of
- * the object at the specified index within the list, replaces with
- * the object designated by valuePtr, and increments the ref count
- * of the replacement object.
+ * attempts to convert it to a list with a non-shared internal rep.
+ * Decrements the ref count of the object at the specified index within
+ * the list, replaces with the object designated by valuePtr, and
+ * increments the ref count of the replacement object.
*
* It is the caller's responsibility to invalidate the string
* representation of the object.
@@ -1384,7 +1262,8 @@
* being modified */
Tcl_Obj** elemPtrs; /* Pointers to elements of the list */
int elemCount; /* Number of elements in the list */
-
+ int i;
+
/* Ensure that the listPtr parameter designates an unshared list */
if (Tcl_IsShared(listPtr)) {
@@ -1397,10 +1276,10 @@
}
}
listRepPtr = (List*) listPtr->internalRep.twoPtrValue.ptr1;
- elemPtrs = listRepPtr->elements;
elemCount = listRepPtr->elemCount;
+ elemPtrs = &listRepPtr->elements;
- /* Ensure that the index is in bounds */
+ /* Ensure that the index is in bounds. */
if (index<0 || index>=elemCount) {
if (interp != NULL) {
@@ -1410,6 +1289,26 @@
}
}
+ /*
+ * If the internal rep is shared, replace it with an unshared copy.
+ */
+
+ if (listRepPtr->refCount > 1) {
+ List *oldListRepPtr = listRepPtr;
+ Tcl_Obj **oldElemPtrs = elemPtrs;
+
+ listRepPtr = NewListIntRep(listRepPtr->maxElemCount, NULL);
+ elemPtrs = &listRepPtr->elements;
+ for (i=0; i < elemCount; i++) {
+ elemPtrs[i] = oldElemPtrs[i];
+ Tcl_IncrRefCount(elemPtrs[i]);
+ }
+ listRepPtr->refCount++;
+ listRepPtr->elemCount = elemCount;
+ listPtr->internalRep.twoPtrValue.ptr1 = (VOID *) listRepPtr;
+ oldListRepPtr->refCount--;
+ }
+
/* Add a reference to the new list element */
Tcl_IncrRefCount(valuePtr);
@@ -1449,18 +1348,19 @@
Tcl_Obj *listPtr; /* List object with internal rep to free. */
{
register List *listRepPtr = (List *) listPtr->internalRep.twoPtrValue.ptr1;
- register Tcl_Obj **elemPtrs = listRepPtr->elements;
+ register Tcl_Obj **elemPtrs = &listRepPtr->elements;
register Tcl_Obj *objPtr;
int numElems = listRepPtr->elemCount;
int i;
- for (i = 0; i < numElems; i++) {
- objPtr = elemPtrs[i];
- Tcl_DecrRefCount(objPtr);
+ if (--listRepPtr->refCount <= 0) {
+ for (i = 0; i < numElems; i++) {
+ objPtr = elemPtrs[i];
+ Tcl_DecrRefCount(objPtr);
+ }
+ ckfree((char *) listRepPtr);
}
- ckfree((char *) elemPtrs);
- ckfree((char *) listRepPtr);
-
+
listPtr->internalRep.twoPtrValue.ptr1 = NULL;
listPtr->internalRep.twoPtrValue.ptr2 = NULL;
}
@@ -1470,19 +1370,14 @@
*
* DupListInternalRep --
*
- * Initialize the internal representation of a list Tcl_Obj to a
- * copy of the internal representation of an existing list object.
+ * Initialize the internal representation of a list Tcl_Obj to share
+ * the internal representation of an existing list object.
*
* Results:
* None.
*
* Side effects:
- * "srcPtr"s list internal rep pointer should not be NULL and we assume
- * it is not NULL. We set "copyPtr"s internal rep to a pointer to a
- * newly allocated List structure that, in turn, points to "srcPtr"s
- * element objects. Those element objects are not actually copied but
- * are shared between "srcPtr" and "copyPtr". The ref count of each
- * element object is incremented.
+ * The reference count of the List internal rep is incremented.
*
*----------------------------------------------------------------------
*/
@@ -1492,33 +1387,10 @@
Tcl_Obj *srcPtr; /* Object with internal rep to copy. */
Tcl_Obj *copyPtr; /* Object with internal rep to set. */
{
- List *srcListRepPtr = (List *) srcPtr->internalRep.twoPtrValue.ptr1;
- int numElems = srcListRepPtr->elemCount;
- int maxElems = srcListRepPtr->maxElemCount;
- register Tcl_Obj **srcElemPtrs = srcListRepPtr->elements;
- register Tcl_Obj **copyElemPtrs;
- register List *copyListRepPtr;
- int i;
-
- /*
- * Allocate a new List structure that points to "srcPtr"s element
- * objects. Increment the ref counts for those (now shared) element
- * objects.
- */
+ List *listRepPtr = (List *) srcPtr->internalRep.twoPtrValue.ptr1;
- copyElemPtrs = (Tcl_Obj **)
- ckalloc((unsigned) maxElems * sizeof(Tcl_Obj *));
- for (i = 0; i < numElems; i++) {
- copyElemPtrs[i] = srcElemPtrs[i];
- Tcl_IncrRefCount(copyElemPtrs[i]);
- }
-
- copyListRepPtr = (List *) ckalloc(sizeof(List));
- copyListRepPtr->maxElemCount = maxElems;
- copyListRepPtr->elemCount = numElems;
- copyListRepPtr->elements = copyElemPtrs;
-
- copyPtr->internalRep.twoPtrValue.ptr1 = (VOID *) copyListRepPtr;
+ listRepPtr->refCount++;
+ copyPtr->internalRep.twoPtrValue.ptr1 = (VOID *) listRepPtr;
copyPtr->internalRep.twoPtrValue.ptr2 = NULL;
copyPtr->typePtr = &tclListType;
}
@@ -1587,8 +1459,14 @@
* corresponding "argv" strings.
*/
- elemPtrs = (Tcl_Obj **)
- ckalloc((unsigned) (estCount * sizeof(Tcl_Obj *)));
+ listRepPtr = NewListIntRep(estCount, NULL);
+ if(!listRepPtr) {
+ Tcl_SetObjResult(interp,
+ Tcl_NewStringObj("Not enough memory to allocate the list internal rep",-1));
+ return TCL_ERROR;
+ }
+ elemPtrs = &listRepPtr->elements;
+
for (p = string, lenRemain = length, i = 0;
lenRemain > 0;
p = nextElem, lenRemain = (limit - nextElem), i++) {
@@ -1599,7 +1477,7 @@
elemPtr = elemPtrs[j];
Tcl_DecrRefCount(elemPtr);
}
- ckfree((char *) elemPtrs);
+ ckfree((char *) listRepPtr);
return result;
}
if (elemStart >= limit) {
@@ -1629,10 +1507,7 @@
Tcl_IncrRefCount(elemPtr); /* since list now holds ref to it */
}
- listRepPtr = (List *) ckalloc(sizeof(List));
- listRepPtr->maxElemCount = estCount;
listRepPtr->elemCount = i;
- listRepPtr->elements = elemPtrs;
/*
* Free the old internalRep before setting the new one. We do this as
@@ -1640,6 +1515,7 @@
* Tcl_GetStringFromObj, to use that old internalRep.
*/
+ listRepPtr->refCount++;
TclFreeIntRep(objPtr);
objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) listRepPtr;
objPtr->internalRep.twoPtrValue.ptr2 = NULL;
@@ -1679,7 +1555,8 @@
register int i;
char *elem, *dst;
int length;
-
+ Tcl_Obj **elemPtrs;
+
/*
* Convert each element of the list to string form and then convert it
* to proper list element form, adding it to the result buffer.
@@ -1695,8 +1572,9 @@
flagPtr = (int *) ckalloc((unsigned) numElems*sizeof(int));
}
listPtr->length = 1;
+ elemPtrs = &listRepPtr->elements;
for (i = 0; i < numElems; i++) {
- elem = Tcl_GetStringFromObj(listRepPtr->elements[i], &length);
+ elem = Tcl_GetStringFromObj(elemPtrs[i], &length);
listPtr->length += Tcl_ScanCountedElement(elem, length,
&flagPtr[i]) + 1;
}
@@ -1708,7 +1586,7 @@
listPtr->bytes = ckalloc((unsigned) listPtr->length);
dst = listPtr->bytes;
for (i = 0; i < numElems; i++) {
- elem = Tcl_GetStringFromObj(listRepPtr->elements[i], &length);
+ elem = Tcl_GetStringFromObj(elemPtrs[i], &length);
dst += Tcl_ConvertCountedElement(elem, length, dst,
flagPtr[i] | (i==0 ? 0 : TCL_DONT_QUOTE_HASH));
*dst = ' ';
Index: generic/tclStubInit.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclStubInit.c,v
retrieving revision 1.113
diff -u -r1.113 tclStubInit.c
--- generic/tclStubInit.c 27 Jan 2005 00:23:27 -0000 1.113
+++ generic/tclStubInit.c 7 Mar 2005 00:52:14 -0000
@@ -264,8 +264,8 @@
TclVarErrMsg, /* 177 */
Tcl_SetStartupScript, /* 178 */
Tcl_GetStartupScript, /* 179 */
- TclNewListObjDirect, /* 180 */
- TclDbNewListObjDirect, /* 181 */
+ NULL, /* 180 */
+ NULL, /* 181 */
TclpLocaltime, /* 182 */
TclpGmtime, /* 183 */
TclThreadStorageLockInit, /* 184 */
Index: generic/tclVar.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclVar.c,v
retrieving revision 1.101
diff -u -r1.101 tclVar.c
--- generic/tclVar.c 14 Dec 2004 21:11:47 -0000 1.101
+++ generic/tclVar.c 7 Mar 2005 00:52:16 -0000
@@ -2468,11 +2468,10 @@
Tcl_Obj *CONST objv[]; /* Argument objects. */
{
Tcl_Obj *varValuePtr, *newValuePtr;
- register List *listRepPtr;
- register Tcl_Obj **elemPtrs;
- int numElems, numRequired, createdNewObj, createVar, i, j;
+ int numElems, createdNewObj, createVar;
Var *varPtr, *arrayPtr;
char *part1;
+ int result;
if (objc < 2) {
Tcl_WrongNumArgs(interp, 1, objv, "varName ?value value ...?");
@@ -2549,60 +2548,19 @@
createdNewObj = 1;
}
- /*
- * Convert the variable's old value to a list object if necessary.
- */
-
- if (varValuePtr->typePtr != &tclListType) {
- int result = tclListType.setFromAnyProc(interp, varValuePtr);
- if (result != TCL_OK) {
- if (createdNewObj) {
- Tcl_DecrRefCount(varValuePtr); /* free unneeded obj. */
- }
- return result;
- }
+ result = Tcl_ListObjLength(interp, varValuePtr, &numElems);
+ if (result == TCL_OK) {
+ result = Tcl_ListObjReplace(interp, varValuePtr, numElems, 0,
+ (objc-2), (objv+2));
}
- listRepPtr = (List *) varValuePtr->internalRep.twoPtrValue.ptr1;
- elemPtrs = listRepPtr->elements;
- numElems = listRepPtr->elemCount;
-
- /*
- * If there is no room in the current array of element pointers,
- * allocate a new, larger array and copy the pointers to it.
- */
-
- numRequired = numElems + (objc-2);
- if (numRequired > listRepPtr->maxElemCount) {
- int newMax = (2 * numRequired);
- Tcl_Obj **newElemPtrs = (Tcl_Obj **)
- ckalloc((unsigned) (newMax * sizeof(Tcl_Obj *)));
-
- memcpy((VOID *) newElemPtrs, (VOID *) elemPtrs,
- (size_t) (numElems * sizeof(Tcl_Obj *)));
- listRepPtr->maxElemCount = newMax;
- listRepPtr->elements = newElemPtrs;
- ckfree((char *) elemPtrs);
- elemPtrs = newElemPtrs;
+ if (result != TCL_OK) {
+ if (createdNewObj) {
+ Tcl_DecrRefCount(varValuePtr); /* free unneeded obj. */
+ }
+ return result;
}
/*
- * Insert the new elements at the end of the list.
- */
-
- for (i = 2, j = numElems; i < objc; i++, j++) {
- elemPtrs[j] = objv[i];
- Tcl_IncrRefCount(objv[i]);
- }
- listRepPtr->elemCount = numRequired;
-
- /*
- * Invalidate and free any old string representation since it no
- * longer reflects the list's internal representation.
- */
-
- Tcl_InvalidateStringRep(varValuePtr);
-
- /*
* Now store the list object back into the variable. If there is an
* error setting the new value, decrement its ref count if it
* was new and we didn't create the variable.
