tcllistobj.c

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

    Tcl_Obj** indices;		/* Vector of indices in the index list*/

    int duplicated;		/* Flag == 1 if the obj has been
				 * duplicated, 0 otherwise */
    Tcl_Obj* retValuePtr;	/* Pointer to the list to be returned */
    int index;			/* Current index in the list - discarded */
    int result;			/* Status return from library calls */
    Tcl_Obj* subListPtr;	/* Pointer to the current sublist */
    int elemCount;		/* Count of elements in the current sublist */
    Tcl_Obj** elemPtrs;		/* Pointers to elements of current sublist  */
    Tcl_Obj* chainPtr;		/* Pointer to the enclosing sublist
				 * of the current sublist */
    int i;


    /*
     * Determine whether the index arg designates a list or a single
     * index.  We have to be careful about the order of the checks to
     * avoid repeated shimmering; see TIP #22 and #23 for details.
     */

    if ( indexArgPtr->typePtr != &tclListType
	 && TclGetIntForIndex( NULL, indexArgPtr, 0, &index ) == TCL_OK ) {

	/*
	 * indexArgPtr designates a single index.
	 */

	return TclLsetFlat( interp, listPtr, 1, &indexArgPtr, valuePtr );

    } else if ( Tcl_ListObjGetElements( NULL, indexArgPtr,
					&indexCount, &indices ) != TCL_OK ) {

	/*
	 * indexArgPtr designates something that is neither an index nor a
	 * well formed list.  Report the error via TclLsetFlat.
	 */

	return TclLsetFlat( interp, listPtr, 1, &indexArgPtr, valuePtr );

    }

    /*
     * At this point, we know that argPtr designates a well formed list,
     * and the 'else if' above has parsed it into indexCount and indices.
     * If there are no indices, simply return 'valuePtr', counting the
     * returned pointer as a reference.
     */

    if ( indexCount == 0 ) {
	Tcl_IncrRefCount( valuePtr );
	return valuePtr;
    }

    /*
     * Duplicate the list arg if necessary.
     */

    if ( Tcl_IsShared( listPtr ) ) {
	duplicated = 1;
	listPtr = Tcl_DuplicateObj( listPtr );
	Tcl_IncrRefCount( listPtr );
    } else {
	duplicated = 0;
    }

    /*
     * It would be tempting simply to go off to TclLsetFlat to finish the
     * processing.  Alas, it is also incorrect!  The problem is that
     * 'indexArgPtr' may designate a sublist of 'listPtr' whose value
     * is to be manipulated.  The fact that 'listPtr' is itself unshared
     * does not guarantee that no sublist is.  Therefore, it's necessary
     * to replicate all the work here, expanding the index list on each
     * trip through the loop.
     */

    /*
     * Anchor the linked list of Tcl_Obj's whose string reps must be
     * invalidated if the operation succeeds.
     */

    retValuePtr = listPtr;
    chainPtr = NULL;

    /*
     * Handle each index arg by diving into the appropriate sublist
     */

    for ( i = 0; ; ++i ) {

	/*
	 * Take the sublist apart.
	 */

	result = Tcl_ListObjGetElements( interp, listPtr,
					 &elemCount, &elemPtrs );
	if ( result != TCL_OK ) {
	    break;
	}
	listPtr->internalRep.twoPtrValue.ptr2 = (VOID *) chainPtr;

	/*
	 * Reconstitute the index array
	 */

	result = Tcl_ListObjGetElements( interp, indexArgPtr,
					 &indexCount, &indices );
	if ( result != TCL_OK ) {
	    /* 
	     * Shouldn't be able to get here, because we already
	     * parsed the thing successfully once.
	     */
	    break;
	}

	/*
	 * Determine the index of the requested element.
	 */

	result = TclGetIntForIndex( interp, indices[ i ],
				    (elemCount - 1), &index );
	if ( result != TCL_OK ) {
	    break;
	}
	
	/*
	 * Check that the index is in range.
	 */

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

	/*
	 * Break the loop after extracting the innermost sublist
	 */

	if ( i >= indexCount-1 ) {
	    result = TCL_OK;
	    break;
	}
	
	/*
	 * Extract the appropriate sublist, and make sure that it is unshared.
	 */

	subListPtr = elemPtrs[ index ];
	if ( Tcl_IsShared( subListPtr ) ) {
	    subListPtr = Tcl_DuplicateObj( subListPtr );
	    result = TclListObjSetElement( interp, listPtr, index,
					    subListPtr );
	    if ( result != TCL_OK ) {
		/* 
		 * We actually shouldn't be able to get here, because
		 * we've already checked everything that TclListObjSetElement
		 * checks. If we were to get here, it would result in leaking
		 * subListPtr.
		 */
		break;
	    }
	}

	/* 
	 * Chain the current sublist onto the linked list of Tcl_Obj's
	 * whose string reps must be spoilt.
	 */

	chainPtr = listPtr;
	listPtr = subListPtr;

    }

    /*
     * Store the new element into the correct slot in the innermost sublist.
     */

    if ( result == TCL_OK ) {
	result = TclListObjSetElement( interp, listPtr, index, valuePtr );
    }

    if ( result == TCL_OK ) {

	listPtr->internalRep.twoPtrValue.ptr2 = (VOID *) chainPtr;

	/* Spoil all the string reps */
	
	while ( listPtr != NULL ) {
	    subListPtr = (Tcl_Obj *) listPtr->internalRep.twoPtrValue.ptr2;
	    Tcl_InvalidateStringRep( listPtr );
	    listPtr->internalRep.twoPtrValue.ptr2 = NULL;
	    listPtr = subListPtr;
	}

	/* 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;

}

/*
 *----------------------------------------------------------------------
 *
 * TclLsetFlat --
 *
 *	Core of the 'lset' command when objc>=5.  Objv[2], ... ,
 *	objv[objc-2] contain scalar 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_LsetList and related functions maintain a linked list of
 * Tcl_Obj's whose string representations must be spoilt by threading
 * via 'ptr2' of the two-pointer internal representation.  On entry
 * to Tcl_LsetList, the values of 'ptr2' are immaterial; on exit,
 * the 'ptr2' field of any Tcl_Obj that has been modified is set to
 * NULL.
 *
 *----------------------------------------------------------------------
 */

Tcl_Obj*
TclLsetFlat( interp, listPtr, indexCount, indexArray, valuePtr )
    Tcl_Interp* interp;		/* Tcl interpreter */
    Tcl_Obj* listPtr;		/* Pointer to the list being modified */
    int indexCount;		/* Number of index args */
    Tcl_Obj *CONST indexArray[];
				/* Index args */
    Tcl_Obj* valuePtr;		/* Value arg to 'lset' */
{

    int duplicated;		/* Flag == 1 if the obj has been
				 * duplicated, 0 otherwise */
    Tcl_Obj* retValuePtr;	/* Pointer to the list to be returned */

    int elemCount;		/* Length of one sublist being changed */
    Tcl_Obj** elemPtrs;		/* Pointers to the elements of a sublist */

    Tcl_Obj* subListPtr;	/* Pointer to the current sublist */

    int index;			/* Index of the element to replace in the
				 * current sublist */
    Tcl_Obj* chainPtr;		/* Pointer to the enclosing list of
				 * the current sublist. */

    int result;			/* Status return from library calls */



    int i;

    /*
     * If there are no indices, then simply return the new value,
     * counting the returned pointer as a reference
     */

    if ( indexCount == 0 ) {
	Tcl_IncrRefCount( valuePtr );
	return valuePtr;
    }

    /*
     * If the list is shared, make a private copy.
     */

    if ( Tcl_IsShared( listPtr ) ) {
	duplicated = 1;
	listPtr = Tcl_DuplicateObj( listPtr );
	Tcl_IncrRefCount( listPtr );
    } else {
	duplicated = 0;
    }

    /*
     * Anchor the linked list of Tcl_Obj's whose string reps must be
     * invalidated if the operation succeeds.
     */

    retValuePtr = listPtr;
    chainPtr = NULL;

    /*
     * Handle each index arg by diving into the appropriate sublist
     */

    for ( i = 0; ; ++i ) {

	/*
	 * Take the sublist apart.
	 */

	result = Tcl_ListObjGetElements( interp, listPtr,
					 &elemCount, &elemPtrs );
	if ( result != TCL_OK ) {
	    break;
	}
	listPtr->internalRep.twoPtrValue.ptr2 = (VOID *) chainPtr;

	/*
	 * Determine the index of the requested element.
	 */

	result = TclGetIntForIndex( interp, indexArray[ i ],
				    (elemCount - 1), &index );
	if ( result != TCL_OK ) {
	    break;
	}
	
	/*
	 * Check that the index is in range.
	 */

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

	/*
	 * Break the loop after extracting the innermost sublist
	 */

	if ( i >= indexCount-1 ) {
	    result = TCL_OK;
	    break;
	}
	
	/*
	 * Extract the appropriate sublist, and make sure that it is unshared.
	 */

	subListPtr = elemPtrs[ index ];
	if ( Tcl_IsShared( subListPtr ) ) {
	    subListPtr = Tcl_DuplicateObj( subListPtr );
	    result = TclListObjSetElement( interp, listPtr, index,
					    subListPtr );
	    if ( result != TCL_OK ) {
		/* 
		 * We actually shouldn't be able to get here.
		 * If we do, it would result in leaking subListPtr,
		 * but everything's been validated already; the error
		 * exit from TclListObjSetElement should never happen.
		 */
		break;
	    }
	}

	/* 
	 * Chain the current sublist onto the linked list of Tcl_Obj's
	 * whose string reps must be spoilt.
	 */

	chainPtr = listPtr;
	listPtr = subListPtr;

    }

    /* Store the result in the list element */

    if ( result == TCL_OK ) {
	result = TclListObjSetElement( interp, listPtr, index, valuePtr );
    }

    if ( result == TCL_OK ) {

	listPtr->internalRep.twoPtrValue.ptr2 = (VOID *) chainPtr;

	/* Spoil all the string reps */
	
	while ( listPtr != NULL ) {
	    subListPtr = (Tcl_Obj *) listPtr->internalRep.twoPtrValue.ptr2;
	    Tcl_InvalidateStringRep( listPtr );
	    listPtr->internalRep.twoPtrValue.ptr2 = NULL;