
/*
 * bltVecCmd.c --
 *
 *	This module implements vector data objects.
 *
 * Copyright 1995-1998 Lucent Technologies, Inc.
 *
 * Permission to use, copy, modify, and distribute this software and
 * its documentation for any purpose and without fee is hereby
 * granted, provided that the above copyright notice appear in all
 * copies and that both that the copyright notice and warranty
 * disclaimer appear in supporting documentation, and that the names
 * of Lucent Technologies any of their entities not be used in
 * advertising or publicity pertaining to distribution of the software
 * without specific, written prior permission.
 *
 * Lucent Technologies disclaims all warranties with regard to this
 * software, including all implied warranties of merchantability and
 * fitness.  In no event shall Lucent Technologies be liable for any
 * special, indirect or consequential damages or any damages
 * whatsoever resulting from loss of use, data or profits, whether in
 * an action of contract, negligence or other tortuous action, arising
 * out of or in connection with the use or performance of this
 * software.
 */

/*
 * TODO:
 *	o Add H. Kirsch's vector binary read operation
 *		x binread file0
 *		x binread -file file0
 *
 *	o Add ASCII/binary file reader
 *		x read fileName
 *
 *	o Allow Tcl-based client notifications.
 *		vector x
 *		x notify call Display
 *		x notify delete Display
 *		x notify reorder #1 #2
 */

#include "bltVecInt.h"

#if (TCL_MAJOR_VERSION > 7) 

static 
int GetDouble(interp, objPtr, valuePtr)
    Tcl_Interp *interp;
    Tcl_Obj *objPtr;
    double *valuePtr;
{
    /* First try to extract the value as a double precision number. */
    if (Tcl_GetDoubleFromObj(interp, objPtr, valuePtr) == TCL_OK) {
	return TCL_OK;
    }
    Tcl_ResetResult(interp);

    /* Then try to parse it as an expression. */
    if (Tcl_ExprDouble(interp, Tcl_GetString(objPtr), valuePtr) == TCL_OK) {
	return TCL_OK;
    }
    return TCL_ERROR;
}

static Tcl_Obj *
GetValues(VectorObject *vPtr, int first, int last)
{ 
    register int i; 
    Tcl_Obj *listObjPtr;

    listObjPtr = Tcl_NewListObj(0, (Tcl_Obj **)NULL);
    for (i = first; i <= last; i++) { 
	Tcl_ListObjAppendElement(vPtr->interp, listObjPtr, 
				 Tcl_NewDoubleObj(vPtr->valueArr[i]));
    } 
    return listObjPtr;
}

static void
ReplicateValue(vPtr, first, last, value) 
    VectorObject *vPtr;
    int first, last;
    double value;
{ 
    register int i;
 
    for (i = first; i <= last; i++) { 
	vPtr->valueArr[i] = value; 
    } 
    vPtr->notifyFlags |= UPDATE_RANGE; 
}

static int
CopyList(vPtr, objc, objv)
    VectorObject *vPtr;
    int objc;
    Tcl_Obj *CONST *objv;
{
    register int i;
    double value;

    if (Blt_VectorChangeLength(vPtr, objc) != TCL_OK) {
	return TCL_ERROR;
    }
    for (i = 0; i < objc; i++) {
	if (GetDouble(vPtr->interp, objv[i], &value) != TCL_OK) {
	    Blt_VectorChangeLength(vPtr, i);
	    return TCL_ERROR;
	}
	vPtr->valueArr[i] = value;
    }
    return TCL_OK;
}

static int
AppendVector(destPtr, srcPtr)
    VectorObject *destPtr, *srcPtr;
{
    int nBytes;
    int oldSize, newSize;

    oldSize = destPtr->length;
    newSize = oldSize + srcPtr->last - srcPtr->first + 1;
    if (Blt_VectorChangeLength(destPtr, newSize) != TCL_OK) {
	return TCL_ERROR;
    }
    nBytes = (newSize - oldSize) * sizeof(double);
    memcpy((char *)(destPtr->valueArr + oldSize),
	(srcPtr->valueArr + srcPtr->first), nBytes);
    destPtr->notifyFlags |= UPDATE_RANGE;
    return TCL_OK;
}

static int
InsertList(vPtr, objc, objv, idx)
    VectorObject *vPtr;
    int objc;
    Tcl_Obj *CONST *objv;
    int idx;
{
    int count;
    register int i;
    double value;
    int oldSize, newSize;

    oldSize = vPtr->length;
    newSize = vPtr->length + objc;
    if (Blt_VectorChangeLength(vPtr, newSize) != TCL_OK) {
	return -1;
    }
    memmove((char *)(vPtr->valueArr + idx + objc),
        (char *)(vPtr->valueArr + idx), sizeof(double)*(oldSize-idx));
    count = oldSize;
    for (i = 0; i < objc; i++) {
	if (GetDouble(vPtr->interp, objv[i], &value) != TCL_OK) {
	    Blt_VectorChangeLength(vPtr, count);
	    return TCL_ERROR;
	}
	vPtr->valueArr[idx++] = value;
    }
    vPtr->notifyFlags |= UPDATE_RANGE;
    return (newSize-oldSize);
}
static int
InsertVector(destPtr, srcPtr, idx)
    VectorObject *destPtr, *srcPtr;
    int idx;
{
    int nBytes;
    int oldSize, newSize, dif;

    oldSize = destPtr->length;
    newSize = oldSize + srcPtr->last - srcPtr->first + 1;
    if (Blt_VectorChangeLength(destPtr, newSize) != TCL_OK) {
	return -1;
    }
    nBytes = (newSize - oldSize) * sizeof(double);
    dif = (newSize-oldSize);
    memmove((char *)(srcPtr->valueArr + idx + dif),
        (char *)(srcPtr->valueArr + idx), sizeof(double)*(oldSize-idx));
    memcpy((char *)(destPtr->valueArr + oldSize),
	(srcPtr->valueArr + srcPtr->first), nBytes);
    destPtr->notifyFlags |= UPDATE_RANGE;
    return dif;
}

static int
AppendList(vPtr, objc, objv)
    VectorObject *vPtr;
    int objc;
    Tcl_Obj *CONST *objv;
{
    int count;
    register int i;
    double value;
    int oldSize;

    oldSize = vPtr->length;
    if (Blt_VectorChangeLength(vPtr, vPtr->length + objc) != TCL_OK) {
	return TCL_ERROR;
    }
    count = oldSize;
    for (i = 0; i < objc; i++) {
	if (GetDouble(vPtr->interp, objv[i], &value) != TCL_OK) {
	    Blt_VectorChangeLength(vPtr, count);
	    return TCL_ERROR;
	}
	vPtr->valueArr[count++] = value;
    }
    vPtr->notifyFlags |= UPDATE_RANGE;
    return TCL_OK;
}

/* Vector instance option commands */

/*
 * -----------------------------------------------------------------------
 *
 * AppendOp --
 *
 *	Appends one of more Tcl lists of values, or vector objects
 *	onto the end of the current vector object.
 *
 * Results:
 *	A standard Tcl result.  If a current vector can't be created,
 *      resized, any of the named vectors can't be found, or one of
 *	lists of values is invalid, TCL_ERROR is returned.
 *
 * Side Effects:
 *	Clients of current vector will be notified of the change.
 *
 * -----------------------------------------------------------------------
 */
static int
AppendOp(vPtr, interp, objc, objv)
    VectorObject *vPtr;
    Tcl_Interp *interp;
    int objc;
    Tcl_Obj *CONST *objv;
{
    register int i;
    int result;
    VectorObject *v2Ptr;

    for (i = 2; i < objc; i++) {
	v2Ptr = Blt_VectorParseElement((Tcl_Interp *)NULL, vPtr->dataPtr, 
	       Tcl_GetString(objv[i]), (char **)NULL, NS_SEARCH_BOTH);
	if (v2Ptr != NULL) {
	    result = AppendVector(vPtr, v2Ptr);
	} else {
	    int nElem;
	    Tcl_Obj **elemObjArr;

	    if (Tcl_ListObjGetElements(interp, objv[i], &nElem, &elemObjArr) 
		!= TCL_OK) {
		return TCL_ERROR;
	    }
	    result = AppendList(vPtr, nElem, elemObjArr);
	}
	if (result != TCL_OK) {
	    return TCL_ERROR;
	}
    }
    if (vPtr->numcols && (vPtr->length%vPtr->numcols)) {
        Tcl_Obj *str = Tcl_NewStringObj("0", -1);
        int add = (vPtr->numcols-(vPtr->length%vPtr->numcols));
        Tcl_IncrRefCount(str);
        for (i=0; i<add; i++) {
            AppendList(vPtr, 1, &str);
        }
        Tcl_DecrRefCount(str);
    }
    if (objc > 2) {
	if (vPtr->flush) {
	    Blt_VectorFlushCache(vPtr);
	}
	Blt_VectorUpdateClients(vPtr);
    }
    return TCL_OK;
}
/*
* -----------------------------------------------------------------------
*
* InsertOp --
*
*	Insert one of more Tcl lists of values at index.
*
* Results:
*	A standard Tcl result.  If a current vector can't be created,
*      resized, any of the named vectors can't be found, or one of
*	lists of values is invalid, TCL_ERROR is returned.
*
* Side Effects:
*	Clients of current vector will be notified of the change.
*
* -----------------------------------------------------------------------
*/
static int
InsertOp(vPtr, interp, objc, objv)
    VectorObject *vPtr;
    Tcl_Interp *interp;
    int objc;
    Tcl_Obj *CONST *objv;
{
    register int i;
    int result, idx, cnt;
    VectorObject *v2Ptr;

    if (Blt_VectorGetIndex(interp, vPtr, Tcl_GetString(objv[2]), &idx, 
        INDEX_CHECK, (Blt_VectorIndexProc **) NULL) != TCL_OK) {
            return TCL_ERROR;
    }

    for (i = 3; i < objc; i++) {
        v2Ptr = Blt_VectorParseElement((Tcl_Interp *)NULL, vPtr->dataPtr, 
        Tcl_GetString(objv[i]), (char **)NULL, NS_SEARCH_BOTH);
        result = TCL_OK;
        if (v2Ptr != NULL) {
            if (v2Ptr->length>0) {
                cnt = InsertVector(vPtr, v2Ptr, idx);
                if (cnt<0) {
                    result = TCL_ERROR;
                } else {
                    idx += cnt;
                }
            }
        } else {
            int nElem;
            Tcl_Obj **elemObjArr;

            if (Tcl_ListObjGetElements(interp, objv[i], &nElem, &elemObjArr) 
                != TCL_OK) {
                return TCL_ERROR;
            }
            cnt = InsertList(vPtr, nElem, elemObjArr, idx);
            if (cnt<0) {
                result = TCL_ERROR;
            } else {
                idx += cnt;
            }
        }
        if (result != TCL_OK) {
            return TCL_ERROR;
        }
    }
    if (vPtr->numcols && (vPtr->length%vPtr->numcols)) {
        Tcl_Obj *str = Tcl_NewStringObj("0", -1);
        int add = (vPtr->numcols-(vPtr->length%vPtr->numcols));
        Tcl_IncrRefCount(str);
        for (i=0; i<add; i++) {
            InsertList(vPtr, 1, &str, idx);
        }
        Tcl_DecrRefCount(str);
    }
    if (objc > 2) {
        if (vPtr->flush) {
            Blt_VectorFlushCache(vPtr);
        }
        Blt_VectorUpdateClients(vPtr);
    }
    return TCL_OK;
}

/*
 * -----------------------------------------------------------------------
 *
 * ClearOp --
 *
 *	Deletes all the accumulated array indices for the Tcl array
 *	associated will the vector.  This routine can be used to
 *	free excess memory from a large vector.
 *      Call with arg to change auto-flush option.
 *
 * Results:
 *	Always returns TCL_OK.
 *
 * Side Effects:
 *	Memory used for the entries of the Tcl array variable is freed.
 *
 * -----------------------------------------------------------------------
 */
/*ARGSUSED*/
static int
ClearOp(vPtr, interp, objc, objv)
    VectorObject *vPtr;
    Tcl_Interp *interp;
    int objc;			
    Tcl_Obj *CONST *objv;	
{
    if (objc>2) {
        if (Tcl_GetBooleanFromObj(interp, objv[2], &vPtr->flush) != TCL_OK) {
            return TCL_ERROR;
        }
    }
    Blt_VectorFlushCache(vPtr);
    Blt_VectorUpdateClients(vPtr);
    Tcl_SetObjResult(interp, Tcl_NewBooleanObj(vPtr->flush));
    return TCL_OK;
}

/*
 * -----------------------------------------------------------------------
 *
 * DeleteOp --
 *
 *	Deletes the given indices from the vector.  If no indices are
 *	provided the entire vector is deleted.
 *
 * Results:
 *	A standard Tcl result.  If any of the given indices is invalid,
 *	interp->result will an error message and TCL_ERROR is returned.
 *
 * Side Effects:
 *	The clients of the vector will be notified of the vector
 *	deletions.
 *
 * -----------------------------------------------------------------------
 */
