summaryrefslogtreecommitdiffstats
path: root/generic/tclListObj.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclListObj.c')
-rw-r--r--generic/tclListObj.c2152
1 files changed, 1190 insertions, 962 deletions
diff --git a/generic/tclListObj.c b/generic/tclListObj.c
index fffe6a2..17aa256 100644
--- a/generic/tclListObj.c
+++ b/generic/tclListObj.c
@@ -1,70 +1,193 @@
-/*
+/*
* tclListObj.c --
*
- * This file contains procedures that implement the Tcl list object
- * type.
+ * This file contains functions that implement the Tcl list object type.
*
* Copyright (c) 1995-1997 Sun Microsystems, Inc.
* Copyright (c) 1998 by Scriptics Corporation.
* Copyright (c) 2001 by Kevin B. Kenny. All rights reserved.
*
- * See the file "license.terms" for information on usage and redistribution
- * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
#include "tclInt.h"
/*
- * Prototypes for procedures defined later in this file:
+ * Prototypes for functions defined later in this file:
*/
-static void DupListInternalRep _ANSI_ARGS_((Tcl_Obj *srcPtr,
- Tcl_Obj *copyPtr));
-static void FreeListInternalRep _ANSI_ARGS_((Tcl_Obj *listPtr));
-static int SetListFromAny _ANSI_ARGS_((Tcl_Interp *interp,
- Tcl_Obj *objPtr));
-static void UpdateStringOfList _ANSI_ARGS_((Tcl_Obj *listPtr));
+static List * AttemptNewList(Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]);
+static List * NewListIntRep(int objc, Tcl_Obj *CONST objv[], int p);
+static void DupListInternalRep(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr);
+static void FreeListInternalRep(Tcl_Obj *listPtr);
+static int SetListFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
+static void UpdateStringOfList(Tcl_Obj *listPtr);
/*
- * The structure below defines the list Tcl object type by means of
- * procedures that can be invoked by generic object code.
+ * The structure below defines the list Tcl object type by means of functions
+ * that can be invoked by generic object code.
*
* The internal representation of a list object is a two-pointer
- * representation. The first pointer designates a List structure that
- * contains an array of pointers to the element objects, together with
- * integers that represent the current element count and the allocated
- * size of the array. The second pointer is normally NULL; during
- * execution of functions in this file that operate on nested sublists,
- * it is occasionally used as working storage to avoid an auxiliary
- * stack.
+ * representation. The first pointer designates a List structure that contains
+ * an array of pointers to the element objects, together with integers that
+ * represent the current element count and the allocated size of the array.
+ * The second pointer is normally NULL; during execution of functions in this
+ * file that operate on nested sublists, it is occasionally used as working
+ * storage to avoid an auxiliary stack.
*/
Tcl_ObjType tclListType = {
- "list", /* name */
- FreeListInternalRep, /* freeIntRepProc */
- DupListInternalRep, /* dupIntRepProc */
- UpdateStringOfList, /* updateStringProc */
- SetListFromAny /* setFromAnyProc */
+ "list", /* name */
+ FreeListInternalRep, /* freeIntRepProc */
+ DupListInternalRep, /* dupIntRepProc */
+ UpdateStringOfList, /* updateStringProc */
+ SetListFromAny /* setFromAnyProc */
};
/*
*----------------------------------------------------------------------
*
+ * NewListIntRep --
+ *
+ * Creates a list internal rep with space for objc elements. objc
+ * must be > 0. If objv!=NULL, initializes with the first objc values
+ * in that array. If objv==NULL, initalize list internal rep to have
+ * 0 elements, with space to add objc more. Flag value "p" indicates
+ * how to behave on failure.
+ *
+ * Results:
+ * A new List struct with refCount 0 is returned. If some failure
+ * prevents this then if p=0, NULL is returned and otherwise the
+ * routine panics.
+ *
+ * Side effects:
+ * The ref counts of the elements in objv are incremented since the
+ * resulting list now refers to them.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static List *
+NewListIntRep(
+ int objc,
+ Tcl_Obj *CONST objv[],
+ int p)
+{
+ List *listRepPtr;
+
+ if (objc <= 0) {
+ Tcl_Panic("NewListIntRep: expects postive element count");
+ }
+
+ /*
+ * 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. See [Bug 219196] for a discussion.
+ */
+
+ if ((size_t)objc > LIST_MAX) {
+ if (p) {
+ Tcl_Panic("max length of a Tcl list (%d elements) exceeded",
+ LIST_MAX);
+ }
+ return NULL;
+ }
+
+ listRepPtr = (List *)
+ attemptckalloc(sizeof(List) + ((objc-1) * sizeof(Tcl_Obj *)));
+ if (listRepPtr == NULL) {
+ if (p) {
+ Tcl_Panic("list creation failed: unable to alloc %u bytes",
+ (unsigned)(sizeof(List) + ((objc-1) * sizeof(Tcl_Obj *))));
+ }
+ return NULL;
+ }
+
+ listRepPtr->canonicalFlag = 0;
+ listRepPtr->refCount = 0;
+ listRepPtr->maxElemCount = objc;
+
+ if (objv) {
+ Tcl_Obj **elemPtrs;
+ int i;
+
+ 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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * AttemptNewList --
+ *
+ * Creates a list internal rep with space for objc elements. objc
+ * must be > 0. If objv!=NULL, initializes with the first objc values
+ * in that array. If objv==NULL, initalize list internal rep to have
+ * 0 elements, with space to add objc more.
+ *
+ * Results:
+ * A new List struct with refCount 0 is returned. If some failure
+ * prevents this then NULL is returned, and an error message is left
+ * in the interp result, unless interp is NULL.
+ *
+ * Side effects:
+ * The ref counts of the elements in objv are incremented since the
+ * resulting list now refers to them.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static List *
+AttemptNewList(
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *CONST objv[])
+{
+ List *listRepPtr = NewListIntRep(objc, objv, 0);
+
+ if (interp != NULL && listRepPtr == NULL) {
+ if (objc > LIST_MAX) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "max length of a Tcl list (%d elements) exceeded",
+ LIST_MAX));
+ } else {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "list creation failed: unable to alloc %u bytes",
+ (unsigned)(sizeof(List) + ((objc-1) * sizeof(Tcl_Obj *)))));
+ }
+ }
+ return listRepPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* Tcl_NewListObj --
*
- * This procedure is normally called when not debugging: i.e., when
+ * This function is normally called when not debugging: i.e., when
* TCL_MEM_DEBUG is not defined. It creates a new list object from an
* (objc,objv) array: that is, each of the objc elements of the array
* referenced by objv is inserted as an element into a new Tcl object.
*
- * When TCL_MEM_DEBUG is defined, this procedure just returns the
- * result of calling the debugging version Tcl_DbNewListObj.
+ * When TCL_MEM_DEBUG is defined, this function just returns the result
+ * of calling the debugging version Tcl_DbNewListObj.
*
* 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. The new object's string representation
- * is left NULL. The resulting new list object has ref count 0.
+ * object is returned. 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
@@ -77,9 +200,9 @@ Tcl_ObjType tclListType = {
#undef Tcl_NewListObj
Tcl_Obj *
-Tcl_NewListObj(objc, objv)
- int objc; /* Count of objects referenced by objv. */
- Tcl_Obj *CONST objv[]; /* An array of pointers to Tcl objects. */
+Tcl_NewListObj(
+ int objc, /* Count of objects referenced by objv. */
+ Tcl_Obj *CONST objv[]) /* An array of pointers to Tcl objects. */
{
return Tcl_DbNewListObj(objc, objv, "unknown", 0);
}
@@ -87,36 +210,31 @@ Tcl_NewListObj(objc, objv)
#else /* if not TCL_MEM_DEBUG */
Tcl_Obj *
-Tcl_NewListObj(objc, objv)
- int objc; /* Count of objects referenced by objv. */
- Tcl_Obj *CONST objv[]; /* An array of pointers to Tcl objects. */
+Tcl_NewListObj(
+ 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);
-
- elemPtrs = (Tcl_Obj **)
- ckalloc((unsigned) (objc * sizeof(Tcl_Obj *)));
- for (i = 0; i < objc; i++) {
- elemPtrs[i] = objv[i];
- Tcl_IncrRefCount(elemPtrs[i]);
- }
-
- listRepPtr = (List *) ckalloc(sizeof(List));
- listRepPtr->maxElemCount = objc;
- listRepPtr->elemCount = objc;
- listRepPtr->elements = elemPtrs;
-
- listPtr->internalRep.twoPtrValue.ptr1 = (VOID *) listRepPtr;
- listPtr->internalRep.twoPtrValue.ptr2 = NULL;
- listPtr->typePtr = &tclListType;
+
+ if (objc <= 0) {
+ return listPtr;
}
+
+ /*
+ * Create the internal rep.
+ */
+
+ listRepPtr = NewListIntRep(objc, objv, 1);
+
+ /*
+ * Now create the object.
+ */
+
+ Tcl_InvalidateStringRep(listPtr);
+ ListSetIntRep(listPtr, listRepPtr);
return listPtr;
}
#endif /* if TCL_MEM_DEBUG */
@@ -126,22 +244,22 @@ Tcl_NewListObj(objc, objv)
*
* Tcl_DbNewListObj --
*
- * This procedure is normally called when debugging: i.e., when
- * TCL_MEM_DEBUG is defined. It creates new list objects. It is the
- * same as the Tcl_NewListObj procedure above except that it calls
+ * This function is normally called when debugging: i.e., when
+ * TCL_MEM_DEBUG is defined. It creates new list objects. It is the same
+ * as the Tcl_NewListObj function above except that it calls
* Tcl_DbCkalloc directly with the file name and line number from its
* caller. This simplifies debugging since then the [memory active]
- * command will report the correct file name and line number when
+ * command will report the correct file name and line number when
* reporting objects that haven't been freed.
*
- * When TCL_MEM_DEBUG is not defined, this procedure just returns the
+ * When TCL_MEM_DEBUG is not defined, this function just returns the
* result of calling Tcl_NewListObj.
*
* 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. The new object's string representation
- * is left NULL. The new list object has ref count 0.
+ * object is returned. The new object's string representation is left
+ * NULL. The new list object has ref count 0.
*
* Side effects:
* The ref counts of the elements in objv are incremented since the
@@ -153,53 +271,49 @@ Tcl_NewListObj(objc, objv)
#ifdef TCL_MEM_DEBUG
Tcl_Obj *
-Tcl_DbNewListObj(objc, objv, file, line)
- int objc; /* Count of objects referenced by objv. */
- Tcl_Obj *CONST 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. */
+Tcl_DbNewListObj(
+ int objc, /* Count of objects referenced by objv. */
+ Tcl_Obj *CONST objv[], /* An array of pointers to Tcl objects. */
+ CONST char *file, /* The name of the source file calling this
+ * function; used for debugging. */
+ 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);
-
- elemPtrs = (Tcl_Obj **)
- ckalloc((unsigned) (objc * sizeof(Tcl_Obj *)));
- for (i = 0; i < objc; i++) {
- elemPtrs[i] = objv[i];
- Tcl_IncrRefCount(elemPtrs[i]);
- }
-
- listRepPtr = (List *) ckalloc(sizeof(List));
- listRepPtr->maxElemCount = objc;
- listRepPtr->elemCount = objc;
- listRepPtr->elements = elemPtrs;
-
- listPtr->internalRep.twoPtrValue.ptr1 = (VOID *) listRepPtr;
- listPtr->internalRep.twoPtrValue.ptr2 = NULL;
- listPtr->typePtr = &tclListType;
+
+ if (objc <= 0) {
+ return listPtr;
}
+
+ /*
+ * Create the internal rep.
+ */
+
+ listRepPtr = NewListIntRep(objc, objv, 1);
+
+ /*
+ * Now create the object.
+ */
+
+ Tcl_InvalidateStringRep(listPtr);
+ ListSetIntRep(listPtr, listRepPtr);
+
return listPtr;
}
#else /* if not TCL_MEM_DEBUG */
Tcl_Obj *
-Tcl_DbNewListObj(objc, objv, file, line)
- int objc; /* Count of objects referenced by objv. */
- Tcl_Obj *CONST 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. */
+Tcl_DbNewListObj(
+ int objc, /* Count of objects referenced by objv. */
+ Tcl_Obj *CONST objv[], /* An array of pointers to Tcl objects. */
+ CONST char *file, /* The name of the source file calling this
+ * function; used for debugging. */
+ int line) /* Line number in the source file; used for
+ * debugging. */
{
return Tcl_NewListObj(objc, objv);
}
@@ -210,8 +324,8 @@ Tcl_DbNewListObj(objc, objv, file, line)
*
* Tcl_SetListObj --
*
- * Modify an object to be a list containing each of the objc elements
- * of the object array referenced by objv.
+ * Modify an object to be a list containing each of the objc elements of
+ * the object array referenced by objv.
*
* Results:
* None.
@@ -219,61 +333,43 @@ Tcl_DbNewListObj(objc, objv, file, line)
* Side effects:
* The object is made a list object and is initialized from the object
* pointers in objv. If objc is less than or equal to zero, an empty
- * object is returned. The new object's string representation
- * is left NULL. The ref counts of the elements in objv are incremented
- * since the list now refers to them. The object's old string and
- * internal representations are freed and its type is set NULL.
+ * object is returned. The new object's string representation is left
+ * NULL. The ref counts of the elements in objv are incremented since the
+ * list now refers to them. The object's old string and internal
+ * representations are freed and its type is set NULL.
*
*----------------------------------------------------------------------
*/
void
-Tcl_SetListObj(objPtr, objc, objv)
- Tcl_Obj *objPtr; /* Object whose internal rep to init. */
- int objc; /* Count of objects referenced by objv. */
- Tcl_Obj *CONST objv[]; /* An array of pointers to Tcl objects. */
+Tcl_SetListObj(
+ Tcl_Obj *objPtr, /* Object whose internal rep to init. */
+ 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;
- Tcl_ObjType *oldTypePtr = objPtr->typePtr;
- int i;
+ List *listRepPtr;
if (Tcl_IsShared(objPtr)) {
- panic("Tcl_SetListObj called with shared object");
+ Tcl_Panic("%s called with shared object", "Tcl_SetListObj");
}
-
+
/*
* Free any old string rep and any internal rep for the old type.
*/
- if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) {
- oldTypePtr->freeIntRepProc(objPtr);
- }
+ TclFreeIntRep(objPtr);
objPtr->typePtr = NULL;
Tcl_InvalidateStringRep(objPtr);
-
+
/*
* Set the object's type to "list" and initialize the internal rep.
- * However, if there are no elements to put in the list, just give
- * the object an empty string rep and a NULL type.
+ * However, if there are no elements to put in the list, just give the
+ * object an empty string rep and a NULL type.
*/
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 = (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 = NewListIntRep(objc, objv, 1);
+ ListSetIntRep(objPtr, listRepPtr);
} else {
objPtr->bytes = tclEmptyStringRep;
objPtr->length = 0;
@@ -283,25 +379,66 @@ Tcl_SetListObj(objPtr, objc, objv)
/*
*----------------------------------------------------------------------
*
+ * TclListObjCopy --
+ *
+ * Makes a "pure list" copy of a list value. This provides for the C
+ * level a counterpart of the [lrange $list 0 end] command, while using
+ * internals details to be as efficient as possible.
+ *
+ * Results:
+ * Normally returns a pointer to a new Tcl_Obj, that contains the same
+ * list value as *listPtr does. The returned Tcl_Obj has a refCount of
+ * zero. If *listPtr does not hold a list, NULL is returned, and if
+ * interp is non-NULL, an error message is recorded there.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+TclListObjCopy(
+ Tcl_Interp *interp, /* Used to report errors if not NULL. */
+ Tcl_Obj *listPtr) /* List object for which an element array is
+ * to be returned. */
+{
+ Tcl_Obj *copyPtr;
+
+ if (listPtr->typePtr != &tclListType) {
+ if (SetListFromAny(interp, listPtr) != TCL_OK) {
+ return NULL;
+ }
+ }
+
+ TclNewObj(copyPtr);
+ TclInvalidateStringRep(copyPtr);
+ DupListInternalRep(listPtr, copyPtr);
+ return copyPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* Tcl_ListObjGetElements --
*
- * This procedure returns an (objc,objv) array of the elements in a
- * list object.
+ * This function returns an (objc,objv) array of the elements in a list
+ * object.
*
* Results:
* The return value is normally TCL_OK; in this case *objcPtr is set to
* the count of list elements and *objvPtr is set to a pointer to an
- * array of (*objcPtr) pointers to each list element. If listPtr does
- * not refer to a list object and the object can not be converted to
- * one, TCL_ERROR is returned and an error message will be left in
- * the interpreter's result if interp is not NULL.
+ * array of (*objcPtr) pointers to each list element. If listPtr does not
+ * refer to a list object and the object can not be converted to one,
+ * TCL_ERROR is returned and an error message will be left in the
+ * interpreter's result if interp is not NULL.
*
* The objects referenced by the returned array should be treated as
* readonly and their ref counts are _not_ incremented; the caller must
- * do that if it holds on to a reference. Furthermore, the pointer
- * and length returned by this procedure may change as soon as any
- * procedure is called on the list object; be careful about retaining
- * the pointer in a local data structure.
+ * do that if it holds on to a reference. Furthermore, the pointer and
+ * length returned by this function may change as soon as any function is
+ * called on the list object; be careful about retaining the pointer in a
+ * local data structure.
*
* Side effects:
* The possible conversion of the object referenced by listPtr
@@ -311,26 +448,33 @@ Tcl_SetListObj(objPtr, objc, objv)
*/
int
-Tcl_ListObjGetElements(interp, listPtr, objcPtr, objvPtr)
- Tcl_Interp *interp; /* Used to report errors if not NULL. */
- register Tcl_Obj *listPtr; /* List object for which an element array
- * is to be returned. */
- int *objcPtr; /* Where to store the count of objects
+Tcl_ListObjGetElements(
+ Tcl_Interp *interp, /* Used to report errors if not NULL. */
+ register Tcl_Obj *listPtr, /* List object for which an element array is
+ * to be returned. */
+ int *objcPtr, /* Where to store the count of objects
* referenced by objv. */
- Tcl_Obj ***objvPtr; /* Where to store the pointer to an array
- * of pointers to the list's objects. */
+ Tcl_Obj ***objvPtr) /* Where to store the pointer to an array of
+ * pointers to the list's objects. */
{
register List *listRepPtr;
if (listPtr->typePtr != &tclListType) {
- int result = SetListFromAny(interp, listPtr);
+ int result;
+
+ if (listPtr->bytes == tclEmptyStringRep) {
+ *objcPtr = 0;
+ *objvPtr = NULL;
+ return TCL_OK;
+ }
+ result = SetListFromAny(interp, listPtr);
if (result != TCL_OK) {
return result;
}
}
- listRepPtr = (List *) listPtr->internalRep.twoPtrValue.ptr1;
+ listRepPtr = ListRepPtr(listPtr);
*objcPtr = listRepPtr->elemCount;
- *objvPtr = listRepPtr->elements;
+ *objvPtr = &listRepPtr->elements;
return TCL_OK;
}
@@ -339,50 +483,46 @@ Tcl_ListObjGetElements(interp, listPtr, objcPtr, objvPtr)
*
* Tcl_ListObjAppendList --
*
- * This procedure appends the objects in the list referenced by
+ * This function appends the objects in the list referenced by
* elemListPtr to the list object referenced by listPtr. If listPtr is
* not already a list object, an attempt will be made to convert it to
* one.
*
* Results:
- * The return value is normally TCL_OK. If listPtr or elemListPtr do
- * not refer to list objects and they can not be converted to one,
- * TCL_ERROR is returned and an error message is left in
- * the interpreter's result if interp is not NULL.
+ * The return value is normally TCL_OK. If listPtr or elemListPtr do not
+ * refer to list objects and they can not be converted to one, TCL_ERROR
+ * is returned and an error message is left in the interpreter's result
+ * if interp is not NULL.
*
* Side effects:
* The reference counts of the elements in elemListPtr are incremented
* since the list now refers to them. listPtr and elemListPtr are
- * converted, if necessary, to list objects. Also, appending the
- * new elements may cause listObj's array of element pointers to grow.
+ * converted, if necessary, to list objects. Also, appending the new
+ * elements may cause listObj's array of element pointers to grow.
* listPtr's old string representation, if any, is invalidated.
*
*----------------------------------------------------------------------
*/
int
-Tcl_ListObjAppendList(interp, listPtr, elemListPtr)
- Tcl_Interp *interp; /* Used to report errors if not NULL. */
- register Tcl_Obj *listPtr; /* List object to append elements to. */
- Tcl_Obj *elemListPtr; /* List obj with elements to append. */
+Tcl_ListObjAppendList(
+ Tcl_Interp *interp, /* Used to report errors if not NULL. */
+ 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)) {
- panic("Tcl_ListObjAppendList called with shared object");
+ Tcl_Panic("%s called with shared object", "Tcl_ListObjAppendList");
}
- if (listPtr->typePtr != &tclListType) {
- result = SetListFromAny(interp, listPtr);
- if (result != TCL_OK) {
- return result;
- }
+
+ result = TclListObjLength(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);
+ result = TclListObjGetElements(interp, elemListPtr, &objc, &objv);
if (result != TCL_OK) {
return result;
}
@@ -391,7 +531,7 @@ Tcl_ListObjAppendList(interp, listPtr, elemListPtr)
* Insert objc new elements starting after the lists's last element.
* Delete zero existing elements.
*/
-
+
return Tcl_ListObjReplace(interp, listPtr, listLen, 0, objc, objv);
}
@@ -400,77 +540,102 @@ Tcl_ListObjAppendList(interp, listPtr, elemListPtr)
*
* Tcl_ListObjAppendElement --
*
- * This procedure is a special purpose version of
- * Tcl_ListObjAppendList: it appends a single object referenced by
- * objPtr to the list object referenced by listPtr. If listPtr is not
- * already a list object, an attempt will be made to convert it to one.
+ * This function is a special purpose version of Tcl_ListObjAppendList:
+ * it appends a single object referenced by objPtr to the list object
+ * referenced by listPtr. If listPtr is not already a list object, an
+ * attempt will be made to convert it to one.
*
* Results:
- * The return value is normally TCL_OK; in this case objPtr is added
- * to the end of listPtr's list. If listPtr does not refer to a list
- * object and the object can not be converted to one, TCL_ERROR is
- * returned and an error message will be left in the interpreter's
- * result if interp is not NULL.
+ * The return value is normally TCL_OK; in this case objPtr is added to
+ * the end of listPtr's list. If listPtr does not refer to a list object
+ * and the object can not be converted to one, TCL_ERROR is returned and
+ * an error message will be left in the interpreter's result if interp is
+ * not NULL.
*
* Side effects:
- * The ref count of objPtr is incremented since the list now refers
- * to it. listPtr will be converted, if necessary, to a list object.
- * Also, appending the new element may cause listObj's array of element
- * pointers to grow. listPtr's old string representation, if any,
- * is invalidated.
+ * The ref count of objPtr is incremented since the list now refers to
+ * it. listPtr will be converted, if necessary, to a list object. Also,
+ * appending the new element may cause listObj's array of element
+ * pointers to grow. listPtr's old string representation, if any, is
+ * invalidated.
*
*----------------------------------------------------------------------
*/
int
-Tcl_ListObjAppendElement(interp, listPtr, objPtr)
- Tcl_Interp *interp; /* Used to report errors if not NULL. */
- Tcl_Obj *listPtr; /* List object to append objPtr to. */
- Tcl_Obj *objPtr; /* Object to append to listPtr's list. */
+Tcl_ListObjAppendElement(
+ Tcl_Interp *interp, /* Used to report errors if not NULL. */
+ Tcl_Obj *listPtr, /* List object to append objPtr to. */
+ Tcl_Obj *objPtr) /* Object to append to listPtr's list. */
{
register List *listRepPtr;
register Tcl_Obj **elemPtrs;
- int numElems, numRequired;
-
+ int numElems, numRequired, newMax, newSize, i;
+
if (Tcl_IsShared(listPtr)) {
- panic("Tcl_ListObjAppendElement called with shared object");
+ Tcl_Panic("%s called with shared object", "Tcl_ListObjAppendElement");
}
if (listPtr->typePtr != &tclListType) {
- int result = SetListFromAny(interp, listPtr);
+ int result;
+
+ if (listPtr->bytes == tclEmptyStringRep) {
+ 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;
+ listRepPtr = ListRepPtr(listPtr);
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.
+ * If there is no room in the current array of element pointers, allocate
+ * a new, larger array and copy the pointers to it. If the List struct is
+ * shared, allocate a new one.
*/
- if (numRequired > listRepPtr->maxElemCount) {
- 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 = AttemptNewList(interp, newMax, NULL);
+ if (listRepPtr == NULL) {
+ return TCL_ERROR;
+ }
+ 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, (size_t)newSize);
listRepPtr->maxElemCount = newMax;
- listRepPtr->elements = newElemPtrs;
- ckfree((char *) elemPtrs);
- elemPtrs = newElemPtrs;
+ listPtr->internalRep.twoPtrValue.ptr1 = (void *) listRepPtr;
}
/*
- * Add objPtr to the end of listPtr's array of element
- * pointers. Increment the ref count for the (now shared) objPtr.
+ * Add objPtr to the end of listPtr's array of element pointers. Increment
+ * the ref count for the (now shared) objPtr.
*/
+ elemPtrs = &listRepPtr->elements;
elemPtrs[numElems] = objPtr;
Tcl_IncrRefCount(objPtr);
listRepPtr->elemCount++;
@@ -489,20 +654,20 @@ Tcl_ListObjAppendElement(interp, listPtr, objPtr)
*
* Tcl_ListObjIndex --
*
- * This procedure returns a pointer to the index'th object from the
- * list referenced by listPtr. The first element has index 0. If index
- * is negative or greater than or equal to the number of elements in
- * the list, a NULL is returned. If listPtr is not a list object, an
- * attempt will be made to convert it to a list.
+ * This function returns a pointer to the index'th object from the list
+ * referenced by listPtr. The first element has index 0. If index is
+ * negative or greater than or equal to the number of elements in the
+ * list, a NULL is returned. If listPtr is not a list object, an attempt
+ * will be made to convert it to a list.
*
* Results:
- * The return value is normally TCL_OK; in this case objPtrPtr is set
- * to the Tcl_Obj pointer for the index'th list element or NULL if
- * index is out of range. This object should be treated as readonly and
- * its ref count is _not_ incremented; the caller must do that if it
- * holds on to the reference. If listPtr does not refer to a list and
- * can't be converted to one, TCL_ERROR is returned and an error
- * message is left in the interpreter's result if interp is not NULL.
+ * The return value is normally TCL_OK; in this case objPtrPtr is set to
+ * the Tcl_Obj pointer for the index'th list element or NULL if index is
+ * out of range. This object should be treated as readonly and its ref
+ * count is _not_ incremented; the caller must do that if it holds on to
+ * the reference. If listPtr does not refer to a list and can't be
+ * converted to one, TCL_ERROR is returned and an error message is left
+ * in the interpreter's result if interp is not NULL.
*
* Side effects:
* listPtr will be converted, if necessary, to a list object.
@@ -511,28 +676,34 @@ Tcl_ListObjAppendElement(interp, listPtr, objPtr)
*/
int
-Tcl_ListObjIndex(interp, listPtr, index, objPtrPtr)
- Tcl_Interp *interp; /* Used to report errors if not NULL. */
- register Tcl_Obj *listPtr; /* List object to index into. */
- register int index; /* Index of element to return. */
- Tcl_Obj **objPtrPtr; /* The resulting Tcl_Obj* is stored here. */
+Tcl_ListObjIndex(
+ Tcl_Interp *interp, /* Used to report errors if not NULL. */
+ register Tcl_Obj *listPtr, /* List object to index into. */
+ register int index, /* Index of element to return. */
+ Tcl_Obj **objPtrPtr) /* The resulting Tcl_Obj* is stored here. */
{
register List *listRepPtr;
-
+
if (listPtr->typePtr != &tclListType) {
- int result = SetListFromAny(interp, listPtr);
+ int result;
+
+ if (listPtr->bytes == tclEmptyStringRep) {
+ *objPtrPtr = NULL;
+ return TCL_OK;
+ }
+ result = SetListFromAny(interp, listPtr);
if (result != TCL_OK) {
return result;
}
}
- listRepPtr = (List *) listPtr->internalRep.twoPtrValue.ptr1;
+ listRepPtr = ListRepPtr(listPtr);
if ((index < 0) || (index >= listRepPtr->elemCount)) {
*objPtrPtr = NULL;
} else {
- *objPtrPtr = listRepPtr->elements[index];
+ *objPtrPtr = (&listRepPtr->elements)[index];
}
-
+
return TCL_OK;
}
@@ -541,16 +712,16 @@ Tcl_ListObjIndex(interp, listPtr, index, objPtrPtr)
*
* Tcl_ListObjLength --
*
- * This procedure returns the number of elements in a list object. If
- * the object is not already a list object, an attempt will be made to
+ * This function returns the number of elements in a list object. If the
+ * object is not already a list object, an attempt will be made to
* convert it to one.
*
* Results:
- * The return value is normally TCL_OK; in this case *intPtr will be
- * set to the integer count of list elements. If listPtr does not refer
- * to a list object and the object can not be converted to one,
- * TCL_ERROR is returned and an error message will be left in
- * the interpreter's result if interp is not NULL.
+ * The return value is normally TCL_OK; in this case *intPtr will be set
+ * to the integer count of list elements. If listPtr does not refer to a
+ * list object and the object can not be converted to one, TCL_ERROR is
+ * returned and an error message will be left in the interpreter's result
+ * if interp is not NULL.
*
* Side effects:
* The possible conversion of the argument object to a list object.
@@ -559,21 +730,27 @@ Tcl_ListObjIndex(interp, listPtr, index, objPtrPtr)
*/
int
-Tcl_ListObjLength(interp, listPtr, intPtr)
- Tcl_Interp *interp; /* Used to report errors if not NULL. */
- register Tcl_Obj *listPtr; /* List object whose #elements to return. */
- register int *intPtr; /* The resulting int is stored here. */
+Tcl_ListObjLength(
+ Tcl_Interp *interp, /* Used to report errors if not NULL. */
+ register Tcl_Obj *listPtr, /* List object whose #elements to return. */
+ register int *intPtr) /* The resulting int is stored here. */
{
register List *listRepPtr;
-
+
if (listPtr->typePtr != &tclListType) {
- int result = SetListFromAny(interp, listPtr);
+ int result;
+
+ if (listPtr->bytes == tclEmptyStringRep) {
+ *intPtr = 0;
+ return TCL_OK;
+ }
+ result = SetListFromAny(interp, listPtr);
if (result != TCL_OK) {
return result;
}
}
- listRepPtr = (List *) listPtr->internalRep.twoPtrValue.ptr1;
+ listRepPtr = ListRepPtr(listPtr);
*intPtr = listRepPtr->elemCount;
return TCL_OK;
}
@@ -582,178 +759,227 @@ Tcl_ListObjLength(interp, listPtr, intPtr)
*----------------------------------------------------------------------
*
* Tcl_ListObjReplace --
- *
- * This procedure replaces zero or more elements of the list referenced
- * by listPtr with the objects from an (objc,objv) array.
- * The objc elements of the array referenced by objv replace the
- * count elements in listPtr starting at first.
+ *
+ * This function replaces zero or more elements of the list referenced by
+ * listPtr with the objects from an (objc,objv) array. The objc elements
+ * of the array referenced by objv replace the count elements in listPtr
+ * starting at first.
*
* If the argument first is zero or negative, it refers to the first
* element. If first is greater than or equal to the number of elements
* in the list, then no elements are deleted; the new elements are
- * appended to the list. Count gives the number of elements to
- * replace. If count is zero or negative then no elements are deleted;
- * the new elements are simply inserted before first.
+ * appended to the list. Count gives the number of elements to replace.
+ * If count is zero or negative then no elements are deleted; the new
+ * elements are simply inserted before first.
*
* The argument objv refers to an array of objc pointers to the new
- * elements to be added to listPtr in place of those that were
- * deleted. If objv is NULL, no new elements are added. If listPtr is
- * not a list object, an attempt will be made to convert it to one.
+ * elements to be added to listPtr in place of those that were deleted.
+ * If objv is NULL, no new elements are added. If listPtr is not a list
+ * object, an attempt will be made to convert it to one.
*
* Results:
- * The return value is normally TCL_OK. If listPtr does
- * not refer to a list object and can not be converted to one,
- * TCL_ERROR is returned and an error message will be left in
- * the interpreter's result if interp is not NULL.
+ * The return value is normally TCL_OK. If listPtr does not refer to a
+ * list object and can not be converted to one, TCL_ERROR is returned and
+ * an error message will be left in the interpreter's result if interp is
+ * not NULL.
*
* Side effects:
- * The ref counts of the objc elements in objv are incremented since
- * the resulting list now refers to them. Similarly, the ref counts for
- * replaced objects are decremented. listPtr is converted, if
- * necessary, to a list object. listPtr's old string representation, if
- * any, is freed.
+ * The ref counts of the objc elements in objv are incremented since the
+ * resulting list now refers to them. Similarly, the ref counts for
+ * replaced objects are decremented. listPtr is converted, if necessary,
+ * to a list object. listPtr's old string representation, if any, is
+ * freed.
*
*----------------------------------------------------------------------
*/
int
-Tcl_ListObjReplace(interp, listPtr, first, count, objc, objv)
- Tcl_Interp *interp; /* Used for error reporting if not NULL. */
- Tcl_Obj *listPtr; /* List object whose elements to replace. */
- int first; /* Index of first element to replace. */
- int count; /* Number of elements to replace. */
- int objc; /* Number of objects to insert. */
- Tcl_Obj *CONST objv[]; /* An array of objc pointers to Tcl objects
- * to insert. */
+Tcl_ListObjReplace(
+ Tcl_Interp *interp, /* Used for error reporting if not NULL. */
+ Tcl_Obj *listPtr, /* List object whose elements to replace. */
+ int first, /* Index of first element to replace. */
+ int count, /* Number of elements to replace. */
+ int objc, /* Number of objects to insert. */
+ Tcl_Obj *CONST objv[]) /* An array of objc pointers to Tcl objects to
+ * insert. */
{
List *listRepPtr;
- register Tcl_Obj **elemPtrs, **newPtrs;
- Tcl_Obj *victimPtr;
- int numElems, numRequired, numAfterLast;
- int start, shift, newMax, i, j, result;
-
+ register Tcl_Obj **elemPtrs;
+ int numElems, numRequired, numAfterLast, start, i, j, isShared;
+
if (Tcl_IsShared(listPtr)) {
- panic("Tcl_ListObjReplace called with shared object");
+ Tcl_Panic("%s called with shared object", "Tcl_ListObjReplace");
}
if (listPtr->typePtr != &tclListType) {
- result = SetListFromAny(interp, listPtr);
- if (result != TCL_OK) {
- return result;
+ if (listPtr->bytes == tclEmptyStringRep) {
+ if (objc) {
+ Tcl_SetListObj(listPtr, objc, NULL);
+ } else {
+ return TCL_OK;
+ }
+ } else {
+ int result = SetListFromAny(interp, listPtr);
+
+ if (result != TCL_OK) {
+ return result;
+ }
}
}
- listRepPtr = (List *) listPtr->internalRep.twoPtrValue.ptr1;
- elemPtrs = listRepPtr->elements;
+
+ /*
+ * Note that when count == 0 and objc == 0, this routine is logically a
+ * no-op, removing and adding no elements to the list. However, by flowing
+ * through this routine anyway, we get the important side effect that the
+ * resulting listPtr is a list in canoncial form. This is important.
+ * Resist any temptation to optimize this case.
+ */
+
+ listRepPtr = ListRepPtr(listPtr);
+ elemPtrs = &listRepPtr->elements;
numElems = listRepPtr->elemCount;
- if (first < 0) {
- first = 0;
+ if (first < 0) {
+ first = 0;
}
if (first >= numElems) {
- first = numElems; /* so we'll insert after last element */
+ first = numElems; /* So we'll insert after last element. */
}
if (count < 0) {
count = 0;
- }
-
- numRequired = (numElems - count + objc);
- if (numRequired <= listRepPtr->maxElemCount) {
+ } else if (numElems < first+count || first+count < 0) {
/*
- * Enough room in the current array. First "delete" count
- * elements starting at first.
+ * The 'first+count < 0' condition here guards agains integer
+ * overflow in determining 'first+count'
*/
+ count = numElems - first;
+ }
- for (i = 0, j = first; i < count; i++, j++) {
- victimPtr = elemPtrs[j];
- TclDecrRefCount(victimPtr);
- }
+ isShared = (listRepPtr->refCount > 1);
+ numRequired = numElems - count + objc;
+
+ if ((numRequired <= listRepPtr->maxElemCount) && !isShared) {
+ int shift;
/*
- * Shift the elements after the last one removed to their
- * new locations.
+ * Can use the current List struct. First "delete" count elements
+ * starting at first.
*/
- start = (first + count);
- numAfterLast = (numElems - start);
- shift = (objc - count); /* numNewElems - numDeleted */
- if ((numAfterLast > 0) && (shift != 0)) {
- Tcl_Obj **src, **dst;
+ for (j = first; j < first + count; j++) {
+ Tcl_Obj *victimPtr = elemPtrs[j];
- src = elemPtrs + start; dst = src + shift;
- memmove((VOID*) dst, (VOID*) src,
- (size_t) (numAfterLast * sizeof(Tcl_Obj*)));
+ TclDecrRefCount(victimPtr);
}
/*
- * Insert the new elements into elemPtrs before "first".
+ * Shift the elements after the last one removed to their new
+ * locations.
*/
- for (i = 0, j = first; i < objc; i++, j++) {
- elemPtrs[j] = objv[i];
- Tcl_IncrRefCount(objv[i]);
- }
-
- /*
- * Update the count of elements.
- */
+ start = first + count;
+ numAfterLast = numElems - start;
+ shift = objc - count; /* numNewElems - numDeleted */
+ if ((numAfterLast > 0) && (shift != 0)) {
+ Tcl_Obj **src = elemPtrs + start;
- listRepPtr->elemCount = numRequired;
+ memmove(src+shift, src, (size_t) numAfterLast * sizeof(Tcl_Obj*));
+ }
} 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 *)));
+ List *oldListRepPtr = listRepPtr;
+ Tcl_Obj **oldPtrs = elemPtrs;
+ int newMax;
- /*
- * Copy over the elements before "first".
- */
+ if (numRequired > listRepPtr->maxElemCount){
+ newMax = 2 * numRequired;
+ } else {
+ newMax = listRepPtr->maxElemCount;
+ }
- if (first > 0) {
- memcpy((VOID *) newPtrs, (VOID *) elemPtrs,
- (size_t) (first * sizeof(Tcl_Obj *)));
+ listRepPtr = AttemptNewList(interp, newMax, NULL);
+ if (listRepPtr == NULL) {
+ return TCL_ERROR;
}
- /*
- * "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;
- /*
- * Copy the elements after the last one removed, shifted to
- * their new locations.
- */
+ if (isShared) {
+ /*
+ * The old struct will remain in place; need new refCounts for the
+ * new List struct references. Copy over only the surviving
+ * elements.
+ */
- start = (first + count);
- numAfterLast = (numElems - start);
- if (numAfterLast > 0) {
- memcpy((VOID *) &(newPtrs[first + objc]),
- (VOID *) &(elemPtrs[start]),
- (size_t) (numAfterLast * sizeof(Tcl_Obj *)));
- }
-
- /*
- * Insert the new elements before "first" and update the
- * count of elements.
- */
+ 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]);
+ }
+
+ oldListRepPtr->refCount--;
+ } else {
+ /*
+ * The old struct will be removed; use its inherited refCounts.
+ */
+
+ if (first > 0) {
+ memcpy(elemPtrs, 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++) {
+ Tcl_Obj *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(elemPtrs + first + objc, oldPtrs + start,
+ (size_t) numAfterLast * sizeof(Tcl_Obj *));
+ }
+
+ ckfree((char *) oldListRepPtr);
}
+ }
- listRepPtr->elemCount = numRequired;
- listRepPtr->maxElemCount = newMax;
- listRepPtr->elements = newPtrs;
- ckfree((char *) elemPtrs);
+ /*
+ * Insert the new elements into elemPtrs before "first". We don't do a
+ * memcpy here because we must increment the reference counts for the
+ * added elements, so we must explicitly loop anyway.
+ */
+
+ 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.
@@ -766,270 +992,249 @@ Tcl_ListObjReplace(interp, listPtr, first, count, objc, objv)
/*
*----------------------------------------------------------------------
*
- * TclLsetList --
- *
- * Core of the 'lset' command when objc == 4. Objv[2] may be
- * either a scalar index or a list of indices.
+ * TclLindexList --
+ *
+ * This procedure handles the 'lindex' command when objc==3.
*
* Results:
- * Returns the new value of the list variable, or NULL if an
- * error occurs.
+ * Returns a pointer to the object extracted, or NULL if an error
+ * occurred. The returned object already includes one reference count for
+ * the pointer returned.
*
* Side effects:
- * Surgery is performed on the list value to produce the
- * result.
- *
- * On entry, the reference count of the variable value does not reflect
- * any references held on the stack. The first action of this function
- * is to determine whether the object is shared, and to duplicate it if
- * it is. The reference count of the duplicate is incremented.
- * At this point, the reference count will be 1 for either case, so that
- * the object will appear to be unshared.
- *
- * If an error occurs, and the object has been duplicated, the reference
- * count on the duplicate is decremented so that it is now 0: this dismisses
- * any memory that was allocated by this procedure.
- *
- * If no error occurs, the reference count of the original object is
- * incremented if the object has not been duplicated, and nothing is
- * done to a reference count of the duplicate. Now the reference count
- * of an unduplicated object is 2 (the returned pointer, plus the one
- * stored in the variable). The reference count of a duplicate object
- * is 1, reflecting that the returned pointer is the only active
- * reference. The caller is expected to store the returned value back
- * in the variable and decrement its reference count. (INST_STORE_*
- * does exactly this.)
- *
- * Tcl_LsetFlat and related functions maintain a linked list of
- * Tcl_Obj's whose string representations must be spoilt by threading
- * via 'ptr2' of the two-pointer internal representation. On entry
- * to Tcl_LsetList, the values of 'ptr2' are immaterial; on exit,
- * the 'ptr2' field of any Tcl_Obj that has been modified is set to
- * NULL.
+ * None.
+ *
+ * Notes:
+ * This procedure is implemented entirely as a wrapper around
+ * TclLindexFlat. All it does is reconfigure the argument format into the
+ * form required by TclLindexFlat, while taking care to manage shimmering
+ * in such a way that we tend to keep the most useful intreps and/or
+ * avoid the most expensive conversions.
*
*----------------------------------------------------------------------
*/
-Tcl_Obj*
-TclLsetList( interp, listPtr, indexArgPtr, valuePtr )
- Tcl_Interp* interp; /* Tcl interpreter */
- Tcl_Obj* listPtr; /* Pointer to the list being modified */
- Tcl_Obj* indexArgPtr; /* Index or index-list arg to 'lset' */
- Tcl_Obj* valuePtr; /* Value arg to 'lset' */
+Tcl_Obj *
+TclLindexList(
+ Tcl_Interp *interp, /* Tcl interpreter. */
+ Tcl_Obj *listPtr, /* List being unpacked. */
+ Tcl_Obj *argPtr) /* Index or index list. */
{
- 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;
+ int index; /* Index into the list. */
+ Tcl_Obj **indices; /* Array of list indices. */
+ int indexCount; /* Size of the array of list indices. */
+ Tcl_Obj *indexListCopy;
/*
- * Determine whether the index arg designates a list or a single
- * index. We have to be careful about the order of the checks to
- * avoid repeated shimmering; see TIP #22 and #23 for details.
+ * Determine whether argPtr designates a list or a single index. We have
+ * to be careful about the order of the checks to avoid repeated
+ * shimmering; see TIP#22 and TIP#33 for the details.
*/
- if ( indexArgPtr->typePtr != &tclListType
- && TclGetIntForIndex( NULL, indexArgPtr, 0, &index ) == TCL_OK ) {
-
- /*
- * indexArgPtr designates a single index.
- */
-
- return TclLsetFlat( interp, listPtr, 1, &indexArgPtr, valuePtr );
-
- } else if ( Tcl_ListObjGetElements( NULL, indexArgPtr,
- &indexCount, &indices ) != TCL_OK ) {
-
+ if (argPtr->typePtr != &tclListType
+ && TclGetIntForIndexM(NULL , argPtr, 0, &index) == TCL_OK) {
/*
- * indexArgPtr designates something that is neither an index nor a
- * well formed list. Report the error via TclLsetFlat.
+ * argPtr designates a single index.
*/
- return TclLsetFlat( interp, listPtr, 1, &indexArgPtr, valuePtr );
-
+ return TclLindexFlat(interp, listPtr, 1, &argPtr);
}
/*
- * 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.
+ * Here we make a private copy of the index list argument to avoid any
+ * shimmering issues that might invalidate the indices array below while
+ * we are still using it. This is probably unnecessary. It does not appear
+ * that any damaging shimmering is possible, and no test has been devised
+ * to show any error when this private copy is not made. But it's cheap,
+ * and it offers some future-proofing insurance in case the TclLindexFlat
+ * implementation changes in some unexpected way, or some new form of
+ * trace or callback permits things to happen that the current
+ * implementation does not.
*/
- if ( indexCount == 0 ) {
- Tcl_IncrRefCount( valuePtr );
- return valuePtr;
- }
-
- /*
- * Duplicate the list arg if necessary.
- */
+ indexListCopy = TclListObjCopy(NULL, argPtr);
+ if (indexListCopy == NULL) {
+ /*
+ * argPtr designates something that is neither an index nor a
+ * well-formed list. Report the error via TclLindexFlat.
+ */
- if ( Tcl_IsShared( listPtr ) ) {
- duplicated = 1;
- listPtr = Tcl_DuplicateObj( listPtr );
- Tcl_IncrRefCount( listPtr );
- } else {
- duplicated = 0;
+ return TclLindexFlat(interp, listPtr, 1, &argPtr);
}
- /*
- * 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.
- */
+ TclListObjGetElements(NULL, indexListCopy, &indexCount, &indices);
+ listPtr = TclLindexFlat(interp, listPtr, indexCount, indices);
+ Tcl_DecrRefCount(indexListCopy);
+ return listPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclLindexFlat --
+ *
+ * This procedure is the core of the 'lindex' command, with all index
+ * arguments presented as a flat list.
+ *
+ * Results:
+ * Returns a pointer to the object extracted, or NULL if an error
+ * occurred. The returned object already includes one reference count for
+ * the pointer returned.
+ *
+ * Side effects:
+ * None.
+ *
+ * Notes:
+ * The reference count of the returned object includes one reference
+ * corresponding to the pointer returned. Thus, the calling code will
+ * usually do something like:
+ * Tcl_SetObjResult(interp, result);
+ * Tcl_DecrRefCount(result);
+ *
+ *----------------------------------------------------------------------
+ */
- retValuePtr = listPtr;
- chainPtr = NULL;
+Tcl_Obj *
+TclLindexFlat(
+ Tcl_Interp *interp, /* Tcl interpreter. */
+ Tcl_Obj *listPtr, /* Tcl object representing the list. */
+ int indexCount, /* Count of indices. */
+ Tcl_Obj *const indexArray[])/* Array of pointers to Tcl objects that
+ * represent the indices in the list. */
+{
+ int i;
- /*
- * Handle each index arg by diving into the appropriate sublist
- */
+ Tcl_IncrRefCount(listPtr);
- for ( i = 0; ; ++i ) {
+ for (i=0 ; i<indexCount && listPtr ; i++) {
+ int index, listLen;
+ Tcl_Obj **elemPtrs, *sublistCopy;
/*
- * Take the sublist apart.
+ * Here we make a private copy of the current sublist, so we avoid any
+ * shimmering issues that might invalidate the elemPtr array below
+ * while we are still using it. See test lindex-8.4.
*/
- result = Tcl_ListObjGetElements( interp, listPtr,
- &elemCount, &elemPtrs );
- if ( result != TCL_OK ) {
- break;
- }
- listPtr->internalRep.twoPtrValue.ptr2 = (VOID *) chainPtr;
-
- /*
- * Reconstitute the index array
- */
+ sublistCopy = TclListObjCopy(interp, listPtr);
+ Tcl_DecrRefCount(listPtr);
+ listPtr = NULL;
- 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.
+ if (sublistCopy == NULL) {
+ /*
+ * The sublist is not a list at all => error.
*/
- 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.
- */
+ TclListObjGetElements(NULL, sublistCopy, &listLen, &elemPtrs);
+
+ if (TclGetIntForIndexM(interp, indexArray[i], /*endValue*/ listLen-1,
+ &index) == TCL_OK) {
+ if (index<0 || index>=listLen) {
+ /*
+ * Index is out of range. Break out of loop with empty result.
+ * First check remaining indices for validity
+ */
- 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.
+ while (++i < indexCount) {
+ if (TclGetIntForIndexM(interp, indexArray[i], -1, &index)
+ != TCL_OK) {
+ Tcl_DecrRefCount(sublistCopy);
+ return NULL;
+ }
+ }
+ listPtr = Tcl_NewObj();
+ } else {
+ /*
+ * Extract the pointer to the appropriate element.
*/
- break;
+
+ listPtr = elemPtrs[index];
}
+ Tcl_IncrRefCount(listPtr);
}
+ Tcl_DecrRefCount(sublistCopy);
+ }
- /*
- * Chain the current sublist onto the linked list of Tcl_Obj's
- * whose string reps must be spoilt.
- */
-
- chainPtr = listPtr;
- listPtr = subListPtr;
+ return listPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclLsetList --
+ *
+ * Core of the 'lset' command when objc == 4. Objv[2] may be either a
+ * scalar index or a list of indices.
+ *
+ * Results:
+ * Returns the new value of the list variable, or NULL if there was an
+ * error. The returned object includes one reference count for the
+ * pointer returned.
+ *
+ * Side effects:
+ * None.
+ *
+ * Notes:
+ * This procedure is implemented entirely as a wrapper around
+ * TclLsetFlat. All it does is reconfigure the argument format into the
+ * form required by TclLsetFlat, while taking care to manage shimmering
+ * in such a way that we tend to keep the most useful intreps and/or
+ * avoid the most expensive conversions.
+ *
+ *----------------------------------------------------------------------
+ */
- }
+Tcl_Obj *
+TclLsetList(
+ Tcl_Interp *interp, /* Tcl interpreter. */
+ Tcl_Obj *listPtr, /* Pointer to the list being modified. */
+ Tcl_Obj *indexArgPtr, /* Index or index-list arg to 'lset'. */
+ Tcl_Obj *valuePtr) /* Value arg to 'lset'. */
+{
+ int indexCount; /* Number of indices in the index list. */
+ Tcl_Obj **indices; /* Vector of indices in the index list. */
+ Tcl_Obj *retValuePtr; /* Pointer to the list to be returned. */
+ int index; /* Current index in the list - discarded. */
+ Tcl_Obj *indexListCopy;
/*
- * Store the new element into the correct slot in the innermost sublist.
+ * Determine whether the index arg designates a list or a single index.
+ * We have to be careful about the order of the checks to avoid repeated
+ * shimmering; see TIP #22 and #23 for details.
*/
- if ( result == TCL_OK ) {
- result = TclListObjSetElement( interp, listPtr, index, valuePtr );
- }
+ if (indexArgPtr->typePtr != &tclListType
+ && TclGetIntForIndexM(NULL, indexArgPtr, 0, &index) == TCL_OK) {
+ /*
+ * indexArgPtr designates a single index.
+ */
- if ( result == TCL_OK ) {
+ return TclLsetFlat(interp, listPtr, 1, &indexArgPtr, valuePtr);
- 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;
- }
+ indexListCopy = TclListObjCopy(NULL, indexArgPtr);
+ if (indexListCopy == NULL) {
+ /*
+ * indexArgPtr designates something that is neither an index nor a
+ * well formed list. Report the error via TclLsetFlat.
+ */
- /* Return the new list if everything worked. */
-
- if ( !duplicated ) {
- Tcl_IncrRefCount( retValuePtr );
- }
- return retValuePtr;
+ return TclLsetFlat(interp, listPtr, 1, &indexArgPtr, valuePtr);
}
+ TclListObjGetElements(NULL, indexArgPtr, &indexCount, &indices);
- /* Clean up the one dangling reference otherwise */
+ /*
+ * Let TclLsetFlat handle the actual lset'ting.
+ */
- if ( duplicated ) {
- Tcl_DecrRefCount( retValuePtr );
- }
- return NULL;
+ retValuePtr = TclLsetFlat(interp, listPtr, indexCount, indices, valuePtr);
+ Tcl_DecrRefCount(indexListCopy);
+ return retValuePtr;
}
/*
@@ -1037,220 +1242,216 @@ TclLsetList( interp, listPtr, indexArgPtr, valuePtr )
*
* TclLsetFlat --
*
- * Core of the 'lset' command when objc>=5. Objv[2], ... ,
- * objv[objc-2] contain scalar indices.
+ * Core engine of the 'lset' command.
*
* Results:
- * Returns the new value of the list variable, or NULL if an
- * error occurs.
+ * Returns the new value of the list variable, or NULL if an error
+ * occurred. The returned object includes one reference count for
+ * the pointer returned.
*
* Side effects:
- * Surgery is performed on the list value to produce the
- * result.
- *
- * On entry, the reference count of the variable value does not reflect
- * any references held on the stack. The first action of this function
- * is to determine whether the object is shared, and to duplicate it if
- * it is. The reference count of the duplicate is incremented.
- * At this point, the reference count will be 1 for either case, so that
- * the object will appear to be unshared.
- *
- * If an error occurs, and the object has been duplicated, the reference
- * count on the duplicate is decremented so that it is now 0: this dismisses
- * any memory that was allocated by this procedure.
- *
- * If no error occurs, the reference count of the original object is
- * incremented if the object has not been duplicated, and nothing is
- * done to a reference count of the duplicate. Now the reference count
- * of an unduplicated object is 2 (the returned pointer, plus the one
- * stored in the variable). The reference count of a duplicate object
- * is 1, reflecting that the returned pointer is the only active
- * reference. The caller is expected to store the returned value back
- * in the variable and decrement its reference count. (INST_STORE_*
- * does exactly this.)
- *
- * Tcl_LsetList and related functions maintain a linked list of
- * Tcl_Obj's whose string representations must be spoilt by threading
- * via 'ptr2' of the two-pointer internal representation. On entry
- * to Tcl_LsetList, the values of 'ptr2' are immaterial; on exit,
- * the 'ptr2' field of any Tcl_Obj that has been modified is set to
- * NULL.
+ * On entry, the reference count of the variable value does not reflect
+ * any references held on the stack. The first action of this function is
+ * to determine whether the object is shared, and to duplicate it if it
+ * is. The reference count of the duplicate is incremented. At this
+ * point, the reference count will be 1 for either case, so that the
+ * object will appear to be unshared.
+ *
+ * If an error occurs, and the object has been duplicated, the reference
+ * count on the duplicate is decremented so that it is now 0: this
+ * dismisses any memory that was allocated by this function.
+ *
+ * If no error occurs, the reference count of the original object is
+ * incremented if the object has not been duplicated, and nothing is done
+ * to a reference count of the duplicate. Now the reference count of an
+ * unduplicated object is 2 (the returned pointer, plus the one stored in
+ * the variable). The reference count of a duplicate object is 1,
+ * reflecting that the returned pointer is the only active reference. The
+ * caller is expected to store the returned value back in the variable
+ * and decrement its reference count. (INST_STORE_* does exactly this.)
+ *
+ * Surgery is performed on the unshared list value to produce the result.
+ * TclLsetFlat maintains a linked list of Tcl_Obj's whose string
+ * representations must be spoilt by threading via 'ptr2' of the
+ * two-pointer internal representation. On entry to TclLsetFlat, the
+ * values of 'ptr2' are immaterial; on exit, the 'ptr2' field of any
+ * Tcl_Obj that has been modified is set to NULL.
*
*----------------------------------------------------------------------
*/
-Tcl_Obj*
-TclLsetFlat( interp, listPtr, indexCount, indexArray, valuePtr )
- Tcl_Interp* interp; /* Tcl interpreter */
- Tcl_Obj* listPtr; /* Pointer to the list being modified */
- int indexCount; /* Number of index args */
- Tcl_Obj *CONST indexArray[];
- /* Index args */
- Tcl_Obj* valuePtr; /* Value arg to 'lset' */
+Tcl_Obj *
+TclLsetFlat(
+ Tcl_Interp *interp, /* Tcl interpreter. */
+ Tcl_Obj *listPtr, /* Pointer to the list being modified. */
+ int indexCount, /* Number of index args. */
+ Tcl_Obj *const indexArray[],
+ /* Index args. */
+ Tcl_Obj *valuePtr) /* Value arg to 'lset'. */
{
-
- int duplicated; /* Flag == 1 if the obj has been
- * duplicated, 0 otherwise */
- Tcl_Obj* retValuePtr; /* Pointer to the list to be returned */
-
- int elemCount; /* Length of one sublist being changed */
- Tcl_Obj** elemPtrs; /* Pointers to the elements of a sublist */
-
- Tcl_Obj* subListPtr; /* Pointer to the current sublist */
-
- int index; /* Index of the element to replace in the
- * current sublist */
- Tcl_Obj* chainPtr; /* Pointer to the enclosing list of
- * the current sublist. */
-
- int result; /* Status return from library calls */
-
-
-
- int i;
+ int index, result;
+ Tcl_Obj *subListPtr, *retValuePtr, *chainPtr;
/*
- * If there are no indices, then simply return the new value,
- * counting the returned pointer as a reference
+ * If there are no indices, simply return the new value.
+ * (Without indices, [lset] is a synonym for [set].
*/
- if ( indexCount == 0 ) {
- Tcl_IncrRefCount( valuePtr );
+ if (indexCount == 0) {
+ Tcl_IncrRefCount(valuePtr);
return valuePtr;
}
/*
- * If the list is shared, make a private copy.
+ * If the list is shared, make a copy we can modify (copy-on-write).
+ * We use Tcl_DuplicateObj() instead of TclListObjCopy() for a few
+ * reasons: 1) we have not yet confirmed listPtr is actually a list;
+ * 2) We make a verbatim copy of any existing string rep, and when
+ * we combine that with the delayed invalidation of string reps of
+ * modified Tcl_Obj's implemented below, the outcome is that any
+ * error condition that causes this routine to return NULL, will
+ * leave the string rep of listPtr and all elements to be unchanged.
*/
- if ( Tcl_IsShared( listPtr ) ) {
- duplicated = 1;
- listPtr = Tcl_DuplicateObj( listPtr );
- Tcl_IncrRefCount( listPtr );
- } else {
- duplicated = 0;
- }
+ subListPtr = Tcl_IsShared(listPtr) ? Tcl_DuplicateObj(listPtr) : listPtr;
/*
* Anchor the linked list of Tcl_Obj's whose string reps must be
* invalidated if the operation succeeds.
*/
- retValuePtr = listPtr;
+ retValuePtr = subListPtr;
chainPtr = NULL;
/*
- * Handle each index arg by diving into the appropriate sublist
+ * Loop through all the index arguments, and for each one dive
+ * into the appropriate sublist.
*/
- for ( i = 0; ; ++i ) {
-
- /*
- * Take the sublist apart.
- */
+ do {
+ int elemCount;
+ Tcl_Obj *parentList, **elemPtrs;
- result = Tcl_ListObjGetElements( interp, listPtr,
- &elemCount, &elemPtrs );
- if ( result != TCL_OK ) {
+ /* Check for the possible error conditions... */
+ result = TCL_ERROR;
+ if (TclListObjGetElements(interp, subListPtr, &elemCount, &elemPtrs)
+ != TCL_OK) {
+ /* ...the sublist we're indexing into isn't a list at all. */
break;
}
- listPtr->internalRep.twoPtrValue.ptr2 = (VOID *) chainPtr;
/*
- * Determine the index of the requested element.
+ * WARNING: the macro TclGetIntForIndexM is not safe for
+ * post-increments, avoid '*indexArray++' here.
*/
-
- result = TclGetIntForIndex( interp, indexArray[ 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;
+ if (TclGetIntForIndexM(interp, *indexArray, elemCount - 1, &index)
+ != TCL_OK) {
+ /* ...the index we're trying to use isn't an index at all. */
+ indexArray++;
break;
}
+ indexArray++;
- /*
- * Break the loop after extracting the innermost sublist
- */
-
- if ( i >= indexCount-1 ) {
- result = TCL_OK;
+ if (index < 0 || index >= elemCount) {
+ /* ...the index points outside the sublist. */
+ if (interp != NULL) {
+ Tcl_SetObjResult(interp,
+ Tcl_NewStringObj("list index out of range", -1));
+ }
break;
}
-
+
/*
- * Extract the appropriate sublist, and make sure that it is unshared.
+ * No error conditions. As long as we're not yet on the last
+ * index, determine the next sublist for the next pass through
+ * the loop, and take steps to make sure it is an unshared copy,
+ * as we intend to modify it.
*/
- 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.
- * If we do, it would result in leaking subListPtr,
- * but everything's been validated already; the error
- * exit from TclListObjSetElement should never happen.
- */
- break;
+ result = TCL_OK;
+ if (--indexCount) {
+ parentList = subListPtr;
+ subListPtr = elemPtrs[index];
+ if (Tcl_IsShared(subListPtr)) {
+ subListPtr = Tcl_DuplicateObj(subListPtr);
}
- }
- /*
- * Chain the current sublist onto the linked list of Tcl_Obj's
- * whose string reps must be spoilt.
- */
+ /*
+ * Replace the original elemPtr[index] in parentList with a copy
+ * we know to be unshared. This call will also deal with the
+ * situation where parentList shares its intrep with other
+ * Tcl_Obj's. Dealing with the shared intrep case can cause
+ * subListPtr to become shared again, so detect that case and
+ * make and store another copy.
+ */
- chainPtr = listPtr;
- listPtr = subListPtr;
+ TclListObjSetElement(NULL, parentList, index, subListPtr);
+ if (Tcl_IsShared(subListPtr)) {
+ subListPtr = Tcl_DuplicateObj(subListPtr);
+ TclListObjSetElement(NULL, parentList, index, subListPtr);
+ }
- }
+ /*
+ * The TclListObjSetElement() calls do not spoil the string
+ * rep of parentList, and that's fine for now, since all we've
+ * done so far is replace a list element with an unshared copy.
+ * The list value remains the same, so the string rep. is still
+ * valid, and unchanged, which is good because if this whole
+ * routine returns NULL, we'd like to leave no change to the
+ * value of the lset variable. Later on, when we set valuePtr
+ * in its proper place, then all containing lists will have
+ * their values changed, and will need their string reps spoiled.
+ * We maintain a list of all those Tcl_Obj's (via a little intrep
+ * surgery) so we can spoil them at that time.
+ */
- /* Store the result in the list element */
+ parentList->internalRep.twoPtrValue.ptr2 = (void *) chainPtr;
+ chainPtr = parentList;
+ }
+ } while (indexCount > 0);
- if ( result == TCL_OK ) {
- result = TclListObjSetElement( interp, listPtr, index, valuePtr );
- }
+ /*
+ * Either we've detected and error condition, and exited the loop
+ * with result == TCL_ERROR, or we've successfully reached the last
+ * index, and we're ready to store valuePtr. In either case, we
+ * need to clean up our string spoiling list of Tcl_Obj's.
+ */
- if ( result == TCL_OK ) {
+ while (chainPtr) {
+ Tcl_Obj *objPtr = chainPtr;
- listPtr->internalRep.twoPtrValue.ptr2 = (VOID *) chainPtr;
+ if (result == TCL_OK) {
- /* 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;
- }
+ /*
+ * We're going to store valuePtr, so spoil string reps
+ * of all containing lists.
+ */
- /* Return the new list if everything worked. */
-
- if ( !duplicated ) {
- Tcl_IncrRefCount( retValuePtr );
+ Tcl_InvalidateStringRep(objPtr);
}
- return retValuePtr;
- }
- /* Clean up the one dangling reference otherwise */
+ /* Clear away our intrep surgery mess */
+ chainPtr = (Tcl_Obj *) objPtr->internalRep.twoPtrValue.ptr2;
+ objPtr->internalRep.twoPtrValue.ptr2 = NULL;
+ }
- if ( duplicated ) {
- Tcl_DecrRefCount( retValuePtr );
+ if (result != TCL_OK) {
+ /*
+ * Error return; message is already in interp. Clean up
+ * any excess memory.
+ */
+ if (retValuePtr != listPtr) {
+ Tcl_DecrRefCount(retValuePtr);
+ }
+ return NULL;
}
- return NULL;
+ /* Store valuePtr in proper sublist and return */
+ TclListObjSetElement(NULL, subListPtr, index, valuePtr);
+ Tcl_InvalidateStringRep(subListPtr);
+ Tcl_IncrRefCount(retValuePtr);
+ return retValuePtr;
}
/*
@@ -1261,86 +1462,125 @@ TclLsetFlat( interp, listPtr, indexCount, indexArray, valuePtr )
* Set a single element of a list to a specified value
*
* Results:
- *
- * The return value is normally TCL_OK. If listPtr does not
- * refer to a list object and cannot be converted to one, TCL_ERROR
- * is returned and an error message will be left in the interpreter
- * result if interp is not NULL. Similarly, if index designates
- * an element outside the range [0..listLength-1], where
- * listLength is the count of elements in the list object designated
- * by listPtr, TCL_ERROR is returned and an error message is left
- * in the interpreter result.
+ * The return value is normally TCL_OK. If listPtr does not refer to a
+ * list object and cannot be converted to one, TCL_ERROR is returned and
+ * an error message will be left in the interpreter result if interp is
+ * not NULL. Similarly, if index designates an element outside the range
+ * [0..listLength-1], where listLength is the count of elements in the
+ * list object designated by listPtr, TCL_ERROR is returned and an error
+ * message is left in the interpreter result.
*
* Side effects:
+ * Tcl_Panic if listPtr designates a shared object. Otherwise, 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.
*
- * Panics 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.
- *
- * It is the caller's responsibility to invalidate the string
- * representation of the object.
+ * It is the caller's responsibility to invalidate the string
+ * representation of the object.
*
*----------------------------------------------------------------------
*/
int
-TclListObjSetElement( interp, listPtr, index, valuePtr )
- Tcl_Interp* interp; /* Tcl interpreter; used for error reporting
- * if not NULL */
- Tcl_Obj* listPtr; /* List object in which element should be
- * stored */
- int index; /* Index of element to store */
- Tcl_Obj* valuePtr; /* Tcl object to store in the designated
- * list element */
+TclListObjSetElement(
+ Tcl_Interp *interp, /* Tcl interpreter; used for error reporting
+ * if not NULL. */
+ Tcl_Obj *listPtr, /* List object in which element should be
+ * stored. */
+ int index, /* Index of element to store. */
+ Tcl_Obj *valuePtr) /* Tcl object to store in the designated list
+ * element. */
{
- int result; /* Return value from this function */
- List* listRepPtr; /* Internal representation of the list
- * being modified */
- Tcl_Obj** elemPtrs; /* Pointers to elements of the list */
- int elemCount; /* Number of elements in the list */
+ List *listRepPtr; /* Internal representation of the list being
+ * modified. */
+ Tcl_Obj **elemPtrs; /* Pointers to elements of the list. */
+ int elemCount; /* Number of elements in the list. */
- /* Ensure that the listPtr parameter designates an unshared list */
+ /*
+ * Ensure that the listPtr parameter designates an unshared list.
+ */
- if ( Tcl_IsShared( listPtr ) ) {
- panic( "Tcl_ListObjSetElement called with shared object" );
+ if (Tcl_IsShared(listPtr)) {
+ Tcl_Panic("%s called with shared object", "TclListObjSetElement");
}
- if ( listPtr->typePtr != &tclListType ) {
- result = SetListFromAny( interp, listPtr );
- if ( result != TCL_OK ) {
+ if (listPtr->typePtr != &tclListType) {
+ int result;
+
+ if (listPtr->bytes == tclEmptyStringRep) {
+ if (interp != NULL) {
+ 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;
+
+ listRepPtr = ListRepPtr(listPtr);
elemCount = listRepPtr->elemCount;
+ elemPtrs = &listRepPtr->elements;
+
+ /*
+ * Ensure that the index is in bounds.
+ */
+
+ if (index<0 || index>=elemCount) {
+ if (interp != NULL) {
+ Tcl_SetObjResult(interp,
+ Tcl_NewStringObj("list index out of range", -1));
+ }
+ return TCL_ERROR;
+ }
+
+ /*
+ * If the internal rep is shared, replace it with an unshared copy.
+ */
- /* Ensure that the index is in bounds */
+ if (listRepPtr->refCount > 1) {
+ List *oldListRepPtr = listRepPtr;
+ Tcl_Obj **oldElemPtrs = elemPtrs;
+ int i;
- if ( index < 0 || index >= elemCount ) {
- if ( interp != NULL ) {
- Tcl_SetObjResult( interp,
- Tcl_NewStringObj( "list index out of range",
- -1 ) );
+ listRepPtr = AttemptNewList(interp, listRepPtr->maxElemCount, NULL);
+ if (listRepPtr == NULL) {
return TCL_ERROR;
}
+ listRepPtr->canonicalFlag = oldListRepPtr->canonicalFlag;
+ elemPtrs = &listRepPtr->elements;
+ for (i=0; i < elemCount; i++) {
+ elemPtrs[i] = oldElemPtrs[i];
+ Tcl_IncrRefCount(elemPtrs[i]);
+ }
+ listRepPtr->refCount++;
+ listRepPtr->elemCount = elemCount;
+ listPtr->internalRep.twoPtrValue.ptr1 = (void *) listRepPtr;
+ oldListRepPtr->refCount--;
}
- /* Add a reference to the new list element */
+ /*
+ * Add a reference to the new list element.
+ */
- Tcl_IncrRefCount( valuePtr );
+ Tcl_IncrRefCount(valuePtr);
- /* Remove a reference from the old list element */
+ /*
+ * Remove a reference from the old list element.
+ */
- Tcl_DecrRefCount( elemPtrs[ index ] );
+ Tcl_DecrRefCount(elemPtrs[index]);
- /* Stash the new object in the list */
+ /*
+ * Stash the new object in the list.
+ */
- elemPtrs[ index ] = valuePtr;
+ elemPtrs[index] = valuePtr;
return TCL_OK;
-
}
/*
@@ -1356,31 +1596,31 @@ TclListObjSetElement( interp, listPtr, index, valuePtr )
*
* Side effects:
* Frees listPtr's List* internal representation and sets listPtr's
- * internalRep.twoPtrValue.ptr1 to NULL. Decrements the ref counts
- * of all element objects, which may free them.
+ * internalRep.twoPtrValue.ptr1 to NULL. Decrements the ref counts of all
+ * element objects, which may free them.
*
*----------------------------------------------------------------------
*/
static void
-FreeListInternalRep(listPtr)
- Tcl_Obj *listPtr; /* List object with internal rep to free. */
+FreeListInternalRep(
+ 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 *objPtr;
- int numElems = listRepPtr->elemCount;
- int i;
-
- for (i = 0; i < numElems; i++) {
- objPtr = elemPtrs[i];
- Tcl_DecrRefCount(objPtr);
+ List *listRepPtr = ListRepPtr(listPtr);
+
+ if (--listRepPtr->refCount <= 0) {
+ Tcl_Obj **elemPtrs = &listRepPtr->elements;
+ int i, numElems = listRepPtr->elemCount;
+
+ for (i = 0; i < numElems; i++) {
+ Tcl_DecrRefCount(elemPtrs[i]);
+ }
+ ckfree((char *) listRepPtr);
}
- ckfree((char *) elemPtrs);
- ckfree((char *) listRepPtr);
listPtr->internalRep.twoPtrValue.ptr1 = NULL;
listPtr->internalRep.twoPtrValue.ptr2 = NULL;
+ listPtr->typePtr = NULL;
}
/*
@@ -1388,57 +1628,26 @@ 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.
*
*----------------------------------------------------------------------
*/
static void
-DupListInternalRep(srcPtr, copyPtr)
- Tcl_Obj *srcPtr; /* Object with internal rep to copy. */
- Tcl_Obj *copyPtr; /* Object with internal rep to set. */
+DupListInternalRep(
+ 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;
+ List *listRepPtr = ListRepPtr(srcPtr);
- /*
- * 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]);
- }
-
- copyListRepPtr = (List *) ckalloc(sizeof(List));
- copyListRepPtr->maxElemCount = maxElems;
- copyListRepPtr->elemCount = numElems;
- copyListRepPtr->elements = copyElemPtrs;
-
- copyPtr->internalRep.twoPtrValue.ptr1 = (VOID *) copyListRepPtr;
- copyPtr->internalRep.twoPtrValue.ptr2 = NULL;
- copyPtr->typePtr = &tclListType;
+ ListSetIntRep(copyPtr, listRepPtr);
}
/*
@@ -1446,8 +1655,7 @@ DupListInternalRep(srcPtr, copyPtr)
*
* SetListFromAny --
*
- * Attempt to generate a list internal form for the Tcl object
- * "objPtr".
+ * Attempt to generate a list internal form for the Tcl object "objPtr".
*
* Results:
* The return value is TCL_OK or TCL_ERROR. If an error occurs during
@@ -1462,110 +1670,113 @@ DupListInternalRep(srcPtr, copyPtr)
*/
static int
-SetListFromAny(interp, objPtr)
- Tcl_Interp *interp; /* Used for error reporting if not NULL. */
- Tcl_Obj *objPtr; /* The object to convert. */
+SetListFromAny(
+ Tcl_Interp *interp, /* Used for error reporting if not NULL. */
+ Tcl_Obj *objPtr) /* The object to convert. */
{
- Tcl_ObjType *oldTypePtr = objPtr->typePtr;
- char *string, *s;
- CONST char *elemStart, *nextElem;
- int lenRemain, length, estCount, elemSize, hasBrace, i, j, result;
- char *limit; /* Points just after string's last byte. */
- register CONST char *p;
- register Tcl_Obj **elemPtrs;
- register Tcl_Obj *elemPtr;
List *listRepPtr;
+ Tcl_Obj **elemPtrs;
/*
- * Get the string representation. Make it up-to-date if necessary.
+ * Dictionaries are a special case; they have a string representation such
+ * that *all* valid dictionaries are valid lists. Hence we can convert
+ * more directly. Only do this when there's no existing string rep; if
+ * there is, it is the string rep that's authoritative (because it could
+ * describe duplicate keys).
*/
- string = Tcl_GetStringFromObj(objPtr, &length);
+ if (objPtr->typePtr == &tclDictType && !objPtr->bytes) {
+ Tcl_Obj *keyPtr, *valuePtr;
+ Tcl_DictSearch search;
+ int done, size;
- /*
- * Parse the string into separate string objects, and create a List
- * structure that points to the element string objects. We use a
- * modified version of Tcl_SplitList's implementation to avoid one
- * malloc and a string copy for each list element. First, estimate the
- * number of elements by counting the number of space characters in the
- * list.
- */
+ /*
+ * Create the new list representation. Note that we do not need to do
+ * anything with the string representation as the transformation (and
+ * the reverse back to a dictionary) are both order-preserving. Also
+ * note that since we know we've got a valid dictionary (by
+ * representation) we also know that fetching the size of the
+ * dictionary or iterating over it will not fail.
+ */
- limit = (string + length);
- estCount = 1;
- for (p = string; p < limit; p++) {
- if (isspace(UCHAR(*p))) { /* INTL: ISO space. */
- estCount++;
+ Tcl_DictObjSize(NULL, objPtr, &size);
+ listRepPtr = AttemptNewList(interp, size > 0 ? 2*size : 1, NULL);
+ if (!listRepPtr) {
+ return TCL_ERROR;
}
- }
+ listRepPtr->elemCount = 2 * size;
- /*
- * Allocate a new List structure with enough room for "estCount"
- * elements. Each element is a pointer to a Tcl_Obj with the appropriate
- * string rep. The initial "estCount" elements are set using the
- * corresponding "argv" strings.
- */
+ /*
+ * Populate the list representation.
+ */
- elemPtrs = (Tcl_Obj **)
- ckalloc((unsigned) (estCount * sizeof(Tcl_Obj *)));
- for (p = string, lenRemain = length, i = 0;
- lenRemain > 0;
- p = nextElem, lenRemain = (limit - nextElem), i++) {
- result = TclFindElement(interp, p, lenRemain, &elemStart, &nextElem,
- &elemSize, &hasBrace);
- if (result != TCL_OK) {
- for (j = 0; j < i; j++) {
- elemPtr = elemPtrs[j];
- Tcl_DecrRefCount(elemPtr);
- }
- ckfree((char *) elemPtrs);
- return result;
- }
- if (elemStart >= limit) {
- break;
- }
- if (i > estCount) {
- panic("SetListFromAny: bad size estimate for list");
+ elemPtrs = &listRepPtr->elements;
+ Tcl_DictObjFirst(NULL, objPtr, &search, &keyPtr, &valuePtr, &done);
+ while (!done) {
+ *elemPtrs++ = keyPtr;
+ *elemPtrs++ = valuePtr;
+ Tcl_IncrRefCount(keyPtr);
+ Tcl_IncrRefCount(valuePtr);
+ Tcl_DictObjNext(&search, &keyPtr, &valuePtr, &done);
}
+ } else {
+ int estCount, length;
+ const char *limit, *nextElem = TclGetStringFromObj(objPtr, &length);
/*
- * Allocate a Tcl object for the element and initialize it from the
- * "elemSize" bytes starting at "elemStart".
+ * Allocate enough space to hold a (Tcl_Obj *) for each
+ * (possible) list element.
*/
- s = ckalloc((unsigned) elemSize + 1);
- if (hasBrace) {
- memcpy((VOID *) s, (VOID *) elemStart, (size_t) elemSize);
- s[elemSize] = 0;
- } else {
- elemSize = TclCopyAndCollapse(elemSize, elemStart, s);
+ estCount = TclMaxListLength(nextElem, length, &limit);
+ estCount += (estCount == 0); /* Smallest List struct holds 1 element. */
+ listRepPtr = AttemptNewList(interp, estCount, NULL);
+ if (listRepPtr == NULL) {
+ return TCL_ERROR;
+ }
+ elemPtrs = &listRepPtr->elements;
+
+ /* Each iteration, parse and store a list element */
+ while (nextElem < limit) {
+ const char *elemStart;
+ int elemSize, literal;
+
+ if (TCL_OK != TclFindElement(interp, nextElem, (limit - nextElem),
+ &elemStart, &nextElem, &elemSize, &literal)) {
+ while (--elemPtrs >= &listRepPtr->elements) {
+ Tcl_DecrRefCount(*elemPtrs);
+ }
+ ckfree((char *) listRepPtr);
+ return TCL_ERROR;
+ }
+ if (elemStart == limit) {
+ break;
+ }
+
+ /* TODO: replace panic with error on alloc failure? */
+ if (literal) {
+ TclNewStringObj(*elemPtrs, elemStart, elemSize);
+ } else {
+ TclNewObj(*elemPtrs);
+ (*elemPtrs)->bytes = ckalloc((unsigned) elemSize + 1);
+ (*elemPtrs)->length = TclCopyAndCollapse(elemSize, elemStart,
+ (*elemPtrs)->bytes);
+ }
+
+ Tcl_IncrRefCount(*elemPtrs++);/* Since list now holds ref to it. */
}
-
- TclNewObj(elemPtr);
- elemPtr->bytes = s;
- elemPtr->length = elemSize;
- elemPtrs[i] = elemPtr;
- Tcl_IncrRefCount(elemPtr); /* since list now holds ref to it */
- }
- listRepPtr = (List *) ckalloc(sizeof(List));
- listRepPtr->maxElemCount = estCount;
- listRepPtr->elemCount = i;
- listRepPtr->elements = elemPtrs;
+ listRepPtr->elemCount = elemPtrs - &listRepPtr->elements;
+ }
/*
- * Free the old internalRep before setting the new one. We do this as
- * late as possible to allow the conversion code, in particular
+ * Free the old internalRep before setting the new one. We do this as late
+ * as possible to allow the conversion code, in particular
* Tcl_GetStringFromObj, to use that old internalRep.
*/
- if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) {
- oldTypePtr->freeIntRepProc(objPtr);
- }
-
- objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) listRepPtr;
- objPtr->internalRep.twoPtrValue.ptr2 = NULL;
- objPtr->typePtr = &tclListType;
+ TclFreeIntRep(objPtr);
+ ListSetIntRep(objPtr, listRepPtr);
return TCL_OK;
}
@@ -1574,39 +1785,50 @@ SetListFromAny(interp, objPtr)
*
* UpdateStringOfList --
*
- * Update the string representation for a list object.
- * Note: This procedure does not invalidate an existing old string rep
- * so storage will be lost if this has not already been done.
+ * Update the string representation for a list object. Note: This
+ * function does not invalidate an existing old string rep so storage
+ * will be lost if this has not already been done.
*
* Results:
* None.
*
* Side effects:
- * The object's string is set to a valid string that results from
- * the list-to-string conversion. This string will be empty if the
- * list has no elements. The list internal representation
- * should not be NULL and we assume it is not NULL.
+ * The object's string is set to a valid string that results from the
+ * list-to-string conversion. This string will be empty if the list has
+ * no elements. The list internal representation should not be NULL and
+ * we assume it is not NULL.
*
*----------------------------------------------------------------------
*/
static void
-UpdateStringOfList(listPtr)
- Tcl_Obj *listPtr; /* List object with string rep to update. */
+UpdateStringOfList(
+ Tcl_Obj *listPtr) /* List object with string rep to update. */
{
# define LOCAL_SIZE 20
- int localFlags[LOCAL_SIZE], *flagPtr;
- List *listRepPtr = (List *) listPtr->internalRep.twoPtrValue.ptr1;
+ int localFlags[LOCAL_SIZE], *flagPtr = NULL;
+ List *listRepPtr = ListRepPtr(listPtr);
int numElems = listRepPtr->elemCount;
- register int i;
+ int i, length, bytesNeeded = 0;
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.
+ * Mark the list as being canonical; although it will now have a string
+ * rep, it is one we derived through proper "canonical" quoting and so
+ * it's known to be free from nasties relating to [concat] and [eval].
*/
+ listRepPtr->canonicalFlag = 1;
+
+ /* Handle empty list case first, so rest of the routine is simpler */
+
+ if (numElems == 0) {
+ listPtr->bytes = tclEmptyStringRep;
+ listPtr->length = 0;
+ return;
+ }
+
/*
* Pass 1: estimate space, gather flags.
*/
@@ -1614,41 +1836,47 @@ UpdateStringOfList(listPtr)
if (numElems <= LOCAL_SIZE) {
flagPtr = localFlags;
} else {
- flagPtr = (int *) ckalloc((unsigned) numElems*sizeof(int));
+ /* We know numElems <= LIST_MAX, so this is safe. */
+ 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);
- listPtr->length += Tcl_ScanCountedElement(elem, length,
- &flagPtr[i]) + 1;
- /*
- * Check for continued sanity. [Bug 1267380]
- */
- if (listPtr->length < 1) {
- Tcl_Panic("string representation size exceeds sane bounds");
+ flagPtr[i] = ( i ? TCL_DONT_QUOTE_HASH : 0 );
+ elem = TclGetStringFromObj(elemPtrs[i], &length);
+ bytesNeeded += TclScanElement(elem, length, flagPtr+i);
+ if (bytesNeeded < 0) {
+ Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
}
}
+ if (bytesNeeded > INT_MAX - numElems + 1) {
+ Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
+ }
+ bytesNeeded += numElems;
/*
* Pass 2: copy into string rep buffer.
*/
- listPtr->bytes = ckalloc((unsigned) listPtr->length);
+ listPtr->length = bytesNeeded - 1;
+ listPtr->bytes = ckalloc((unsigned) bytesNeeded);
dst = listPtr->bytes;
for (i = 0; i < numElems; i++) {
- elem = Tcl_GetStringFromObj(listRepPtr->elements[i], &length);
- dst += Tcl_ConvertCountedElement(elem, length, dst, flagPtr[i]);
- *dst = ' ';
- dst++;
+ flagPtr[i] |= ( i ? TCL_DONT_QUOTE_HASH : 0 );
+ elem = TclGetStringFromObj(elemPtrs[i], &length);
+ dst += TclConvertElement(elem, length, dst, flagPtr[i]);
+ *dst++ = ' ';
}
+ listPtr->bytes[listPtr->length] = '\0';
+
if (flagPtr != localFlags) {
ckfree((char *) flagPtr);
}
- if (dst == listPtr->bytes) {
- *dst = 0;
- } else {
- dst--;
- *dst = 0;
- }
- listPtr->length = dst - listPtr->bytes;
}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */