Tcl Source Code

2011-04-18  Don Porter  <[email protected]>





	* generic/tclInt.h:	Define and use macros that test whether
	* generic/tclBasic.c:	a Tcl list value is canonical.
	* generic/tclUtil.c:

2011-04-18  Donal K. Fellows  <[email protected]>

InfoLoadedCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    const char *interpName;
    int result;

    if ((objc != 1) && (objc != 2)) {
	Tcl_WrongNumArgs(interp, 1, objv, "?interp?");
	return TCL_ERROR;
    }

    if (objc == 1) {		/* Get loaded pkgs in all interpreters. */
	interpName = NULL;
    } else {			/* Get pkgs just in specified interp. */
	interpName = TclGetString(objv[1]);
    }
    result = TclGetLoadedPackages(interp, interpName);
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * InfoNameOfExecutableCmd --
 *

    result = TclListObjGetElements(interp, objv[1], &listLen, &elemPtrs);
    if (result != TCL_OK) {
	return result;
    }

    if (Tcl_IsShared(objv[1]) ||
	    (((List *) objv[1]->internalRep.twoPtrValue.ptr1)->refCount > 1)) {
	Tcl_SetObjResult(interp, Tcl_NewListObj(last - first + 1,
		&elemPtrs[first]));
    } else {
	/*
	 * In-place is possible.
	 */

    /*
     * Get an empty list object that is allocated large enough to hold each
     * init value elementCount times.
     */

    listPtr = Tcl_NewListObj(totalElems, NULL);
    if (totalElems) {
	List *listRepPtr = listPtr->internalRep.twoPtrValue.ptr1;

	listRepPtr->elemCount = elementCount*objc;
	dataArray = &listRepPtr->elements;
    }

    /*
     * Set the elements. Note that we handle the common degenerate case of a

     */

    if (!elemc) {
	Tcl_SetObjResult(interp, objv[1]);
	return TCL_OK;
    }

    if (Tcl_IsShared(objv[1])) {

	Tcl_Obj *resultObj, **dataArray;
	List *listPtr;

    makeNewReversedList:
	resultObj = Tcl_NewListObj(elemc, NULL);
	listPtr = resultObj->internalRep.twoPtrValue.ptr1;
	listPtr->elemCount = elemc;
	dataArray = &listPtr->elements;

	for (i=0,j=elemc-1 ; i<elemc ; i++,j--) {
	    dataArray[j] = elemv[i];
	    Tcl_IncrRefCount(elemv[i]);
	}

	Tcl_SetObjResult(interp, resultObj);
    } else {
	/*
	 * It is theoretically possible for a list object to have a shared
	 * internal representation, but be an unshared object. Check for this
	 * and use the "shared" code if we have that problem. [Bug 1675044]
	 */

	if (((List *) objv[1]->internalRep.twoPtrValue.ptr1)->refCount > 1) {
	    goto makeNewReversedList;
	}

	/*
	 * Not shared, so swap "in place". This relies on Tcl_LOGE above
	 * returning a pointer to the live array of Tcl_Obj values.
	 */

	for (i=0,j=elemc-1 ; i<j ; i++,j--) {

     */

    if (sortInfo.resultCode == TCL_OK) {
	List *listRepPtr;
	Tcl_Obj **newArray, *objPtr;

	resultPtr = Tcl_NewListObj(sortInfo.numElements * groupSize, NULL);
	listRepPtr = resultPtr->internalRep.twoPtrValue.ptr1;
	newArray = &listRepPtr->elements;
	if (group) {
	    for (i=0; elementPtr!=NULL ; elementPtr=elementPtr->nextPtr) {
		idx = elementPtr->payload.index;
		for (j = 0; j < groupSize; j++) {
		    if (indices) {
			objPtr = Tcl_NewIntObj(idx + j - groupOffset);

	    Tcl_SetResult(interp, "insufficient memory to create list",
		    TCL_STATIC);
	    Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
	    return TCL_ERROR;
	}

	if (n) {
	    List *listRepPtr = (List *)
		    listPtr->internalRep.twoPtrValue.ptr1;
	    Tcl_DictSearch s;
	    Tcl_Obj *key, **vals;
	    int done, i = 0;

	    listRepPtr->elemCount = n;
	    vals = &listRepPtr->elements;

	}

	result = SetListFromAny(interp, listPtr);
	if (result != TCL_OK) {
	    return result;
	}
    }
    listRepPtr = listPtr->internalRep.twoPtrValue.ptr1;
    *objcPtr = listRepPtr->elemCount;
    *objvPtr = &listRepPtr->elements;
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------

	result = SetListFromAny(interp, listPtr);
	if (result != TCL_OK) {
	    return result;
	}
    }

    listRepPtr = listPtr->internalRep.twoPtrValue.ptr1;
    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 the List struct is
     * shared, allocate a new one.

	result = SetListFromAny(interp, listPtr);
	if (result != TCL_OK) {
	    return result;
	}
    }

    listRepPtr = listPtr->internalRep.twoPtrValue.ptr1;
    if ((index < 0) || (index >= listRepPtr->elemCount)) {
	*objPtrPtr = NULL;
    } else {
	*objPtrPtr = (&listRepPtr->elements)[index];
    }

    return TCL_OK;

	result = SetListFromAny(interp, listPtr);
	if (result != TCL_OK) {
	    return result;
	}
    }

    listRepPtr = listPtr->internalRep.twoPtrValue.ptr1;
    *intPtr = listRepPtr->elemCount;
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *

     * Note that when count == 0 and objc == 0, this routine is logically a
     * no-op, removing and adding no elements to the list. However, by flowing
     * through this routine anyway, we get the important side effect that the
     * resulting listPtr is a list in canoncial form. This is important.
     * Resist any temptation to optimize this case.
     */

    listRepPtr = listPtr->internalRep.twoPtrValue.ptr1;
    elemPtrs = &listRepPtr->elements;
    numElems = listRepPtr->elemCount;

    if (first < 0) {
	first = 0;
    }
    if (first >= numElems) {

	}
	result = SetListFromAny(interp, listPtr);
	if (result != TCL_OK) {
	    return result;
	}
    }

    listRepPtr = listPtr->internalRep.twoPtrValue.ptr1;
    elemCount = listRepPtr->elemCount;
    elemPtrs = &listRepPtr->elements;

    /*
     * Ensure that the index is in bounds.
     */

 *----------------------------------------------------------------------
 */

static void
FreeListInternalRep(
    Tcl_Obj *listPtr)		/* List object with internal rep to free. */
{
    register List *listRepPtr = listPtr->internalRep.twoPtrValue.ptr1;
    register Tcl_Obj **elemPtrs = &listRepPtr->elements;
    register Tcl_Obj *objPtr;
    int numElems = listRepPtr->elemCount;
    int i;

    if (--listRepPtr->refCount <= 0) {
	for (i = 0;  i < numElems;  i++) {

 */

static void
DupListInternalRep(
    Tcl_Obj *srcPtr,		/* Object with internal rep to copy. */
    Tcl_Obj *copyPtr)		/* Object with internal rep to set. */
{
    List *listRepPtr = srcPtr->internalRep.twoPtrValue.ptr1;

    listRepPtr->refCount++;
    copyPtr->internalRep.twoPtrValue.ptr1 = listRepPtr;
    copyPtr->internalRep.twoPtrValue.ptr2 = NULL;
    copyPtr->typePtr = &tclListType;
}


static void
UpdateStringOfList(
    Tcl_Obj *listPtr)		/* List object with string rep to update. */
{
#   define LOCAL_SIZE 20
    int localFlags[LOCAL_SIZE], *flagPtr;
    List *listRepPtr = listPtr->internalRep.twoPtrValue.ptr1;
    int numElems = listRepPtr->elemCount;
    register int i;
    const char *elem;
    char *dst;
    int length;
    Tcl_Obj **elemPtrs;