/*ARGSUSED*/
static int
DeleteOp(vPtr, interp, objc, objv)
    VectorObject *vPtr;
    Tcl_Interp *interp;
    int objc;
    Tcl_Obj *CONST *objv;
{
    unsigned char *unsetArr;
    register int i, j;
    register int count;
    char *string;

    /* FIXME: Don't delete vector with no indices.  */
    if (objc == 2) {
	Blt_VectorFree(vPtr);
	return TCL_OK;
    }
    /*
     * Allocate an "unset" bitmap the size of the vector.  
     */
    unsetArr = Blt_Calloc(sizeof(unsigned char), (vPtr->length + 7) / 8);
    assert(unsetArr);

#define SetBit(i) \
    unsetArr[(i) >> 3] |= (1 << ((i) & 0x07))
#define GetBit(i) \
    (unsetArr[(i) >> 3] & (1 << ((i) & 0x07)))

    for (i = 2; i < objc; i++) {
	string = Tcl_GetString(objv[i]);
	if (Blt_VectorGetIndexRange(interp, vPtr, string, 
		(INDEX_COLON | INDEX_CHECK), (Blt_VectorIndexProc **) NULL) 
		!= TCL_OK) {
	    Blt_Free(unsetArr);
	    return TCL_ERROR;
	}
	for (j = vPtr->first; j <= vPtr->last; j++) {
	    SetBit(j);		/* Mark the range of elements for deletion. */
	}
    }
    count = 0;
    for (i = 0; i < vPtr->length; i++) {
	if (GetBit(i)) {
	    continue;		/* Skip elements marked for deletion. */
	}
	if (count < i) {
	    vPtr->valueArr[count] = vPtr->valueArr[i];
	}
	count++;
    }
    Blt_Free(unsetArr);
    vPtr->length = count;
    if (vPtr->flush) {
	Blt_VectorFlushCache(vPtr);
    }
    Blt_VectorUpdateClients(vPtr);
    return TCL_OK;
}

/*
 * -----------------------------------------------------------------------
 *
 * DupOp --
 *
 *	Creates one or more duplicates of the vector object.
 *
 * Results:
 *	A standard Tcl result.  If a new vector can't be created,
 *      or and existing vector resized, TCL_ERROR is returned.
 *
 * Side Effects:
 *	Clients of existing vectors will be notified of the change.
 *
 * -----------------------------------------------------------------------
 */
