tcllistobj.c

来自「tcl是工具命令语言」· C语言 代码 · 共 1,659 行 · 第 1/4 页

 *
 * 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.twoPtrValue.ptr1;
    elemPtrs = listRepPtr->elements;
    numElems = listRepPtr->elemCount;
    numRequired = numElems + 1 ;
    
    /*
     * If there is no room in the current array of element pointers,
     * allocate a new, larger array and copy the pointers to it.
     */

    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.twoPtrValue.ptr1;
    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.twoPtrValue.ptr1;
    *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.twoPtrValue.ptr1;
    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;
}

/*
 *----------------------------------------------------------------------
 *
 * TclLsetList --
 *	
 *	Core of the 'lset' command when objc == 4.  Objv[2] may be
 *	either a scalar index or a list of indices.
 *
 * Results:
 *	Returns the new value of the list variable, or NULL if an
 *	error occurs.
 *
 * Side effects:
 *	Surgery is performed on the list value to produce the
 *	result.
 *
 * On entry, the reference count of the variable value does not reflect
 * any references held on the stack.  The first action of this function
 * is to determine whether the object is shared, and to duplicate it if
 * it is.  The reference count of the duplicate is incremented.
 * At this point, the reference count will be 1 for either case, so that
 * the object will appear to be unshared.
 *
 * If an error occurs, and the object has been duplicated, the reference
 * count on the duplicate is decremented so that it is now 0: this dismisses
 * any memory that was allocated by this procedure.
 *
 * If no error occurs, the reference count of the original object is
 * incremented if the object has not been duplicated, and nothing is
 * done to a reference count of the duplicate.  Now the reference count
 * of an unduplicated object is 2 (the returned pointer, plus the one
 * stored in the variable).  The reference count of a duplicate object
 * is 1, reflecting that the returned pointer is the only active
 * reference.  The caller is expected to store the returned value back
 * in the variable and decrement its reference count.  (INST_STORE_*
 * does exactly this.)
 *
 * Tcl_LsetFlat and related functions maintain a linked list of
 * Tcl_Obj's whose string representations must be spoilt by threading
 * via 'ptr2' of the two-pointer internal representation.  On entry
 * to Tcl_LsetList, the values of 'ptr2' are immaterial; on exit,
 * the 'ptr2' field of any Tcl_Obj that has been modified is set to
 * NULL.
 *
 *----------------------------------------------------------------------
 */

Tcl_Obj*
TclLsetList( interp, listPtr, indexArgPtr, valuePtr )
    Tcl_Interp* interp;		/* Tcl interpreter */
    Tcl_Obj* listPtr;		/* Pointer to the list being modified */
    Tcl_Obj* indexArgPtr;	/* Index or index-list arg to 'lset' */
    Tcl_Obj* valuePtr;		/* Value arg to 'lset' */
{
    int indexCount;		/* Number of indices in the index list */