URL
https://opencores.org/ocsvn/or1k/or1k/trunk
Subversion Repositories or1k
[/] [or1k/] [trunk/] [insight/] [tcl/] [generic/] [tclListObj.c] - Rev 1774
Go to most recent revision | Compare with Previous | Blame | View Log
/* * 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 2002-01-16 10:25:28 markom 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. */ Tcl_InvalidateStringRep(objPtr); if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) { oldTypePtr->freeIntRepProc(objPtr); } objPtr->typePtr = NULL; /* * Set the object's type to "list" and initialize the internal rep. */ 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, *elemStart, *nextElem, *s; int lenRemain, length, estCount, elemSize, hasBrace, i, j, result; char *limit; /* Points just after string's last byte. */ register 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))) { 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; }
Go to most recent revision | Compare with Previous | Blame | View Log