tcllistobj.c

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

	    listPtr = subListPtr;
	}

	/* Return the new list if everything worked. */
	
	if ( !duplicated ) {
	    Tcl_IncrRefCount( retValuePtr );
	}
	return retValuePtr;
    }

    /* Clean up the one dangling reference otherwise */

    if ( duplicated ) {
	Tcl_DecrRefCount( retValuePtr );
    }
    return NULL;

}

/*
 *----------------------------------------------------------------------
 *
 * TclListObjSetElement --
 *
 *	Set a single element of a list to a specified value
 *
 * Results:
 *
 *	The return value is normally TCL_OK.  If listPtr does not
 *	refer to a list object and cannot be converted to one, TCL_ERROR
 *	is returned and an error message will be left in the interpreter
 *	result if interp is not NULL.  Similarly, if index designates
 *	an element outside the range [0..listLength-1], where
 *	listLength is the count of elements in the list object designated
 *	by listPtr, TCL_ERROR is returned and an error message is left
 *	in the interpreter result.
 *
 * Side effects:
 *
 *	Panics if listPtr designates a shared object.  Otherwise, attempts
 *	to convert it to a list.  Decrements the ref count of the object
 *	at the specified index within the list, replaces with the
 *	object designated by valuePtr, and increments the ref count
 *	of the replacement object.  
 *
 * It is the caller's responsibility to invalidate the string
 * representation of the object.
 *
 *----------------------------------------------------------------------
 */

int
TclListObjSetElement( interp, listPtr, index, valuePtr )
    Tcl_Interp* interp;		/* Tcl interpreter; used for error reporting
				 * if not NULL */
    Tcl_Obj* listPtr;		/* List object in which element should be
				 * stored */
    int index;			/* Index of element to store */
    Tcl_Obj* valuePtr;		/* Tcl object to store in the designated
				 * list element */
{
    int result;			/* Return value from this function */
    List* listRepPtr;		/* Internal representation of the list
				 * being modified */
    Tcl_Obj** elemPtrs;		/* Pointers to elements of the list */
    int elemCount;		/* Number of elements in the list */

    /* Ensure that the listPtr parameter designates an unshared list */

    if ( Tcl_IsShared( listPtr ) ) {
	panic( "Tcl_ListObjSetElement 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;
    elemCount = listRepPtr->elemCount;

    /* Ensure that the index is in bounds */

    if ( index < 0 || index >= elemCount ) {
	if ( interp != NULL ) {
	    Tcl_SetObjResult( interp,
			      Tcl_NewStringObj( "list index out of range",
						-1 ) );
	    return TCL_ERROR;
	}
    }

    /* Add a reference to the new list element */

    Tcl_IncrRefCount( valuePtr );

    /* Remove a reference from the old list element */

    Tcl_DecrRefCount( elemPtrs[ index ] );

    /* Stash the new object in the list */

    elemPtrs[ index ] = valuePtr;

    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.twoPtrValue.ptr1 to NULL. Decrements the ref counts
 *	of all element objects, which may free them.
 *
 *----------------------------------------------------------------------
 */

static void
FreeListInternalRep(listPtr)
    Tcl_Obj *listPtr;		/* List object with internal rep to free. */
{
    register List *listRepPtr = (List *) listPtr->internalRep.twoPtrValue.ptr1;
    register Tcl_Obj **elemPtrs = listRepPtr->elements;
    register Tcl_Obj *objPtr;
    int numElems = listRepPtr->elemCount;
    int i;
    
    for (i = 0;  i < numElems;  i++) {
	objPtr = elemPtrs[i];
	Tcl_DecrRefCount(objPtr);
    }
    ckfree((char *) elemPtrs);
    ckfree((char *) listRepPtr);

    listPtr->internalRep.twoPtrValue.ptr1 = NULL;
    listPtr->internalRep.twoPtrValue.ptr2 = NULL;
}

/*
 *----------------------------------------------------------------------
 *
 * 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.twoPtrValue.ptr1;
    int numElems = srcListRepPtr->elemCount;
    int maxElems = srcListRepPtr->maxElemCount;
    register Tcl_Obj **srcElemPtrs = srcListRepPtr->elements;
    register Tcl_Obj **copyElemPtrs;
    register List *copyListRepPtr;
    int i;

    /*
     * Allocate a new List structure that points to "srcPtr"s element
     * objects. Increment the ref counts for those (now shared) element
     * objects.
     */
    
    copyElemPtrs = (Tcl_Obj **)
	ckalloc((unsigned) maxElems * sizeof(Tcl_Obj *));
    for (i = 0;  i < numElems;  i++) {
	copyElemPtrs[i] = srcElemPtrs[i];
	Tcl_IncrRefCount(copyElemPtrs[i]);
    }
    
    copyListRepPtr = (List *) ckalloc(sizeof(List));
    copyListRepPtr->maxElemCount = maxElems;
    copyListRepPtr->elemCount    = numElems;
    copyListRepPtr->elements     = copyElemPtrs;
    
    copyPtr->internalRep.twoPtrValue.ptr1 = (VOID *) copyListRepPtr;
    copyPtr->internalRep.twoPtrValue.ptr2 = NULL;
    copyPtr->typePtr = &tclListType;
}

/*
 *----------------------------------------------------------------------
 *
 * 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.twoPtrValue.ptr1 = (VOID *) listRepPtr;
    objPtr->internalRep.twoPtrValue.ptr2 = NULL;
    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.twoPtrValue.ptr1;
    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;
}