--- projs/trunk/shared_source/c_tcl_base_7_5_w_mods/tcllistobj.c 2016/11/05 10:55:22 70 +++ projs/trunk/shared_source/c_tcl_base_7_5_w_mods/tcllistobj.c 2016/11/05 11:07:06 71 @@ -1,1062 +1,1062 @@ -/* $Header$ */ -/* - * tclListObj.c -- - * - * This file contains procedures that implement the Tcl list object - * type. - * - * Copyright (c) 1995-1997 Sun Microsystems, Inc. - * Copyright (c) 1998 by Scriptics Corporation. - * - * See the file "license.terms" for information on usage and redistribution - * of this file, and for a DISCLAIMER OF ALL WARRANTIES. - * - * RCS: @(#) $Id: tcllistobj.c,v 1.1.1.1 2001/06/13 04:42:36 dtashley Exp $ - */ - -#include "tclInt.h" - -/* - * Prototypes for procedures 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)); - -/* - * The structure below defines the list Tcl object type by means of - * procedures that can be invoked by generic object code. - */ - -Tcl_ObjType tclListType = { - "list", /* name */ - FreeListInternalRep, /* freeIntRepProc */ - DupListInternalRep, /* dupIntRepProc */ - UpdateStringOfList, /* updateStringProc */ - SetListFromAny /* setFromAnyProc */ -}; - -/* - *---------------------------------------------------------------------- - * - * Tcl_NewListObj -- - * - * This procedure 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. - * - * 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. - * - * Side effects: - * The ref counts of the elements in objv are incremented since the - * resulting list now refers to them. - * - *---------------------------------------------------------------------- - */ - -#ifdef TCL_MEM_DEBUG -#undef 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. */ -{ - return Tcl_DbNewListObj(objc, objv, "unknown", 0); -} - -#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. */ -{ - register Tcl_Obj *listPtr; - register Tcl_Obj **elemPtrs; - register List *listRepPtr; - int i; - - 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.otherValuePtr = (VOID *) listRepPtr; - listPtr->typePtr = &tclListType; - } - return listPtr; -} -#endif /* if TCL_MEM_DEBUG */ - -/* - *---------------------------------------------------------------------- - * - * 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 - * Tcl_DbCkalloc directly with the file name and line number from its - * caller. This simplifies debugging since then the checkmem 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 - * 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. - * - * Side effects: - * The ref counts of the elements in objv are incremented since the - * resulting list now refers to them. - * - *---------------------------------------------------------------------- - */ - -#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. */ - char *file; /* The name of the source file calling this - * procedure; used for debugging. */ - int line; /* Line number in the source file; used - * for debugging. */ -{ - register Tcl_Obj *listPtr; - register Tcl_Obj **elemPtrs; - register List *listRepPtr; - int i; - - 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.otherValuePtr = (VOID *) listRepPtr; - listPtr->typePtr = &tclListType; - } - 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. */ - char *file; /* The name of the source file calling this - * procedure; used for debugging. */ - int line; /* Line number in the source file; used - * for debugging. */ -{ - return Tcl_NewListObj(objc, objv); -} -#endif /* TCL_MEM_DEBUG */ - -/* - *---------------------------------------------------------------------- - * - * Tcl_SetListObj -- - * - * Modify an object to be a list containing each of the objc elements - * of the object array referenced by objv. - * - * Results: - * None. - * - * 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. - * - *---------------------------------------------------------------------- - */ - -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. */ -{ - register Tcl_Obj **elemPtrs; - register List *listRepPtr; - Tcl_ObjType *oldTypePtr = objPtr->typePtr; - int i; - - if (Tcl_IsShared(objPtr)) { - panic("Tcl_SetListObj called with shared object"); - } - - /* - * Free any old string rep and any internal rep for the old type. - */ - - if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) { - oldTypePtr->freeIntRepProc(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. - */ - - 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.otherValuePtr = (VOID *) listRepPtr; - objPtr->typePtr = &tclListType; - } else { - objPtr->bytes = tclEmptyStringRep; - } -} - -/* - *---------------------------------------------------------------------- - * - * Tcl_ListObjGetElements -- - * - * This procedure 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. - * - * 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. - * - * Side effects: - * The possible conversion of the object referenced by listPtr - * to a list object. - * - *---------------------------------------------------------------------- - */ - -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 - * referenced by objv. */ - 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); - if (result != TCL_OK) { - return result; - } - } - listRepPtr = (List *) listPtr->internalRep.otherValuePtr; - *objcPtr = listRepPtr->elemCount; - *objvPtr = listRepPtr->elements; - return TCL_OK; -} - -/* - *---------------------------------------------------------------------- - * - * Tcl_ListObjAppendList -- - * - * This procedure 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. - * - * 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. - * 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. */ -{ - register List *listRepPtr; - int listLen, objc, result; - Tcl_Obj **objv; - - if (Tcl_IsShared(listPtr)) { - panic("Tcl_ListObjAppendList called with shared object"); - } - if (listPtr->typePtr != &tclListType) { - result = SetListFromAny(interp, listPtr); - if (result != TCL_OK) { - return result; - } - } - listRepPtr = (List *) listPtr->internalRep.otherValuePtr; - listLen = listRepPtr->elemCount; - - result = Tcl_ListObjGetElements(interp, elemListPtr, &objc, &objv); - if (result != TCL_OK) { - return result; - } - - /* - * Insert objc new elements starting after the lists's last element. - * Delete zero existing elements. - */ - - return Tcl_ListObjReplace(interp, listPtr, listLen, 0, objc, objv); -} - -/* - *---------------------------------------------------------------------- - * - * 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. - * - * 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. - * - * 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. - * - *---------------------------------------------------------------------- - */ - -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. */ -{ - register List *listRepPtr; - register Tcl_Obj **elemPtrs; - int numElems, numRequired; - - if (Tcl_IsShared(listPtr)) { - panic("Tcl_ListObjAppendElement called with shared object"); - } - if (listPtr->typePtr != &tclListType) { - int result = SetListFromAny(interp, listPtr); - if (result != TCL_OK) { - return result; - } - } - - listRepPtr = (List *) listPtr->internalRep.otherValuePtr; - elemPtrs = listRepPtr->elements; - numElems = listRepPtr->elemCount; - numRequired = numElems + 1 ; - - /* - * If there is no room in the current array of element pointers, - * allocate a new, larger array and copy the pointers to it. - */ - - if (numRequired > listRepPtr->maxElemCount) { - int newMax = (2 * numRequired); - Tcl_Obj **newElemPtrs = (Tcl_Obj **) - ckalloc((unsigned) (newMax * sizeof(Tcl_Obj *))); - - memcpy((VOID *) newElemPtrs, (VOID *) elemPtrs, - (size_t) (numElems * sizeof(Tcl_Obj *))); - - listRepPtr->maxElemCount = newMax; - listRepPtr->elements = newElemPtrs; - ckfree((char *) elemPtrs); - elemPtrs = newElemPtrs; - } - - /* - * Add objPtr to the end of listPtr's array of element - * pointers. Increment the ref count for the (now shared) objPtr. - */ - - elemPtrs[numElems] = objPtr; - Tcl_IncrRefCount(objPtr); - listRepPtr->elemCount++; - - /* - * Invalidate any old string representation since the list's internal - * representation has changed. - */ - - Tcl_InvalidateStringRep(listPtr); - return TCL_OK; -} - -/* - *---------------------------------------------------------------------- - * - * 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. - * - * 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. - * - * Side effects: - * listPtr will be converted, if necessary, to a list object. - * - *---------------------------------------------------------------------- - */ - -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. */ -{ - register List *listRepPtr; - - if (listPtr->typePtr != &tclListType) { - int result = SetListFromAny(interp, listPtr); - if (result != TCL_OK) { - return result; - } - } - - listRepPtr = (List *) listPtr->internalRep.otherValuePtr; - if ((index < 0) || (index >= listRepPtr->elemCount)) { - *objPtrPtr = NULL; - } else { - *objPtrPtr = listRepPtr->elements[index]; - } - - return TCL_OK; -} - -/* - *---------------------------------------------------------------------- - * - * 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 - * 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. - * - * Side effects: - * The possible conversion of the argument object to a list object. - * - *---------------------------------------------------------------------- - */ - -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. */ -{ - register List *listRepPtr; - - if (listPtr->typePtr != &tclListType) { - int result = SetListFromAny(interp, listPtr); - if (result != TCL_OK) { - return result; - } - } - - listRepPtr = (List *) listPtr->internalRep.otherValuePtr; - *intPtr = listRepPtr->elemCount; - return TCL_OK; -} - -/* - *---------------------------------------------------------------------- - * - * 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. - * - * 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. - * - * 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. - * - * 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. - * - * 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. - * - *---------------------------------------------------------------------- - */ - -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. */ -{ - List *listRepPtr; - register Tcl_Obj **elemPtrs, **newPtrs; - Tcl_Obj *victimPtr; - int numElems, numRequired, numAfterLast; - int start, shift, newMax, i, j, result; - - if (Tcl_IsShared(listPtr)) { - panic("Tcl_ListObjReplace called with shared object"); - } - if (listPtr->typePtr != &tclListType) { - result = SetListFromAny(interp, listPtr); - if (result != TCL_OK) { - return result; - } - } - listRepPtr = (List *) listPtr->internalRep.otherValuePtr; - elemPtrs = listRepPtr->elements; - numElems = listRepPtr->elemCount; - - if (first < 0) { - first = 0; - } - if (first >= numElems) { - first = numElems; /* so we'll insert after last element */ - } - if (count < 0) { - count = 0; - } - - numRequired = (numElems - count + objc); - if (numRequired <= listRepPtr->maxElemCount) { - /* - * Enough room in the current array. First "delete" count - * elements starting at first. - */ - - for (i = 0, j = first; i < count; i++, j++) { - victimPtr = elemPtrs[j]; - TclDecrRefCount(victimPtr); - } - - /* - * Shift the elements after the last one removed to their - * new locations. - */ - - start = (first + count); - numAfterLast = (numElems - start); - shift = (objc - count); /* numNewElems - numDeleted */ - if ((numAfterLast > 0) && (shift != 0)) { - Tcl_Obj **src, **dst; - - if (shift < 0) { - for (src = elemPtrs + start, dst = src + shift; - numAfterLast > 0; numAfterLast--, src++, dst++) { - *dst = *src; - } - } else { - for (src = elemPtrs + numElems - 1, dst = src + shift; - numAfterLast > 0; numAfterLast--, src--, dst--) { - *dst = *src; - } - } - } - - /* - * Insert the new elements into elemPtrs before "first". - */ - - for (i = 0, j = first; i < objc; i++, j++) { - elemPtrs[j] = objv[i]; - Tcl_IncrRefCount(objv[i]); - } - - /* - * Update the count of elements. - */ - - listRepPtr->elemCount = numRequired; - } else { - /* - * Not enough room in the current array. Allocate a larger array and - * insert elements into it. - */ - - newMax = (2 * numRequired); - newPtrs = (Tcl_Obj **) - ckalloc((unsigned) (newMax * sizeof(Tcl_Obj *))); - - /* - * Copy over the elements before "first". - */ - - if (first > 0) { - memcpy((VOID *) newPtrs, (VOID *) elemPtrs, - (size_t) (first * sizeof(Tcl_Obj *))); - } - - /* - * "Delete" count elements starting at first. - */ - - for (i = 0, j = first; i < count; i++, j++) { - victimPtr = elemPtrs[j]; - TclDecrRefCount(victimPtr); - } - - /* - * Copy the elements after the last one removed, shifted to - * their new locations. - */ - - start = (first + count); - numAfterLast = (numElems - start); - if (numAfterLast > 0) { - memcpy((VOID *) &(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, j = first; i < objc; i++, j++) { - newPtrs[j] = objv[i]; - Tcl_IncrRefCount(objv[i]); - } - - listRepPtr->elemCount = numRequired; - listRepPtr->maxElemCount = newMax; - listRepPtr->elements = newPtrs; - ckfree((char *) elemPtrs); - } - - /* - * Invalidate and free any old string representation since it no longer - * reflects the list's internal representation. - */ - - Tcl_InvalidateStringRep(listPtr); - return TCL_OK; -} - -/* - *---------------------------------------------------------------------- - * - * FreeListInternalRep -- - * - * Deallocate the storage associated with a list object's internal - * representation. - * - * Results: - * None. - * - * Side effects: - * Frees listPtr's List* internal representation and sets listPtr's - * internalRep.otherValuePtr 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. */ -{ - register List *listRepPtr = (List *) listPtr->internalRep.otherValuePtr; - 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); - } - ckfree((char *) elemPtrs); - ckfree((char *) listRepPtr); -} - -/* - *---------------------------------------------------------------------- - * - * DupListInternalRep -- - * - * Initialize the internal representation of a list Tcl_Obj to a - * copy of 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. - * - *---------------------------------------------------------------------- - */ - -static void -DupListInternalRep(srcPtr, copyPtr) - Tcl_Obj *srcPtr; /* Object with internal rep to copy. */ - Tcl_Obj *copyPtr; /* Object with internal rep to set. */ -{ - List *srcListRepPtr = (List *) srcPtr->internalRep.otherValuePtr; - int numElems = srcListRepPtr->elemCount; - int maxElems = srcListRepPtr->maxElemCount; - register Tcl_Obj **srcElemPtrs = srcListRepPtr->elements; - register Tcl_Obj **copyElemPtrs; - register List *copyListRepPtr; - int i; - - /* - * Allocate a new List structure that points to "srcPtr"s element - * objects. Increment the ref counts for those (now shared) element - * objects. - */ - - copyElemPtrs = (Tcl_Obj **) - ckalloc((unsigned) maxElems * sizeof(Tcl_Obj *)); - for (i = 0; i < numElems; i++) { - copyElemPtrs[i] = srcElemPtrs[i]; - Tcl_IncrRefCount(copyElemPtrs[i]); - } - - copyListRepPtr = (List *) ckalloc(sizeof(List)); - copyListRepPtr->maxElemCount = maxElems; - copyListRepPtr->elemCount = numElems; - copyListRepPtr->elements = copyElemPtrs; - - copyPtr->internalRep.otherValuePtr = (VOID *) copyListRepPtr; - copyPtr->typePtr = &tclListType; -} - -/* - *---------------------------------------------------------------------- - * - * SetListFromAny -- - * - * 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 - * conversion, an error message is left in the interpreter's result - * unless "interp" is NULL. - * - * Side effects: - * If no error occurs, a list is stored as "objPtr"s internal - * representation. - * - *---------------------------------------------------------------------- - */ - -static int -SetListFromAny(interp, objPtr) - 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; - - /* - * Get the string representation. Make it up-to-date if necessary. - */ - - string = Tcl_GetStringFromObj(objPtr, &length); - - /* - * 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. - */ - - limit = (string + length); - estCount = 1; - for (p = string; p < limit; p++) { - if (isspace(UCHAR(*p))) { /* INTL: ISO space. */ - estCount++; - } - } - - /* - * 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. - */ - - 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"); - } - - /* - * Allocate a Tcl object for the element and initialize it from the - * "elemSize" bytes starting at "elemStart". - */ - - s = ckalloc((unsigned) elemSize + 1); - if (hasBrace) { - memcpy((VOID *) s, (VOID *) elemStart, (size_t) elemSize); - s[elemSize] = 0; - } else { - elemSize = TclCopyAndCollapse(elemSize, elemStart, s); - } - - 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; - - /* - * 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.otherValuePtr = (VOID *) listRepPtr; - objPtr->typePtr = &tclListType; - return TCL_OK; -} - -/* - *---------------------------------------------------------------------- - * - * 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. - * - * 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. - * - *---------------------------------------------------------------------- - */ - -static void -UpdateStringOfList(listPtr) - Tcl_Obj *listPtr; /* List object with string rep to update. */ -{ -# define LOCAL_SIZE 20 - int localFlags[LOCAL_SIZE], *flagPtr; - List *listRepPtr = (List *) listPtr->internalRep.otherValuePtr; - int numElems = listRepPtr->elemCount; - register int i; - char *elem, *dst; - int length; - - /* - * Convert each element of the list to string form and then convert it - * to proper list element form, adding it to the result buffer. - */ - - /* - * Pass 1: estimate space, gather flags. - */ - - if (numElems <= LOCAL_SIZE) { - flagPtr = localFlags; - } else { - flagPtr = (int *) ckalloc((unsigned) numElems*sizeof(int)); - } - listPtr->length = 1; - for (i = 0; i < numElems; i++) { - elem = Tcl_GetStringFromObj(listRepPtr->elements[i], &length); - listPtr->length += Tcl_ScanCountedElement(elem, length, - &flagPtr[i]) + 1; - } - - /* - * Pass 2: copy into string rep buffer. - */ - - listPtr->bytes = ckalloc((unsigned) listPtr->length); - 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++; - } - if (flagPtr != localFlags) { - ckfree((char *) flagPtr); - } - if (dst == listPtr->bytes) { - *dst = 0; - } else { - dst--; - *dst = 0; - } - listPtr->length = dst - listPtr->bytes; -} - -/* End of tcllistobj.c */ +/* $Header$ */ +/* + * tclListObj.c -- + * + * This file contains procedures that implement the Tcl list object + * type. + * + * Copyright (c) 1995-1997 Sun Microsystems, Inc. + * Copyright (c) 1998 by Scriptics Corporation. + * + * See the file "license.terms" for information on usage and redistribution + * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + * + * RCS: @(#) $Id: tcllistobj.c,v 1.1.1.1 2001/06/13 04:42:36 dtashley Exp $ + */ + +#include "tclInt.h" + +/* + * Prototypes for procedures 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)); + +/* + * The structure below defines the list Tcl object type by means of + * procedures that can be invoked by generic object code. + */ + +Tcl_ObjType tclListType = { + "list", /* name */ + FreeListInternalRep, /* freeIntRepProc */ + DupListInternalRep, /* dupIntRepProc */ + UpdateStringOfList, /* updateStringProc */ + SetListFromAny /* setFromAnyProc */ +}; + +/* + *---------------------------------------------------------------------- + * + * Tcl_NewListObj -- + * + * This procedure 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. + * + * 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. + * + * Side effects: + * The ref counts of the elements in objv are incremented since the + * resulting list now refers to them. + * + *---------------------------------------------------------------------- + */ + +#ifdef TCL_MEM_DEBUG +#undef 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. */ +{ + return Tcl_DbNewListObj(objc, objv, "unknown", 0); +} + +#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. */ +{ + register Tcl_Obj *listPtr; + register Tcl_Obj **elemPtrs; + register List *listRepPtr; + int i; + + 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.otherValuePtr = (VOID *) listRepPtr; + listPtr->typePtr = &tclListType; + } + return listPtr; +} +#endif /* if TCL_MEM_DEBUG */ + +/* + *---------------------------------------------------------------------- + * + * 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 + * Tcl_DbCkalloc directly with the file name and line number from its + * caller. This simplifies debugging since then the checkmem 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 + * 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. + * + * Side effects: + * The ref counts of the elements in objv are incremented since the + * resulting list now refers to them. + * + *---------------------------------------------------------------------- + */ + +#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. */ + char *file; /* The name of the source file calling this + * procedure; used for debugging. */ + int line; /* Line number in the source file; used + * for debugging. */ +{ + register Tcl_Obj *listPtr; + register Tcl_Obj **elemPtrs; + register List *listRepPtr; + int i; + + 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.otherValuePtr = (VOID *) listRepPtr; + listPtr->typePtr = &tclListType; + } + 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. */ + char *file; /* The name of the source file calling this + * procedure; used for debugging. */ + int line; /* Line number in the source file; used + * for debugging. */ +{ + return Tcl_NewListObj(objc, objv); +} +#endif /* TCL_MEM_DEBUG */ + +/* + *---------------------------------------------------------------------- + * + * Tcl_SetListObj -- + * + * Modify an object to be a list containing each of the objc elements + * of the object array referenced by objv. + * + * Results: + * None. + * + * 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. + * + *---------------------------------------------------------------------- + */ + +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. */ +{ + register Tcl_Obj **elemPtrs; + register List *listRepPtr; + Tcl_ObjType *oldTypePtr = objPtr->typePtr; + int i; + + if (Tcl_IsShared(objPtr)) { + panic("Tcl_SetListObj called with shared object"); + } + + /* + * Free any old string rep and any internal rep for the old type. + */ + + if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) { + oldTypePtr->freeIntRepProc(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. + */ + + 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.otherValuePtr = (VOID *) listRepPtr; + objPtr->typePtr = &tclListType; + } else { + objPtr->bytes = tclEmptyStringRep; + } +} + +/* + *---------------------------------------------------------------------- + * + * Tcl_ListObjGetElements -- + * + * This procedure 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. + * + * 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. + * + * Side effects: + * The possible conversion of the object referenced by listPtr + * to a list object. + * + *---------------------------------------------------------------------- + */ + +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 + * referenced by objv. */ + 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); + if (result != TCL_OK) { + return result; + } + } + listRepPtr = (List *) listPtr->internalRep.otherValuePtr; + *objcPtr = listRepPtr->elemCount; + *objvPtr = listRepPtr->elements; + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * Tcl_ListObjAppendList -- + * + * This procedure 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. + * + * 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. + * 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. */ +{ + register List *listRepPtr; + int listLen, objc, result; + Tcl_Obj **objv; + + if (Tcl_IsShared(listPtr)) { + panic("Tcl_ListObjAppendList called with shared object"); + } + if (listPtr->typePtr != &tclListType) { + result = SetListFromAny(interp, listPtr); + if (result != TCL_OK) { + return result; + } + } + listRepPtr = (List *) listPtr->internalRep.otherValuePtr; + listLen = listRepPtr->elemCount; + + result = Tcl_ListObjGetElements(interp, elemListPtr, &objc, &objv); + if (result != TCL_OK) { + return result; + } + + /* + * Insert objc new elements starting after the lists's last element. + * Delete zero existing elements. + */ + + return Tcl_ListObjReplace(interp, listPtr, listLen, 0, objc, objv); +} + +/* + *---------------------------------------------------------------------- + * + * 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. + * + * 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. + * + * 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. + * + *---------------------------------------------------------------------- + */ + +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. */ +{ + register List *listRepPtr; + register Tcl_Obj **elemPtrs; + int numElems, numRequired; + + if (Tcl_IsShared(listPtr)) { + panic("Tcl_ListObjAppendElement called with shared object"); + } + if (listPtr->typePtr != &tclListType) { + int result = SetListFromAny(interp, listPtr); + if (result != TCL_OK) { + return result; + } + } + + listRepPtr = (List *) listPtr->internalRep.otherValuePtr; + elemPtrs = listRepPtr->elements; + numElems = listRepPtr->elemCount; + numRequired = numElems + 1 ; + + /* + * If there is no room in the current array of element pointers, + * allocate a new, larger array and copy the pointers to it. + */ + + if (numRequired > listRepPtr->maxElemCount) { + int newMax = (2 * numRequired); + Tcl_Obj **newElemPtrs = (Tcl_Obj **) + ckalloc((unsigned) (newMax * sizeof(Tcl_Obj *))); + + memcpy((VOID *) newElemPtrs, (VOID *) elemPtrs, + (size_t) (numElems * sizeof(Tcl_Obj *))); + + listRepPtr->maxElemCount = newMax; + listRepPtr->elements = newElemPtrs; + ckfree((char *) elemPtrs); + elemPtrs = newElemPtrs; + } + + /* + * Add objPtr to the end of listPtr's array of element + * pointers. Increment the ref count for the (now shared) objPtr. + */ + + elemPtrs[numElems] = objPtr; + Tcl_IncrRefCount(objPtr); + listRepPtr->elemCount++; + + /* + * Invalidate any old string representation since the list's internal + * representation has changed. + */ + + Tcl_InvalidateStringRep(listPtr); + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * 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. + * + * 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. + * + * Side effects: + * listPtr will be converted, if necessary, to a list object. + * + *---------------------------------------------------------------------- + */ + +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. */ +{ + register List *listRepPtr; + + if (listPtr->typePtr != &tclListType) { + int result = SetListFromAny(interp, listPtr); + if (result != TCL_OK) { + return result; + } + } + + listRepPtr = (List *) listPtr->internalRep.otherValuePtr; + if ((index < 0) || (index >= listRepPtr->elemCount)) { + *objPtrPtr = NULL; + } else { + *objPtrPtr = listRepPtr->elements[index]; + } + + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * 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 + * 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. + * + * Side effects: + * The possible conversion of the argument object to a list object. + * + *---------------------------------------------------------------------- + */ + +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. */ +{ + register List *listRepPtr; + + if (listPtr->typePtr != &tclListType) { + int result = SetListFromAny(interp, listPtr); + if (result != TCL_OK) { + return result; + } + } + + listRepPtr = (List *) listPtr->internalRep.otherValuePtr; + *intPtr = listRepPtr->elemCount; + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * 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. + * + * 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. + * + * 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. + * + * 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. + * + * 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. + * + *---------------------------------------------------------------------- + */ + +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. */ +{ + List *listRepPtr; + register Tcl_Obj **elemPtrs, **newPtrs; + Tcl_Obj *victimPtr; + int numElems, numRequired, numAfterLast; + int start, shift, newMax, i, j, result; + + if (Tcl_IsShared(listPtr)) { + panic("Tcl_ListObjReplace called with shared object"); + } + if (listPtr->typePtr != &tclListType) { + result = SetListFromAny(interp, listPtr); + if (result != TCL_OK) { + return result; + } + } + listRepPtr = (List *) listPtr->internalRep.otherValuePtr; + elemPtrs = listRepPtr->elements; + numElems = listRepPtr->elemCount; + + if (first < 0) { + first = 0; + } + if (first >= numElems) { + first = numElems; /* so we'll insert after last element */ + } + if (count < 0) { + count = 0; + } + + numRequired = (numElems - count + objc); + if (numRequired <= listRepPtr->maxElemCount) { + /* + * Enough room in the current array. First "delete" count + * elements starting at first. + */ + + for (i = 0, j = first; i < count; i++, j++) { + victimPtr = elemPtrs[j]; + TclDecrRefCount(victimPtr); + } + + /* + * Shift the elements after the last one removed to their + * new locations. + */ + + start = (first + count); + numAfterLast = (numElems - start); + shift = (objc - count); /* numNewElems - numDeleted */ + if ((numAfterLast > 0) && (shift != 0)) { + Tcl_Obj **src, **dst; + + if (shift < 0) { + for (src = elemPtrs + start, dst = src + shift; + numAfterLast > 0; numAfterLast--, src++, dst++) { + *dst = *src; + } + } else { + for (src = elemPtrs + numElems - 1, dst = src + shift; + numAfterLast > 0; numAfterLast--, src--, dst--) { + *dst = *src; + } + } + } + + /* + * Insert the new elements into elemPtrs before "first". + */ + + for (i = 0, j = first; i < objc; i++, j++) { + elemPtrs[j] = objv[i]; + Tcl_IncrRefCount(objv[i]); + } + + /* + * Update the count of elements. + */ + + listRepPtr->elemCount = numRequired; + } else { + /* + * Not enough room in the current array. Allocate a larger array and + * insert elements into it. + */ + + newMax = (2 * numRequired); + newPtrs = (Tcl_Obj **) + ckalloc((unsigned) (newMax * sizeof(Tcl_Obj *))); + + /* + * Copy over the elements before "first". + */ + + if (first > 0) { + memcpy((VOID *) newPtrs, (VOID *) elemPtrs, + (size_t) (first * sizeof(Tcl_Obj *))); + } + + /* + * "Delete" count elements starting at first. + */ + + for (i = 0, j = first; i < count; i++, j++) { + victimPtr = elemPtrs[j]; + TclDecrRefCount(victimPtr); + } + + /* + * Copy the elements after the last one removed, shifted to + * their new locations. + */ + + start = (first + count); + numAfterLast = (numElems - start); + if (numAfterLast > 0) { + memcpy((VOID *) &(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, j = first; i < objc; i++, j++) { + newPtrs[j] = objv[i]; + Tcl_IncrRefCount(objv[i]); + } + + listRepPtr->elemCount = numRequired; + listRepPtr->maxElemCount = newMax; + listRepPtr->elements = newPtrs; + ckfree((char *) elemPtrs); + } + + /* + * Invalidate and free any old string representation since it no longer + * reflects the list's internal representation. + */ + + Tcl_InvalidateStringRep(listPtr); + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * FreeListInternalRep -- + * + * Deallocate the storage associated with a list object's internal + * representation. + * + * Results: + * None. + * + * Side effects: + * Frees listPtr's List* internal representation and sets listPtr's + * internalRep.otherValuePtr 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. */ +{ + register List *listRepPtr = (List *) listPtr->internalRep.otherValuePtr; + 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); + } + ckfree((char *) elemPtrs); + ckfree((char *) listRepPtr); +} + +/* + *---------------------------------------------------------------------- + * + * DupListInternalRep -- + * + * Initialize the internal representation of a list Tcl_Obj to a + * copy of 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. + * + *---------------------------------------------------------------------- + */ + +static void +DupListInternalRep(srcPtr, copyPtr) + Tcl_Obj *srcPtr; /* Object with internal rep to copy. */ + Tcl_Obj *copyPtr; /* Object with internal rep to set. */ +{ + List *srcListRepPtr = (List *) srcPtr->internalRep.otherValuePtr; + int numElems = srcListRepPtr->elemCount; + int maxElems = srcListRepPtr->maxElemCount; + register Tcl_Obj **srcElemPtrs = srcListRepPtr->elements; + register Tcl_Obj **copyElemPtrs; + register List *copyListRepPtr; + int i; + + /* + * Allocate a new List structure that points to "srcPtr"s element + * objects. Increment the ref counts for those (now shared) element + * objects. + */ + + copyElemPtrs = (Tcl_Obj **) + ckalloc((unsigned) maxElems * sizeof(Tcl_Obj *)); + for (i = 0; i < numElems; i++) { + copyElemPtrs[i] = srcElemPtrs[i]; + Tcl_IncrRefCount(copyElemPtrs[i]); + } + + copyListRepPtr = (List *) ckalloc(sizeof(List)); + copyListRepPtr->maxElemCount = maxElems; + copyListRepPtr->elemCount = numElems; + copyListRepPtr->elements = copyElemPtrs; + + copyPtr->internalRep.otherValuePtr = (VOID *) copyListRepPtr; + copyPtr->typePtr = &tclListType; +} + +/* + *---------------------------------------------------------------------- + * + * SetListFromAny -- + * + * 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 + * conversion, an error message is left in the interpreter's result + * unless "interp" is NULL. + * + * Side effects: + * If no error occurs, a list is stored as "objPtr"s internal + * representation. + * + *---------------------------------------------------------------------- + */ + +static int +SetListFromAny(interp, objPtr) + 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; + + /* + * Get the string representation. Make it up-to-date if necessary. + */ + + string = Tcl_GetStringFromObj(objPtr, &length); + + /* + * 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. + */ + + limit = (string + length); + estCount = 1; + for (p = string; p < limit; p++) { + if (isspace(UCHAR(*p))) { /* INTL: ISO space. */ + estCount++; + } + } + + /* + * 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. + */ + + 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"); + } + + /* + * Allocate a Tcl object for the element and initialize it from the + * "elemSize" bytes starting at "elemStart". + */ + + s = ckalloc((unsigned) elemSize + 1); + if (hasBrace) { + memcpy((VOID *) s, (VOID *) elemStart, (size_t) elemSize); + s[elemSize] = 0; + } else { + elemSize = TclCopyAndCollapse(elemSize, elemStart, s); + } + + 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; + + /* + * 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.otherValuePtr = (VOID *) listRepPtr; + objPtr->typePtr = &tclListType; + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * 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. + * + * 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. + * + *---------------------------------------------------------------------- + */ + +static void +UpdateStringOfList(listPtr) + Tcl_Obj *listPtr; /* List object with string rep to update. */ +{ +# define LOCAL_SIZE 20 + int localFlags[LOCAL_SIZE], *flagPtr; + List *listRepPtr = (List *) listPtr->internalRep.otherValuePtr; + int numElems = listRepPtr->elemCount; + register int i; + char *elem, *dst; + int length; + + /* + * Convert each element of the list to string form and then convert it + * to proper list element form, adding it to the result buffer. + */ + + /* + * Pass 1: estimate space, gather flags. + */ + + if (numElems <= LOCAL_SIZE) { + flagPtr = localFlags; + } else { + flagPtr = (int *) ckalloc((unsigned) numElems*sizeof(int)); + } + listPtr->length = 1; + for (i = 0; i < numElems; i++) { + elem = Tcl_GetStringFromObj(listRepPtr->elements[i], &length); + listPtr->length += Tcl_ScanCountedElement(elem, length, + &flagPtr[i]) + 1; + } + + /* + * Pass 2: copy into string rep buffer. + */ + + listPtr->bytes = ckalloc((unsigned) listPtr->length); + 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++; + } + if (flagPtr != localFlags) { + ckfree((char *) flagPtr); + } + if (dst == listPtr->bytes) { + *dst = 0; + } else { + dst--; + *dst = 0; + } + listPtr->length = dst - listPtr->bytes; +} + +/* End of tcllistobj.c */