/*ARGSUSED*/
static int
DupOp(vPtr, interp, objc, objv)
    VectorObject *vPtr;
    Tcl_Interp *interp;		/* Not used. */
    int objc;
    Tcl_Obj *CONST *objv;
{
    VectorObject *v2Ptr;
    int isNew;
    register int i;
    char *string;

    for (i = 2; i < objc; i++) {
	string = Tcl_GetString(objv[i]);
	v2Ptr = Blt_VectorCreate(vPtr->dataPtr, string, string, string,&isNew);
	if (v2Ptr == NULL) {
	    return TCL_ERROR;
	}
	if (v2Ptr == vPtr) {
	    continue;
	}
	if (Blt_VectorDuplicate(v2Ptr, vPtr) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (!isNew) {
	    if (v2Ptr->flush) {
		Blt_VectorFlushCache(v2Ptr);
	    }
	    Blt_VectorUpdateClients(v2Ptr);
	}
    }
    return TCL_OK;
}

/*
 * -----------------------------------------------------------------------
 *
 * IndexOp --
 *
 *	Sets or reads the value of the index.  This simulates what the
 *	vector's variable does.
 *
 * Results:
 *	A standard Tcl result.  If the index is invalid,
 *	interp->result will an error message and TCL_ERROR is returned.
 *	Otherwise interp->result will contain the values.
 *
 * -----------------------------------------------------------------------
 */
static int
IndexOp(vPtr, interp, objc, objv)
    VectorObject *vPtr;
    Tcl_Interp *interp;
    int objc;
    Tcl_Obj *CONST *objv;
{
    int first, last;
    char *string;

    string = Tcl_GetString(objv[2]);
    if (Blt_VectorGetIndexRange(interp, vPtr, string, INDEX_ALL_FLAGS, 
		(Blt_VectorIndexProc **) NULL) != TCL_OK) {
	return TCL_ERROR;
    }
    first = vPtr->first, last = vPtr->last;
    if (objc == 3) {
	Tcl_Obj *listObjPtr;

	if (first == vPtr->length) {
	    Tcl_AppendResult(interp, "can't get index \"", string, "\"",
		(char *)NULL);
	    return TCL_ERROR;	/* Can't read from index "++end" */
	}
	listObjPtr = GetValues(vPtr, first, last);
	Tcl_SetObjResult(interp, listObjPtr);
    } else {
	double value;

	/* FIXME: huh? Why set values here?.  */
	if (first == SPECIAL_INDEX) {
	    Tcl_AppendResult(interp, "can't set index \"", string, "\"",
		(char *)NULL);
	    return TCL_ERROR;	/* Tried to set "min" or "max" */
	}
	if (GetDouble(vPtr->interp, objv[3], &value) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (first == vPtr->length) {
	    if (Blt_VectorChangeLength(vPtr, vPtr->length + 1) != TCL_OK) {
		return TCL_ERROR;
	    }
	}
	ReplicateValue(vPtr, first, last, value);
	Tcl_SetObjResult(interp, objv[3]);
	if (vPtr->flush) {
	    Blt_VectorFlushCache(vPtr);
	}
	Blt_VectorUpdateClients(vPtr);
    }
    return TCL_OK;
}

/* Get an int or expression. */
static int
GetIntObj(interp, obj, iPtr)
    Tcl_Interp *interp;
    Tcl_Obj *obj;
    int *iPtr;
{
    if (Tcl_GetIntFromObj(interp, obj, iPtr) != TCL_OK) {
        long l;
        Tcl_ResetResult(interp);
        if (Tcl_ExprLongObj(interp, obj, &l) != TCL_OK) {
            return TCL_ERROR;
        }
        *iPtr = (int)l;
    }
    return TCL_OK;
}


/*
 * -----------------------------------------------------------------------
 *
 * LengthOp --
 *
 *	Returns the length of the vector.  If a new size is given, the
 *	vector is resized to the new vector.
 *
 * Results:
 *	A standard Tcl result.  If the new length is invalid,
 *	interp->result will an error message and TCL_ERROR is returned.
 *	Otherwise interp->result will contain the length of the vector.
 *
 * -----------------------------------------------------------------------
 */
static int
LengthOp(vPtr, interp, objc, objv)
    VectorObject *vPtr;
    Tcl_Interp *interp;
    int objc;
    Tcl_Obj *CONST *objv;
{
    if (objc == 3) {
	int size;

	if (GetIntObj(interp, objv[2], &size) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (size < 0) {
	    Tcl_AppendResult(interp, "bad vector size \"", 
		Tcl_GetString(objv[2]), "\"", (char *)NULL);
	    return TCL_ERROR;
	}
	if (size%vPtr->numcols) {
             Tcl_AppendResult(interp, "size not multiple of columns \"", 
                 Tcl_GetString(objv[2]), "\"", (char *)NULL);
             return TCL_ERROR;
        }
	if (Blt_VectorChangeLength(vPtr, size) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (vPtr->flush) {
	    Blt_VectorFlushCache(vPtr);
	}
	Blt_VectorUpdateClients(vPtr);
    }
    Tcl_SetObjResult(interp, Tcl_NewIntObj(vPtr->length));
    return TCL_OK;
}

/*
 * -----------------------------------------------------------------------
 *
 * VariableOp --
 *
 *	Queries or sets the offset of the array index from the base
 *	address of the data array of values.
 *
 * Results:
 *	A standard Tcl result.  If the source vector doesn't exist
 *	or the source list is not a valid list of numbers, TCL_ERROR
 *	returned.  Otherwise TCL_OK is returned.
 *
 * -----------------------------------------------------------------------
 */
/*ARGSUSED*/
static int
VariableOp(vPtr, interp, objc, objv)
    VectorObject *vPtr;
    Tcl_Interp *interp;
    int objc;			/* Not used. */
    Tcl_Obj *CONST *objv;
{
    if (objc > 2) {
	if (Blt_VectorMapVariable(interp, vPtr, Tcl_GetString(objv[2])) 
	    != TCL_OK) {
	    return TCL_ERROR;
	}
    }
    if (vPtr->arrayName != NULL) {
	Tcl_SetResult(interp, vPtr->arrayName, TCL_VOLATILE);
    }
    return TCL_OK;
}

/*
 * -----------------------------------------------------------------------
 *
 * MergeOp --
 *
 *	Merges the values from the given vectors to the current vector.
 *
 * Results:
 *	A standard Tcl result.  If any of the given vectors differ in size,
 *	TCL_ERROR is returned.  Otherwise TCL_OK is returned and the
 *	vector data will contain merged values of the given vectors.
 *
 * -----------------------------------------------------------------------
 */
/*ARGSUSED*/
static int
MergeOp(vPtr, interp, objc, objv)
    VectorObject *vPtr;
    Tcl_Interp *interp;
    int objc;
    Tcl_Obj *CONST *objv;
{
    VectorObject *v2Ptr;
    VectorObject **vecArr;
    register VectorObject **vPtrPtr;
    int refSize, length, nElem;
    register int i;
    double *valuePtr, *valueArr;
    
    /* Allocate an array of vector pointers of each vector to be
     * merged in the current vector.  */
    vecArr = Blt_Malloc(sizeof(VectorObject *) * objc);
    assert(vecArr);
    vPtrPtr = vecArr;

    refSize = -1;
    nElem = 0;
    for (i = 2; i < objc; i++) {
	if (Blt_VectorLookupName(vPtr->dataPtr, Tcl_GetString(objv[i]), &v2Ptr)
		!= TCL_OK) {
	    Blt_Free(vecArr);
	    return TCL_ERROR;
	}
	/* Check that all the vectors are the same length */
	length = v2Ptr->last - v2Ptr->first + 1;
	if (refSize < 0) {
	    refSize = length;
	} else if (length != refSize) {
	    Tcl_AppendResult(vPtr->interp, "vectors \"", vPtr->name,
		"\" and \"", v2Ptr->name, "\" differ in length",
		(char *)NULL);
	    Blt_Free(vecArr);
	    return TCL_ERROR;
	}
	*vPtrPtr++ = v2Ptr;
	nElem += refSize;
    }
    *vPtrPtr = NULL;

    valueArr = Blt_Malloc(sizeof(double) * nElem);
    if (valueArr == NULL) {
	Tcl_AppendResult(vPtr->interp, "not enough memory to allocate ", 
		 Blt_Itoa(nElem), " vector elements", (char *)NULL);
	return TCL_ERROR;
    }
    /* Merge the values from each of the vectors into the current vector */
    valuePtr = valueArr;
    for (i = 0; i < refSize; i++) {
	for (vPtrPtr = vecArr; *vPtrPtr != NULL; vPtrPtr++) {
	    *valuePtr++ = (*vPtrPtr)->valueArr[i + (*vPtrPtr)->first];
	}
    }
    Blt_Free(vecArr);
    Blt_VectorReset(vPtr, valueArr, nElem, nElem, TCL_DYNAMIC);
    return TCL_OK;
}

/*
 * -----------------------------------------------------------------------
 *
 * NormalizeOp --
 *
 *	Normalizes the vector.
 *
 * Results:
 *	A standard Tcl result.  If the density is invalid, TCL_ERROR
 *	is returned.  Otherwise TCL_OK is returned.
 *
 * -----------------------------------------------------------------------
 */
/*ARGSUSED*/
static int
NormalizeOp(vPtr, interp, objc, objv)
    VectorObject *vPtr;
    Tcl_Interp *interp;
    int objc;
    Tcl_Obj *CONST *objv;
{
    register int i;
    double range;

    Blt_VectorUpdateRange(vPtr);
    range = vPtr->max - vPtr->min;
    if (objc > 2) {
	VectorObject *v2Ptr;
	int isNew;
	char *string;

	string = Tcl_GetString(objv[2]);
	v2Ptr = Blt_VectorCreate(vPtr->dataPtr, string, string, string, 
				 &isNew);
	if (v2Ptr == NULL) {
	    return TCL_ERROR;
	}
	if (Blt_VectorChangeLength(v2Ptr, vPtr->length) != TCL_OK) {
	    return TCL_ERROR;
	}
	for (i = 0; i < vPtr->length; i++) {
	    v2Ptr->valueArr[i] = (vPtr->valueArr[i] - vPtr->min) / range;
	}
	Blt_VectorUpdateRange(v2Ptr);
	if (!isNew) {
	    if (v2Ptr->flush) {
		Blt_VectorFlushCache(v2Ptr);
	    }
	    Blt_VectorUpdateClients(v2Ptr);
	}
    } else {
	double norm;
	Tcl_Obj *listObjPtr;

	listObjPtr = Tcl_NewListObj(0, (Tcl_Obj **)NULL);
	for (i = 0; i < vPtr->length; i++) {
	    norm = (vPtr->valueArr[i] - vPtr->min) / range;
	    Tcl_ListObjAppendElement(interp, listObjPtr, 
		Tcl_NewDoubleObj(norm));
	}
	Tcl_SetObjResult(interp, listObjPtr);
    }
    return TCL_OK;
}

/*
 * -----------------------------------------------------------------------
 *
 * NotifyOp --
 *
 *	Notify clients of changes to vector.
 *
 * Results:
 *	A standard Tcl result.
 *
 *  x vector notify now
 *  x vector notify always
 *  x vector notify whenidle
 *
 * -----------------------------------------------------------------------
 */
/*ARGSUSED*/
static int
NotifyOp(vPtr, interp, objc, objv)
    VectorObject *vPtr;
    Tcl_Interp *interp;
    int objc;
    Tcl_Obj *CONST *objv;
{
    int option;
    int bool;
    char *string;
    enum optionIndices {
	OPTION_ALWAYS, OPTION_NEVER, OPTION_WHENIDLE, 
	OPTION_NOW, OPTION_CANCEL, OPTION_PENDING,
	OPTION_CALLBACK
    };
    static char *optionArr[] = {
	"always", "never", "whenidle", "now", "cancel", "pending", "callback", NULL
    };
    if (objc == 2) {
        if (vPtr->notifyFlags&NOTIFY_WHENIDLE) {
            Tcl_AppendResult(interp, "whenidle", 0);
        } else if (vPtr->notifyFlags&NOTIFY_NEVER) {
            Tcl_AppendResult(interp, "never", 0);
        } else if (vPtr->notifyFlags&NOTIFY_ALWAYS) {
            Tcl_AppendResult(interp, "always", 0);
        }
        return TCL_OK;
    }
    if (Tcl_GetIndexFromObj(interp, objv[2], optionArr, "qualifier", TCL_EXACT,
	    &option) != TCL_OK) {
	return TCL_OK;
    }
    if (option != OPTION_CALLBACK && objc != 3) {
        Tcl_AppendResult(interp, "only callback takes args", 0);
        return TCL_ERROR;
    }
    switch (option) {
    case OPTION_ALWAYS:
	vPtr->notifyFlags &= ~NOTIFY_WHEN_MASK;
	vPtr->notifyFlags |= NOTIFY_ALWAYS;
	break;
    case OPTION_NEVER:
	vPtr->notifyFlags &= ~NOTIFY_WHEN_MASK;
	vPtr->notifyFlags |= NOTIFY_NEVER;
	break;
    case OPTION_WHENIDLE:
	vPtr->notifyFlags &= ~NOTIFY_WHEN_MASK;
	vPtr->notifyFlags |= NOTIFY_WHENIDLE;
	break;
    case OPTION_NOW:
	/* FIXME: How does this play when an update is pending? */
	Blt_VectorNotifyClients(vPtr);
	break;
    case OPTION_CANCEL:
	if (vPtr->notifyFlags & NOTIFY_PENDING) {
	    vPtr->notifyFlags &= ~NOTIFY_PENDING;
	    Tcl_CancelIdleCall(Blt_VectorNotifyClients, (ClientData)vPtr);
	}
	break;
    case OPTION_PENDING:
	bool = (vPtr->notifyFlags & NOTIFY_PENDING);
	Tcl_SetObjResult(interp, Tcl_NewBooleanObj(bool));
	break;
    case OPTION_CALLBACK:
        if (objc == 3) {
            if (vPtr->callback != NULL) {
                Tcl_SetObjResult(interp, vPtr->callback);
            }
        } else {
            string = Tcl_GetString(objv[3]);
            if (string && string[0]) {
                Tcl_IncrRefCount(objv[3]);
            }
            if (vPtr->callback) {
                Tcl_DecrRefCount(vPtr->callback);
            }
            if (string && string[0]) {
                vPtr->callback = objv[3];
            } else {
                vPtr->callback = NULL;
            }
        }
        break;
    }
    return TCL_OK;
}

/*
 * -----------------------------------------------------------------------
 *
 * PopulateOp --
 *
 *	Creates or resizes a new vector based upon the density specified.
 *
 * Results:
 *	A standard Tcl result.  If the density is invalid, TCL_ERROR
 *	is returned.  Otherwise TCL_OK is returned.
 *
 * -----------------------------------------------------------------------
 */
/*ARGSUSED*/
static int
PopulateOp(vPtr, interp, objc, objv)
    VectorObject *vPtr;
    Tcl_Interp *interp;
    int objc;
    Tcl_Obj *CONST *objv;
{
    VectorObject *v2Ptr;
    int size, density;
    int isNew;
    register int i, j;
    double slice, range;
    register double *valuePtr;
    int count;
    char *string;

    string = Tcl_GetString(objv[2]);
    v2Ptr = Blt_VectorCreate(vPtr->dataPtr, string, string, string, &isNew);
    if (v2Ptr == NULL) {
	return TCL_ERROR;
    }
    if (vPtr->length == 0) {
	return TCL_OK;		/* Source vector is empty. */
    }
    if (GetIntObj(interp, objv[3], &density) != TCL_OK) {
	return TCL_ERROR;
    }
    if (density < 1) {
	Tcl_AppendResult(interp, "bad density \"", Tcl_GetString(objv[3]), 
		"\"", (char *)NULL);
	return TCL_ERROR;
    }
    size = (vPtr->length - 1) * (density + 1) + 1;
    if (Blt_VectorChangeLength(v2Ptr, size) != TCL_OK) {
	return TCL_ERROR;
    }
    count = 0;
    valuePtr = v2Ptr->valueArr;
    for (i = 0; i < (vPtr->length - 1); i++) {
	range = vPtr->valueArr[i + 1] - vPtr->valueArr[i];
	slice = range / (double)(density + 1);
	for (j = 0; j <= density; j++) {
	    *valuePtr = vPtr->valueArr[i] + (slice * (double)j);
	    valuePtr++;
	    count++;
	}
    }
    count++;
    *valuePtr = vPtr->valueArr[i];
    assert(count == v2Ptr->length);
    if (!isNew) {
	if (v2Ptr->flush) {
	    Blt_VectorFlushCache(v2Ptr);
	}
	Blt_VectorUpdateClients(v2Ptr);
    }
    return TCL_OK;
}

/*
 * -----------------------------------------------------------------------
 *
 * RangeOp --
 *
 *	Returns a Tcl list of the range of vector values specified.
 *
 * Results:
 *	A standard Tcl result.  If the given range is invalid, TCL_ERROR
 *	is returned.  Otherwise TCL_OK is returned and interp->result
 *	will contain the list of values.
 *
 * -----------------------------------------------------------------------
 */
/*ARGSUSED*/
static int
RangeOp(vPtr, interp, objc, objv)
    VectorObject *vPtr;
    Tcl_Interp *interp;
    int objc;			/* Not used. */
    Tcl_Obj *CONST *objv;
{
    Tcl_Obj *listObjPtr;
    int first, last;
    register int i;

    if ((Blt_VectorGetIndex(interp, vPtr, Tcl_GetString(objv[2]), &first, 
		INDEX_CHECK, (Blt_VectorIndexProc **) NULL) != TCL_OK) ||
	(Blt_VectorGetIndex(interp, vPtr, Tcl_GetString(objv[3]), &last, 
		INDEX_CHECK, (Blt_VectorIndexProc **) NULL) != TCL_OK)) {
	return TCL_ERROR;
    }
    listObjPtr = Tcl_NewListObj(0, (Tcl_Obj **)NULL);
    if (first > last) {
	/* Return the list reversed */
	for (i = last; i <= first; i++) {
	    Tcl_ListObjAppendElement(interp, listObjPtr, 
		Tcl_NewDoubleObj(vPtr->valueArr[i]));
	}
    } else {
	for (i = first; i <= last; i++) {
	    Tcl_ListObjAppendElement(interp, listObjPtr, 
		Tcl_NewDoubleObj(vPtr->valueArr[i]));
	}
    }
    Tcl_SetObjResult(interp, listObjPtr);
    return TCL_OK;
}

/*
 * ----------------------------------------------------------------------
 *
 * InRange --
 *
 *	Determines if a value lies within a given range.
 *
 *	The value is normalized and compared against the interval
 *	[0..1], where 0.0 is the minimum and 1.0 is the maximum.
 *	DBL_EPSILON is the smallest number that can be represented
 *	on the host machine, such that (1.0 + epsilon) != 1.0.
 *
 *	Please note, min cannot be greater than max.
 *
 * Results:
 *	If the value is within of the interval [min..max], 1 is 
 *	returned; 0 otherwise.
 *
 * ----------------------------------------------------------------------
 */
INLINE static int
InRange(value, min, max)
    double value, min, max;
{
    double range;

    range = max - min;
    if (range < DBL_EPSILON) {
	return (FABS(max - value) < DBL_EPSILON);
    } else {
	double norm;

	norm = (value - min) / range;
	return ((norm >= -DBL_EPSILON) && ((norm - 1.0) < DBL_EPSILON));
    }
}

enum NativeFormats {
    FMT_UNKNOWN = -1,
    FMT_UCHAR, FMT_CHAR,
    FMT_USHORT, FMT_SHORT,
    FMT_UINT, FMT_INT,
    FMT_ULONG, FMT_LONG,
    FMT_FLOAT, FMT_DOUBLE
};

/*
 * -----------------------------------------------------------------------
 *
 * GetBinaryFormat
 *
 *      Translates a format string into a native type.  Formats may be
 *	as follows.
 *
 *		signed		i1, i2, i4, i8
 *		unsigned 	u1, u2, u4, u8
 *		real		r4, r8, r16
 *
 *	But there must be a corresponding native type.  For example,
 *	this for reading 2-byte binary integers from an instrument and
 *	converting them to unsigned shorts or ints.
 *
 * -----------------------------------------------------------------------
 */
static enum NativeFormats
GetBinaryFormat(interp, string, sizePtr)
    Tcl_Interp *interp;
    char *string;
    int *sizePtr;
{
    char c;

    c = tolower(string[0]);
    if (Tcl_GetInt(interp, string + 1, sizePtr) != TCL_OK) {
	Tcl_AppendResult(interp, "unknown binary format \"", string,
	    "\": incorrect byte size", (char *)NULL);
	return FMT_UNKNOWN;
    }
    switch (c) {
    case 'r':
	if (*sizePtr == sizeof(double)) {
	    return FMT_DOUBLE;
	} else if (*sizePtr == sizeof(float)) {
	    return FMT_FLOAT;
	}
	break;

    case 'i':
	if (*sizePtr == sizeof(char)) {
	    return FMT_CHAR;
	} else if (*sizePtr == sizeof(int)) {
	    return FMT_INT;
	} else if (*sizePtr == sizeof(long)) {
	    return FMT_LONG;
	} else if (*sizePtr == sizeof(short)) {
	    return FMT_SHORT;
	}
	break;

    case 'u':
	if (*sizePtr == sizeof(unsigned char)) {
	    return FMT_UCHAR;
	} else if (*sizePtr == sizeof(unsigned int)) {
	    return FMT_UINT;
	} else if (*sizePtr == sizeof(unsigned long)) {
	    return FMT_ULONG;
	} else if (*sizePtr == sizeof(unsigned short)) {
	    return FMT_USHORT;
	}
	break;

    default:
	Tcl_AppendResult(interp, "unknown binary format \"", string,
	    "\": should be either i#, r#, u# (where # is size in bytes)",
	    (char *)NULL);
	return FMT_UNKNOWN;
    }
    Tcl_AppendResult(interp, "can't handle format \"", string, "\"", 
		     (char *)NULL);
    return FMT_UNKNOWN;
}

static int
CopyValues(vPtr, byteArr, fmt, size, length, swap, indexPtr)
    VectorObject *vPtr;
    char *byteArr;
    enum NativeFormats fmt;
    int size;
    int length;
    int swap;
    int *indexPtr;
{
    register int i, n;
    int newSize;

    if ((swap) && (size > 1)) {
	int nBytes = size * length;
	register unsigned char *p;
	register int left, right;

	for (i = 0; i < nBytes; i += size) {
	    p = (unsigned char *)(byteArr + i);
	    for (left = 0, right = size - 1; left < right; left++, right--) {
		p[left] ^= p[right];
		p[right] ^= p[left];
		p[left] ^= p[right];
	    }

	}
    }
    newSize = *indexPtr + length;
    if (newSize > vPtr->length) {
	if (Blt_VectorChangeLength(vPtr, newSize) != TCL_OK) {
	    return TCL_ERROR;
	}
    }
#define CopyArrayToVector(vPtr, arr) \
    for (i = 0, n = *indexPtr; i < length; i++, n++) { \
	(vPtr)->valueArr[n] = (double)(arr)[i]; \
    }

    switch (fmt) {
    case FMT_CHAR:
	CopyArrayToVector(vPtr, (char *)byteArr);
	break;

    case FMT_UCHAR:
	CopyArrayToVector(vPtr, (unsigned char *)byteArr);
	break;

    case FMT_INT:
	CopyArrayToVector(vPtr, (int *)byteArr);
	break;

    case FMT_UINT:
	CopyArrayToVector(vPtr, (unsigned int *)byteArr);
	break;

    case FMT_LONG:
	CopyArrayToVector(vPtr, (long *)byteArr);
	break;

    case FMT_ULONG:
	CopyArrayToVector(vPtr, (unsigned long *)byteArr);
	break;

    case FMT_SHORT:
	CopyArrayToVector(vPtr, (short int *)byteArr);
	break;

    case FMT_USHORT:
	CopyArrayToVector(vPtr, (unsigned short int *)byteArr);
	break;

    case FMT_FLOAT:
	CopyArrayToVector(vPtr, (float *)byteArr);
	break;

    case FMT_DOUBLE:
	CopyArrayToVector(vPtr, (double *)byteArr);
	break;

    case FMT_UNKNOWN:
	break;
    }
    *indexPtr += length;
    return TCL_OK;
}

/*
 * -----------------------------------------------------------------------
 *
 * BinreadOp --
 *
 *	Reads binary values from a Tcl channel. Values are either appended
 *	to the end of the vector or placed at a given index (using the
 *	"-at" option), overwriting existing values.  Data is read until EOF
 *	is found on the channel or a specified number of values are read.
 *	(note that this is not necessarily the same as the number of bytes).
 *
 *	The following flags are supported:
 *		-swap		Swap bytes
 *		-at index	Start writing data at the index.
 *		-format fmt	Specifies the format of the data.
 *
 *	This binary reader was created by Harald Kirsch (kir@iitb.fhg.de).
 *	Anything that's wrong is due to my munging of his code.
 *
 * Results:
 *	Returns a standard Tcl result. The interpreter result will contain
 *	the number of values (not the number of bytes) read.
 *
 * Caveats:
 *	Channel reads must end on an element boundary.
 *
 * -----------------------------------------------------------------------
 */
/*ARGSUSED*/
static int
BinreadOp(vPtr, interp, objc, objv)
    VectorObject *vPtr;
    Tcl_Interp *interp;
    int objc;
    Tcl_Obj *CONST *objv;
{
    Tcl_Channel channel;
    char *byteArr;
    char *string;
    enum NativeFormats fmt;
    int arraySize, bytesRead;
    int count, total;
    int first;
    int size, length, mode;
    int swap;
    register int i;

    string = Tcl_GetString(objv[2]);
    channel = Tcl_GetChannel(interp, string, &mode);
    if (channel == NULL) {
	return TCL_ERROR;
    }
    if ((mode & TCL_READABLE) == 0) {
	Tcl_AppendResult(interp, "channel \"", string,
	    "\" wasn't opened for reading", (char *)NULL);
	return TCL_ERROR;
    }
    first = vPtr->length;
    fmt = FMT_DOUBLE;
    size = sizeof(double);
    swap = FALSE;
    count = 0;

    if (objc > 3) {
	string = Tcl_GetString(objv[3]);
	if (string[0] != '-') {
	    long int value;
	    /* Get the number of values to read.  */
	    if (Tcl_GetLongFromObj(interp, objv[3], &value) != TCL_OK) {
		return TCL_ERROR;
	    }
	    if (value < 0) {
		Tcl_AppendResult(interp, "count can't be negative", 
				 (char *)NULL);
		return TCL_ERROR;
	    }
	    count = (int)value;
	    objc--, objv++;
	}
    }
    /* Process any option-value pairs that remain.  */
    for (i = 3; i < objc; i++) {
	string = Tcl_GetString(objv[i]);
	if (strcmp(string, "-swap") == 0) {
	    swap = TRUE;
	} else if (strcmp(string, "-format") == 0) {
	    i++;
	    if (i >= objc) {
		Tcl_AppendResult(interp, "missing arg after \"", string,
		    "\"", (char *)NULL);
		return TCL_ERROR;
	    }
	    string = Tcl_GetString(objv[i]);
	    fmt = GetBinaryFormat(interp, string, &size);
	    if (fmt == FMT_UNKNOWN) {
		return TCL_ERROR;
	    }
	} else if (strcmp(string, "-at") == 0) {
	    i++;
	    if (i >= objc) {
		Tcl_AppendResult(interp, "missing arg after \"", string,
		    "\"", (char *)NULL);
		return TCL_ERROR;
	    }
	    string = Tcl_GetString(objv[i]);
	    if (Blt_VectorGetIndex(interp, vPtr, string, &first, 0, 
			 (Blt_VectorIndexProc **)NULL) != TCL_OK) {
		return TCL_ERROR;
	    }
	    if (first > vPtr->length) {
		Tcl_AppendResult(interp, "index \"", string,
		    "\" is out of range", (char *)NULL);
		return TCL_ERROR;
	    }
	}
    }

#define BUFFER_SIZE 1024
    if (count == 0) {
	arraySize = BUFFER_SIZE * size;
    } else {
	arraySize = count * size;
    }

    byteArr = Blt_Malloc(arraySize);
    assert(byteArr);

    /* FIXME: restore old channel translation later? */
    if (Tcl_SetChannelOption(interp, channel, "-translation",
	    "binary") != TCL_OK) {
	return TCL_ERROR;
    }
    total = 0;
    while (!Tcl_Eof(channel)) {
	bytesRead = Tcl_Read(channel, byteArr, arraySize);
	if (bytesRead < 0) {
	    Tcl_AppendResult(interp, "error reading channel: ",
		Tcl_PosixError(interp), (char *)NULL);
	    return TCL_ERROR;
	}
	if ((bytesRead % size) != 0) {
	    Tcl_AppendResult(interp, "error reading channel: short read",
		(char *)NULL);
	    return TCL_ERROR;
	}
	length = bytesRead / size;
	if (CopyValues(vPtr, byteArr, fmt, size, length, swap, &first)
	    != TCL_OK) {
	    return TCL_ERROR;
	}
	total += length;
	if (count > 0) {
	    break;
	}
    }
    Blt_Free(byteArr);

    if (vPtr->flush) {
	Blt_VectorFlushCache(vPtr);
    }
    Blt_VectorUpdateClients(vPtr);

    /* Set the result as the number of values read.  */
    Tcl_SetObjResult(interp, Tcl_NewIntObj(total));
    return TCL_OK;
}

static int
BinwriteOp(vPtr, interp, objc, objv)
    VectorObject *vPtr;
    Tcl_Interp *interp;
    int objc;
    Tcl_Obj *CONST *objv;
{
    Tcl_Channel channel;
    char *string;
    int bytesWrite;
    int count, total;
    int first;
    int  mode;
    register int i;

    string = Tcl_GetString(objv[2]);
    channel = Tcl_GetChannel(interp, string, &mode);
    if (channel == NULL) {
	return TCL_ERROR;
    }
    if ((mode & TCL_WRITABLE) == 0) {
	Tcl_AppendResult(interp, "channel \"", string,
	    "\" wasn't opened for writing", (char *)NULL);
	return TCL_ERROR;
    }
    first = 0;
    count = vPtr->length;

    if (objc > 3) {
	string = Tcl_GetString(objv[3]);
	if (string[0] != '-') {
	    long int value;
	    /* Get the number of values to write.  */
	    if (Tcl_GetLongFromObj(interp, objv[3], &value) != TCL_OK) {
		return TCL_ERROR;
	    }
	    if (value < 0) {
		Tcl_AppendResult(interp, "count can't be negative", 
				 (char *)NULL);
		return TCL_ERROR;
	    }
	    count = (int)value;
	    objc--, objv++;
	}
    }
    /* Process any option-value pairs that remain.  */
    for (i = 3; i < objc; i++) {
	string = Tcl_GetString(objv[i]);
         if (strcmp(string, "-at") == 0) {
	    i++;
	    if (i >= objc) {
		Tcl_AppendResult(interp, "missing arg after \"", string,
		    "\"", (char *)NULL);
		return TCL_ERROR;
	    }
	    string = Tcl_GetString(objv[i]);
	    if (Blt_VectorGetIndex(interp, vPtr, string, &first, 0, 
			 (Blt_VectorIndexProc **)NULL) != TCL_OK) {
		return TCL_ERROR;
	    }
	    if ((first+count) > vPtr->length) {
		Tcl_AppendResult(interp, "index \"", string,
		    "\" is out of range", (char *)NULL);
		return TCL_ERROR;
	    }
	}
    }

    /* FIXME: restore old channel translation later? */
    if (Tcl_SetChannelOption(interp, channel, "-translation",
	    "binary") != TCL_OK) {
	return TCL_ERROR;
    }
    total = sizeof(double)*first;
    count = sizeof(double)*count;
    while (!Tcl_Eof(channel)) {
        bytesWrite = BUFSIZ;
        if (bytesWrite > (count-total)) {
            bytesWrite = (count-total);
        }
	bytesWrite = Tcl_Write(channel, ((char*)vPtr->valueArr)+total, bytesWrite);
	if (bytesWrite <= 0) {
	    Tcl_AppendResult(interp, "error writing channel: ",
		Tcl_PosixError(interp), (char *)NULL);
	    return TCL_ERROR;
	}
	total += bytesWrite;
	if (total >= count) {
	    break;
	}
    }

    /* Set the result as the number of values written.  */
    Tcl_SetObjResult(interp, Tcl_NewIntObj(total/sizeof(double)));
    return TCL_OK;
}

/*
 * -----------------------------------------------------------------------
 *
 * SearchOp --
 *
 *	Searchs for a value in the vector. Returns the indices of all
 *	vector elements matching a particular value.
 *
 * Results:
 *	Always returns TCL_OK.  interp->result will contain a list of
 *	the indices of array elements matching value. If no elements
 *	match, interp->result will contain the empty string.
 *
 * -----------------------------------------------------------------------
 */
/*ARGSUSED*/
static int
SearchOp(vPtr, interp, objc, objv)
    VectorObject *vPtr;
    Tcl_Interp *interp;
    int objc;
    Tcl_Obj *CONST *objv;
{
    double min, max;
    register int i;
    int wantValue;
    char *string;
    Tcl_Obj *listObjPtr;

    wantValue = FALSE;
    string = Tcl_GetString(objv[2]);
    if ((string[0] == '-') && (strcmp(string, "-value") == 0)) {
	wantValue = TRUE;
	objv++, objc--;
    }
    if (GetDouble(interp, objv[2], &min) != TCL_OK) {
	return TCL_ERROR;
    }
    max = min;
    if ((objc > 3) && (GetDouble(interp, objv[3], &max) != TCL_OK)) {
	return TCL_ERROR;
    }
    if ((min - max) >= DBL_EPSILON) {
	return TCL_OK;		/* Bogus range. Don't bother looking. */
    }
    listObjPtr = Tcl_NewListObj(0, (Tcl_Obj **)NULL);
    if (wantValue) {
	for (i = 0; i < vPtr->length; i++) {
	    if (InRange(vPtr->valueArr[i], min, max)) {
		Tcl_ListObjAppendElement(interp, listObjPtr, 
			Tcl_NewDoubleObj(vPtr->valueArr[i]));
	    }
	}
    } else {
	for (i = 0; i < vPtr->length; i++) {
	    if (InRange(vPtr->valueArr[i], min, max)) {
		Tcl_ListObjAppendElement(interp, listObjPtr,
			 Tcl_NewIntObj(i + vPtr->offset));
	    }
	}
    }
    Tcl_SetObjResult(interp, listObjPtr);
    return TCL_OK;
}

/*
 * -----------------------------------------------------------------------
 *
 * OffsetOp --
 *
 *	Queries or sets the offset of the array index from the base
 *	address of the data array of values.
 *
 * Results:
 *	A standard Tcl result.  If the source vector doesn't exist
 *	or the source list is not a valid list of numbers, TCL_ERROR
 *	returned.  Otherwise TCL_OK is returned.
 *	Clients of the vector are notified.
 *	Any cached array indices are flushed.
 *
 * -----------------------------------------------------------------------
 */
/*ARGSUSED*/
static int
OffsetOp(vPtr, interp, objc, objv)
    VectorObject *vPtr;
    Tcl_Interp *interp;
    int objc;
    Tcl_Obj *CONST *objv;
{
    if (objc == 3) {
	int newOffset;

	if (GetIntObj(interp, objv[2], &newOffset) != TCL_OK) {
	    return TCL_ERROR;
	}
        if (vPtr->numcols>1 && newOffset && newOffset%vPtr->numcols) {
            /* newOffset += (vPtr->numcols-(newOffset%vPtr->numcols)); */
            Tcl_AppendResult(interp, "offset must be a multiple of numcols", 0);
            return TCL_ERROR;
        }

	vPtr->offset = newOffset;
        if (vPtr->flush) {
            Blt_VectorFlushCache(vPtr);
        }
        Blt_VectorUpdateClients(vPtr);
    }
    Tcl_SetObjResult(interp, Tcl_NewIntObj(vPtr->offset));
    return TCL_OK;
}

/*
 * -----------------------------------------------------------------------
 *
 * RandomOp --
 *
 *	Generates random values for the length of the vector.
 *
 * Results:
 *	A standard Tcl result.
 *
 * -----------------------------------------------------------------------
 */
/*ARGSUSED*/
static int
RandomOp(vPtr, interp, objc, objv)
    VectorObject *vPtr;
    Tcl_Interp *interp;
    int objc;			/* Not used. */
    Tcl_Obj *CONST *objv;		/* Not used. */
{
#ifdef HAVE_DRAND48
    register int i;

    for (i = 0; i < vPtr->length; i++) {
	vPtr->valueArr[i] = drand48();
    }
#endif /* HAVE_DRAND48 */
    if (vPtr->flush) {
	Blt_VectorFlushCache(vPtr);
    }
    Blt_VectorUpdateClients(vPtr);
    return TCL_OK;
}

/*
 * -----------------------------------------------------------------------
 *
 * SeqOp --
 *
 *	Generates a sequence of values in the vector.
 *
 * Results:
 *	A standard Tcl result.
 *
 * -----------------------------------------------------------------------
 */
/*ARGSUSED*/
static int
SeqOp(vPtr, interp, objc, objv)
    VectorObject *vPtr;
    Tcl_Interp *interp;
    int objc;			/* Not used. */
    Tcl_Obj *CONST *objv;
{
    register int i;
    double start, finish, step;
    int fillVector;
    int nSteps;
    char *string;

    if (GetDouble(interp, objv[2], &start) != TCL_OK) {
	return TCL_ERROR;
    }
    fillVector = FALSE;
    string = Tcl_GetString(objv[3]);
    if ((string[0] == 'e') && (strcmp(string, "end") == 0)) {
	fillVector = TRUE;
    } else if (GetDouble(interp, objv[3], &finish) != TCL_OK) {
	return TCL_ERROR;
    }
    step = 1.0;
    if ((objc > 4) && (GetDouble(interp, objv[4], &step) != TCL_OK)) {
	return TCL_ERROR;
    }
    if (fillVector) {
	nSteps = vPtr->length;
    } else {
	nSteps = (int)((finish - start) / step) + 1;
    }
    if (nSteps > 0) {
	if (Blt_VectorChangeLength(vPtr, nSteps) != TCL_OK) {
	    return TCL_ERROR;
	}
	for (i = 0; i < nSteps; i++) {
	    vPtr->valueArr[i] = start + (step * (double)i);
	}
	if (vPtr->flush) {
	    Blt_VectorFlushCache(vPtr);
	}
	Blt_VectorUpdateClients(vPtr);
    }
    return TCL_OK;
}

/*
 * -----------------------------------------------------------------------
 *
 * SetOp --
 *
 *	Sets the data of the vector object from a list of values.
 *
 * Results:
 *	A standard Tcl result.  If the source vector doesn't exist
 *	or the source list is not a valid list of numbers, TCL_ERROR
 *	returned.  Otherwise TCL_OK is returned.
 *
 * Side Effects:
 *	The vector data is reset.  Clients of the vector are notified.
 *	Any cached array indices are flushed.
 *
 * -----------------------------------------------------------------------
 */
/*ARGSUSED*/
static int
SetOp(vPtr, interp, objc, objv)
    VectorObject *vPtr;
    Tcl_Interp *interp;
    int objc;			/* Not used. */
    Tcl_Obj *CONST *objv;
{
    int result;
    VectorObject *v2Ptr;
    int nElem;
    Tcl_Obj **elemObjArr;

    /* The source can be either a list of numbers or another vector.  */

    v2Ptr = Blt_VectorParseElement((Tcl_Interp *)NULL, vPtr->dataPtr, 
	   Tcl_GetString(objv[2]), (char **)NULL, NS_SEARCH_BOTH);
    if (v2Ptr != NULL) {
	if (vPtr == v2Ptr) {
	    VectorObject *tmpPtr;
	    /* 
	     * Source and destination vectors are the same.  Copy the
	     * source first into a temporary vector to avoid memory
	     * overlaps. 
	     */
	    tmpPtr = Blt_VectorNew(vPtr->dataPtr);
	    result = Blt_VectorDuplicate(tmpPtr, v2Ptr);
	    if (result == TCL_OK) {
		result = Blt_VectorDuplicate(vPtr, tmpPtr);
	    }
	    Blt_VectorFree(tmpPtr);
	} else {
	    result = Blt_VectorDuplicate(vPtr, v2Ptr);
	}
    } else if (Tcl_ListObjGetElements(interp, objv[2], &nElem, &elemObjArr) 
	       == TCL_OK) {
	result = CopyList(vPtr, nElem, elemObjArr);
    } else {
	return TCL_ERROR;
    }

    if (result == TCL_OK) {
	/*
	 * The vector has changed; so flush the array indices (they're
	 * wrong now), find the new range of the data, and notify
	 * the vector's clients that it's been modified.
	 */
	if (vPtr->flush) {
	    Blt_VectorFlushCache(vPtr);
	}
	Blt_VectorUpdateClients(vPtr);
    }
    return result;
}

/*
 * -----------------------------------------------------------------------
 *
 * SplitOp --
 *
 *	Copies the values from the vector evens into one of more
 *	vectors.
 *
 * Results:
 *	A standard Tcl result.  
 *
 * -----------------------------------------------------------------------
 */
/*ARGSUSED*/
static int
SplitOp(vPtr, interp, objc, objv)
    VectorObject *vPtr;
    Tcl_Interp *interp;
    int objc;
    Tcl_Obj *CONST *objv;
{
    int nVectors;

    nVectors = objc - 2;
    if (nVectors == 0 || (vPtr->length % nVectors) != 0) {
	Tcl_AppendResult(interp, "can't split vector \"", vPtr->name, 
	   "\" into ", Blt_Itoa(nVectors), " even parts.", (char *)NULL);
	return TCL_ERROR;
    }
    if (nVectors > 0) {
	VectorObject *v2Ptr;
	char *string;		/* Name of vector. */
	int i, j, k;
	int oldSize, newSize, extra, isNew;

	extra = vPtr->length / nVectors;
	for (i = 0; i < nVectors; i++) {
	    string = Tcl_GetString(objv[i+2]);
	    v2Ptr = Blt_VectorCreate(vPtr->dataPtr, string, string, string,
		&isNew);
	    oldSize = v2Ptr->length;
	    newSize = oldSize + extra;
	    if (Blt_VectorChangeLength(v2Ptr, newSize) != TCL_OK) {
		return TCL_ERROR;
	    }
	    for (j = i, k = oldSize; j < vPtr->length; j += nVectors, k++) {
		v2Ptr->valueArr[k] = vPtr->valueArr[j];
	    }
	    Blt_VectorUpdateClients(v2Ptr);
	    if (v2Ptr->flush) {
		Blt_VectorFlushCache(v2Ptr);
	    }
	}
    }
    return TCL_OK;
}


static VectorObject **sortVectorArr; /* Pointer to the array of values
				      * currently being sorted. */
static int nSortVectors;
static int reverse;		/* Indicates the ordering of the sort. If
				 * non-zero, the vectors are sorted in
				 * decreasing order */

static int
CompareVectors(a, b)
    void *a;
    void *b;
{
    double delta;
    int i;
    int sign;
    register VectorObject *vPtr;

    sign = (reverse) ? -1 : 1;
    for (i = 0; i < nSortVectors; i++) {
	vPtr = sortVectorArr[i];
	delta = vPtr->valueArr[*(int *)a] - vPtr->valueArr[*(int *)b];
	if (delta < 0.0) {
	    return (-1 * sign);
	} else if (delta > 0.0) {
	    return (1 * sign);
	}
    }
    return 0;
}

int *
Blt_VectorSortIndex(vPtrPtr, nVectors)
    VectorObject **vPtrPtr;
    int nVectors;
{
    int *indexArr;
    register int i;
    VectorObject *vPtr = *vPtrPtr;
    int length;

    length = vPtr->last - vPtr->first + 1;
    indexArr = Blt_Malloc(sizeof(int) * length);
    assert(indexArr);
    for (i = vPtr->first; i <= vPtr->last; i++) {
	indexArr[i] = i;
    }
    sortVectorArr = vPtrPtr;
    nSortVectors = nVectors;
    qsort((char *)indexArr, length, sizeof(int), 
	  (QSortCompareProc *)CompareVectors);
    return indexArr;
}

static int *
SortVectors(vPtr, interp, objc, objv)
    VectorObject *vPtr;
    Tcl_Interp *interp;
    int objc;
    Tcl_Obj *CONST *objv;
{
    VectorObject **vPtrArray, *v2Ptr;
    int *iArr;
    register int i;

    vPtrArray = Blt_Malloc(sizeof(VectorObject *) * (objc + 1));
    assert(vPtrArray);
    vPtrArray[0] = vPtr;
    iArr = NULL;
    for (i = 0; i < objc; i++) {
	if (Blt_VectorLookupName(vPtr->dataPtr, Tcl_GetString(objv[i]), &v2Ptr)
	    != TCL_OK) {
	    goto error;
	}
	if (v2Ptr->length != vPtr->length) {
	    Tcl_AppendResult(interp, "vector \"", v2Ptr->name,
		"\" is not the same size as \"", vPtr->name, "\"",
		(char *)NULL);
	    goto error;
	}
	vPtrArray[i + 1] = v2Ptr;
    }
    iArr = Blt_VectorSortIndex(vPtrArray, objc + 1);
  error:
    Blt_Free(vPtrArray);
    return iArr;
}


/*
 * -----------------------------------------------------------------------
 *
 * SortOp --
 *
 *	Sorts the vector object and any other vectors according to
 *	sorting order of the vector object.
 *
 * Results:
 *	A standard Tcl result.  If any of the auxiliary vectors are
 *	a different size than the sorted vector object, TCL_ERROR is
 *	returned.  Otherwise TCL_OK is returned.
 *
 * Side Effects:
 *	The vectors are sorted.
 *
 * -----------------------------------------------------------------------
 */

static int
SortOp(vPtr, interp, objc, objv)
    VectorObject *vPtr;
    Tcl_Interp *interp;
    int objc;
    Tcl_Obj *CONST *objv;
{
    VectorObject *v2Ptr;
    char *string;
    double *mergeArr;
    int *iArr;
    int refSize, nBytes;
    int result;
    register int i, n;

    reverse = FALSE;
    if (objc > 2) {
	int length;

	string = Tcl_GetStringFromObj(objv[2], &length);
	if (string[0] == '-') {
	    if ((length > 1) && (strncmp(string, "-reverse", length) == 0)) {
		reverse = TRUE;
	    } else {
		Tcl_AppendResult(interp, "unknown flag \"", string,
			 "\": should be \"-reverse\"", (char *)NULL);
		return TCL_ERROR;
	    }
	    objc--, objv++;
	}
    }
    if (objc > 2) {
	iArr = SortVectors(vPtr, interp, objc - 2, objv + 2);
    } else {
	iArr = Blt_VectorSortIndex(&vPtr, 1);
    }
    if (iArr == NULL) {
	return TCL_ERROR;
    }
    refSize = vPtr->length;

    /*
     * Create an array to store a copy of the current values of the
     * vector. We'll merge the values back into the vector based upon
     * the indices found in the index array.
     */
    nBytes = sizeof(double) * refSize;
    mergeArr = Blt_Malloc(nBytes);
    assert(mergeArr);
    memcpy((char *)mergeArr, (char *)vPtr->valueArr, nBytes);
    for (n = 0; n < refSize; n++) {
	vPtr->valueArr[n] = mergeArr[iArr[n]];
    }
    if (vPtr->flush) {
	Blt_VectorFlushCache(vPtr);
    }
    Blt_VectorUpdateClients(vPtr);

    /* Now sort any other vectors in the same fashion.  The vectors
     * must be the same size as the iArr though.  */
    result = TCL_ERROR;
    for (i = 2; i < objc; i++) {
	if (Blt_VectorLookupName(vPtr->dataPtr, Tcl_GetString(objv[i]), &v2Ptr)
	    != TCL_OK) {
	    goto error;
	}
	if (v2Ptr->length != refSize) {
	    Tcl_AppendResult(interp, "vector \"", v2Ptr->name,
		"\" is not the same size as \"", vPtr->name, "\"",
		(char *)NULL);
	    goto error;
	}
	memcpy((char *)mergeArr, (char *)v2Ptr->valueArr, nBytes);
	for (n = 0; n < refSize; n++) {
	    v2Ptr->valueArr[n] = mergeArr[iArr[n]];
	}
	Blt_VectorUpdateClients(v2Ptr);
	if (v2Ptr->flush) {
	    Blt_VectorFlushCache(v2Ptr);
	}
    }
    result = TCL_OK;
  error:
    Blt_Free(mergeArr);
    Blt_Free(iArr);
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * InstExprOp --
 *
 *	Computes the result of the expression which may be
 *	either a scalar (single value) or vector (list of values).
 *
 * Results:
 *	A standard Tcl result.
 *
 *----------------------------------------------------------------------
 */
/*ARGSUSED*/
static int
InstExprOp(vPtr, interp, objc, objv)
    VectorObject *vPtr;
    Tcl_Interp *interp;
    int objc;
    Tcl_Obj *CONST *objv;
{

    if (Blt_ExprVector(interp, Tcl_GetString(objv[2]), (Blt_Vector *) vPtr) 
	!= TCL_OK) {
	return TCL_ERROR;
    }
    if (vPtr->flush) {
	Blt_VectorFlushCache(vPtr);
    }
    Blt_VectorUpdateClients(vPtr);
    return TCL_OK;
}

/*
 * -----------------------------------------------------------------------
 *
 * ArithOp --
 *
 * Results:
 *	A standard Tcl result.  If the source vector doesn't exist
 *	or the source list is not a valid list of numbers, TCL_ERROR
 *	returned.  Otherwise TCL_OK is returned.
 *
 * Side Effects:
 *	The vector data is reset.  Clients of the vector are notified.
 *	Any cached array indices are flushed.
 *
 * -----------------------------------------------------------------------
 */
/*ARGSUSED*/
static int
ArithOp(vPtr, interp, objc, objv)
    VectorObject *vPtr;
    Tcl_Interp *interp;
    int objc;			/* Not used. */
    Tcl_Obj *CONST *objv;
{
    register double value;
    register int i;
    VectorObject *v2Ptr;
    double scalar;
    Tcl_Obj *listObjPtr;
    char *string;

    v2Ptr = Blt_VectorParseElement((Tcl_Interp *)NULL, vPtr->dataPtr, 
		Tcl_GetString(objv[2]), (char **)NULL, NS_SEARCH_BOTH);
    if (v2Ptr != NULL) {
	register int j;
	int length;

	length = v2Ptr->last - v2Ptr->first + 1;
	if (length != vPtr->length) {
	    Tcl_AppendResult(interp, "vectors \"", Tcl_GetString(objv[0]), 
		"\" and \"", Tcl_GetString(objv[2]), 
		"\" are not the same length", (char *)NULL);
	    return TCL_ERROR;
	}
	string = Tcl_GetString(objv[1]);
	listObjPtr = Tcl_NewListObj(0, (Tcl_Obj **)NULL);
	switch (string[0]) {
	case '*':
	    for (i = 0, j = v2Ptr->first; i < vPtr->length; i++, j++) {
		value = vPtr->valueArr[i] * v2Ptr->valueArr[j];
		Tcl_ListObjAppendElement(interp, listObjPtr,
			 Tcl_NewDoubleObj(value));
	    }
	    break;

	case '/':
	    for (i = 0, j = v2Ptr->first; i < vPtr->length; i++, j++) {
		value = vPtr->valueArr[i] / v2Ptr->valueArr[j];
		Tcl_ListObjAppendElement(interp, listObjPtr,
			 Tcl_NewDoubleObj(value));
	    }
	    break;

	case '-':
	    for (i = 0, j = v2Ptr->first; i < vPtr->length; i++, j++) {
		value = vPtr->valueArr[i] - v2Ptr->valueArr[j];
		Tcl_ListObjAppendElement(interp, listObjPtr,
			 Tcl_NewDoubleObj(value));
	    }
	    break;

	case '+':
	    for (i = 0, j = v2Ptr->first; i < vPtr->length; i++, j++) {
		value = vPtr->valueArr[i] + v2Ptr->valueArr[j];
		Tcl_ListObjAppendElement(interp, listObjPtr,
			 Tcl_NewDoubleObj(value));
	    }
	    break;
	}
	Tcl_SetObjResult(interp, listObjPtr);

    } else if (GetDouble(interp, objv[2], &scalar) == TCL_OK) {
	listObjPtr = Tcl_NewListObj(0, (Tcl_Obj **)NULL);
	string = Tcl_GetString(objv[1]);
	switch (string[0]) {
	case '*':
	    for (i = 0; i < vPtr->length; i++) {
		value = vPtr->valueArr[i] * scalar;
		Tcl_ListObjAppendElement(interp, listObjPtr,
			 Tcl_NewDoubleObj(value));
	    }
	    break;

	case '/':
	    for (i = 0; i < vPtr->length; i++) {
		value = vPtr->valueArr[i] / scalar;
		Tcl_ListObjAppendElement(interp, listObjPtr,
			 Tcl_NewDoubleObj(value));
	    }
	    break;

	case '-':
	    for (i = 0; i < vPtr->length; i++) {
		value = vPtr->valueArr[i] - scalar;
		Tcl_ListObjAppendElement(interp, listObjPtr,
			 Tcl_NewDoubleObj(value));
	    }
	    break;

	case '+':
	    for (i = 0; i < vPtr->length; i++) {
		value = vPtr->valueArr[i] + scalar;
		Tcl_ListObjAppendElement(interp, listObjPtr,
			 Tcl_NewDoubleObj(value));
	    }
	    break;
	}
	Tcl_SetObjResult(interp, listObjPtr);
    } else {
	return TCL_ERROR;
    }
    return TCL_OK;
}

/* 

 * Set the numcols used in matrix math.
 *
 *   $vec matrix numcols ?n?
 */

static int
MatrixNumcolsObjOp(vPtr, interp, objc, objv)
    VectorObject *vPtr;
    Tcl_Interp *interp;
    int objc;
    Tcl_Obj *CONST *objv;
{
    int i;

    if (objc == 3) {
        Tcl_SetObjResult(interp, Tcl_NewIntObj(vPtr->numcols));
        return TCL_OK;
    }
    if (GetIntObj(vPtr->interp, objv[3], &i) != TCL_OK) {
        return TCL_ERROR;
    }
    if (i<=0) {
        Tcl_AppendResult(interp, "value must >= 1", 0);
        return TCL_ERROR;
    }
    vPtr->numcols = i;
    if (vPtr->length%i) {
        Blt_VectorChangeLength(vPtr, vPtr->length);
    }
    if (vPtr->offset && vPtr->offset%i) {
        vPtr->offset += (i-(i%vPtr->offset));
    }
    vPtr->notifyFlags |= UPDATE_RANGE;
    if (vPtr->flush) {
        Blt_VectorFlushCache(vPtr);
    }
    Blt_VectorUpdateClients(vPtr);
    return TCL_OK;
}

/* 
 * Set the numcols used in matrix math.
 *
 *   $vec matrix numrows ?n?
 */

static int
MatrixNumrowsObjOp(vPtr, interp, objc, objv)
    VectorObject *vPtr;
    Tcl_Interp *interp;
    int objc;
    Tcl_Obj *CONST *objv;
{
    int i, newSize;

    if (vPtr->numcols<=0) {
        Tcl_AppendResult(interp, "must set matrix numcols", 0);
        return TCL_ERROR;
    }
    if (objc <= 3) {
        Tcl_SetObjResult(interp, Tcl_NewIntObj(vPtr->length/vPtr->numcols));
        return TCL_OK;
    }
    if (GetIntObj(vPtr->interp, objv[3], &i) != TCL_OK) {
        return TCL_ERROR;
    }
    if (i == (vPtr->length/vPtr->numcols)) {
        return TCL_OK;
    }
    newSize = (vPtr->numcols*i);
    if (Blt_VectorChangeLength(vPtr, newSize) != TCL_OK) {
        return TCL_ERROR;
    }
    vPtr->notifyFlags |= UPDATE_RANGE;
    if (vPtr->flush) {
        Blt_VectorFlushCache(vPtr);
    }
    Blt_VectorUpdateClients(vPtr);
    return TCL_OK;
}

static int
MatrixTransposeObjOp(vPtr, interp, objc, objv)
    VectorObject *vPtr;
    Tcl_Interp *interp;
    int objc;
    Tcl_Obj *CONST *objv;
{
    int cols, rows, r, c, src, dst, bytes;
    double *v, *n;

    cols = vPtr->numcols;
    if ((vPtr->length)%cols) {
        Tcl_AppendResult(interp, "numcols must be set to MOD the array size", 0);
        return TCL_ERROR;
    }
    rows = (vPtr->length/cols);
    v = vPtr->valueArr;
    bytes = sizeof(double)*vPtr->length;
    n = Blt_Calloc(1, bytes);
    
    for (r=0; r<rows; r++) {
        for (c=0; c<cols; c++) {
            src = (r*cols)+c;
            dst = (c*rows)+r;
            n[dst] = v[src];
        }
    }
    memcpy(vPtr->valueArr, n, bytes);
    Blt_Free(n);
    vPtr->numcols = rows;
    vPtr->notifyFlags |= UPDATE_RANGE;
    if (vPtr->flush) {
        Blt_VectorFlushCache(vPtr);
    }
    Blt_VectorUpdateClients(vPtr);
    return TCL_OK;
}

/*
* -----------------------------------------------------------------------
*
* SortOp --
*
*	Sorts the vector by column. eg.
*
*          vecName matrix sort 1 -reverse
*
* Results:
*	A standard Tcl result.
*
* Side Effects:
*	The vector is sorted.
*
* -----------------------------------------------------------------------
*/

static int
MatrixSortObjOp(vPtr, interp, objc, objv)
VectorObject *vPtr;
Tcl_Interp *interp;
int objc;
Tcl_Obj *CONST *objv;
{
    char *string;
    double *mergeArr;
    int *iArr;
    int refSize, nBytes;
    register int i, n;
    int column, ncols, nrows;
    double *v;

    if (!strcmp("end", Tcl_GetString(objv[3]))) {
        column = vPtr->numcols-1;
    } else if (GetIntObj(interp, objv[3], &column) != TCL_OK) {    
        return TCL_ERROR;
    }
    ncols = vPtr->numcols;
    if (column<0 || column>=ncols) {
        Tcl_AppendResult(interp, "bad column", 0);
        return TCL_ERROR;
    }
    reverse = FALSE;
    if (objc > 4) {
        int length;

        string = Tcl_GetStringFromObj(objv[4], &length);
        if ((length > 1) && (strncmp(string, "-reverse", length) == 0)) {
            reverse = TRUE;
        } else {
            Tcl_AppendResult(interp, "unknown flag \"", string,
            "\": should be \"-reverse\"", (char *)NULL);
            return TCL_ERROR;
        }
    }
    nrows = vPtr->length/ncols;
    iArr = Blt_Malloc(sizeof(int) * nrows);
    assert(iArr);
    for (n = 0, i = column; i < vPtr->length; n++, i+=ncols) {
        iArr[n] = i;
    }
    sortVectorArr = &vPtr;
    nSortVectors = 1;
    qsort((char *)iArr, nrows, sizeof(int), 
        (QSortCompareProc *)CompareVectors);

    refSize = vPtr->length;
    nBytes = sizeof(double) * refSize;
    mergeArr = Blt_Malloc(nBytes);
    assert(mergeArr);
    memcpy((char *)mergeArr, (char *)vPtr->valueArr, nBytes);
    v = vPtr->valueArr;
    for (n = 0; n < nrows; n++) {
        int cind;
        cind = iArr[n] - column;
        for (i=0; i<ncols; i++) {
            v[n*ncols+i] = mergeArr[cind+i];
        }
    }
    Blt_Free(mergeArr);
    Blt_Free(iArr);
    if (vPtr->flush) {
        Blt_VectorFlushCache(vPtr);
    }
    Blt_VectorUpdateClients(vPtr);

    return TCL_OK;
}

/* 
 * Delete a column from a matrix vector..
 *
 *   vector matrix insert $vec ?offset?
 */

static int
MatrixDeleteObjOp(vPtr, interp, objc, objv)
    VectorObject *vPtr;
    Tcl_Interp *interp;
    int objc;
    Tcl_Obj *CONST *objv;
{
    int i, j, offset = 0, newSize, numrows, rsz;
    double *v;

    if (objc > 3) {
        if (!strcmp("end", Tcl_GetString(objv[3]))) {
            offset = vPtr->numcols-1;
        } else if (GetIntObj(interp, objv[3], &offset) != TCL_OK) {    
            return TCL_ERROR;
        }
    }
    if (offset<0 || offset>=(vPtr->numcols) || vPtr->numcols<=1) {
        Tcl_AppendResult(interp, "value must be < numcols", 0);
        return TCL_ERROR;
    }
    numrows = vPtr->length/vPtr->numcols;
    newSize = numrows*(vPtr->numcols-1);
    rsz = vPtr->numcols;

    v = vPtr->valueArr;
    for (i=0; i<numrows; i++) {
        int in, io;
        in = i*(rsz-1);
        io = i*(rsz);
        if (offset == (rsz-1)) {
            for (j=0; j<(rsz-1); j++) {
                v[in+j] = v[io+j];
            }
        } else if (offset == 0) {
            for (j=0; j<(rsz-1); j++) {
                v[in+j] = v[io+j+1];
            }
        } else {
            for (j=0; j<offset; j++) {
                v[in+j] = v[io+j];
            }
            for (j=offset+1; j<(rsz-1); j++) {
                v[in+j-1] = v[io+j];
            }
        }
    }
    if (Blt_VectorChangeLength(vPtr, newSize) != TCL_OK) {
        return TCL_ERROR;
    }
    vPtr->numcols = rsz-1;
    vPtr->notifyFlags |= UPDATE_RANGE;
    if (vPtr->flush) {
        Blt_VectorFlushCache(vPtr);
    }
    Blt_VectorUpdateClients(vPtr);
    
    return TCL_OK;
}

/* 
 * Insert a column into a matrix vector..
 *
 *   vector matrix insert $vec ?offset? ?initValue?
 *
 * TODO: support insert from another matrix.
 */

static int
MatrixInsertObjOp(vPtr, interp, objc, objv)
    VectorObject *vPtr;
    Tcl_Interp *interp;
    int objc;
    Tcl_Obj *CONST *objv;
{
    int i, j, offset = 0, newSize, numrows, rsz;
    double initValue = 0.0, *v;

    if (objc > 3) {
        if (!strcmp("end", Tcl_GetString(objv[3]))) {
            offset = vPtr->numcols;
        } else if (GetIntObj(interp, objv[3], &offset) != TCL_OK) {    
            return TCL_ERROR;
        }
    }
    if (objc > 4 && GetDouble(interp, objv[4], &initValue) != TCL_OK) {
        return TCL_ERROR;
    }
    if (offset<0 || offset>vPtr->numcols || vPtr->numcols<=0) {
        Tcl_AppendResult(interp, "value must be <= numcols", 0);
        return TCL_ERROR;
    }
    numrows = vPtr->length/vPtr->numcols;
    newSize = numrows*(vPtr->numcols+1);
    rsz = vPtr->numcols;
    if (Blt_VectorChangeLength(vPtr, newSize) != TCL_OK) {
        return TCL_ERROR;
    }
    v = vPtr->valueArr;

    for (i=numrows-1; i>=0; i--) {
        int in, io;
        in = i*(rsz+1);
        io = i*(rsz);
        if (offset == rsz) {
            for (j=rsz-1; j>=0; j--) {
                v[in+j] = v[io+j];
            }
            v[in+rsz] = initValue;
        } else if (offset == 0) {
            for (j=rsz-1; j>=0; j--) {
                v[in+j+1] = v[io+j];
            }
            v[in] = initValue;
        } else {
            for (j=rsz-1; j>=offset; j--) {
                v[in+j+1] = v[io+j];
            }
            for (; j>=0; j--) {
                v[in+j] = v[io+j];
            }
            v[in+offset] = initValue;
        }
    }
    vPtr->numcols = rsz+1;
    vPtr->notifyFlags |= UPDATE_RANGE;
    if (vPtr->flush) {
        Blt_VectorFlushCache(vPtr);
    }
    Blt_VectorUpdateClients(vPtr);
    
    return TCL_OK;
}

/* 
 * Set a column to a value.
 *
 *   vecName matrix set $vec ?column? ?valuelist?
 *
 */

static int
MatrixSetObjOp(vPtr, interp, objc, objv)
    VectorObject *vPtr;
    Tcl_Interp *interp;
    int objc;
    Tcl_Obj *CONST *objv;
{
    int i, offset = 0, numrows, rsz;
    double initValue = 0.0, *v;
    int nElem = 0, eInd = 0;
    Tcl_Obj **elemObjArr;


    if (objc > 3) {
        if (!strcmp("end", Tcl_GetString(objv[3]))) {
            offset = vPtr->numcols-1;
        } else if (GetIntObj(interp, objv[3], &offset) != TCL_OK) {    
            return TCL_ERROR;
        }
    }
    if (objc > 4) {
        if (GetDouble(interp, objv[4], &initValue) != TCL_OK) {
            if (Tcl_ListObjGetElements(interp, objv[4], &nElem, &elemObjArr) 
                != TCL_OK) {
                return TCL_ERROR;
            }
            if (nElem<1 || GetDouble(interp, elemObjArr[0],
                &initValue) != TCL_OK) {
                Tcl_AppendResult( interp, "list must have >=1 value", 0);
                return TCL_ERROR;
            }
            eInd = 1;
        }
    }
    if (offset<0 || offset>=vPtr->numcols || vPtr->numcols<=0) {
        Tcl_AppendResult(interp, "column offset must be <= numcols", 0);
        return TCL_ERROR;
    }
    numrows = vPtr->length/vPtr->numcols;
    rsz = vPtr->numcols;
    v = vPtr->valueArr;

    for (i=0; i<numrows; i++) {
        if (eInd && i>0 && i<nElem) {
            if (GetDouble(interp, elemObjArr[i], &initValue)
                != TCL_OK) {
                return TCL_ERROR;
            }
        }
        v[i*rsz+offset] = initValue;
    }
    Tcl_ResetResult(interp);
    vPtr->notifyFlags |= UPDATE_RANGE;
    if (vPtr->flush) {
        Blt_VectorFlushCache(vPtr);
    }
    Blt_VectorUpdateClients(vPtr);
    return TCL_OK;
}

/* 
 * Get column values.
 *
 *   vecName matrix get $vec ?coloffset? 
 *
 */

static int
MatrixGetObjOp(vPtr, interp, objc, objv)
    VectorObject *vPtr;
    Tcl_Interp *interp;
    int objc;
    Tcl_Obj *CONST *objv;
{
    int i, offset = 0, numrows, rsz;
    double  *v, *v3;
    Tcl_Obj *lPtr;

    if (objc > 3) {
        if (!strcmp("end", Tcl_GetString(objv[3]))) {
            offset = vPtr->numcols-1;
        } else if (GetIntObj(interp, objv[3], &offset) != TCL_OK) {    
            return TCL_ERROR;
        }
    }
    if (offset<0 || offset>=vPtr->numcols || vPtr->numcols<=0) {
        Tcl_AppendResult(interp, "column offset must be <= numcols", 0);
        return TCL_ERROR;
    }
    numrows = vPtr->length/vPtr->numcols;
    rsz = vPtr->numcols;
    v = vPtr->valueArr;

    if (objc>4) {
        int isNew, newSize;
        VectorObject *v3Ptr;
        char *string = Tcl_GetString(objv[4]);
        
        v3Ptr = Blt_VectorCreate(vPtr->dataPtr, string, string, string,&isNew);
        if (v3Ptr == NULL) {
            return TCL_ERROR;
        }
        newSize = numrows;
        if (Blt_VectorChangeLength(v3Ptr, newSize) != TCL_OK) {
            return TCL_ERROR;
        }
        v3Ptr->numcols = 1;
        v3 = v3Ptr->valueArr;
        for (i=0; i<numrows; i++) {
            v3[i] = v[i*rsz+offset];
        }
        if (!isNew) {
            v3Ptr->notifyFlags |= UPDATE_RANGE;
            if (v3Ptr->flush) {
                Blt_VectorFlushCache(v3Ptr);
            }
            Blt_VectorUpdateClients(v3Ptr);
        }
    } else {
        lPtr = Tcl_NewListObj(0,0);
        for (i=0; i<numrows; i++) {
            Tcl_ListObjAppendElement(interp, lPtr, Tcl_NewDoubleObj(v[i*rsz+offset]));
        }
        Tcl_SetObjResult(interp, lPtr);
    }
    return TCL_OK;
}

/* 
* Copy columns
 *
 *   vecName matrix copy $vec srcVec ?dstcoloffset? ?srccoloffset?
 *
 */

static int
MatrixCopyObjOp(vPtr, interp, objc, objv)
    VectorObject *vPtr;
    Tcl_Interp *interp;
    int objc;
    Tcl_Obj *CONST *objv;
{
    int i, offset = 0, srcoffset = 0, numrows, numrows2, rsz, rsz2;
    double *v, *v2;
    VectorObject *v2Ptr = vPtr;


    if (objc > 3) {
        if (!strcmp("end", Tcl_GetString(objv[3]))) {
            offset = vPtr->numcols-1;
        } else if (GetIntObj(interp, objv[3], &offset) != TCL_OK) {    
            return TCL_ERROR;
        }
    }
    if (objc > 4) {
        if (!strcmp("end", Tcl_GetString(objv[4]))) {
            srcoffset = v2Ptr->numcols-1;
        } else if (GetIntObj(interp, objv[4], &srcoffset) != TCL_OK) {    
            return TCL_ERROR;
        }
    }
    if (objc>5 && Blt_VectorLookupName(vPtr->dataPtr, Tcl_GetString(objv[5]),
        &v2Ptr) != TCL_OK) {
        return TCL_ERROR;
    }

    if (vPtr == v2Ptr && srcoffset == offset) {
        Tcl_AppendResult(interp, "column offsets must be different", 0);
        return TCL_ERROR;
    }
    if (offset<0 || offset>=vPtr->numcols || vPtr->numcols<=0) {
        Tcl_AppendResult(interp, "column offset must be <= numcols", 0);
        return TCL_ERROR;
    }
    if (srcoffset<0 || srcoffset>=v2Ptr->numcols || v2Ptr->numcols<=0) {
        Tcl_AppendResult(interp, "src column offset must be <= numcols", 0);
        return TCL_ERROR;
    }
    numrows = vPtr->length/vPtr->numcols;
    numrows2 = v2Ptr->length/v2Ptr->numcols;
    rsz = vPtr->numcols;
    rsz2 = v2Ptr->numcols;
    
    if (numrows2>numrows) {
        int newSize = numrows2*(vPtr->numcols+1);
        if (Blt_VectorChangeLength(vPtr, newSize) != TCL_OK) {
            return TCL_ERROR;
        }
    }
    v = vPtr->valueArr;
    v2 = v2Ptr->valueArr;

    for (i=0; i<numrows2; i++) {
        v[i*rsz+offset] = v2[i*rsz2+srcoffset];
    }
    vPtr->notifyFlags |= UPDATE_RANGE;
    if (vPtr->flush) {
        Blt_VectorFlushCache(vPtr);
    }
    Blt_VectorUpdateClients(vPtr);
    
    return TCL_OK;
}

/* 
 * Shift values down or up within a column.
 *
 *   $vec matrix shift  column ?amount? ?start?
 *
 *   $vec matrix shift 1 5
 *
 */

static int
MatrixShiftObjOp(vPtr, interp, objc, objv)
    VectorObject *vPtr;
    Tcl_Interp *interp;
    int objc;
    Tcl_Obj *CONST *objv;
{
    int i, offset = 0, amount = 1, numrows, rsz, start=vPtr->first;
    double *v;
    
    if (!strcmp("end", Tcl_GetString(objv[3]))) {
        offset = vPtr->numcols-1;
    } else if (GetIntObj(interp, objv[3], &offset) != TCL_OK) {    
        return TCL_ERROR;
    }
    if (objc > 4) {
        if (GetIntObj(interp, objv[4], &amount) != TCL_OK) {    
            return TCL_ERROR;
        }
    }
    if (objc > 5) {
        if (GetIntObj(interp, objv[5], &start) != TCL_OK) {    
            return TCL_ERROR;
        }
    }
    if (offset<0 || offset>=vPtr->numcols || vPtr->numcols<=0) {
        Tcl_AppendResult(interp, "column offset must be < numcols", 0);
        return TCL_ERROR;
    }
    start -= vPtr->first;
    rsz = vPtr->numcols;
    numrows = vPtr->length/rsz;
    if (amount==0) return TCL_OK;
    v = vPtr->valueArr;
    if (amount>numrows || amount<-numrows)  {
        for (i=start; i<numrows; i++) {
            v[i*rsz+offset] = 0;
        }
    } else {    
        if (amount < 0) {
            for (i=start; i<numrows; i++) {
                if ((i-amount)>= numrows) {
                    v[i*rsz+offset] = 0;
                } else {
                    v[i*rsz+offset] = v[(i-amount)*rsz+offset];
                }
            }
        } else {
            for (i=numrows-1; i>=start; i--) {
                if ((i-amount) < 0) {
                    v[i*rsz+offset] = 0;
                } else {
                    v[i*rsz+offset] = v[(i-amount)*rsz+offset];
                }
            }
        }
    }
    vPtr->notifyFlags |= UPDATE_RANGE;
    if (vPtr->flush) {
        Blt_VectorFlushCache(vPtr);
    }
    Blt_VectorUpdateClients(vPtr);
    
    return TCL_OK;
}

/* 
* Perform matrix multiplication.
*
*   $vec matrix multiply vecName
*
*/

static int
MatrixMultiplyObjOp(vPtr, interp, objc, objv)
    VectorObject *vPtr;
    Tcl_Interp *interp;
    int objc;
    Tcl_Obj *CONST *objv;
{
    VectorObject *v2Ptr;
    int nc1, nc2, nr1, nr2, i, mr, mc, len, result = TCL_OK;
    double *v1, *v2, *v, vStatic[256];
    char *str;
    Tcl_Obj *lPtr;
    
    if (Blt_VectorLookupName(vPtr->dataPtr, str=Tcl_GetString(objv[3]),
        &v2Ptr) != TCL_OK) {
            return TCL_ERROR;
    }
    
    nc1=vPtr->numcols;
    nc2=v2Ptr->numcols;
    nr1 = (vPtr->length/nc1);
    nr2 = (v2Ptr->length/nc2);
    if (v2Ptr->length<=0 || vPtr->length<=0) {
        Tcl_AppendResult(interp, "vectors must not be empty", 0);
        return TCL_ERROR;
    }
    if (nc1 != nr2) {
        Tcl_AppendResult(interp, "numcols != numrows of ", str, 0);
        return TCL_ERROR;
    }
    v1 = vPtr->valueArr;
    v2 = v2Ptr->valueArr;
    len = nr1*nc2;
    if (len<=256) {
        v = vStatic;
        memset(v, 0,sizeof(vStatic));
    } else {
        v = (double*)Blt_Calloc(sizeof(double), len);
    }
    for (mc=0; mc<nc2; mc++) {
        for (mr=0; mr<nr1; mr++) {
            for (i=0; i<nc1; i++) {
                v[mr*nc2+mc] += v1[mr*nc1+i]*v2[i*nc2+mc];
            }
        }
    }
    if (objc>4) {
        int isNew, newSize;
        VectorObject *v3Ptr;
        char *string = Tcl_GetString(objv[4]);
        
        v3Ptr = Blt_VectorCreate(vPtr->dataPtr, string, string, string,&isNew);
        if (v3Ptr == NULL) {
            result = TCL_ERROR;
            goto cleanup;
        }
        newSize = len;
        if (Blt_VectorChangeLength(v3Ptr, newSize) != TCL_OK) {
            result = TCL_ERROR;
            goto cleanup;
        }
        memcpy(v3Ptr->valueArr, v, sizeof(double)*newSize);
        v3Ptr->numcols = nc2;
        if (!isNew) {
            v3Ptr->notifyFlags |= UPDATE_RANGE;
            if (v3Ptr->flush) {
                Blt_VectorFlushCache(v3Ptr);
            }
            Blt_VectorUpdateClients(v3Ptr);
        }
    } else {

        lPtr = Tcl_NewListObj(0,0);
        for (i=0; i<len; i++) {
            Tcl_ListObjAppendElement(interp, lPtr, Tcl_NewDoubleObj(v[i]));
        }
        Tcl_SetObjResult(interp, lPtr);
    }
cleanup:
    if (v != vStatic) {
        Blt_Free((char*)v);
    }
    
    return result;
}

static Blt_OpSpec matrixCmdOps[] =
{
    {"copy",     1, (Blt_Op)MatrixCopyObjOp, 5, 6, "dstcolumn srccolumn ?srcVec?",},
    {"delete",   1, (Blt_Op)MatrixDeleteObjOp, 4, 4, "column",},
    {"get",      1, (Blt_Op)MatrixGetObjOp, 4, 5, "column ?dstVec?",},
    {"insert",   1, (Blt_Op)MatrixInsertObjOp, 4, 5, "column ?inititem?",},
    {"multiply", 1, (Blt_Op)MatrixMultiplyObjOp, 4, 5, "vecName ?dstVec?",},
    {"numcols",  2, (Blt_Op)MatrixNumcolsObjOp, 3, 4, "?newsize?",},
    {"numrows",  2, (Blt_Op)MatrixNumrowsObjOp, 3, 4, "?newsize?",},
    {"shift",    2, (Blt_Op)MatrixShiftObjOp, 5, 6, "column offset ?start?",},
    {"set",      2, (Blt_Op)MatrixSetObjOp, 4, 5, "column ?valuelist?",},
    {"sort",     2, (Blt_Op)MatrixSortObjOp, 4, 5, "column ?-reverse?",},
    {"transpose", 1, (Blt_Op)MatrixTransposeObjOp, 3, 3, "",},
};

static int nMatrixOps = sizeof(matrixCmdOps) / sizeof(Blt_OpSpec);

static int
MatrixOp(vPtr, interp, objc, objv)
    VectorObject *vPtr;
    Tcl_Interp *interp;
    int objc;
    Tcl_Obj *CONST *objv;
{
    int result = TCL_OK;
    Blt_Op proc;
    
    proc = Blt_GetOpFromObj(interp, nMatrixOps, matrixCmdOps, BLT_OP_ARG2, objc, objv, 0);
    if (proc == NULL) {
        return TCL_ERROR;
    }
    return (*proc) (vPtr, interp, objc, objv);
    
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * VectorInstCmd --
 *
 *	Parses and invokes the appropriate vector instance command
 *	option.
 *
 * Results:
 *	A standard Tcl result.
 *
 *----------------------------------------------------------------------
 */
static Blt_OpSpec vectorInstOps[] =
{
    {"*", 1, (Blt_Op)ArithOp, 3, 3, "item",},	/*Deprecated*/
    {"+", 1, (Blt_Op)ArithOp, 3, 3, "item",},	/*Deprecated*/
    {"-", 1, (Blt_Op)ArithOp, 3, 3, "item",},	/*Deprecated*/
    {"/", 1, (Blt_Op)ArithOp, 3, 3, "item",},	/*Deprecated*/
    {"append", 1, (Blt_Op)AppendOp, 3, 0, "item ?item...?",},
    {"binread", 4, (Blt_Op)BinreadOp, 3, 0, "channel ?numValues? ?flags?",},
    {"binwrite", 4, (Blt_Op)BinwriteOp, 3, 0, "channel ?numValues? ?flags?",},
    {"clear", 1, (Blt_Op)ClearOp, 2, 3, "?autoflush?",},
    {"delete", 2, (Blt_Op)DeleteOp, 2, 0, "index ?index...?",},
    {"dup", 2, (Blt_Op)DupOp, 3, 0, "vecName",},
    {"expr", 1, (Blt_Op)InstExprOp, 3, 3, "expression",},
    {"index", 3, (Blt_Op)IndexOp, 3, 4, "index ?value?",},
    {"insert", 3, (Blt_Op)InsertOp, 3, 0, "index value ?value...?",},
    {"length", 1, (Blt_Op)LengthOp, 2, 3, "?newSize?",},
    {"matrix", 2, (Blt_Op)MatrixOp, 3, 0, "op ...",},
    {"merge", 2, (Blt_Op)MergeOp, 3, 0, "vecName ?vecName...?",},
    {"normalize", 3, (Blt_Op)NormalizeOp, 2, 3, "?vecName?",},	/*Deprecated*/
    {"notify", 3, (Blt_Op)NotifyOp, 2, 4, "?keyword? ?callback?",},
    {"offset", 2, (Blt_Op)OffsetOp, 2, 3, "?offset?",},
    {"populate", 1, (Blt_Op)PopulateOp, 4, 4, "vecName density",},
    {"random", 4, (Blt_Op)RandomOp, 2, 2, "",},	/*Deprecated*/
    {"range", 4, (Blt_Op)RangeOp, 4, 4, "first last",},
    {"search", 3, (Blt_Op)SearchOp, 3, 4, "?-value? value ?value?",},
    {"seq", 3, (Blt_Op)SeqOp, 4, 5, "start end ?step?",},
    {"set", 3, (Blt_Op)SetOp, 3, 3, "list",},
    {"sort", 2, (Blt_Op)SortOp, 2, 0, "?-reverse? ?vecName...?",},
    {"split", 2, (Blt_Op)SplitOp, 2, 0, "?vecName...?",},
    {"variable", 1, (Blt_Op)VariableOp, 2, 3, "?varName?",},
};

static int nInstOps = sizeof(vectorInstOps) / sizeof(Blt_OpSpec);

int
Blt_VectorInstCmd(clientData, interp, objc, objv)
    ClientData clientData;
    Tcl_Interp *interp;
    int objc;
    Tcl_Obj *CONST *objv;
{
    Blt_Op proc;
    VectorObject *vPtr = clientData;

    vPtr->first = 0;
    vPtr->last = vPtr->length - 1;
    proc = Blt_GetOpFromObj(interp, nInstOps, vectorInstOps, BLT_OP_ARG1, objc,
	objv, 0);
    if (proc == NULL) {
	return TCL_ERROR;
    }
    return (*proc) (vPtr, interp, objc, objv);
}


/*
 * ----------------------------------------------------------------------
 *
 * Blt_VectorVarTrace --
 *
 * Results:
 *	Returns NULL on success.  Only called from a variable trace.
 *
 * Side effects:
 *
 * ----------------------------------------------------------------------
 */
char *
Blt_VectorVarTrace(clientData, interp, part1, part2, flags)
    ClientData clientData;	/* Vector object. */
    Tcl_Interp *interp;
    char *part1, *part2;
    int flags;
{
    Blt_VectorIndexProc *indexProc;
    VectorObject *vPtr = clientData;
    int first, last;
    int varFlags;
#define MAX_ERR_MSG	1023
    static char message[MAX_ERR_MSG + 1];

    if (part2 == NULL) {
	if (flags & TCL_TRACE_UNSETS) {
	    Blt_Free(vPtr->arrayName);
	    vPtr->arrayName = NULL;
	    vPtr->varNsPtr = NULL;
	    if (vPtr->freeOnUnset) {
		Blt_VectorFree(vPtr);
	    }
	}
	return NULL;
    }
    if (Blt_VectorGetIndexRange(interp, vPtr, part2,
        INDEX_ALL_FLAGS|INDEX_VAR_TRACE, &indexProc) != TCL_OK) {
            if (strcmp(part2, "active") == 0 || !strcmp(part2, "#TEST KEY#")) {
            /* TkTable stores these cells. */
            return TCL_OK;
        }                    
	goto error;
    }
    first = vPtr->first, last = vPtr->last;
    varFlags = TCL_LEAVE_ERR_MSG | (TCL_GLOBAL_ONLY & flags);
    if (flags & TCL_TRACE_WRITES) {
	double value;
	Tcl_Obj *objPtr;

	if (first == SPECIAL_INDEX) { /* Tried to set "min" or "max" */
	    if (indexProc != NULL) {
                return "read-only index";
            } else {
                return TCL_OK;
            }
	}
	objPtr = Tcl_GetVar2Ex(interp, part1, part2, varFlags);
	if (objPtr == NULL) {
	    goto error;
	}
	if (!strlen(Tcl_GetString(objPtr))) {
	    value = 0.0;
	} else if (GetDouble(interp, objPtr, &value) != TCL_OK) {
	    if ((last == first) && (first >= 0)) {
		/* Single numeric index. Reset the array element to
		 * its old value on errors */
		Tcl_SetVar2Ex(interp, part1, part2, objPtr, varFlags);
	    }
	    goto error;
	}
	if (first == vPtr->length) {
	    if (Blt_VectorChangeLength(vPtr, vPtr->length + 1) != TCL_OK) {
		return "error resizing vector";
	    }
	}
	/* Set possibly an entire range of values */
	ReplicateValue(vPtr, first, last, value);
    } else if (flags & TCL_TRACE_READS) {
	double value;
	Tcl_Obj *objPtr;

	if (first == SPECIAL_INDEX && indexProc == NULL) {
             return TCL_OK;
	}
	if (vPtr->length == 0) {
	    if (Tcl_SetVar2(interp, part1, part2, "", varFlags) == NULL) {
		goto error;
	    }
	    return NULL;
	}
	if  (first == vPtr->length) {
	    return "write-only index";
	}
	if (first == last) {
	    if (first >= 0) {
		value = vPtr->valueArr[first];
	    } else {
		vPtr->first = 0, vPtr->last = vPtr->length - 1;
		value = (*indexProc) ((Blt_Vector *) vPtr);
	    }
	    objPtr = Tcl_NewDoubleObj(value);
	    if (Tcl_SetVar2Ex(interp, part1, part2, objPtr, varFlags) == NULL) {
		Tcl_DecrRefCount(objPtr);
		goto error;
	    }
	} else {
	    objPtr = GetValues(vPtr, first, last);
	    if (Tcl_SetVar2Ex(interp, part1, part2, objPtr, varFlags) == NULL) {
		Tcl_DecrRefCount(objPtr);
		goto error;
	    }
	}
    } else if (flags & TCL_TRACE_UNSETS) {
	register int i, j;

	if ((first == vPtr->length) || (first == SPECIAL_INDEX)) {
	    return "special vector index";
	}
         if (vPtr->numcols>1) {
             return NULL;
         } else {
             /*
             * Collapse the vector from the point of the first unset element.
             * Also flush any array variable entries so that the shift is
             * reflected when the array variable is read.
             */
             for (i = first, j = last + 1; j < vPtr->length; i++, j++) {
                 vPtr->valueArr[i] = vPtr->valueArr[j];
             }
             vPtr->length -= ((last - first) + 1);
             if (vPtr->flush) {
                 Blt_VectorFlushCache(vPtr);
             }
	}
    } else {
	return "unknown variable trace flag";
    }
    if (flags & (TCL_TRACE_UNSETS | TCL_TRACE_WRITES)) {
	Blt_VectorUpdateClients(vPtr);
    }
    Tcl_ResetResult(interp);
    return NULL;

 error: 
    strncpy(message, Tcl_GetStringResult(interp), MAX_ERR_MSG);
    message[MAX_ERR_MSG] = '\0';
    return message;
}

#endif /* TCL_MAJOR_VERSION > 7 */
