diff options
Diffstat (limited to 'generic')
| -rw-r--r-- | generic/tclBasic.c | 37 | ||||
| -rw-r--r-- | generic/tclCmdIL.c | 46 | ||||
| -rw-r--r-- | generic/tclConfig.c | 34 | ||||
| -rw-r--r-- | generic/tclExecute.c | 9 | ||||
| -rw-r--r-- | generic/tclInt.decls | 17 | ||||
| -rw-r--r-- | generic/tclInt.h | 28 | ||||
| -rw-r--r-- | generic/tclIntDecls.h | 30 | ||||
| -rw-r--r-- | generic/tclListObj.c | 871 | ||||
| -rw-r--r-- | generic/tclStubInit.c | 6 | ||||
| -rw-r--r-- | generic/tclVar.c | 66 |
10 files changed, 508 insertions, 636 deletions
diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 1c497dc..bcb8967 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -13,7 +13,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclBasic.c,v 1.142 2005/03/18 15:50:59 dgp Exp $ + * RCS: @(#) $Id: tclBasic.c,v 1.143 2005/04/02 02:08:29 msofer Exp $ */ #include "tclInt.h" @@ -3754,26 +3754,31 @@ Tcl_EvalObjEx(interp, objPtr, flags) */ 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); diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c index 746d033..1813fe0 100644 --- a/generic/tclCmdIL.c +++ b/generic/tclCmdIL.c @@ -15,7 +15,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclCmdIL.c,v 1.71 2004/12/14 21:11:45 msofer Exp $ + * RCS: @(#) $Id: tclCmdIL.c,v 1.72 2005/04/02 02:08:31 msofer Exp $ */ #include "tclInt.h" @@ -2866,8 +2866,9 @@ Tcl_LrepeatObjCmd(dummy, interp, objc, objv) 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 @@ Tcl_LrepeatObjCmd(dummy, interp, objc, objv) 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 @@ Tcl_LrepeatObjCmd(dummy, interp, objc, objv) 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 @@ Tcl_LrepeatObjCmd(dummy, interp, objc, objv) 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; } diff --git a/generic/tclConfig.c b/generic/tclConfig.c index 4daf92f..4172fdb 100644 --- a/generic/tclConfig.c +++ b/generic/tclConfig.c @@ -9,7 +9,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclConfig.c,v 1.6 2004/10/29 15:39:05 dkf Exp $ + * RCS: @(#) $Id: tclConfig.c,v 1.7 2005/04/02 02:08:32 msofer Exp $ */ #include "tclInt.h" @@ -196,7 +196,7 @@ QueryConfigObjCmd(clientData, interp, objc, objv) 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 @@ QueryConfigObjCmd(clientData, interp, objc, objv) } 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: diff --git a/generic/tclExecute.c b/generic/tclExecute.c index a66f278..395b7ef 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclExecute.c,v 1.176 2005/04/01 19:08:30 msofer Exp $ + * RCS: @(#) $Id: tclExecute.c,v 1.177 2005/04/02 02:08:32 msofer Exp $ */ #include "tclInt.h" @@ -4677,7 +4677,7 @@ TclExecuteByteCode(interp, codePtr) 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; @@ -4739,8 +4739,7 @@ TclExecuteByteCode(interp, codePtr) 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++) { @@ -4749,7 +4748,7 @@ TclExecuteByteCode(interp, codePtr) setEmptyStr = 1; TclNewObj(valuePtr); } else { - valuePtr = listRepPtr->elements[valIndex]; + valuePtr = elements[valIndex]; } varIndex = varListPtr->varIndexes[j]; diff --git a/generic/tclInt.decls b/generic/tclInt.decls index f59d01e..be0618f 100644 --- a/generic/tclInt.decls +++ b/generic/tclInt.decls @@ -12,7 +12,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: tclInt.decls,v 1.85 2004/12/15 20:44:38 msofer Exp $ +# RCS: @(#) $Id: tclInt.decls,v 1.86 2005/04/02 02:08:36 msofer Exp $ library tcl @@ -734,14 +734,15 @@ declare 179 generic { 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 diff --git a/generic/tclInt.h b/generic/tclInt.h index 4521ff4..cb72307 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -12,7 +12,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclInt.h,v 1.218 2005/04/01 16:18:59 msofer Exp $ + * RCS: @(#) $Id: tclInt.h,v 1.219 2005/04/02 02:08:37 msofer Exp $ */ #ifndef _TCLINT @@ -1618,20 +1618,34 @@ typedef enum TclEolTranslation { /* * 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 *---------------------------------------------------------------- diff --git a/generic/tclIntDecls.h b/generic/tclIntDecls.h index 23acb90..5d38426 100644 --- a/generic/tclIntDecls.h +++ b/generic/tclIntDecls.h @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclIntDecls.h,v 1.76 2004/12/15 20:44:39 msofer Exp $ + * RCS: @(#) $Id: tclIntDecls.h,v 1.77 2005/04/02 02:08:56 msofer Exp $ */ #ifndef _TCLINTDECLS @@ -917,18 +917,8 @@ EXTERN void Tcl_SetStartupScript _ANSI_ARGS_((Tcl_Obj * pathPtr, 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 @@ typedef struct TclIntStubs { 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 @@ extern TclIntStubs *tclIntStubsPtr; #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 */ diff --git a/generic/tclListObj.c b/generic/tclListObj.c index 162101c..ddcb062 100644 --- a/generic/tclListObj.c +++ b/generic/tclListObj.c @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclListObj.c,v 1.20 2004/11/11 01:17:51 das Exp $ + * RCS: @(#) $Id: tclListObj.c,v 1.21 2005/04/02 02:08:59 msofer Exp $ */ #include "tclInt.h" @@ -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)); @@ -46,8 +48,78 @@ Tcl_ObjType tclListType = { FreeListInternalRep, /* freeIntRepProc */ DupListInternalRep, /* dupIntRepProc */ UpdateStringOfList, /* updateStringProc */ - SetListFromAny /* setFromAnyProc */ + NULL /* setFromAnyProc */ }; + + +/* + *---------------------------------------------------------------------- + * + * 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 and objv==NULL it creates the list internal rep of a list + * with 0 elements, where enough space has been preallocated to store + * objc elements. + * If objc<=0, it returns NULL. + * + * Results: + * A new List struct is returned. If objc<=0 or if the allocation fails + * for lack of memory, NULL is returned. + * 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) { + return NULL; + } + + /* 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 +165,34 @@ Tcl_NewListObj(objc, objv) 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; + List *listRepPtr; + Tcl_Obj *listPtr; TclNewObj(listPtr); - if (objc > 0) { - Tcl_InvalidateStringRep(listPtr); + if (objc <= 0) { + return 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. + */ + + 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 +237,34 @@ Tcl_DbNewListObj(objc, objv, file, line) int line; /* Line number in the source file; used * for debugging. */ { - register Tcl_Obj *listPtr; - register Tcl_Obj **elemPtrs; - register List *listRepPtr; - int i; + Tcl_Obj *listPtr; + List *listRepPtr; TclDbNewObj(listPtr, file, line); - if (objc > 0) { - Tcl_InvalidateStringRep(listPtr); + if (objc <= 0) { + return 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. + */ + + 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 +286,6 @@ Tcl_DbNewListObj(objc, objv, file, line) /* *---------------------------------------------------------------------- * - * 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 +311,7 @@ Tcl_SetListObj(objPtr, objc, objv) 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 +332,14 @@ Tcl_SetListObj(objPtr, objc, objv) */ 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; @@ -436,14 +389,23 @@ Tcl_ListObjGetElements(interp, listPtr, objcPtr, objvPtr) register List *listRepPtr; if (listPtr->typePtr != &tclListType) { - int result = SetListFromAny(interp, listPtr); + int result, length; + + (void) Tcl_GetStringFromObj(listPtr, &length); + if (!length) { + *objcPtr = 0; + *objvPtr = NULL; + return TCL_OK; + } + + result = SetListFromAny(interp, listPtr); if (result != TCL_OK) { return result; } } listRepPtr = (List *) listPtr->internalRep.twoPtrValue.ptr1; *objcPtr = listRepPtr->elemCount; - *objvPtr = listRepPtr->elements; + *objvPtr = &listRepPtr->elements; return TCL_OK; } @@ -479,21 +441,17 @@ Tcl_ListObjAppendList(interp, listPtr, elemListPtr) 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,40 +501,66 @@ Tcl_ListObjAppendElement(interp, listPtr, objPtr) { 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"); } if (listPtr->typePtr != &tclListType) { - int result = SetListFromAny(interp, listPtr); + int result, length; + + (void) Tcl_GetStringFromObj(listPtr, &length); + if (!length) { + Tcl_SetListObj(listPtr, 1, &objPtr); + return TCL_OK; + } + + result = SetListFromAny(interp, listPtr); if (result != TCL_OK) { return result; } } 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 +568,7 @@ Tcl_ListObjAppendElement(interp, listPtr, objPtr) * pointers. Increment the ref count for the (now shared) objPtr. */ + elemPtrs = &listRepPtr->elements; elemPtrs[numElems] = objPtr; Tcl_IncrRefCount(objPtr); listRepPtr->elemCount++; @@ -633,7 +618,14 @@ Tcl_ListObjIndex(interp, listPtr, index, objPtrPtr) register List *listRepPtr; if (listPtr->typePtr != &tclListType) { - int result = SetListFromAny(interp, listPtr); + int result, length; + + (void) Tcl_GetStringFromObj(listPtr, &length); + if (!length) { + return 0; + } + + result = SetListFromAny(interp, listPtr); if (result != TCL_OK) { return result; } @@ -643,7 +635,7 @@ Tcl_ListObjIndex(interp, listPtr, index, objPtrPtr) if ((index < 0) || (index >= listRepPtr->elemCount)) { *objPtrPtr = NULL; } else { - *objPtrPtr = listRepPtr->elements[index]; + *objPtrPtr = (&listRepPtr->elements)[index]; } return TCL_OK; @@ -680,7 +672,15 @@ Tcl_ListObjLength(interp, listPtr, intPtr) register List *listRepPtr; if (listPtr->typePtr != &tclListType) { - int result = SetListFromAny(interp, listPtr); + int result, length; + + (void) Tcl_GetStringFromObj(listPtr, &length); + if (!length) { + *intPtr = 0; + return TCL_OK; + } + + result = SetListFromAny(interp, listPtr); if (result != TCL_OK) { return result; } @@ -740,22 +740,35 @@ Tcl_ListObjReplace(interp, listPtr, first, count, objc, objv) * 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"); } if (listPtr->typePtr != &tclListType) { - result = SetListFromAny(interp, listPtr); - if (result != TCL_OK) { - return result; + int length; + + (void) Tcl_GetStringFromObj(listPtr, &length); + if (!length) { + if (objc) { + Tcl_SetListObj(listPtr, objc, NULL); + } else { + return TCL_OK; + } + } else { + result = SetListFromAny(interp, listPtr); + if (result != TCL_OK) { + return result; + } } } + listRepPtr = (List *) listPtr->internalRep.twoPtrValue.ptr1; - elemPtrs = listRepPtr->elements; + elemPtrs = &listRepPtr->elements; numElems = listRepPtr->elemCount; if (first < 0) { @@ -766,16 +779,21 @@ Tcl_ListObjReplace(interp, listPtr, first, count, objc, objv) } if (count < 0) { count = 0; + } else if (numElems < first+count) { + count = numElems - first; } + 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 +813,100 @@ Tcl_ListObjReplace(interp, listPtr, first, count, objc, objv) 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++; + + 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. + */ - for (i = 0, j = first; i < count; i++, j++) { - victimPtr = elemPtrs[j]; - TclDecrRefCount(victimPtr); - } + 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]); + } - /* - * Copy the elements after the last one removed, shifted to - * their new locations. - */ + oldListRepPtr->refCount--; + } else { + /* + * The old struct will be removed; use its inherited refCounts. + */ - start = (first + count); - numAfterLast = (numElems - start); - if (numAfterLast > 0) { - memcpy((VOID *) &(newPtrs[first + objc]), - (VOID *) &(elemPtrs[start]), - (size_t) (numAfterLast * sizeof(Tcl_Obj *))); - } + if (first > 0) { + memcpy((VOID *) elemPtrs, (VOID *) oldPtrs, + (size_t) (first * sizeof(Tcl_Obj *))); + } - /* - * Insert the new elements before "first" and update the - * count of elements. - */ + /* + * "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 *))); + } - for (i = 0, j = first; i < objc; i++, j++) { - newPtrs[j] = objv[i]; - Tcl_IncrRefCount(objv[i]); + ckfree((char *) oldListRepPtr); } - - listRepPtr->elemCount = numRequired; - listRepPtr->maxElemCount = newMax; - listRepPtr->elements = newPtrs; - ckfree((char *) elemPtrs); } /* + * 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 +971,11 @@ TclLsetList(interp, listPtr, indexArgPtr, valuePtr) { 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 +1003,39 @@ TclLsetList(interp, listPtr, indexArgPtr, valuePtr) /* * 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. - */ - - if (indexCount == 0) { - Tcl_IncrRefCount(valuePtr); - return valuePtr; - } - - /* - * Duplicate the list arg if necessary. + * 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 (Tcl_IsShared(listPtr)) { - duplicated = 1; - listPtr = Tcl_DuplicateObj(listPtr); - Tcl_IncrRefCount(listPtr); + if (indexCount) { + indexListRepPtr = (List *) indexArgPtr->internalRep.twoPtrValue.ptr1; + indexListRepPtr->refCount++; } else { - duplicated = 0; + indexListRepPtr = NULL; /* avoid compiler warning*/ } + /* - * 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. + * Let TclLsetFlat handle the actual lset'ting. */ - /* - * Anchor the linked list of Tcl_Obj's whose string reps must be - * invalidated if the operation succeeds. - */ - - retValuePtr = listPtr; - chainPtr = NULL; + retValuePtr = TclLsetFlat(interp, listPtr, indexCount, indices, valuePtr); /* - * Handle each index arg by diving into the appropriate sublist + * If we are the only users of indexListRepPtr, we free it before + * returning. */ - - 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; + + if (indexCount) { + if (--indexListRepPtr->refCount <= 0) { + for (i=0; i<indexCount; i++) { + Tcl_DecrRefCount(indices[i]); } + ckfree((char *) indexListRepPtr); } - - /* - * Chain the current sublist onto the linked list of Tcl_Obj's - * whose string reps must be spoilt. - */ - - chainPtr = listPtr; - listPtr = subListPtr; } - - /* - * Store the new element into the correct slot in the innermost sublist. - */ - - 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); - } - return retValuePtr; - } - - /* Clean up the one dangling reference otherwise */ - - if (duplicated) { - Tcl_DecrRefCount(retValuePtr); - } - return NULL; + return retValuePtr; } /* @@ -1200,7 +1106,7 @@ TclLsetFlat(interp, listPtr, indexCount, indexArray, valuePtr) * 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 @@ -1244,6 +1150,12 @@ TclLsetFlat(interp, listPtr, indexCount, indexArray, valuePtr) if (result != TCL_OK) { break; } + if (elemCount == 0) { + Tcl_SetObjResult(interp, + Tcl_NewStringObj("list index out of range", -1)); + result = TCL_ERROR; + break; + } listPtr->internalRep.twoPtrValue.ptr2 = (VOID *) chainPtr; /* @@ -1358,10 +1270,10 @@ TclLsetFlat(interp, listPtr, indexCount, indexArray, valuePtr) * 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,23 +1296,33 @@ TclListObjSetElement(interp, listPtr, index, valuePtr) * 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)) { Tcl_Panic("Tcl_ListObjSetElement called with shared object"); } if (listPtr->typePtr != &tclListType) { + int length; + + (void) Tcl_GetStringFromObj(listPtr, &length); + if (!length) { + Tcl_SetObjResult(interp, + Tcl_NewStringObj("list index out of range", -1)); + return TCL_ERROR; + } result = SetListFromAny(interp, listPtr); if (result != TCL_OK) { return result; } } + 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 +1332,26 @@ TclListObjSetElement(interp, listPtr, index, valuePtr) } } + /* + * 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 +1391,19 @@ FreeListInternalRep(listPtr) 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 +1413,14 @@ FreeListInternalRep(listPtr) * * 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 +1430,10 @@ DupListInternalRep(srcPtr, copyPtr) 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. - */ - - copyElemPtrs = (Tcl_Obj **) - ckalloc((unsigned) maxElems * sizeof(Tcl_Obj *)); - for (i = 0; i < numElems; i++) { - copyElemPtrs[i] = srcElemPtrs[i]; - Tcl_IncrRefCount(copyElemPtrs[i]); - } + List *listRepPtr = (List *) srcPtr->internalRep.twoPtrValue.ptr1; - 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 +1502,14 @@ SetListFromAny(interp, objPtr) * 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 +1520,7 @@ SetListFromAny(interp, objPtr) elemPtr = elemPtrs[j]; Tcl_DecrRefCount(elemPtr); } - ckfree((char *) elemPtrs); + ckfree((char *) listRepPtr); return result; } if (elemStart >= limit) { @@ -1629,10 +1550,7 @@ SetListFromAny(interp, objPtr) 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 +1558,7 @@ SetListFromAny(interp, objPtr) * Tcl_GetStringFromObj, to use that old internalRep. */ + listRepPtr->refCount++; TclFreeIntRep(objPtr); objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) listRepPtr; objPtr->internalRep.twoPtrValue.ptr2 = NULL; @@ -1679,7 +1598,8 @@ UpdateStringOfList(listPtr) 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 +1615,9 @@ UpdateStringOfList(listPtr) 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 +1629,7 @@ UpdateStringOfList(listPtr) 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 = ' '; diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index 29ed7bb..6dfe793 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -8,7 +8,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclStubInit.c,v 1.113 2005/01/27 00:23:27 andreas_kupries Exp $ + * RCS: @(#) $Id: tclStubInit.c,v 1.114 2005/04/02 02:08:59 msofer Exp $ */ #include "tclInt.h" @@ -264,8 +264,8 @@ TclIntStubs tclIntStubs = { TclVarErrMsg, /* 177 */ Tcl_SetStartupScript, /* 178 */ Tcl_GetStartupScript, /* 179 */ - TclNewListObjDirect, /* 180 */ - TclDbNewListObjDirect, /* 181 */ + NULL, /* 180 */ + NULL, /* 181 */ TclpLocaltime, /* 182 */ TclpGmtime, /* 183 */ TclThreadStorageLockInit, /* 184 */ diff --git a/generic/tclVar.c b/generic/tclVar.c index 362449a..dc8162e 100644 --- a/generic/tclVar.c +++ b/generic/tclVar.c @@ -15,7 +15,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclVar.c,v 1.101 2004/12/14 21:11:47 msofer Exp $ + * RCS: @(#) $Id: tclVar.c,v 1.102 2005/04/02 02:09:01 msofer Exp $ */ #include "tclInt.h" @@ -2468,11 +2468,10 @@ Tcl_LappendObjCmd(dummy, interp, objc, objv) 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 @@ Tcl_LappendObjCmd(dummy, interp, objc, objv) 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. |