/*
 * bltVector.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 "bltInt.h"
#include "bltChain.h"

#ifdef TIME_WITH_SYS_TIME
#include <sys/time.h>
#include <time.h>
#else
#ifdef HAVE_SYS_TIME_H
#include <sys/time.h>
#else
#include <time.h>
#endif /* HAVE_SYS_TIME_H */
#endif /* TIME_WITH_SYS_TIME */

extern double bltNegInfinity, bltPosInfinity;

#ifndef TCL_NAMESPACE_ONLY
#define TCL_NAMESPACE_ONLY TCL_GLOBAL_ONLY
#endif

#define VECTOR_THREAD_KEY	"BLT Vector Data"
#define VECTOR_MAGIC		((unsigned int) 0x46170277)

#define DEF_ARRAY_SIZE		64
#define SPECIAL_INDEX		-2
#define VECFLAGS(v)	\
	(((v)->varNsPtr != NULL) ? (TCL_NAMESPACE_ONLY | TCL_GLOBAL_ONLY) : 0;
#define TRACE_ALL  (TCL_TRACE_WRITES | TCL_TRACE_READS | TCL_TRACE_UNSETS)

/* These defines allow parsing of different types of indices */

#define INDEX_SPECIAL	(1<<0)	/* Recognize "min", "max", and "++end" as
				 * valid indices */
#define INDEX_COLON	(1<<1)	/* Also recognize a range of indices 
				 * separated by a colon */
#define INDEX_CHECK	(1<<2)	/* Verify that the specified index or 
				 * range of indices are within limits */
#define INDEX_ALL_FLAGS    (INDEX_SPECIAL | INDEX_COLON | INDEX_CHECK)

#define VECTOR_CHAR(c)	((isalnum(UCHAR(c))) || \
	(c == '_') || (c == ':') || (c == '@') || (c == '.'))

#if defined(HAVE_DRAND48) && defined(NO_DECL_DRAND48)
extern double drand48 _ANSI_ARGS_((void));
#endif
#if defined(HAVE_SRAND48) && defined(NO_DECL_SRAND48)
extern void srand48 _ANSI_ARGS_((long int seed));
#endif

typedef struct {
    Tcl_HashTable vectorTable;	/* Table of vectors */
    Tcl_HashTable mathProcTable; /* Table of vector math functions */
    Tcl_HashTable indexProcTable;
    Tcl_Interp *interp;

} VectorInterpData;

/*
 * Vector --
 *
 *	A vector is an array of double precision values.  It can be
 *	accessed through a Tcl command, a Tcl array variable, or C
 *	API. The storage for the array points initially to a
 *	statically allocated buffer, but to malloc-ed memory if more
 *	is necessary.
 *
 *	Vectors can be shared by several clients (for example, two
 *	different graph widgets).  The data is shared. When a client
 *	wants to use a vector, it allocates a vector identifier, which
 *	identifies the client.  Clients use this ID to specify a
 *	callback routine to be invoked whenever the vector is modified
 *	or destroyed.  Whenever the vector is updated or destroyed,
 *	each client is notified of the change by their callback
 *	routine.
 */

typedef struct {

    /*
     * If you change these fields, make sure you change the definition
     * of Blt_Vector in bltInt.h and blt.h too.
     */

    double *valueArr;		/* Array of values (malloc-ed) */

    int length;			/* Current number of values in the array. */

    int size;			/* Maximum number of values that can be stored
				 * in the value array. */

    double min, max;		/* Minimum and maximum values in the vector */

    int dirty;			/* Indicates if the vector has been updated */

    int reserved;

    /* The following fields are local to this module  */

    char *name;			/* The namespace-qualified name of the vector.
				 * It points to the hash key allocated for the
				 * entry in the vector hash table. */

    VectorInterpData *dataPtr;
    Tcl_Interp *interp;		/* Interpreter associated with the
				 * vector */

    Tcl_HashEntry *hashPtr;	/* If non-NULL, pointer in a hash table to
				 * track the vectors in use. */

    Tcl_FreeProc *freeProc;	/* Address of procedure to call to
				 * release storage for the value
				 * array, Optionally can be one of the
				 * following: TCL_STATIC, TCL_DYNAMIC,
				 * or TCL_VOLATILE. */

    char *arrayName;		/* The name of the Tcl array variable
				 * mapped to the vector
				 * (malloc'ed). If NULL, indicates
				 * that the vector isn't mapped to any
				 * variable */

    Tcl_Namespace *varNsPtr;	/* Namespace context of the Tcl variable
				 * associated with the vector. This is
				 * needed to reset the indices of the array
				 * variable. */

    Tcl_Namespace *nsPtr;	/* Namespace context of the vector itself. */

    int offset;			/* Offset from zero of the vector's
				 * starting index */

    Tcl_Command cmdToken;	/* Token for vector's Tcl command. */

    Blt_Chain *chainPtr;	/* List of clients using this vector */

    int notifyFlags;		/* Notification flags. See definitions
				 * below */

    int varFlags;		/* Indicate if the variable is global, namespace,
				 * or local */
    int freeOnUnset;		/* For backward compatibility only: If non-zero,
				 * free the vector when its variable is unset. */

    int flush;

    int first, last;		/* Selected region of vector. This is used
				 * mostly for the math routines */

} Vector;

#define NOTIFY_UPDATED		((int)BLT_VECTOR_NOTIFY_UPDATE)
#define NOTIFY_DESTROYED	((int)BLT_VECTOR_NOTIFY_DESTROY)

#define NOTIFY_NEVER		(1<<3)	/* Never notify clients of updates to
					 * the vector */
#define NOTIFY_ALWAYS		(1<<4)	/* Notify clients after each update
					 * of the vector is made */
#define NOTIFY_WHENIDLE		(1<<5)	/* Notify clients at the next idle point
					 * that the vector has been updated. */

#define NOTIFY_PENDING		(1<<6)	/* A do-when-idle notification of the
					 * vector's clients is pending. */
#define NOTIFY_NOW		(1<<7)	/* Notify clients of changes once
					 * immediately */

#define NOTIFY_WHEN_MASK	(NOTIFY_NEVER|NOTIFY_ALWAYS|NOTIFY_WHENIDLE)

#define UPDATE_RANGE		(1<<9)	/* The data of the vector has changed.
					 * Update the min and max limits when
					 * they are needed */
/*
 * ClientInfo --
 *
 *	A vector can be shared by several clients.  Each client
 *	allocates this structure that acts as its key for using the
 *	vector.  Clients can also designate a callback routine that is
 *	executed whenever the vector is updated or destroyed.
 *
 */
typedef struct {
    unsigned int magic;		/* Magic value designating whether this
				 * really is a vector token or not */

    Vector *serverPtr;		/* Pointer to the master record of the
				 * vector.  If NULL, indicates that the
				 * vector has been destroyed but as of
				 * yet, this client hasn't recognized
				 * it. */

    Blt_VectorChangedProc *proc;/* Routine to call when the contents
				 * of the vector change or the vector
				 * is deleted. */

    ClientData clientData;	/* Data passed whenever the vector
				 * change procedure is called. */

    Blt_ChainLink *linkPtr;	/* Used to quickly remove this entry from
				 * its server's client chain. */
} ClientInfo;

/*
 * Built-in math functions:
 */
typedef int (GenericMathProc) _ANSI_ARGS_(ANYARGS);

/*
 * Three types of math functions:
 *
 *	ComponentProc		Function is applied in multiple calls to
 *				each component of the vector.
 *	VectorProc		Entire vector is passed, each component is
 *				modified.
 *	ScalarProc		Entire vector is passed, single scalar value
 *				is returned.
 */

typedef double (ComponentProc) _ANSI_ARGS_((double value));
typedef int (VectorProc) _ANSI_ARGS_((Vector *vPtr));
typedef double (ScalarProc) _ANSI_ARGS_((Vector *vPtr));

/*
 * MathFunction --
 *
 *	Contains information about math functions that can be called
 *	for vectors.  The table of math functions is global within the
 *	application.  So you can't define two different "sqrt"
 *	functions.
 */
typedef struct {
    char *name;			/* Name of built-in math function.  If
				 * NULL, indicates that the function
				 * was user-defined and dynamically
				 * allocated.  Function names are
				 * global across all interpreters. */

    GenericMathProc *proc;	/* Procedure that implements this math
				 * function. */

    ClientData clientData;	/* Argument to pass when invoking the
				 * function. */

} MathFunction;

/*
 * Macros for testing floating-point values for certain special cases:
 *
 *	IS_NAN	Test for not-a-number by comparing a value against itself
 *	IF_INF	Test for infinity by comparing against the largest floating
 *		point value.
 */

#define IS_NAN(v) ((v) != (v))

#ifdef DBL_MAX
#   define IS_INF(v) (((v) > DBL_MAX) || ((v) < -DBL_MAX))
#else
#   define IS_INF(v) 0
#endif

/* The data structure below is used to describe an expression value,
 * which can be either a double-precision floating-point value, or a
 * string.  A given number has only one value at a time.  */

#define STATIC_STRING_SPACE 150

/*
 * Tokens --
 *
 *	The token types are defined below.  In addition, there is a
 *	table associating a precedence with each operator.  The order
 *	of types is important.  Consult the code before changing it.
 */
enum Tokens {
    VALUE, OPEN_PAREN, CLOSE_PAREN, COMMA, END, UNKNOWN,
    MULT = 8, DIVIDE, MOD, PLUS, MINUS,
    LEFT_SHIFT, RIGHT_SHIFT,
    LESS, GREATER, LEQ, GEQ, EQUAL, NEQ,
    OLD_BIT_AND, EXPONENT, OLD_BIT_OR, OLD_QUESTY, OLD_COLON,
    AND, OR, UNARY_MINUS, OLD_UNARY_PLUS, NOT, OLD_BIT_NOT
};

/*
 * ParseValue --
 *
 *	The following data structure is used by various parsing
 *	procedures to hold information about where to store the
 *	results of parsing (e.g. the substituted contents of a quoted
 *	argument, or the result of a nested command).  At any given
 *	time, the space available for output is fixed, but a procedure
 *	may be called to expand the space available if the current
 *	space runs out.
 */

typedef struct ParseValueRec ParseValue;

struct ParseValueRec {
    char *buffer;		/* Address of first character in
				 * output buffer. */
    char *next;			/* Place to store next character in
				 * output buffer. */
    char *end;			/* Address of the last usable character
				 * in the buffer. */
    void (*expandProc) _ANSI_ARGS_((ParseValue * pvPtr, int needed));
    /* Procedure to call when space runs out;
				 * it will make more space. */
    ClientData clientData;	/* Arbitrary information for use of
				 * expandProc. */
};

typedef struct {
    Vector *vPtr;
    char staticSpace[STATIC_STRING_SPACE];
    ParseValue pv;		/* Used to hold a string value, if any. */
} Value;

/*
 * ParseInfo --
 *
 *	The data structure below describes the state of parsing an
 *	expression.  It's passed among the routines in this module.
 */
typedef struct {
    char *expr;			/* The entire right-hand side of the
				 * expression, as originally passed to
				 * Blt_ExprVector. */

    char *nextPtr;		/* Position of the next character to
				 * be scanned from the expression
				 * string. */

    enum Tokens token;		/* Type of the last token to be parsed
				 * from nextPtr.  See below for
				 * definitions.  Corresponds to the
				 * characters just before nextPtr. */

} ParseInfo;

/*
 * Precedence table.  The values for non-operator token types are ignored.
 */
static int precTable[] =
{
    0, 0, 0, 0, 0, 0, 0, 0,
    12, 12, 12,			/* MULT, DIVIDE, MOD */
    11, 11,			/* PLUS, MINUS */
    10, 10,			/* LEFT_SHIFT, RIGHT_SHIFT */
    9, 9, 9, 9,			/* LESS, GREATER, LEQ, GEQ */
    8, 8,			/* EQUAL, NEQ */
    7,				/* OLD_BIT_AND */
    13,				/* EXPONENTIATION */
    5,				/* OLD_BIT_OR */
    4,				/* AND */
    3,				/* OR */
    2,				/* OLD_QUESTY */
    1,				/* OLD_COLON */
    14, 14, 14, 14		/* UNARY_MINUS, OLD_UNARY_PLUS, NOT,
				 * OLD_BIT_NOT */
};


#ifdef notdef
/*
 * Mapping from operator numbers to strings;  used for error messages.
 */

static char *operatorStrings[] =
{
    "VALUE", "(", ")", ",", "END", "UNKNOWN", "6", "7",
    "*", "/", "%", "+", "-", "<<", ">>", "<", ">", "<=",
    ">=", "==", "!=", "&", "^", "|", "&&", "||", "?", ":",
    "-", "+", "!", "~",
};
#endif

/*
 * Forward declarations.
 */
static int NextValue _ANSI_ARGS_((Tcl_Interp *interp, ParseInfo *parsePtr,
	int prec, Value * valuePtr));
static char *VariableProc _ANSI_ARGS_((ClientData clientData,
	Tcl_Interp *interp, char *part1, char *part2, int flags));
static int VectorInstCmd _ANSI_ARGS_((ClientData clientData, 
	Tcl_Interp *interp, int argc, char **argv));

#if (TCL_VERSION_NUMBER >= _VERSION(8,1,0))
#define TclParseBraces Blt_ParseBraces
#define TclParseNestedCmd Blt_ParseNestedCmd
#define TclParseQuotes Blt_ParseQuotes
#define TclExpandParseValue Blt_ExpandParseValue
#endif /* TCL_VERSION_NUMBER >= _VERSION(8,1,0) */

extern int TclParseBraces _ANSI_ARGS_((Tcl_Interp *interp, char *string,
	char **termPtr, ParseValue * pvPtr));

extern int TclParseNestedCmd _ANSI_ARGS_((Tcl_Interp *interp, char *string,
	int flags, char **termPtr, ParseValue * pvPtr));

extern int TclParseQuotes _ANSI_ARGS_((Tcl_Interp *interp, char *string,
	int termChar, int flags, char **termPtr, ParseValue * pvPtr));

extern void TclExpandParseValue _ANSI_ARGS_((ParseValue * pvPtr, int needed));

static Vector *CreateVector _ANSI_ARGS_((VectorInterpData *dataPtr, char *name,
    char *cmdName, char *varName, int *newPtr));

static Vector *FindVector _ANSI_ARGS_((VectorInterpData *dataPtr, 
	char *vecName, unsigned int flags));

static Vector *ParseVector _ANSI_ARGS_((Tcl_Interp *interp, 
	VectorInterpData *dataPtr, char *start, char **endPtr, int flags));

#ifdef __STDC__
static Tcl_IdleProc NotifyClients;
static Tcl_CmdDeleteProc VectorInstDeleteProc;
static Tcl_CmdProc VectorCmd;
static Tcl_InterpDeleteProc VectorInterpDeleteProc;
static Blt_VectorIndexProc Min, Max, Mean, Sum, Product;
#endif /* __STDC__ */

/*
 * ----------------------------------------------------------------------
 *
 * FindRange --
 *
 *	Determines the minimum and maximum values in the vector.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The min and max fields of the vector are updated.
 *
 * ----------------------------------------------------------------------
 */
static void
FindRange(array, first, last, minPtr, maxPtr)
    double array[];
    int first, last;
    double *minPtr, *maxPtr;
{
    register double min, max;
    register int i;

    if (first > last) {
	min = max = 0.0;
    } else {
	min = max = array[first];
	for (i = first + 1; i <= last; i++) {
	    if (min > array[i]) {
		min = array[i];
	    } else if (max < array[i]) {
		max = array[i];
	    }
	}
    }
    *minPtr = min, *maxPtr = max;
}

static void
UpdateRange(vPtr)
    Vector *vPtr;
{
    FindRange(vPtr->valueArr, 0, vPtr->length - 1, &(vPtr->min), &(vPtr->max));
    vPtr->notifyFlags &= ~UPDATE_RANGE;
}

/*
 * ----------------------------------------------------------------------
 *
 * GetIndex --
 *
 *	Converts the string representing an index in the vector, to
 *	its numeric value.  A valid index may be an numeric string of
 *	the string "end" (indicating the last element in the string).
 *
 * Results:
 *	A standard Tcl result.  If the string is a valid index, TCL_OK
 *	is returned.  Otherwise TCL_ERROR is returned and interp->result
 *	will contain an error message.
 *
 * ----------------------------------------------------------------------
 */
static int
GetIndex(interp, vPtr, string, indexPtr, flags, procPtrPtr)
    Tcl_Interp *interp;
    Vector *vPtr;
    char *string;
    int *indexPtr;
    int flags;
    Blt_VectorIndexProc **procPtrPtr;
{
    char c;
    long int value;

    c = string[0];

    /* Treat the index "end" like a numeric index.  */

    if ((c == 'e') && (strcmp(string, "end") == 0)) {
	if (vPtr->length < 1) {
	    if (interp != NULL) {
		Tcl_AppendResult(interp, "bad index \"end\": vector is empty", 
				 (char *)NULL);
	    }
	    return TCL_ERROR;
	}
	*indexPtr = vPtr->length - 1;
	return TCL_OK;
    } else if ((c == '+') && (strcmp(string, "++end") == 0)) {
	*indexPtr = vPtr->length;
	return TCL_OK;
    }
    if (procPtrPtr != NULL) {
	Tcl_HashEntry *hPtr;

	hPtr = Tcl_FindHashEntry(&(vPtr->dataPtr->indexProcTable), string);
	if (hPtr != NULL) {
	    *indexPtr = SPECIAL_INDEX;
	    *procPtrPtr = (Blt_VectorIndexProc *) Tcl_GetHashValue(hPtr);
	    return TCL_OK;
	}
    }
    if (Tcl_ExprLong(interp, string, &value) != TCL_OK) {
	if (interp != NULL) {
	    Tcl_AppendResult(interp, "bad index \"", string, "\"", 
			     (char *)NULL);
	}
	return TCL_ERROR;
    }
    /*
     * Correct the index by the current value of the offset. This makes
     * all the numeric indices non-negative, which is how we distinguish
     * the special non-numeric indices.
     */
    value -= vPtr->offset;

    if ((value < 0) || 
	((flags & INDEX_CHECK) && (value >= vPtr->length))) {
	if (interp != NULL) {
	    Tcl_AppendResult(interp, "index \"", string, "\" is out of range", 
			 (char *)NULL);
	}
	return TCL_ERROR;
    }
    *indexPtr = (int)value;
    return TCL_OK;
}

/*
 * ----------------------------------------------------------------------
 *
 * GetIndex2 --
 *
 *	Converts the string representing an index in the vector, to
 *	its numeric value.  A valid index may be an numeric string of
 *	the string "end" (indicating the last element in the string).
 *
 * Results:
 *	A standard Tcl result.  If the string is a valid index, TCL_OK
 *	is returned.  Otherwise TCL_ERROR is returned and interp->result
 *	will contain an error message.
 *
 * ----------------------------------------------------------------------
 */
static int
GetIndex2(interp, vPtr, string, flags, procPtrPtr)
    Tcl_Interp *interp;
    Vector *vPtr;
    char *string;
    int flags;
    Blt_VectorIndexProc **procPtrPtr;
{
    Blt_VectorIndexProc *procPtr;
    int ielem;
    char *colon;

    colon = NULL;
    if (flags & INDEX_COLON) {
	colon = strchr(string, ':');
    }
    if (colon != NULL) {
	if (string == colon) {
	    vPtr->first = 0;	/* Default to the first index */
	} else {
	    int result;

	    *colon = '\0';
	    result = GetIndex(interp, vPtr, string, &ielem, flags,
		(Blt_VectorIndexProc **) NULL);
	    *colon = ':';
	    if (result != TCL_OK) {
		return TCL_ERROR;
	    }
	    vPtr->first = ielem;
	}
	if (*(colon + 1) == '\0') {
	    /* Default to the last index */
	    vPtr->last = (vPtr->length > 0) ? vPtr->length - 1 : 0;
	} else {
	    if (GetIndex(interp, vPtr, colon + 1, &ielem, flags,
		    (Blt_VectorIndexProc **) NULL) != TCL_OK) {
		return TCL_ERROR;
	    }
	    vPtr->last = ielem;
	}
	if (vPtr->first > vPtr->last) {
	    if (interp != NULL) {
		Tcl_AppendResult(interp, "bad range \"", string,
			 "\" (first > last)", (char *)NULL);
	    }
	    return TCL_ERROR;
	}
    } else {
	if (GetIndex(interp, vPtr, string, &ielem, flags, &procPtr) != TCL_OK) {
	    return TCL_ERROR;
	}
	vPtr->last = vPtr->first = ielem;
	if (procPtrPtr != NULL) {
	    *procPtrPtr = procPtr;
	}
    }
    return TCL_OK;
}

/*
 * ----------------------------------------------------------------------
 *
 * GetVectorObject --
 *
 *	Searches for the vector associated with the name given.
 *	Allow for a range specification.
 *
 * Results:
 *	Returns a pointer to the vector if found, otherwise NULL.
 *
 * ----------------------------------------------------------------------
 */
static Vector *
GetVectorObject(dataPtr, name, flags)
    VectorInterpData *dataPtr;	/* Interpreter-specific data. */
    char *name;
    int flags;
{
    char *vecName;
    Tcl_Namespace *nsPtr;
    Tcl_DString dString;
    Tcl_HashEntry *hPtr;
    Vector *vPtr;

    nsPtr = NULL;
    vecName = name;
    if (Blt_ParseQualifiedName(dataPtr->interp, name, &nsPtr, &vecName) 
	!= TCL_OK) {
	return NULL;		/* Can't find namespace. */
    }

    vPtr = NULL;
    Tcl_DStringInit(&dString);
    if (nsPtr != NULL) {
	/* Search only in designated namespace. */
	name = Blt_GetQualifiedName(nsPtr, vecName, &dString);
	hPtr = Tcl_FindHashEntry(&(dataPtr->vectorTable), name);
	if (hPtr != NULL) {
	    vPtr = (Vector *) Tcl_GetHashValue(hPtr);
	}
    } else {
	if (flags & NS_SEARCH_CURRENT) {
	    /* Look first in the current namespace. */
	    nsPtr = Tcl_GetCurrentNamespace(dataPtr->interp);
	    name = Blt_GetQualifiedName(nsPtr, vecName, &dString);
	    hPtr = Tcl_FindHashEntry(&(dataPtr->vectorTable), name);
	    if (hPtr != NULL) {
		vPtr = (Vector *) Tcl_GetHashValue(hPtr);
	    }
	}
	if ((vPtr == NULL) && (flags & NS_SEARCH_GLOBAL)) {
	    /* And then in the global namespace. */
	    nsPtr = Tcl_GetGlobalNamespace(dataPtr->interp);
	    name = Blt_GetQualifiedName(nsPtr, vecName, &dString);
	    hPtr = Tcl_FindHashEntry(&(dataPtr->vectorTable), name);
	    if (hPtr != NULL) {
		vPtr = (Vector *) Tcl_GetHashValue(hPtr);
	    }
	}
    }
    Tcl_DStringFree(&dString);
    return vPtr;
}

static Vector *
ParseVector(interp, dataPtr, start, endPtr, flags)
    Tcl_Interp *interp;
    VectorInterpData *dataPtr;	/* Interpreter-specific data. */
    char *start;
    char **endPtr;
    int flags;
{
    register char *p;
    char saved;
    Vector *vPtr;

    p = start;
    while (isspace(UCHAR(*p))) {
	p++;
    }
    start = p;

    /* Check the vector name */
    while (VECTOR_CHAR(*p)) {
	p++;
    }
    saved = *p;
    *p = '\0';
    vPtr = GetVectorObject(dataPtr, start, flags);
    if (vPtr == NULL) {
	if (interp != NULL) {
	    Tcl_AppendResult(interp, "can't find vector \"", start, "\"", 
			     (char *)NULL);
	}
	*p = saved;
	return NULL;
    }
    *p = saved;
    vPtr->first = 0;
    vPtr->last = vPtr->length - 1;
    if (*p == '(') {
	int count, result;

	start = p + 1;
	p++;

	/* Find the matching right parenthesis */
	count = 1;
	while (*p != '\0') {
	    if (*p == ')') {
		count--;
		if (count == 0) {
		    break;
		}
	    } else if (*p == '(') {
		count++;
	    }
	    p++;
	}
	if (count > 0) {
	    if (interp != NULL) {
		Tcl_AppendResult(interp, "unbalanced parentheses \"", start, 
			"\"", (char *)NULL);
	    }
	    return NULL;
	}
	saved = *p;
	*p = '\0';
	result = GetIndex2(interp, vPtr, start, (INDEX_COLON | INDEX_CHECK), 
		   (Blt_VectorIndexProc **) NULL);
	*p = ')';
	if (result != TCL_OK) {
	    return NULL;
	}
	p++;
    }
    *endPtr = p;
    return vPtr;
}

/*
 * ----------------------------------------------------------------------
 *
 * NotifyClients --
 *
 *	Notifies each client of the vector that the vector has changed
 *	(updated or destroyed) by calling the provided function back.
 *	The function pointer may be NULL, in that case the client is
 *	not notified.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The results depend upon what actions the client callbacks
 *	take.
 *
 * ----------------------------------------------------------------------
 */
static void
NotifyClients(clientData)
    ClientData clientData;
{
    Vector *vPtr = (Vector *)clientData;
    Blt_ChainLink *linkPtr;
    ClientInfo *clientPtr;
    Blt_VectorNotify notify;

    notify = (vPtr->notifyFlags & NOTIFY_DESTROYED)
	? BLT_VECTOR_NOTIFY_DESTROY : BLT_VECTOR_NOTIFY_UPDATE;
    vPtr->notifyFlags &= ~(NOTIFY_UPDATED | NOTIFY_DESTROYED | NOTIFY_PENDING);

    if (vPtr->notifyFlags & UPDATE_RANGE) {
	UpdateRange(vPtr);
    }
    for (linkPtr = Blt_ChainFirstLink(vPtr->chainPtr); linkPtr != NULL;
	linkPtr = Blt_ChainNextLink(linkPtr)) {
	clientPtr = (ClientInfo *)Blt_ChainGetValue(linkPtr);
	if (clientPtr->proc != NULL) {
	    (*clientPtr->proc) (vPtr->interp, clientPtr->clientData, notify);
	}
    }
    /*
     * Some clients may not handle the "destroy" callback properly
     * (they should call Blt_FreeVectorId to release the client
     * identifier), so mark any remaining clients to indicate that
     * vector's server has gone away.
     */
    if (notify == BLT_VECTOR_NOTIFY_DESTROY) {
	for (linkPtr = Blt_ChainFirstLink(vPtr->chainPtr); linkPtr != NULL;
	    linkPtr = Blt_ChainNextLink(linkPtr)) {
	    clientPtr = (ClientInfo *)Blt_ChainGetValue(linkPtr);
	    clientPtr->serverPtr = NULL;
	}
    }
}

/*
 * ----------------------------------------------------------------------
 *
 * UpdateClients --
 *
 *	Notifies each client of the vector that the vector has changed
 *	(updated or destroyed) by calling the provided function back.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The individual client callbacks are eventually invoked.
 *
 * ----------------------------------------------------------------------
 */
static void
UpdateClients(vPtr)
    Vector *vPtr;
{
    vPtr->dirty++;
    if (vPtr->notifyFlags & NOTIFY_NEVER) {
	return;
    }
    vPtr->notifyFlags |= NOTIFY_UPDATED;
    if (vPtr->notifyFlags & NOTIFY_ALWAYS) {
	NotifyClients((ClientData)vPtr);
	return;
    }
    if (!(vPtr->notifyFlags & NOTIFY_PENDING)) {
	vPtr->notifyFlags |= NOTIFY_PENDING;
	Tcl_DoWhenIdle(NotifyClients, (ClientData)vPtr);
    }
}

/*
 * ----------------------------------------------------------------------
 *
 * FlushCache --
 *
 *	Unsets all the elements of the Tcl array variable associated
 *	with the vector, freeing memory associated with the variable.
 *	This includes both the hash table and the hash keys.  The down
 *	side is that this effectively flushes the caching of vector
 *	elements in the array.  This means that the subsequent reads
 *	of the array will require a decimal to string conversion.
 *
 *	This is needed when the vector changes its values, making
 *	the array variable out-of-sync.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	All elements of array variable (except one) are unset, freeing
 *	the memory associated with the variable.
 *
 * ----------------------------------------------------------------------
 */
static void
FlushCache(vPtr)
    Vector *vPtr;
{
    Tcl_CallFrame *framePtr;
    Tcl_Interp *interp = vPtr->interp;

#if (TCL_MAJOR_VERSION > 7)
    Tcl_HashTable *tablePtr;
#endif
    if (vPtr->arrayName == NULL) {
	return;			/* Doesn't use the variable API */
    }
    framePtr = NULL;
    if (vPtr->varNsPtr != NULL) {
	framePtr = Blt_EnterNamespace(interp, vPtr->varNsPtr);
    }
    /* Turn off the trace temporarily so that we can unset all the
     * elements in the array.  */

    Tcl_UntraceVar2(interp, vPtr->arrayName, (char *)NULL,
	TRACE_ALL | vPtr->varFlags, VariableProc, (ClientData)vPtr);

#if (TCL_MAJOR_VERSION == 7)
    /* Clear all the element entries from the entire array */
    Tcl_UnsetVar2(interp, vPtr->arrayName, (char *)NULL, vPtr->varFlags);
#else
    tablePtr = Blt_GetArrayVariableTable(interp, vPtr->arrayName,
	vPtr->varFlags);
    if (tablePtr != NULL) {
	Tcl_DeleteHashTable(tablePtr);
	Tcl_InitHashTable(tablePtr, TCL_STRING_KEYS);
    }
#endif
    /* Restore the "end" index by default and the trace on the entire array */
    Tcl_SetVar2(interp, vPtr->arrayName, "end", "", vPtr->varFlags);
    Tcl_TraceVar2(interp, vPtr->arrayName, (char *)NULL,
	TRACE_ALL | vPtr->varFlags, VariableProc, (ClientData)vPtr);

    if ((vPtr->varNsPtr != NULL) && (framePtr != NULL)) {
	Blt_LeaveNamespace(interp, framePtr);	/* Go back to current */
    }
}

/*
 * ----------------------------------------------------------------------
 *
 * FindVector --
 *
 *	Searches for the vector associated with the name given.  Allow
 *	for a range specification.
 *
 * Results:
 *	Returns a pointer to the vector if found, otherwise NULL.
 *	If the name is not associated with a vector and the
 *	TCL_LEAVE_ERR_MSG flag is set, and interp->result will contain
 *	an error message.
 *
 * ----------------------------------------------------------------------
 */
static Vector *
FindVector(dataPtr, vecName, flags)
    VectorInterpData *dataPtr;	/* Interpreter-specific data. */
    char *vecName;
    unsigned int flags;
{
    char *endPtr;

    return ParseVector(NULL, dataPtr, vecName, &endPtr, flags);
}

/*
 * ----------------------------------------------------------------------
 *
 * StringToVector --
 *
 *	Searches for the vector associated with the name given.  Allow
 *	for a range specification.
 *
 * Results:
 *	Returns a pointer to the vector if found, otherwise NULL.
 *	If the name is not associated with a vector and the
 *	TCL_LEAVE_ERR_MSG flag is set, and interp->result will contain
 *	an error message.
 *
 * ----------------------------------------------------------------------
 */
static int
StringToVector(dataPtr, vecName, vPtrPtr)
    VectorInterpData *dataPtr;	/* Interpreter-specific data. */
    char *vecName;
    Vector **vPtrPtr;
{
    Vector *vPtr;
    char *endPtr;

    vPtr = ParseVector(dataPtr->interp, dataPtr, vecName, &endPtr, 
	NS_SEARCH_BOTH);
    if (vPtr == NULL) {
	return TCL_ERROR;
    }
    if (*endPtr != '\0') {
	Tcl_AppendResult(dataPtr->interp, 
			 "extra characters after vector name", (char *)NULL);
	return TCL_ERROR;
    }
    *vPtrPtr = vPtr;
    return TCL_OK;
}

/*
 * ----------------------------------------------------------------------
 *
 * DeleteCommand --
 *
 *	Deletes the Tcl command associated with the vector, without
 *	triggering a callback to "VectorInstDeleteProc".
 *
 * Results:
 *	None.
 *
 * ----------------------------------------------------------------------
 */
static void
DeleteCommand(vPtr)
    Vector *vPtr;		/* Vector associated with the Tcl command. */
{
    Tcl_Interp *interp = vPtr->interp;
    char *name;			/* Name of Tcl command. */
    Tcl_CmdInfo cmdInfo;

    name = Tcl_GetCommandName(interp, vPtr->cmdToken);
    if (Tcl_GetCommandInfo(interp, name, &cmdInfo)) {
	cmdInfo.deleteProc = NULL;	/* Disable the callback before
					 * deleting the Tcl command.*/
	Tcl_SetCommandInfo(interp, name, &cmdInfo);
	Tcl_DeleteCommand(interp, name);
    }
    vPtr->cmdToken = 0;
}

/*
 * ----------------------------------------------------------------------
 *
 * UnmapVariable --
 *
 *	Destroys the trace on the current Tcl variable designated
 *	to access the vector.
 *
 * Results:
 *	None.
 *
 * ----------------------------------------------------------------------
 */
static void
UnmapVariable(vPtr)
    Vector *vPtr;
{
    Tcl_Interp *interp = vPtr->interp;
    Tcl_CallFrame *framePtr;

    framePtr = NULL;
    if (vPtr->varNsPtr != NULL) {	/* Activate namespace */
	framePtr = Blt_EnterNamespace(interp, vPtr->varNsPtr);
    }
    /* Unset the entire array */
    Tcl_UntraceVar2(interp, vPtr->arrayName, (char *)NULL,
	(TRACE_ALL | vPtr->varFlags), VariableProc, (ClientData)vPtr);
    Tcl_UnsetVar2(interp, vPtr->arrayName, (char *)NULL, vPtr->varFlags);

    if ((vPtr->varNsPtr != NULL) && (framePtr != NULL)) {
	/* Go back to current namespace */
	Blt_LeaveNamespace(interp, framePtr);
    }
    if (vPtr->arrayName != NULL) {
	free((char *)vPtr->arrayName);
	vPtr->arrayName = NULL;
    }
    vPtr->varNsPtr = NULL;
}

/*
 * ----------------------------------------------------------------------
 *
 * MapVariable --
 *
 *	Sets up traces on a Tcl variable to access the vector.
 *
 *	If another variable is already mapped, it's first untraced and
 *	removed.  Don't do anything else for variables named "" (even
 *	though Tcl allows this pathology). Saves the name of the new
 *	array variable.
 *
 * Results:
 *	A standard Tcl result. If an error occurs setting the variable
 *	TCL_ERROR is returned and an error message is left in the
 *	interpreter.
 *
 * Side effects:
 *	Traces are set for the new variable. The new variable name is
 *	saved in a malloc'ed string in vPtr->arrayName.  If this
 *	variable is non-NULL, it indicates that a Tcl variable has
 *	been mapped to this vector.
 *
 * ----------------------------------------------------------------------
 */
static int
MapVariable(interp, vPtr, name)
    Tcl_Interp *interp;
    Vector *vPtr;
    char *name;
{
    Tcl_Namespace *nsPtr;
    Tcl_CallFrame *framePtr;
    char *varName, *result;

    if (vPtr->arrayName != NULL) {
	UnmapVariable(vPtr);
    }
    if ((name == NULL) || (name[0] == '\0')) {
	return TCL_OK;		/* If the variable name is the empty
				 * string, simply return after
				 * removing any existing variable. */
    }
    framePtr = NULL;

    /* Get the variable name (without the namespace qualifier). */
    if (Blt_ParseQualifiedName(interp, name, &nsPtr, &varName) != TCL_OK) {
	Tcl_AppendResult(interp, "can't find namespace in \"", name, "\"",
	    (char *)NULL);
	return TCL_ERROR;
    }
    if (nsPtr != NULL) {
	/* [incr Tcl] 2.x doesn't like qualifiers with variable names,
	 * so we need to enter the namespace if one was designated. */
	framePtr = Blt_EnterNamespace(interp, nsPtr);
    }
    /*
     * To play it safe, delete the variable first.  This has
     * side-effect of unmapping the variable from any vector that may
     * be currently using it.
     */
    Tcl_UnsetVar2(interp, varName, (char *)NULL, 0);

    /* Set the index "end" in the array.  This will create the
     * variable immediately so that we can check its namespace
     * context.  */
    result = Tcl_SetVar2(interp, varName, "end", "", TCL_LEAVE_ERR_MSG);

    /* Determine if the variable is global or not.  If there wasn't a
     * namespace qualifier, it still may be global.  We need to look
     * inside the Var structure to see what it's namespace field says.
     * NULL indicates that it's local.  */

    vPtr->varNsPtr = Blt_NamespaceOfVariable(interp, varName);
    vPtr->varFlags = (vPtr->varNsPtr != NULL) ?
	(TCL_NAMESPACE_ONLY | TCL_GLOBAL_ONLY) : 0;

    if (result != NULL) {
	/* Trace the array on reads, writes, and unsets */
	Tcl_TraceVar2(interp, varName, (char *)NULL, 
		(TRACE_ALL | vPtr->varFlags), VariableProc, (ClientData)vPtr);
    }
    if ((nsPtr != NULL) && (framePtr != NULL)) {
	Blt_LeaveNamespace(interp, framePtr);	/* Go back to current */
    }
    vPtr->arrayName = strdup(varName);
    return (result == NULL) ? TCL_ERROR : TCL_OK;
}

/*
 * ----------------------------------------------------------------------
 *
 * ResizeVector --
 *
 *	Resizes the vector to the new size.
 *
 *	The new size of the vector is computed by doubling the
 *	size of the vector until it fits the number of slots needed
 *	(designated by *length*).
 *
 *	If the new size is the same as the old, simply adjust the
 *	length of the vector.  Otherwise we're copying the data from
 *	one memory location to another. The trailing elements of the 
 *	vector need to be reset to zero.
 *
 *	If the storage changed memory locations, free up the old
 *	location if it was dynamically allocated.
 *
 * Results:
 *	A standard Tcl result.  If the reallocation is successful,
 *	TCL_OK is returned, otherwise TCL_ERROR.
 *
 * Side effects:
 *	Memory for the array is reallocated.
 *
 * ----------------------------------------------------------------------
 */

static int
ResizeVector(vPtr, length)
    Vector *vPtr;
    int length;
{
    int newSize;		/* Size of array in elements */
    double *newArr;
    Tcl_FreeProc *freeProc;

    newArr = NULL;
    newSize = 0;
    freeProc = TCL_STATIC;

    if (length > 0) {
	int wanted, used;

	wanted = length;
	used = vPtr->length;

	/* Compute the new size by doubling old size until it's big enough */
	newSize = DEF_ARRAY_SIZE;
	if (wanted > DEF_ARRAY_SIZE) {
	    while (newSize < wanted) {
		newSize += newSize;
	    }
	}
	freeProc = vPtr->freeProc;
	if (newSize == vPtr->size) {
	    newArr = vPtr->valueArr; /* Same size, use current array. */
	} else {
	    /* Dynamically allocate memory for the new array. */
	    newArr = (double *)malloc(newSize * sizeof(double));
	    if (newArr == NULL) {
		Tcl_AppendResult(vPtr->interp, "can't allocate ", 
		Blt_Itoa(newSize), " elements for vector \"", vPtr->name, 
				 "\"", (char *)NULL); return TCL_ERROR;
	    }
	    if (used > wanted) {
		used = wanted;
	    }
	    /* Copy any previous data */
	    if (used > 0) {
		memcpy(newArr, vPtr->valueArr, used * sizeof(double));
	    }
	    freeProc = TCL_DYNAMIC;
	}
	/* Clear any new slots that we're now using in the array */
	if (wanted > used) {
	    memset(newArr + used, 0, (wanted - used) * sizeof(double));
	}
    }
    if ((newArr != vPtr->valueArr) && (vPtr->valueArr != NULL)) {
	/* 
	 * We're not using the old storage anymore, so free it if it's
	 * not static.  It's static because the user previously reset
	 * the vector with a statically allocated array (setting freeProc 
	 * to TCL_STATIC).  
	 */
	if (vPtr->freeProc != TCL_STATIC) {
	    if (vPtr->freeProc == TCL_DYNAMIC) {
		free((char *)vPtr->valueArr);
	    } else {
		(*vPtr->freeProc) ((char *)vPtr->valueArr);
	    }
	}
    }
    vPtr->valueArr = newArr;
    vPtr->size = newSize;
    vPtr->length = length;
    vPtr->first = 0;
    vPtr->last = length - 1;
    vPtr->freeProc = freeProc;	/* Set the type of the new storage */
    return TCL_OK;
}

static Vector *
NewVector(dataPtr)
    VectorInterpData *dataPtr;	/* Interpreter-specific data. */
{
    Vector *vPtr;

    vPtr = (Vector *)calloc(1, sizeof(Vector));
    assert(vPtr);
    vPtr->notifyFlags = NOTIFY_WHENIDLE;
    vPtr->freeProc = TCL_STATIC;
    vPtr->dataPtr = dataPtr;
    vPtr->valueArr = NULL;
    vPtr->length = vPtr->size = 0;
    vPtr->interp = dataPtr->interp;
    vPtr->hashPtr = NULL;
    vPtr->chainPtr = Blt_ChainCreate();
    vPtr->flush = FALSE;
    return vPtr;
}

/*
 * ----------------------------------------------------------------------
 *
 * FreeVector --
 *
 *	Removes the memory and frees resources associated with the
 *	vector.
 *
 *	o Removes the trace and the Tcl array variable and unsets
 *	  the variable.
 *	o Notifies clients of the vector that the vector is being
 *	  destroyed.
 *	o Removes any clients that are left after notification.
 *	o Frees the memory (if necessary) allocated for the array.
 *	o Removes the entry from the hash table of vectors.
 *	o Frees the memory allocated for the name.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *
 * ----------------------------------------------------------------------
 */
static void
FreeVector(vPtr)
    Vector *vPtr;
{
    Blt_ChainLink *linkPtr;
    ClientInfo *clientPtr;

    if (vPtr->cmdToken != 0) {
	DeleteCommand(vPtr);
    }
    if (vPtr->arrayName != NULL) {
	UnmapVariable(vPtr);
    }
    vPtr->length = 0;

    /* Immediately notify clients that vector is going away */
    if (vPtr->notifyFlags & NOTIFY_PENDING) {
	vPtr->notifyFlags &= ~NOTIFY_PENDING;
	Tcl_CancelIdleCall(NotifyClients, (ClientData)vPtr);
    }
    vPtr->notifyFlags |= NOTIFY_DESTROYED;
    NotifyClients((ClientData)vPtr);

    for (linkPtr = Blt_ChainFirstLink(vPtr->chainPtr); linkPtr != NULL;
	linkPtr = Blt_ChainNextLink(linkPtr)) {
	clientPtr = (ClientInfo *)Blt_ChainGetValue(linkPtr);
	free((char *)clientPtr);
    }
    Blt_ChainDestroy(vPtr->chainPtr);
    if ((vPtr->valueArr != NULL) && (vPtr->freeProc != TCL_STATIC)) {
	if (vPtr->freeProc == TCL_DYNAMIC) {
	    free((char *)vPtr->valueArr);
	} else {
	    (*vPtr->freeProc) ((char *)vPtr->valueArr);
	}
    }
    if (vPtr->hashPtr != NULL) {
	Tcl_DeleteHashEntry(vPtr->hashPtr);
    }
#ifdef NAMESPACE_DELETE_NOTIFY
    if (vPtr->nsPtr != NULL) {
	Blt_DestroyNsDeleteNotify(vPtr->interp, vPtr->nsPtr, (ClientData)vPtr);
    }
#endif /* NAMESPACE_DELETE_NOTIFY */
    free((char *)vPtr);
}

/*
 * ----------------------------------------------------------------------
 *
 * VectorInstDeleteProc --
 *
 *	Deletes the command associated with the vector.  This is
 *	called only when the command associated with the vector is
 *	destroyed.
 *
 * Results:
 *	None.
 *
 * ----------------------------------------------------------------------
 */
static void
VectorInstDeleteProc(clientData)
    ClientData clientData;
{
    Vector *vPtr = (Vector *)clientData;

    vPtr->cmdToken = 0;
    FreeVector(vPtr);
}

/*
 * ----------------------------------------------------------------------
 *
 * CreateVector --
 *
 *	Creates a vector structure and the following items:
 *
 *	o Tcl command
 *	o Tcl array variable and establishes traces on the variable
 *	o Adds a  new entry in the vector hash table
 *
 * Results:
 *	A pointer to the new vector structure.  If an error occurred
 *	NULL is returned and an error message is left in
 *	interp->result.
 *
 * Side effects:
 *	A new Tcl command and array variable is added to the
 *	interpreter.
 *
 * ---------------------------------------------------------------------- */
static Vector *
CreateVector(dataPtr, vecName, cmdName, varName, newPtr)
    VectorInterpData *dataPtr;	/* Interpreter-specific data. */
    char *vecName;		/* Namespace-qualified name of the vector */
    char *cmdName;		/* Name of the Tcl command mapped to
				 * the vector */
    char *varName;		/* Name of the Tcl array mapped to the
				 * vector */
    int *newPtr;
{
    Tcl_DString dString;
    Vector *vPtr;
    int isNew;
    char *name, *qualName;
    Tcl_Namespace *nsPtr;
    Tcl_HashEntry *hPtr;
    Tcl_Interp *interp = dataPtr->interp;

    isNew = 0;
    nsPtr = NULL;
    vPtr = NULL;

    if (Blt_ParseQualifiedName(interp, vecName, &nsPtr, &name) != TCL_OK) {
	Tcl_AppendResult(interp, "can't find namespace in \"", vecName, "\"",
	    (char *)NULL);
	return NULL;
    }
    if (nsPtr == NULL) {
	nsPtr = Tcl_GetCurrentNamespace(interp);
    }
    Tcl_DStringInit(&dString);
    if ((name[0] == '#') && (strcmp(name, "#auto") == 0)) {
	int nextId = 0;
	char string[200];

	do {	/* Generate a unique vector name. */
	    sprintf(string, "vector%d", nextId++);
	    qualName = Blt_GetQualifiedName(nsPtr, string, &dString);
	    hPtr = Tcl_FindHashEntry(&(dataPtr->vectorTable), qualName);
	} while (hPtr != NULL);
    } else {
	register char *p;

	for (p = name; *p != '\0'; p++) {
	    if (!VECTOR_CHAR(*p)) {
		Tcl_AppendResult(interp, "bad vector name \"", name,
		    "\": must contain digits, letters, underscore, or period",
		    (char *)NULL);
		goto error;
	    }
	}
	qualName = Blt_GetQualifiedName(nsPtr, name, &dString);
	vPtr = FindVector(dataPtr, qualName, NS_SEARCH_CURRENT);
    }
    if (vPtr == NULL) {
	hPtr = Tcl_CreateHashEntry(&(dataPtr->vectorTable), qualName, &isNew);
	vPtr = NewVector(dataPtr);
	vPtr->hashPtr = hPtr;
	vPtr->nsPtr = nsPtr;

	vPtr->name = Tcl_GetHashKey(&(dataPtr->vectorTable), hPtr);
#ifdef NAMESPACE_DELETE_NOTIFY
	Blt_CreateNsDeleteNotify(interp, nsPtr, (ClientData)vPtr,
	    VectorInstDeleteProc);
#endif /* NAMESPACE_DELETE_NOTIFY */
	Tcl_SetHashValue(hPtr, (char *)vPtr);
    }
    if (cmdName != NULL) {
	Tcl_CmdInfo cmdInfo;

	if ((cmdName == vecName) ||
	    ((name[0] == '#') && (strcmp(name, "#auto") == 0))) {
	    cmdName = qualName;
	} 
	if (Tcl_GetCommandInfo(interp, cmdName, &cmdInfo)) {
	    if ((ClientData)vPtr != cmdInfo.clientData) {
		Tcl_AppendResult(interp, "command \"", cmdName,
				 "\" already exists", (char *)NULL);
		goto error;
	    }
	    /* We get here only if the old name is the same as the new. */
	    goto checkVariable;
	}
    }
    if (vPtr->cmdToken != 0) {
	DeleteCommand(vPtr);	/* Command already exists, delete old first */
    }
    if (cmdName != NULL) {
	vPtr->cmdToken = Blt_CreateCommand(interp, cmdName, 
		VectorInstCmd, (ClientData)vPtr, VectorInstDeleteProc);
    }
  checkVariable:
    if (varName != NULL) {
	if ((varName == vecName) ||
	    ((varName[0] == '#') && (strcmp(varName, "#auto") == 0))) {
	    varName = qualName;
	}
	if (MapVariable(interp, vPtr, varName) != TCL_OK) {
	    goto error;
	}
    }

    Tcl_DStringFree(&dString);
    *newPtr = isNew;
    return vPtr;

  error:
    Tcl_DStringFree(&dString);
    if (vPtr != NULL) {
	FreeVector((ClientData)vPtr);
    }
    return NULL;
}

static void
GetValues(vPtr, first, last, dStrPtr)
    Vector *vPtr;
    int first, last;
    Tcl_DString *dStrPtr;
{
    register int i;
    char string[TCL_DOUBLE_SPACE + 1];

    for (i = first; i <= last; i++) {
	Tcl_PrintDouble(vPtr->interp, vPtr->valueArr[i], string);
	Tcl_DStringAppendElement(dStrPtr, string);
    }
}

static void
SetValues(vPtr, first, last, value)
    Vector *vPtr;
    int first, last;
    double value;
{
    register int i;

    /* Set possibly an entire range of values */
    for (i = first; i <= last; i++) {
	vPtr->valueArr[i] = value;
    }
    vPtr->notifyFlags |= UPDATE_RANGE;
}

/*
 * ----------------------------------------------------------------------
 *
 * VariableProc --
 *
 * Results:
 *	Returns NULL on success.  Only called from a variable trace.
 *
 * Side effects:
 *
 * ----------------------------------------------------------------------
 */
static char *
VariableProc(clientData, interp, part1, part2, flags)
    ClientData clientData;	/* File output information. */
    Tcl_Interp *interp;
    char *part1, *part2;
    int flags;
{
    Vector *vPtr = (Vector *)clientData;
    char string[TCL_DOUBLE_SPACE + 1];
#define MAX_ERR_MSG	1023
    static char message[MAX_ERR_MSG + 1];
    Blt_VectorIndexProc *indexProc;
    int varFlags;
    int first, last;

    if (part2 == NULL) {
	if (flags & TCL_TRACE_UNSETS) {
	    free((char *)vPtr->arrayName);
	    vPtr->arrayName = NULL;
	    vPtr->varNsPtr = NULL;
	    if (vPtr->freeOnUnset) {
		FreeVector(vPtr);
	    }
	}
	return NULL;
    }
    if (vPtr->notifyFlags & UPDATE_RANGE) {
	UpdateRange(vPtr);
    }
    if (GetIndex2(interp, vPtr, part2, INDEX_ALL_FLAGS, &indexProc) != 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;
	char *newValue;

	if (first == SPECIAL_INDEX) { /* Tried to set "min" or "max" */
	    return "read-only index";
	}
	newValue = Tcl_GetVar2(interp, part1, part2, varFlags);
	if (newValue == NULL) {
	    goto error;
	}
	if (Tcl_ExprDouble(interp, newValue, &value) != TCL_OK) {
	    if ((last == first) && (first >= 0)) {
		/* Single numeric index. Reset the array element to
		 * its old value on errors */
		Tcl_PrintDouble(interp, vPtr->valueArr[first], string);
		Tcl_SetVar2(interp, part1, part2, string, varFlags);
	    }
	    goto error;
	}
	if (first == vPtr->length) {
	    if (ResizeVector(vPtr, vPtr->length + 1) != TCL_OK) {
		return "error resizing vector";
	    }
	}
	/* Set possibly an entire range of values */
	SetValues(vPtr, first, last, value);
    } else if (flags & TCL_TRACE_READS) {
	double value;

	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);
	    }
	    Tcl_PrintDouble(interp, value, string);
	    if (Tcl_SetVar2(interp, part1, part2, string, varFlags) 
		== NULL) {
		goto error;
	    }
	} else {
	    Tcl_DString dString;
	    char *result;

	    Tcl_DStringInit(&dString);
	    GetValues(vPtr, first, last, &dString);
	    result = Tcl_SetVar2(interp, part1, part2, 
		Tcl_DStringValue(&dString), varFlags);
	    Tcl_DStringFree(&dString);
	    if (result == NULL) {
		goto error;
	    }
	}
    } else if (flags & TCL_TRACE_UNSETS) {
	register int i, j;

	if ((first == vPtr->length) || (first == SPECIAL_INDEX)) {
	    return "special vector index";
	}
	/*
	 * 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) {
	    FlushCache(vPtr);
	}
	UpdateRange(vPtr);
    } else {
	return "unknown variable trace flag";
    }
    if (flags & (TCL_TRACE_UNSETS | TCL_TRACE_WRITES)) {
	UpdateClients(vPtr);
    }
    Tcl_ResetResult(interp);
    return NULL;

 error: 
    strncpy(message, Tcl_GetStringResult(interp), MAX_ERR_MSG);
    message[MAX_ERR_MSG] = '\0';
    return message;
}

/*ARGSUSED*/
static int
CopyList(vPtr, nElem, elemArr)
    Vector *vPtr;
    int nElem;
    char **elemArr;
{
    register int i;
    double value;

    if (ResizeVector(vPtr, nElem) != TCL_OK) {
	return TCL_ERROR;
    }
    for (i = 0; i < nElem; i++) {
	if (Tcl_GetDouble(vPtr->interp, elemArr[i], &value)!= TCL_OK) {
	    vPtr->length = i;
	    return TCL_ERROR;
	}
	vPtr->valueArr[i] = value;
    }
    return TCL_OK;
}

static int
CopyVector(destPtr, srcPtr)
    Vector *destPtr, *srcPtr;
{
    int nBytes;
    int length;

    length = srcPtr->last - srcPtr->first + 1;
    if (ResizeVector(destPtr, length) != TCL_OK) {
	return TCL_ERROR;
    }
    nBytes = length * sizeof(double);
    memcpy(destPtr->valueArr, srcPtr->valueArr + srcPtr->first, nBytes);
    if (srcPtr->notifyFlags & UPDATE_RANGE) {
	UpdateRange(srcPtr);
    }
    UpdateRange(destPtr);
    destPtr->offset = srcPtr->offset;
    return TCL_OK;
}

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

    oldSize = destPtr->length;
    newSize = oldSize + srcPtr->last - srcPtr->first + 1;
    if (ResizeVector(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
AppendList(vPtr, nElem, elemArr)
    Vector *vPtr;
    int nElem;
    char **elemArr;
{
    int count;
    register int i;
    double value;
    int oldSize;

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

static Vector **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 Vector *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;
}

static int *
SortIndex(vPtrPtr, nVectors)
    Vector **vPtrPtr;
    int nVectors;
{
    int *indexArr;
    register int i;
    Vector *vPtr = *vPtrPtr;

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

static int
Sort(vPtr)
    Vector *vPtr;
{
    int *indexArr;
    double *tempArr;
    register int i;

    indexArr = SortIndex(&vPtr, 1);
    tempArr = (double *)malloc(sizeof(double) * vPtr->length);
    assert(tempArr);
    for (i = 0; i < vPtr->length; i++) {
	tempArr[i] = vPtr->valueArr[indexArr[i]];
    }
    free((char *)indexArr);
    if (ResizeVector(vPtr, vPtr->length) != TCL_OK) {
	return TCL_ERROR;
    }
    for (i = 0; i < vPtr->length; i++) {
	vPtr->valueArr[i] = tempArr[i];
    }
    free((char *)tempArr);
    return TCL_OK;
}

static double
Length(vecPtr)
    Blt_Vector *vecPtr;
{
    Vector *vPtr = (Vector *)vecPtr;
    int length;

    length = vPtr->last - vPtr->first + 1;
    return (double) length;
}

/* ARGSUSED */
static double
Min(vecPtr)
    Blt_Vector *vecPtr;
{
    Vector *vPtr = (Vector *)vecPtr;
    double min, max;

    FindRange(vPtr->valueArr, vPtr->first, vPtr->last, &min, &max);
    return min;
}

static double
Max(vecPtr)
    Blt_Vector *vecPtr;
{
    Vector *vPtr = (Vector *)vecPtr;
    double min, max;

    FindRange(vPtr->valueArr, vPtr->first, vPtr->last, &min, &max);
    return max;
}

static double
Mean(vecPtr)
    Blt_Vector *vecPtr;
{
    Vector *vPtr = (Vector *)vecPtr;
    register int i;
    double sum;

    sum = 0.0;
    for (i = 0; i < vPtr->length; i++) {
	sum += vPtr->valueArr[i];
    }
    return sum / (double)vPtr->length;
}

/*
 *  var = 1/N Sum( (x[i] - mean)^2 )
 */
static double
Variance(vecPtr)
    Blt_Vector *vecPtr;
{
    Vector *vPtr = (Vector *)vecPtr;
    register double dx, var, mean;
    register int i;

    if (vPtr->length < 2) {
	return 0.0;
    }
    mean = Mean(vecPtr);
    var = 0.0;
    for (i = 0; i < vPtr->length; i++) {
	dx = vPtr->valueArr[i] - mean;
	var += dx * dx;
    }
    var /= (double)(vPtr->length - 1);
    return var;
}

/*
 *  skew = Sum( (x[i] - mean)^3 ) / (var^3/2)
 */
static double
Skew(vecPtr)
    Blt_Vector *vecPtr;
{
    Vector *vPtr = (Vector *)vecPtr;
    register double diff, var, skew, mean, diffsq;
    register int i;

    if (vPtr->length < 2) {
	return 0.0;
    }
    mean = Mean(vecPtr);
    var = skew = 0.0;
    for (i = 0; i < vPtr->length; i++) {
	diff = vPtr->valueArr[i] - mean;
	diff = FABS(diff);
	diffsq = diff * diff;
	var += diffsq;
	skew += diffsq * diff;
    }
    var /= (double)(vPtr->length - 1);
    skew /= vPtr->length * var * sqrt(var);
    return skew;
}

static double
StdDeviation(vecPtr)
    Blt_Vector *vecPtr;
{
    double var;

    var = Variance(vecPtr);
    if (var > 0.0) {
	return sqrt(var);
    }
    return 0.0;
}


static double
AvgDeviation(vecPtr)
    Blt_Vector *vecPtr;
{
    Vector *vPtr = (Vector *)vecPtr;
    register double diff, avg, mean;
    register int i;

    if (vPtr->length < 2) {
	return 0.0;
    }
    mean = Mean(vecPtr);
    avg = 0.0;
    for (i = 0; i < vPtr->length; i++) {
	diff = vPtr->valueArr[i] - mean;
	avg += FABS(diff);
    }
    avg /= (double)(vPtr->length);
    return avg;
}


static double
Kurtosis(vecPtr)
    Blt_Vector *vecPtr;
{
    Vector *vPtr = (Vector *)vecPtr;
    register double diff, diffsq, kurt, var, mean;
    register int i;

    if (vPtr->length < 2) {
	return 0.0;
    }
    mean = Mean(vecPtr);
    var = kurt = 0.0;
    for (i = 0; i < vPtr->length; i++) {
	diff = vPtr->valueArr[i] - mean;
	diffsq = diff * diff;
	var += diffsq;
	kurt += diffsq * diffsq;
    }
    var /= (double)(vPtr->length - 1);
    if (var == 0.0) {
	return 0.0;
    }
    kurt /= (vPtr->length * var * var);
    return kurt - 3.0;		/* Fisher Kurtosis */
}


static double
Median(vecPtr)
    Blt_Vector *vecPtr;
{
    Vector *vPtr = (Vector *)vecPtr;
    int *indexArr;
    double median;
    int mid;

    if (vPtr->length == 0) {
	return 0.0;
    }
    indexArr = SortIndex(&vPtr, 1);
    mid = (vPtr->length - 1) / 2;
    if (vPtr->length & 1) {
	/* Odd number of values, median is given */
	median = vPtr->valueArr[indexArr[mid]];
    } else {
	/* Even number of values, median is average. */
	median = (vPtr->valueArr[indexArr[mid]] +
	    vPtr->valueArr[indexArr[mid + 1]]) * 0.5;
    }
    free((char *)indexArr);
    return median;
}

static double
Q1(vecPtr)
    Blt_Vector *vecPtr;
{
    Vector *vPtr = (Vector *)vecPtr;
    double q1;

    q1 = bltNegInfinity;
    if (vPtr->length > 3) {
	int *indexArr;
	int mid, quart;

	indexArr = SortIndex(&vPtr, 1);
	mid = (vPtr->length - 1) / 2;
	quart = mid / 2;
	if (mid & 1) {
	    /* Even number of elements in bottom half [0..mid] */
	    q1 = (vPtr->valueArr[indexArr[quart]] +
		  vPtr->valueArr[indexArr[quart + 1]]) * 0.5;
	} else {
	    /* Odd number of elements in bottom half [0..mid], q1 is value */
	    q1 = vPtr->valueArr[indexArr[quart]];
	}
	free((char *)indexArr);
    }
    return q1;
}

static double
Q3(vecPtr)
    Blt_Vector *vecPtr;
{
    Vector *vPtr = (Vector *)vecPtr;
    double q3;

    q3 = bltNegInfinity;
    if (vPtr->length > 3) {
	int mid, quart;
	int *indexArr;

	indexArr = SortIndex(&vPtr, 1);
	mid = (vPtr->length - 1) / 2;
	quart = ((vPtr->length - 1) + mid) / 2;
	if (mid & 1) {
	    /* Even number of elements in upper half [mid..n-1] */
	    q3 = (vPtr->valueArr[indexArr[quart]] +
		  vPtr->valueArr[indexArr[quart + 1]]) * 0.5;
	} else {
	    /* Odd number of elements in upper half [mid..n-1], q1 is value */
	    q3 = vPtr->valueArr[indexArr[quart]];
	}
	free((char *)indexArr);
    }
    return q3;
}


static int
Norm(vecPtr)
    Blt_Vector *vecPtr;
{
    Vector *vPtr = (Vector *)vecPtr;
    double norm, range, min, max;
    register int i;

    min = Min(vecPtr);
    max = Max(vecPtr);
    range = max - min;
    for (i = 0; i < vPtr->length; i++) {
	norm = (vPtr->valueArr[i] - min) / range;
	vPtr->valueArr[i] = norm;
    }
    return TCL_OK;
}

static double
Product(vecPtr)
    Blt_Vector *vecPtr;
{
    Vector *vPtr = (Vector *)vecPtr;
    register int i;
    register double prod;

    prod = 1.0;
    for (i = 0; i < vPtr->length; i++) {
	prod *= vPtr->valueArr[i];
    }
    return prod;
}

static double
Sum(vecPtr)
    Blt_Vector *vecPtr;
{
    Vector *vPtr = (Vector *)vecPtr;
    register int i;
    double sum;

    sum = 0.0;
    for (i = 0; i < vPtr->length; i++) {
	sum += vPtr->valueArr[i];
    }
    return sum;
}

static double
Nonzeros(vecPtr)
    Blt_Vector *vecPtr;
{
    Vector *vPtr = (Vector *)vecPtr;
    register int i;
    int count;

    count = 0;
    for (i = 0; i < vPtr->length; i++) {
	if (vPtr->valueArr[i] == 0.0) {
	    count++;
	}
    }
    return (double) count;
}

static double
Fabs(value)
    double value;
{
    if (value < 0.0) {
	return -value;
    }
    return value;
}

static double
Round(value)
    double value;
{
    if (value < 0.0) {
	return ceil(value - 0.5);
    } else {
	return floor(value + 0.5);
    }
}

static double
Fmod(x, y)
    double x, y;
{
    if (y == 0.0) {
	return 0.0;
    }
    return x - (floor(x / y) * y);
}

/* 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, argc, argv)
    Vector *vPtr;
    Tcl_Interp *interp;
    int argc;
    char **argv;
{
    register int i;
    int result;
    Vector *v2Ptr;

    for (i = 2; i < argc; i++) {
	v2Ptr = FindVector(vPtr->dataPtr, argv[i], NS_SEARCH_BOTH);
	if (v2Ptr != NULL) {
	    result = AppendVector(vPtr, v2Ptr);
	} else {
	    int nElem;
	    char **elemArr;

	    if (Tcl_SplitList(interp, argv[i], &nElem, &elemArr) != TCL_OK) {
		return TCL_ERROR;
	    }
	    result = AppendList(vPtr, nElem, elemArr);
	    free((char *)elemArr);
	}
	if (result != TCL_OK) {
	    return TCL_ERROR;
	}
    }
    if (argc > 2) {
	if (vPtr->flush) {
	    FlushCache(vPtr);
	}
	FlushCache(vPtr);
	UpdateClients(vPtr);
    }
    if (vPtr->notifyFlags & UPDATE_RANGE) {
	UpdateRange(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.
 *
 * 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, argc, argv)
    Vector *vPtr;
    Tcl_Interp *interp;
    int argc;
    char **argv;
{
    FlushCache(vPtr);
    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, argc, argv)
    Vector *vPtr;
    Tcl_Interp *interp;
    int argc;
    char **argv;
{
    unsigned char *unsetArr;
    register int i, j;
    register int count;

    if (argc == 2) {
	FreeVector(vPtr);
	return TCL_OK;
    }
    /*
     * Allocate an "unset" bitmap the size of the vector.  We should
     * try to use bit fields instead of a character array, since
     * memory may be an issue if the vector is large.
     */
    unsetArr = (unsigned char *)calloc(sizeof(unsigned char), vPtr->length);
    assert(unsetArr);
    for (i = 2; i < argc; i++) {
	if (GetIndex2(interp, vPtr, argv[i], (INDEX_COLON | INDEX_CHECK),
		      (Blt_VectorIndexProc **) NULL) != TCL_OK) {
	    free((char *)unsetArr);
	    return TCL_ERROR;
	}
	for (j = vPtr->first; j <= vPtr->last; j++) {
	    unsetArr[j] = TRUE;
	}
    }
    count = 0;
    for (i = 0; i < vPtr->length; i++) {
	if (unsetArr[i]) {
	    continue;
	}
	if (count < i) {
	    vPtr->valueArr[count] = vPtr->valueArr[i];
	}
	count++;
    }
    free((char *)unsetArr);
    vPtr->length = count;
    if (vPtr->flush) {
	FlushCache(vPtr);
    }
    UpdateClients(vPtr);
    UpdateRange(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, argc, argv)
    Vector *vPtr;
    Tcl_Interp *interp;		/* Not used. */
    int argc;
    char **argv;
{
    Vector *v2Ptr;
    int isNew;
    register int i;

    for (i = 2; i < argc; i++) {
	v2Ptr = CreateVector(vPtr->dataPtr, argv[i], argv[i], argv[i], &isNew);
	if (v2Ptr == NULL) {
	    return TCL_ERROR;
	}
	if (v2Ptr == vPtr) {
	    continue;
	}
	if (CopyVector(v2Ptr, vPtr) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (!isNew) {
	    if (v2Ptr->flush) {
		FlushCache(v2Ptr);
	    }
	    UpdateClients(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, argc, argv)
    Vector *vPtr;
    Tcl_Interp *interp;
    int argc;
    char **argv;
{
    int first, last;

    if (GetIndex2(interp, vPtr, argv[2], INDEX_ALL_FLAGS, 
		(Blt_VectorIndexProc **) NULL) != TCL_OK) {
	return TCL_ERROR;
    }
    first = vPtr->first, last = vPtr->last;
    if (argc == 3) {
	Tcl_DString dString;

	if (first == vPtr->length) {
	    Tcl_AppendResult(interp, "can't get index \"", argv[2], "\"",
		(char *)NULL);
	    return TCL_ERROR;	/* Can't read from index "++end" */
	}
	Tcl_DStringInit(&dString);
	GetValues(vPtr, first, last, &dString);
	Tcl_DStringResult(interp, &dString);
	Tcl_DStringFree(&dString);
    } else {
	char string[TCL_DOUBLE_SPACE + 1];
	double value;

	if (first == SPECIAL_INDEX) {
	    Tcl_AppendResult(interp, "can't set index \"", argv[2], "\"",
		(char *)NULL);
	    return TCL_ERROR;	/* Tried to set "min" or "max" */
	}
	if (Tcl_ExprDouble(interp, argv[3], &value) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (first == vPtr->length) {
	    if (ResizeVector(vPtr, vPtr->length + 1) != TCL_OK) {
		return TCL_ERROR;
	    }
	}
	SetValues(vPtr, first, last, value);
	Tcl_PrintDouble(interp, value, string);
	Tcl_SetResult(interp, string, TCL_VOLATILE);
	if (vPtr->flush) {
	    FlushCache(vPtr);
	}
	UpdateClients(vPtr);
    }
    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, argc, argv)
    Vector *vPtr;
    Tcl_Interp *interp;
    int argc;
    char **argv;
{
    if (argc == 3) {
	int size;

	if (Tcl_GetInt(interp, argv[2], &size) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (size < 0) {
	    Tcl_AppendResult(interp, "bad vector size \"", argv[3], "\"",
		(char *)NULL);
	    return TCL_ERROR;
	}
	if (ResizeVector(vPtr, size) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (vPtr->flush) {
	    FlushCache(vPtr);
	}
	UpdateClients(vPtr);
    }
    Tcl_SetResult(interp, Blt_Itoa(vPtr->length), TCL_VOLATILE);
    return TCL_OK;
}

/*
 * -----------------------------------------------------------------------
 *
 * MapOp --
 *
 *	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
MapOp(vPtr, interp, argc, argv)
    Vector *vPtr;
    Tcl_Interp *interp;
    int argc;			/* Not used. */
    char **argv;
{
    if (argc > 2) {
	if (MapVariable(interp, vPtr, argv[2]) != TCL_OK) {
	    return TCL_ERROR;
	}
    }
    if (vPtr->arrayName != NULL) {
	Tcl_SetResult(interp, vPtr->arrayName, TCL_STATIC);
    }
    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, argc, argv)
    Vector *vPtr;
    Tcl_Interp *interp;
    int argc;
    char **argv;
{
    Vector *v2Ptr;
    Vector **vecArr;
    register Vector **vPtrPtr;
    int refSize, length;
    register int i;

    /* Allocate an array of vector pointers of each vector to be
     * merged in the current vector.  */
    vecArr = (Vector **)malloc(sizeof(Vector *) * argc);
    assert(vecArr);
    vPtrPtr = vecArr;
    *vPtrPtr = vPtr;		/* Initialize the list with the first vector */
    vPtrPtr++;

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

    /* Merge the values from each of the vectors into the current vector */
    for (i = 0; i < refSize; i++) {
	for (vPtrPtr = vecArr; *vPtrPtr != NULL; vPtrPtr++) {
	    Tcl_AppendElement(interp,
		Blt_Dtoa(interp, (*vPtrPtr)->valueArr[i + (*vPtrPtr)->first]));
	}
    }
    free((char *)vecArr);
    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, argc, argv)
    Vector *vPtr;
    Tcl_Interp *interp;
    int argc;
    char **argv;
{
    register int i;
    double range;

    range = vPtr->max - vPtr->min;
    if (argc > 2) {
	Vector *v2Ptr;
	int isNew;

	v2Ptr = CreateVector(vPtr->dataPtr, argv[2], argv[2], argv[2], &isNew);
	if (v2Ptr == NULL) {
	    return TCL_ERROR;
	}
	if (ResizeVector(v2Ptr, vPtr->length) != TCL_OK) {
	    return TCL_ERROR;
	}
	for (i = 0; i < vPtr->length; i++) {
	    v2Ptr->valueArr[i] = (vPtr->valueArr[i] - vPtr->min) / range;
	}
	UpdateRange(v2Ptr);
	if (!isNew) {
	    if (v2Ptr->flush) {
		FlushCache(v2Ptr);
	    }
	    UpdateClients(v2Ptr);
	}
    } else {
	double norm;

	for (i = 0; i < vPtr->length; i++) {
	    norm = (vPtr->valueArr[i] - vPtr->min) / range;
	    Tcl_AppendElement(interp, Blt_Dtoa(interp, norm));
	}
    }
    return TCL_OK;
}

/*
 * -----------------------------------------------------------------------
 *
 * NotifyOp --
 *
 *	Notify clients of 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.
 *
 *  x vector notify now
 *  x vector notify always
 *  x vector notify whenidle
 *  x vector notify update {}
 *  x vector notify delete {}
 *
 * -----------------------------------------------------------------------
 */
/*ARGSUSED*/
static int
NotifyOp(vPtr, interp, argc, argv)
    Vector *vPtr;
    Tcl_Interp *interp;
    int argc;
    char **argv;
{
    char c;
    int length;

    c = argv[2][0];
    length = strlen(argv[2]);
    if ((c == 'a') && (length > 1)
	&& (strncmp(argv[2], "always", length) == 0)) {
	vPtr->notifyFlags &= ~NOTIFY_WHEN_MASK;
	vPtr->notifyFlags |= NOTIFY_ALWAYS;
    } else if ((c == 'n') && (length > 2)
	&& (strncmp(argv[2], "never", length) == 0)) {
	vPtr->notifyFlags &= ~NOTIFY_WHEN_MASK;
	vPtr->notifyFlags |= NOTIFY_NEVER;
    } else if ((c == 'w') && (length > 1)
	&& (strncmp(argv[2], "whenidle", length) == 0)) {
	vPtr->notifyFlags &= ~NOTIFY_WHEN_MASK;
	vPtr->notifyFlags |= NOTIFY_WHENIDLE;
    } else if ((c == 'n') && (length > 2)
	&& (strncmp(argv[2], "now", length) == 0)) {
	/* How does this play when an update is pending? */
	NotifyClients(vPtr);
    } else if ((c == 'c') && (length > 1)
	&& (strncmp(argv[2], "cancel", length) == 0)) {
	if (vPtr->notifyFlags & NOTIFY_PENDING) {
	    vPtr->notifyFlags &= ~NOTIFY_PENDING;
	    Tcl_CancelIdleCall(NotifyClients, (ClientData)vPtr);
	}
    } else if ((c == 'p') && (length > 1)
	&& (strncmp(argv[2], "pending", length) == 0)) {
	Tcl_SetResult(interp, (vPtr->notifyFlags & NOTIFY_PENDING) ? "1" : "0",
	    TCL_STATIC);
    } else {
	Tcl_AppendResult(interp, "bad qualifier \"", argv[2], "\": should be \
\"always\", \"never\", \"whenidle\", \"now\", \"cancel\", or \"pending\"",
	    (char *)NULL);
	return TCL_ERROR;
    }
    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, argc, argv)
    Vector *vPtr;
    Tcl_Interp *interp;
    int argc;
    char **argv;
{
    Vector *v2Ptr;
    int size, density;
    int isNew;
    register int i, j;
    double slice, range;
    register double *valuePtr;
    int count;

    v2Ptr = CreateVector(vPtr->dataPtr, argv[2], argv[2], argv[2], &isNew);
    if (v2Ptr == NULL) {
	return TCL_ERROR;
    }
    if (vPtr->length == 0) {
	return TCL_OK;		/* Source vector is empty. */
    }
    if (Tcl_GetInt(interp, argv[3], &density) != TCL_OK) {
	return TCL_ERROR;
    }
    if (density < 1) {
	Tcl_AppendResult(interp, "bad density \"", argv[3], "\"", (char *)NULL);
	return TCL_ERROR;
    }
    size = (vPtr->length - 1) * (density + 1) + 1;
    if (ResizeVector(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);
    UpdateRange(v2Ptr);
    if (!isNew) {
	if (v2Ptr->flush) {
	    FlushCache(v2Ptr);
	}
	UpdateClients(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, argc, argv)
    Vector *vPtr;
    Tcl_Interp *interp;
    int argc;			/* Not used. */
    char **argv;
{
    int first, last;
    register int i;

    if ((GetIndex(interp, vPtr, argv[2], &first, INDEX_CHECK,
		(Blt_VectorIndexProc **) NULL) != TCL_OK) ||
	(GetIndex(interp, vPtr, argv[3], &last, INDEX_CHECK,
		(Blt_VectorIndexProc **) NULL) != TCL_OK)) {
	return TCL_ERROR;
    }
    if (first > last) {
	/* Return the list reversed */
	for (i = last; i <= first; i++) {
	    Tcl_AppendElement(interp, Blt_Dtoa(interp, vPtr->valueArr[i]));
	}
    } else {
	for (i = first; i <= last; i++) {
	    Tcl_AppendElement(interp, Blt_Dtoa(interp, vPtr->valueArr[i]));
	}
    }
    return TCL_OK;
}

/*
 * ----------------------------------------------------------------------
 *
 * OutOfRange --
 *
 *	Determines if a value does not lie 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, *max* can't equal *min*.
 *
 * Results:
 *	Returns whether the value lies outside of the given range.
 *	If value is outside of the interval [min..max], 1 is returned;
 *	0 otherwise.
 *
 * ----------------------------------------------------------------------
 */
INLINE static int
OutOfRange(value, min, max)
    register double value, min, max;
{
    register double norm;

    norm = (value - min) / (max - min);
    return (((norm - 1.0) > DBL_EPSILON) || (((1.0 - 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 TCL_ERROR;
    }
    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)
    Vector *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 (ResizeVector(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).
 *
 * 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, argc, argv)
    Vector *vPtr;
    Tcl_Interp *interp;
    int argc;
    char **argv;
{
    char *byteArr;
    enum NativeFormats fmt;
    int size, length, mode;
    Tcl_Channel channel;
    int arraySize, bytesRead;
    int count, total;
    int first;
    int swap;
    register int i;

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

    if ((argc > 3) && (argv[3][0] != '-')) {
	long int value;
	/* Get the number of values to read.  */
	if (Tcl_ExprLong(interp, argv[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;
	argc--, argv++;
    }
    /* Process any option-value pairs that remain.  */
    for (i = 3; i < argc; i++) {
	if (strcmp(argv[i], "-swap") == 0) {
	    swap = TRUE;
	} else if (strcmp(argv[i], "-format") == 0) {
	    i += 1;
	    if (i >= argc) {
		Tcl_AppendResult(interp, "missing arg after \"", argv[i - 1],
		    "\"", (char *)NULL);
		return TCL_ERROR;
	    }
	    fmt = GetBinaryFormat(interp, argv[i], &size);
	    if (fmt == FMT_UNKNOWN) {
		return TCL_ERROR;
	    }
	} else if (strcmp(argv[i], "-at") == 0) {
	    i += 1;
	    if (i >= argc) {
		Tcl_AppendResult(interp, "missing arg after \"", argv[i - 1],
		    "\"", (char *)NULL);
		return TCL_ERROR;
	    }
	    if (GetIndex(interp, vPtr, argv[i], &first, 0, 
			 (Blt_VectorIndexProc **)NULL) != TCL_OK) {
		return TCL_ERROR;
	    }
	    if (first > vPtr->length) {
		Tcl_AppendResult(interp, "index \"", argv[i],
		    "\" 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 = (char *)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;
	}
    }
    free((char *)byteArr);

    if (vPtr->flush) {
	FlushCache(vPtr);
    }
    UpdateRange(vPtr);
    UpdateClients(vPtr);

    /* Set the result as the number of values read.  */
    Tcl_SetResult(interp, Blt_Itoa(total), TCL_VOLATILE);
    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, argc, argv)
    Vector *vPtr;
    Tcl_Interp *interp;
    int argc;			/* Not used. */
    char **argv;
{
    double min, max;
    register int i;
    int needValue = 0;

    if ((argv[2][0] == '-') && (strcmp(argv[2], "-value") == 0)) {
	needValue++;
	argv++, argc--;
    }
    if (Tcl_ExprDouble(interp, argv[2], &min) != TCL_OK) {
	return TCL_ERROR;
    }
    max = min;
    if ((argc > 3) && (Tcl_ExprDouble(interp, argv[3], &max) != TCL_OK)) {
	return TCL_ERROR;
    }
#ifdef notdef
    if (min > max) {
	double temp;

	temp = max, max = min, min = temp;
    }
#endif
    if (min != max) {
	for (i = 0; i < vPtr->length; i++) {
	    if (!OutOfRange(vPtr->valueArr[i], min, max)) {
		if (needValue) {
		    Tcl_AppendElement(interp,
			Blt_Dtoa(interp, vPtr->valueArr[i + vPtr->offset]));
		} else {
		    Tcl_AppendElement(interp, Blt_Itoa(i + vPtr->offset));
		}
	    }
	}
    } else {
	for (i = 0; i < vPtr->length; i++) {
	    if (vPtr->valueArr[i] == min) {
		if (needValue) {
		    Tcl_AppendElement(interp,
			Blt_Dtoa(interp, vPtr->valueArr[i + vPtr->offset]));
		} else {
		    Tcl_AppendElement(interp, Blt_Itoa(i + vPtr->offset));
		}
	    }
	}
    }
    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.
 *
 * -----------------------------------------------------------------------
 */
/*ARGSUSED*/
static int
OffsetOp(vPtr, interp, argc, argv)
    Vector *vPtr;
    Tcl_Interp *interp;
    int argc;			/* Not used. */
    char **argv;
{
    if (argc == 3) {
	int newOffset;

	if (Tcl_GetInt(interp, argv[2], &newOffset) != TCL_OK) {
	    return TCL_ERROR;
	}
	vPtr->offset = newOffset;
    }
    Tcl_SetResult(interp, Blt_Itoa(vPtr->offset), TCL_VOLATILE);
    return TCL_OK;
}

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

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

/*
 * -----------------------------------------------------------------------
 *
 * SequenceOp --
 *
 *	Generates a sequence of values in the vector.
 *
 * Results:
 *	A standard Tcl result.
 *
 * -----------------------------------------------------------------------
 */
/*ARGSUSED*/
static int
SequenceOp(vPtr, interp, argc, argv)
    Vector *vPtr;
    Tcl_Interp *interp;
    int argc;			/* Not used. */
    char **argv;
{
    register int i;
    double start, finish, step;
    int fillVector;
    int nSteps;

    if (Tcl_ExprDouble(interp, argv[2], &start) != TCL_OK) {
	return TCL_ERROR;
    }
    fillVector = FALSE;
    if ((argv[3][0] == 'e') && (strcmp(argv[3], "end") == 0)) {
	fillVector = TRUE;
    } else if (Tcl_ExprDouble(interp, argv[3], &finish) != TCL_OK) {
	return TCL_ERROR;
    }
    step = 1.0;
    if ((argc > 4) && (Tcl_ExprDouble(interp, argv[4], &step) != TCL_OK)) {
	return TCL_ERROR;
    }
    if (fillVector) {
	nSteps = vPtr->length;
    } else {
	nSteps = (int)((finish - start) / step) + 1;
    }
    if (nSteps > 0) {
	if (ResizeVector(vPtr, nSteps) != TCL_OK) {
	    return TCL_ERROR;
	}
	for (i = 0; i < nSteps; i++) {
	    vPtr->valueArr[i] = start + (step * (double)i);
	}
	UpdateRange(vPtr);
	if (vPtr->flush) {
	    FlushCache(vPtr);
	}
	UpdateClients(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, argc, argv)
    Vector *vPtr;
    Tcl_Interp *interp;
    int argc;			/* Not used. */
    char **argv;
{
    int result;
    Vector *v2Ptr;
    int nElem;
    char **elemArr;

    /* The source can be either a list of expressions of another
     * vector.  */
    if (Tcl_SplitList(interp, argv[2], &nElem, &elemArr) != TCL_OK) {
	return TCL_ERROR;
    }
    /* If there's only one element, see whether it's the name of a
     * vector.  Otherwise, treat it as a single numeric expression. */

    if ((nElem == 1) && 
	((v2Ptr = FindVector(vPtr->dataPtr, argv[2], NS_SEARCH_BOTH)) != NULL)) {
	result = CopyVector(vPtr, v2Ptr);
    } else {
	result = CopyList(vPtr, nElem, elemArr);
    }
    free((char *)elemArr);

    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) {
	    FlushCache(vPtr);
	}
	UpdateRange(vPtr);
	UpdateClients(vPtr);
    }
    return result;
}

static int *
SortVectors(vPtr, interp, argc, argv)
    Vector *vPtr;
    Tcl_Interp *interp;
    int argc;
    char **argv;
{
    Vector **vPtrArray, *v2Ptr;
    int *indexArr;
    register int i;

    vPtrArray = (Vector **)malloc(sizeof(Vector *) * (argc + 1));
    assert(vPtrArray);
    vPtrArray[0] = vPtr;
    indexArr = NULL;
    for (i = 0; i < argc; i++) {
	if (StringToVector(vPtr->dataPtr, argv[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;
    }
    indexArr = SortIndex(vPtrArray, argc + 1);
  error:
    free((char *)vPtrArray);
    return indexArr;
}

/*
 * -----------------------------------------------------------------------
 *
 * 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, argc, argv)
    Vector *vPtr;
    Tcl_Interp *interp;
    int argc;
    char **argv;
{
    int *indexArr;
    double *mergeArr;
    Vector *v2Ptr;
    int refSize, nBytes;
    int result;
    register int i, n;

    reverse = FALSE;
    if ((argc > 2) && (argv[2][0] == '-')) {
	int length;

	length = strlen(argv[2]);
	if ((length > 1) && (strncmp(argv[2], "-reverse", length) == 0)) {
	    reverse = TRUE;
	} else {
	    Tcl_AppendResult(interp, "unknown flag \"", argv[2],
		"\": should be \"-reverse\"", (char *)NULL);
	    return TCL_ERROR;
	}
	argc--, argv++;
    }
    if (argc > 2) {
	indexArr = SortVectors(vPtr, interp, argc - 2, argv + 2);
    } else {
	indexArr = SortIndex(&vPtr, 1);
    }
    if (indexArr == 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 = (double *)malloc(nBytes);
    assert(mergeArr);
    memcpy((char *)mergeArr, (char *)vPtr->valueArr, nBytes);
    for (n = 0; n < refSize; n++) {
	vPtr->valueArr[n] = mergeArr[indexArr[n]];
    }
    if (vPtr->flush) {
	FlushCache(vPtr);
    }
    UpdateClients(vPtr);

    /* Now sort any other vectors in the same fashion.  The vectors
     * must be the same size as the indexArr though.  */
    result = TCL_ERROR;
    for (i = 2; i < argc; i++) {
	if (StringToVector(vPtr->dataPtr, argv[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[indexArr[n]];
	}
	UpdateClients(v2Ptr);
	if (v2Ptr->flush) {
	    FlushCache(v2Ptr);
	}
    }
    result = TCL_OK;
  error:
    free((char *)mergeArr);
    free((char *)indexArr);
    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, argc, argv)
    Vector *vPtr;
    Tcl_Interp *interp;
    int argc;
    char **argv;
{
    if (Blt_ExprVector(interp, argv[2], (Blt_Vector *) vPtr) != TCL_OK) {
	return TCL_ERROR;
    }
    if (vPtr->flush) {
	FlushCache(vPtr);
    }
    UpdateRange(vPtr);
    UpdateClients(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, argc, argv)
    Vector *vPtr;
    Tcl_Interp *interp;
    int argc;			/* Not used. */
    char **argv;
{
    register double value;
    register int i;
    Vector *v2Ptr;

    v2Ptr = FindVector(vPtr->dataPtr, argv[2], 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 \"", argv[0], "\" and \"",
		argv[2], "\" are not the same length", (char *)NULL);
	    return TCL_ERROR;
	}
	switch (argv[1][0]) {
	case '*':
	    for (i = 0, j = v2Ptr->first; i < vPtr->length; i++, j++) {
		value = vPtr->valueArr[i] * v2Ptr->valueArr[j];
		Tcl_AppendElement(interp, Blt_Dtoa(interp, value));
	    }
	    break;

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

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

	case '+':
	    for (i = 0, j = v2Ptr->first; i < vPtr->length; i++, j++) {
		value = vPtr->valueArr[i] + v2Ptr->valueArr[j];
		Tcl_AppendElement(interp, Blt_Dtoa(interp, value));
	    }
	    break;
	}
    } else {
	double scalar;

	if (Tcl_ExprDouble(interp, argv[2], &scalar) != TCL_OK) {
	    return TCL_ERROR;
	}
	switch (argv[1][0]) {
	case '*':
	    for (i = 0; i < vPtr->length; i++) {
		value = vPtr->valueArr[i] * scalar;
		Tcl_AppendElement(interp, Blt_Dtoa(interp, value));
	    }
	    break;

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

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

	case '+':
	    for (i = 0; i < vPtr->length; i++) {
		value = vPtr->valueArr[i] + scalar;
		Tcl_AppendElement(interp, Blt_Dtoa(interp, value));
	    }
	    break;
	}
    }
    return TCL_OK;
}

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

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

static int
VectorInstCmd(clientData, interp, argc, argv)
    ClientData clientData;
    Tcl_Interp *interp;
    int argc;
    char **argv;
{
    Blt_OpProc opProc;
    Vector *vPtr = (Vector *)clientData;

    vPtr->first = 0;
    vPtr->last = vPtr->length - 1;
    if (vPtr->notifyFlags & UPDATE_RANGE) {
	UpdateRange(vPtr);
    }
    opProc = Blt_GetOperation(interp, nInstOps, vectorInstOps, BLT_OPER_ARG1,
	argc, argv, 0);
    if (opProc == NULL) {
	return TCL_ERROR;
    }
    return (*opProc) (vPtr, interp, argc, argv);
}

/*
 *----------------------------------------------------------------------
 *
 * VectorNamesOp --
 *
 *	Reports the names of all the current vectors in the interpreter.
 *
 * Results:
 *	A standard Tcl result.  interp->result will contain a list of
 *	all the names of the vector instances.
 *
 *----------------------------------------------------------------------
 */
/*ARGSUSED*/
static int
VectorNamesOp(clientData, interp, argc, argv)
    ClientData clientData;	/* Interpreter-specific data. */
    Tcl_Interp *interp;
    int argc;
    char **argv;
{
    VectorInterpData *dataPtr = (VectorInterpData *)clientData;
    Tcl_HashEntry *hPtr;
    char *name;
    Tcl_HashSearch cursor;

    for (hPtr = Tcl_FirstHashEntry(&(dataPtr->vectorTable), &cursor);
	hPtr != NULL; hPtr = Tcl_NextHashEntry(&cursor)) {
	name = Tcl_GetHashKey(&(dataPtr->vectorTable), hPtr);
	if ((argc == 2) || (Tcl_StringMatch(name, argv[2]))) {
	    Tcl_AppendElement(interp, name);
	}
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * VectorCreateOp --
 *
 *	Creates a Tcl command, and array variable representing an
 *	instance of a vector.
 *
 *	vector a
 *	vector b(20)
 *	vector c(-5:14)
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */
/*ARGSUSED*/
static int
VectorCreate2(clientData, interp, argStart, argc, argv)
    ClientData clientData;	/* Interpreter-specific data. */
    Tcl_Interp *interp;
    int argStart;
    int argc;
    char **argv;
{
    VectorInterpData *dataPtr = (VectorInterpData *)clientData;
    Vector *vPtr;
    char *leftParen, *rightParen;
    int isNew, size, first, last;
    char *cmdName, *varName;
    int length;
    int inspectFlags, freeOnUnset, flush;
    char **nameArr;
    int count;
    register int i;

    /*
     * Handle switches to the vector command and collect the vector
     * name arguments into an array.
     */
    varName = cmdName = NULL;
    freeOnUnset = 0;
    nameArr = (char **)malloc(sizeof(char *) * argc);
    assert(nameArr);

    inspectFlags = TRUE;
    flush = FALSE;
    count = 0;
    vPtr = NULL;
    for (i = argStart; i < argc; i++) {
	if ((inspectFlags) && (argv[i][0] == '-')) {
	    length = strlen(argv[i]);
	    if ((length > 1) &&
		(strncmp(argv[i], "-variable", length) == 0)) {
		if ((i + 1) == argc) {
		    Tcl_AppendResult(interp,
			"no variable name supplied with \"",
			argv[i], "\" switch", (char *)NULL);
		    goto error;
		}
		i++;
		varName = argv[i];
	    } else if ((length > 1) &&
		(strncmp(argv[i], "-command", length) == 0)) {
		if ((i + 1) == argc) {
		    Tcl_AppendResult(interp,
			"no command name supplied with \"",
			argv[i], "\" switch", (char *)NULL);
		    goto error;
		}
		i++;
		cmdName = argv[i];
	    } else if ((length > 1) &&
		(strncmp(argv[i], "-watchunset", length) == 0)) {
		int bool;

		if ((i + 1) == argc) {
		    Tcl_AppendResult(interp, "no value name supplied with \"",
			argv[i], "\" switch", (char *)NULL);
		    goto error;
		}
		i++;
		if (Tcl_GetBoolean(interp, argv[i], &bool) != TCL_OK) {
		    goto error;
		}
		freeOnUnset = bool;
	    } else if ((length > 1) && (strncmp(argv[i], "-flush", length) == 0)) {
		int bool;

		if ((i + 1) == argc) {
		    Tcl_AppendResult(interp, "no value name supplied with \"",
			argv[i], "\" switch", (char *)NULL);
		    goto error;
		}
		i++;
		if (Tcl_GetBoolean(interp, argv[i], &bool) != TCL_OK) {
		    goto error;
		}
		flush = bool;
	    } else if ((length > 1) && (argv[i][1] == '-') &&
		(argv[i][2] == '\0')) {
		inspectFlags = FALSE;	/* Allow vector names to start with - */
	    } else {
		Tcl_AppendResult(interp, "bad vector switch \"", argv[i], "\"",
		    (char *)NULL);
		goto error;
	    }
	} else {
	    nameArr[count++] = argv[i];
	}
    }
    if (count == 0) {
	Tcl_AppendResult(interp, "no vector names supplied", (char *)NULL);
	goto error;
    }
    if (count > 1) {
	if ((cmdName != NULL) && (cmdName[0] != '\0')) {
	    Tcl_AppendResult(interp,
		"can't specify more than one vector with \"-command\" switch",
		(char *)NULL);
	    goto error;
	}
	if ((varName != NULL) && (varName[0] != '\0')) {
	    Tcl_AppendResult(interp,
		"can't specify more than one vector with \"-variable\" switch",
		(char *)NULL);
	    goto error;
	}
    }
    for (i = 0; i < count; i++) {
	size = first = last = 0;
	leftParen = strchr(nameArr[i], '(');
	rightParen = strchr(nameArr[i], ')');
	if (((leftParen != NULL) && (rightParen == NULL)) ||
	    ((leftParen == NULL) && (rightParen != NULL)) ||
	    (leftParen > rightParen)) {
	    Tcl_AppendResult(interp, "bad vector specification \"", nameArr[i],
		"\"", (char *)NULL);
	    goto error;
	}
	if (leftParen != NULL) {
	    int result;
	    char *colon;

	    *rightParen = '\0';
	    colon = strchr(leftParen + 1, ':');
	    if (colon != NULL) {

		/* Specification is in the form vecName(first:last) */
		*colon = '\0';
		result = Tcl_GetInt(interp, leftParen + 1, &first);
		if ((*(colon + 1) != '\0') && (result == TCL_OK)) {
		    result = Tcl_GetInt(interp, colon + 1, &last);
		    if (first > last) {
			Tcl_AppendResult(interp, "bad vector range \"",
			    nameArr[i], "\"", (char *)NULL);
			result = TCL_ERROR;
		    }
		    size = (last - first) + 1;
		}
		*colon = ':';
	    } else {
		/* Specification is in the form vecName(size) */
		result = Tcl_GetInt(interp, leftParen + 1, &size);
	    }
	    *rightParen = ')';
	    if (result != TCL_OK) {
		goto error;
	    }
	    if (size < 0) {
		Tcl_AppendResult(interp, "bad vector size \"", nameArr[i], "\"",
		    (char *)NULL);
		goto error;
	    }
	}
	if (leftParen != NULL) {
	    *leftParen = '\0';
	}
	/*
	 * By default, we create a Tcl command by the name of the vector.
	 */
	vPtr = CreateVector(dataPtr, nameArr[i],
	    (cmdName == NULL) ? nameArr[i] : cmdName,
	    (varName == NULL) ? nameArr[i] : varName,
	    &isNew);
	if (leftParen != NULL) {
	    *leftParen = '(';
	}
	if (vPtr == NULL) {
	    goto error;
	}
	vPtr->freeOnUnset = freeOnUnset;
	vPtr->flush = flush;
	vPtr->offset = first;
	if (size > 0) {
	    if (ResizeVector(vPtr, size) != TCL_OK) {
		goto error;
	    }
	}
	if (!isNew) {
	    if (vPtr->flush) {
		FlushCache(vPtr);
	    }
	    UpdateClients(vPtr);
	}
    }
    free((char *)nameArr);
    if (vPtr != NULL) {
	/* Return the name of the last vector created  */
	Tcl_SetResult(interp, vPtr->name, TCL_STATIC);
    }
    return TCL_OK;
  error:
    free((char *)nameArr);
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * VectorCreateOp --
 *
 *	Creates a Tcl command, and array variable representing an
 *	instance of a vector.
 *
 *	vector a
 *	vector b(20)
 *	vector c(-5:14)
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */
/*ARGSUSED*/
static int
VectorCreateOp(clientData, interp, argc, argv)
    ClientData clientData;
    Tcl_Interp *interp;
    int argc;
    char **argv;
{
    return VectorCreate2(clientData, interp, 2, argc, argv);
}

/*
 *----------------------------------------------------------------------
 *
 * VectorDestroyOp --
 *
 *	Destroys the vector and its related Tcl command and array
 *	variable (if they exist).
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	Deletes the vector.
 *
 *----------------------------------------------------------------------
 */
/*ARGSUSED*/
static int
VectorDestroyOp(clientData, interp, argc, argv)
    ClientData clientData;	/* Interpreter-specific data. */
    Tcl_Interp *interp;
    int argc;
    char **argv;
{
    VectorInterpData *dataPtr = (VectorInterpData *)clientData;
    Vector *vPtr;
    register int i;

    for (i = 2; i < argc; i++) {
	if (StringToVector(dataPtr, argv[i], &vPtr) != TCL_OK) {
	    return TCL_ERROR;
	}
	FreeVector((ClientData)vPtr);
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * VectorExprOp --
 *
 *	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
VectorExprOp(clientData, interp, argc, argv)
    ClientData clientData;	/* Unused */
    Tcl_Interp *interp;
    int argc;
    char **argv;
{
    return Blt_ExprVector(interp, argv[2], (Blt_Vector *) NULL);
}

static Blt_OpSpec vectorCmdOps[] =
{
    {"create", 1, (Blt_OpProc)VectorCreateOp, 3, 0,
	"vecName ?vecName...? ?switches...?",},
    {"destroy", 1, (Blt_OpProc)VectorDestroyOp, 3, 0,
	"vecName ?vecName...?",},
    {"expr", 1, (Blt_OpProc)VectorExprOp, 3, 3, "expression",},
    {"names", 1, (Blt_OpProc)VectorNamesOp, 2, 3, "?pattern?...",},
};

static int nCmdOps = sizeof(vectorCmdOps) / sizeof(Blt_OpSpec);

/*ARGSUSED*/
static int
VectorCmd(clientData, interp, argc, argv)
    ClientData clientData;	/* Interpreter-specific data. */
    Tcl_Interp *interp;
    int argc;
    char **argv;
{
    Blt_OpProc opProc;

    /*
     * Try to replicate the old vector command's behavior:
     */
    if (argc > 1) {
	char c;
	register int i;
	register Blt_OpSpec *specPtr;

	c = argv[1][0];
	for (specPtr = vectorCmdOps, i = 0; i < nCmdOps; i++, specPtr++) {
	    if ((c == specPtr->name[0]) &&
		(strcmp(argv[1], specPtr->name) == 0)) {
		goto doOperation;
	    }
	}
	/*
	 * The first argument is not an operation, so assume that its
	 * actually the name of a vector to be created
	 */
	return VectorCreate2(clientData, interp, 1, argc, argv);
    }
  doOperation:
    /* Do the usual vector operation lookup now. */
    opProc = Blt_GetOperation(interp, nCmdOps, vectorCmdOps, BLT_OPER_ARG1,
	argc, argv, 0);
    if (opProc == NULL) {
	return TCL_ERROR;
    }
    return (*opProc) (clientData, interp, argc, argv);
}

/*
 * -----------------------------------------------------------------------
 *
 * VectorInterpDeleteProc --
 *
 *	This is called when the interpreter hosting the "vector" command
 *	is deleted.  
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Destroys the math and index hash tables.  In addition removes
 *	the hash table managing all vector names.
 *
 * ------------------------------------------------------------------------
 */
/* ARGSUSED */
static void
VectorInterpDeleteProc(clientData, interp)
    ClientData clientData;	/* Interpreter-specific data. */
    Tcl_Interp *interp;
{
    VectorInterpData *dataPtr = (VectorInterpData *)clientData;
    Tcl_HashEntry *hPtr;
    Tcl_HashSearch cursor;
    MathFunction *mathPtr;
    Vector *vPtr;
    
    for (hPtr = Tcl_FirstHashEntry(&(dataPtr->vectorTable), &cursor);
	 hPtr != NULL; hPtr = Tcl_NextHashEntry(&cursor)) {
	vPtr = (Vector *)Tcl_GetHashValue(hPtr);
	vPtr->hashPtr = NULL;
	FreeVector((ClientData)vPtr);
    }
    Tcl_DeleteHashTable(&(dataPtr->vectorTable));

    /* If any user-defined math functions were installed, remove them.  */
    for (hPtr = Tcl_FirstHashEntry(&(dataPtr->mathProcTable), &cursor); 
	 hPtr != NULL; hPtr = Tcl_NextHashEntry(&cursor)) {
	mathPtr = (MathFunction *) Tcl_GetHashValue(hPtr);
	if (mathPtr->name == NULL) {
	    free((char *)mathPtr);
	}
    }
    Tcl_DeleteHashTable(&(dataPtr->mathProcTable));
    Tcl_DeleteHashTable(&(dataPtr->indexProcTable));
    Tcl_DeleteAssocData(interp, VECTOR_THREAD_KEY);
    free((char *)dataPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * MathError --
 *
 *	This procedure is called when an error occurs during a
 *	floating-point operation.  It reads errno and sets
 *	interp->result accordingly.
 *
 * Results:
 *	Interp->result is set to hold an error message.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */
static void
MathError(interp, value)
    Tcl_Interp *interp;		/* Where to store error message. */
    double value;		/* Value returned after error;  used to
				 * distinguish underflows from overflows. */
{
    if ((errno == EDOM) || (value != value)) {
	Tcl_AppendResult(interp, "domain error: argument not in valid range",
	    (char *)NULL);
	Tcl_SetErrorCode(interp, "ARITH", "DOMAIN", interp->result,
	    (char *)NULL);
    } else if ((errno == ERANGE) || IS_INF(value)) {
	if (value == 0.0) {
	    Tcl_AppendResult(interp, 
			     "floating-point value too small to represent",
		(char *)NULL);
	    Tcl_SetErrorCode(interp, "ARITH", "UNDERFLOW", interp->result,
		(char *)NULL);
	} else {
	    Tcl_AppendResult(interp, 
			     "floating-point value too large to represent",
		(char *)NULL);
	    Tcl_SetErrorCode(interp, "ARITH", "OVERFLOW", interp->result,
		(char *)NULL);
	}
    } else {
	char buf[20];

	sprintf(buf, "%d", errno);
	Tcl_AppendResult(interp, "unknown floating-point error, ",
	    "errno = ", buf, (char *)NULL);
	Tcl_SetErrorCode(interp, "ARITH", "UNKNOWN", interp->result,
	    (char *)NULL);
    }
}

/*
 *--------------------------------------------------------------
 *
 * ParseString --
 *
 *	Given a string (such as one coming from command or variable
 *	substitution), make a Value based on the string.  The value
 *	will be a floating-point or integer, if possible, or else it
 *	will just be a copy of the string.
 *
 * Results:
 *	TCL_OK is returned under normal circumstances, and TCL_ERROR
 *	is returned if a floating-point overflow or underflow occurred
 *	while reading in a number.  The value at *valuePtr is modified
 *	to hold a number, if possible.
 *
 * Side effects:
 *	None.
 *
 *--------------------------------------------------------------
 */

static int
ParseString(interp, string, valuePtr)
    Tcl_Interp *interp;		/* Where to store error message. */
    char *string;		/* String to turn into value. */
    Value *valuePtr;		/* Where to store value information.
				 * Caller must have initialized pv field. */
{
    char *endPtr;
    double value;
    Vector *vPtr;

    errno = 0;
    value = strtod(string, &endPtr);
    if ((endPtr != string) && (*endPtr == '\0')) {
	if (errno != 0) {
	    Tcl_ResetResult(interp);
	    MathError(interp, value);
	    return TCL_ERROR;
	}
	if (ResizeVector(valuePtr->vPtr, 1) != TCL_OK) {
	    return TCL_ERROR;
	}
	valuePtr->vPtr->valueArr[0] = value;
	return TCL_OK;
    }
    vPtr = ParseVector(interp, valuePtr->vPtr->dataPtr, string, &endPtr, 
	       NS_SEARCH_BOTH);
    if (vPtr == NULL) {
	return TCL_ERROR;
    }
    if (*endPtr != '\0') {
	Tcl_AppendResult(interp, "extra characters after vector",
	    (char *)NULL);
	return TCL_ERROR;
    }
    CopyVector(valuePtr->vPtr, vPtr);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * ParseAndExecuteFunction --
 *
 *	This procedure is invoked to parse a math function from an
 *	expression string, carry out the function, and return the
 *	value computed.
 *
 * Results:
 *	TCL_OK is returned if all went well and the function's value
 *	was computed successfully.  If the name doesn't match any
 *	known math function, returns TCL_RETURN. And if a format error
 *	was found, TCL_ERROR is returned and an error message is left
 *	in interp->result.
 *
 *	After a successful return parsePtr will be updated to point to
 *	the character just after the function call, the token is set
 *	to VALUE, and the value is stored in valuePtr.
 *
 * Side effects:
 *	Embedded commands could have arbitrary side-effects.
 *
 *----------------------------------------------------------------------
 */
static int
ParseAndExecuteFunction(interp, start, parsePtr, valuePtr)
    Tcl_Interp *interp;		/* Interpreter to use for error reporting. */
    char *start;		/* Start of string to parse */
    ParseInfo *parsePtr;	/* Describes the state of the parse.
				 * parsePtr->nextPtr must point to the
				 * first character of the function's
				 * name. */
    Value *valuePtr;		/* Where to store value, if that is
				 * what's parsed from string.  Caller
				 * must have initialized pv field
				 * correctly. */
{
    Tcl_HashEntry *hPtr;
    MathFunction *mathPtr;	/* Info about math function. */
    register char *p;
    VectorInterpData *dataPtr;	/* Interpreter-specific data. */

    /*
     * Find the end of the math function's name and lookup the
     * record for the function.
     */
    p = start;
    while (isspace(UCHAR(*p))) {
	p++;
    }
    parsePtr->nextPtr = p;
    while (isalnum(UCHAR(*p)) || (*p == '_')) {
	p++;
    }
    if (*p != '(') {
	return TCL_RETURN;	/* Must start with open parenthesis */
    }
    dataPtr = valuePtr->vPtr->dataPtr;
    *p = '\0';
    hPtr = Tcl_FindHashEntry(&(dataPtr->mathProcTable), parsePtr->nextPtr);
    *p = '(';
    if (hPtr == NULL) {
	return TCL_RETURN;	/* Name doesn't match any known function */
    }
    /* Pick up the single value as the argument to the function */
    parsePtr->token = OPEN_PAREN;
    parsePtr->nextPtr = p + 1;
    valuePtr->pv.next = valuePtr->pv.buffer;
    if (NextValue(interp, parsePtr, -1, valuePtr) != TCL_OK) {
	return TCL_ERROR;	/* Parse error */
    }
    if (parsePtr->token != CLOSE_PAREN) {
	Tcl_AppendResult(interp, "unmatched parentheses in expression \"",
	    parsePtr->expr, "\"", (char *)NULL);
	return TCL_ERROR;	/* Missing right parenthesis */
    }
    mathPtr = (MathFunction *) Tcl_GetHashValue(hPtr);
    if ((*mathPtr->proc) (mathPtr->clientData, interp, valuePtr->vPtr)
	!= TCL_OK) {
	return TCL_ERROR;	/* Function invocation error */
    }
    parsePtr->token = VALUE;
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * NextToken --
 *
 *	Lexical analyzer for expression parser:  parses a single value,
 *	operator, or other syntactic element from an expression string.
 *
 * Results:
 *	TCL_OK is returned unless an error occurred while doing lexical
 *	analysis or executing an embedded command.  In that case a
 *	standard Tcl error is returned, using interp->result to hold
 *	an error message.  In the event of a successful return, the token
 *	and field in parsePtr is updated to refer to the next symbol in
 *	the expression string, and the expr field is advanced past that
 *	token;  if the token is a value, then the value is stored at
 *	valuePtr.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */
static int
NextToken(interp, parsePtr, valuePtr)
    Tcl_Interp *interp;		/* Interpreter to use for error reporting. */
    ParseInfo *parsePtr;	/* Describes the state of the parse. */
    Value *valuePtr;		/* Where to store value, if that is
				 * what's parsed from string.  Caller
				 * must have initialized pv field
				 * correctly. */
{
    register char *p;
    char *endPtr;
    char *var;
    int result;

    p = parsePtr->nextPtr;
    while (isspace(UCHAR(*p))) {
	p++;
    }
    if (*p == '\0') {
	parsePtr->token = END;
	parsePtr->nextPtr = p;
	return TCL_OK;
    }
    /*
     * Try to parse the token as a floating-point number. But check
     * that the first character isn't a "-" or "+", which "strtod"
     * will happily accept as an unary operator.  Otherwise, we might
     * accidently treat a binary operator as unary by mistake, which
     * will eventually cause a syntax error.
     */
    if ((*p != '-') && (*p != '+')) {
	double value;

	errno = 0;
	value = strtod(p, &endPtr);
	if (endPtr != p) {
	    if (errno != 0) {
		MathError(interp, value);
		return TCL_ERROR;
	    }
	    parsePtr->token = VALUE;
	    parsePtr->nextPtr = endPtr;

	    /*
	     * Save the single floating-point value as an 1-component vector.
	     */
	    if (ResizeVector(valuePtr->vPtr, 1) != TCL_OK) {
		return TCL_ERROR;
	    }
	    valuePtr->vPtr->valueArr[0] = value;
	    return TCL_OK;
	}
    }
    parsePtr->nextPtr = p + 1;
    switch (*p) {
    case '$':
	parsePtr->token = VALUE;
	var = Tcl_ParseVar(interp, p, &endPtr);
	if (var == NULL) {
	    return TCL_ERROR;
	}
	parsePtr->nextPtr = endPtr;
	Tcl_ResetResult(interp);
	result = ParseString(interp, var, valuePtr);
	return result;

    case '[':
	parsePtr->token = VALUE;
	result = TclParseNestedCmd(interp, p + 1, 0, &endPtr, &(valuePtr->pv));
	if (result != TCL_OK) {
	    return result;
	}
	parsePtr->nextPtr = endPtr;
	Tcl_ResetResult(interp);
	result = ParseString(interp, valuePtr->pv.buffer, valuePtr);
	return result;

    case '"':
	parsePtr->token = VALUE;
	result = TclParseQuotes(interp, p + 1, '"', 0, &endPtr, &(valuePtr->pv));
	if (result != TCL_OK) {
	    return result;
	}
	parsePtr->nextPtr = endPtr;
	Tcl_ResetResult(interp);
	result = ParseString(interp, valuePtr->pv.buffer, valuePtr);
	return result;

    case '{':
	parsePtr->token = VALUE;
	result = TclParseBraces(interp, p + 1, &endPtr, &valuePtr->pv);
	if (result != TCL_OK) {
	    return result;
	}
	parsePtr->nextPtr = endPtr;
	Tcl_ResetResult(interp);
	result = ParseString(interp, valuePtr->pv.buffer, valuePtr);
	return result;

    case '(':
	parsePtr->token = OPEN_PAREN;
	break;

    case ')':
	parsePtr->token = CLOSE_PAREN;
	break;

    case ',':
	parsePtr->token = COMMA;
	break;

    case '*':
	parsePtr->token = MULT;
	break;

    case '/':
	parsePtr->token = DIVIDE;
	break;

    case '%':
	parsePtr->token = MOD;
	break;

    case '+':
	parsePtr->token = PLUS;
	break;

    case '-':
	parsePtr->token = MINUS;
	break;

    case '^':
	parsePtr->token = EXPONENT;
	break;

    case '<':
	switch (*(p + 1)) {
#ifdef later
	case '<':
	    parsePtr->nextPtr = p + 2;
	    parsePtr->token = LEFT_SHIFT;
	    break;
#endif
	case '=':
	    parsePtr->nextPtr = p + 2;
	    parsePtr->token = LEQ;
	    break;
	default:
	    parsePtr->token = LESS;
	    break;
	}
	break;

    case '>':
	switch (*(p + 1)) {
#ifdef later
	case '>':
	    parsePtr->nextPtr = p + 2;
	    parsePtr->token = RIGHT_SHIFT;
	    break;
#endif
	case '=':
	    parsePtr->nextPtr = p + 2;
	    parsePtr->token = GEQ;
	    break;
	default:
	    parsePtr->token = GREATER;
	    break;
	}
	break;

    case '=':
	if (*(p + 1) == '=') {
	    parsePtr->nextPtr = p + 2;
	    parsePtr->token = EQUAL;
	} else {
	    parsePtr->token = UNKNOWN;
	}
	break;

    case '&':
	if (*(p + 1) == '&') {
	    parsePtr->nextPtr = p + 2;
	    parsePtr->token = AND;
	} else {
	    parsePtr->token = UNKNOWN;
	}
	break;

    case '|':
	if (*(p + 1) == '|') {
	    parsePtr->nextPtr = p + 2;
	    parsePtr->token = OR;
	} else {
	    parsePtr->token = UNKNOWN;
	}
	break;

    case '!':
	if (*(p + 1) == '=') {
	    parsePtr->nextPtr = p + 2;
	    parsePtr->token = NEQ;
	} else {
	    parsePtr->token = NOT;
	}
	break;

    default:
	parsePtr->token = VALUE;
	result = ParseAndExecuteFunction(interp, p, parsePtr, valuePtr);
	if ((result == TCL_OK) || (result == TCL_ERROR)) {
	    return result;
	} else {
	    Vector *vPtr;

	    vPtr = ParseVector(interp, valuePtr->vPtr->dataPtr, p, &endPtr, 
		       NS_SEARCH_BOTH);
	    if (vPtr == NULL) {
		return TCL_ERROR;
	    }
	    CopyVector(valuePtr->vPtr, vPtr);
	    parsePtr->nextPtr = endPtr;
	}
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * NextValue --
 *
 *	Parse a "value" from the remainder of the expression in parsePtr.
 *
 * Results:
 *	Normally TCL_OK is returned.  The value of the expression is
 *	returned in *valuePtr.  If an error occurred, then interp->result
 *	contains an error message and TCL_ERROR is returned.
 *	InfoPtr->token will be left pointing to the token AFTER the
 *	expression, and parsePtr->nextPtr will point to the character just
 *	after the terminating token.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */
static int
NextValue(interp, parsePtr, prec, valuePtr)
    Tcl_Interp *interp;		/* Interpreter to use for error reporting. */
    ParseInfo *parsePtr;	/* Describes the state of the parse
				 * just before the value (i.e. NextToken will
				 * be called to get first token of value). */
    int prec;			/* Treat any un-parenthesized operator
				 * with precedence <= this as the end
				 * of the expression. */
    Value *valuePtr;		/* Where to store the value of the expression.
				 * Caller must have initialized pv field. */
{
    Value value2;		/* Second operand for current operator.  */
    int operator;		/* Current operator (either unary or binary). */
    int gotOp;			/* Non-zero means already lexed the operator
				 * (while picking up value for unary operator).
				 * Don't lex again. */
    int result;
    Vector *vPtr, *v2Ptr;
    register int i;

    /*
     * There are two phases to this procedure.  First, pick off an initial
     * value.  Then, parse (binary operator, value) pairs until done.
     */

    vPtr = valuePtr->vPtr;
    v2Ptr = NewVector(vPtr->dataPtr);
    gotOp = FALSE;
    value2.vPtr = v2Ptr;
    value2.pv.buffer = value2.pv.next = value2.staticSpace;
    value2.pv.end = value2.pv.buffer + STATIC_STRING_SPACE - 1;
    value2.pv.expandProc = TclExpandParseValue;
    value2.pv.clientData = (ClientData)NULL;

    result = NextToken(interp, parsePtr, valuePtr);
    if (result != TCL_OK) {
	goto done;
    }
    if (parsePtr->token == OPEN_PAREN) {

	/* Parenthesized sub-expression. */

	result = NextValue(interp, parsePtr, -1, valuePtr);
	if (result != TCL_OK) {
	    goto done;
	}
	if (parsePtr->token != CLOSE_PAREN) {
	    Tcl_AppendResult(interp, "unmatched parentheses in expression \"",
		parsePtr->expr, "\"", (char *)NULL);
	    result = TCL_ERROR;
	    goto done;
	}
    } else {
	if (parsePtr->token == MINUS) {
	    parsePtr->token = UNARY_MINUS;
	}
	if (parsePtr->token >= UNARY_MINUS) {
	    operator = parsePtr->token;
	    result = NextValue(interp, parsePtr, precTable[operator], valuePtr);
	    if (result != TCL_OK) {
		goto done;
	    }
	    gotOp = TRUE;
	    /* Process unary operators. */
	    switch (operator) {
	    case UNARY_MINUS:
		for (i = 0; i < vPtr->length; i++) {
		    vPtr->valueArr[i] = -(vPtr->valueArr[i]);
		}
		break;

	    case NOT:
		for (i = 0; i < vPtr->length; i++) {
		    vPtr->valueArr[i] = (double)(!vPtr->valueArr[i]);
		}
		break;
	    default:
		Tcl_AppendResult(interp, "unknown operator", (char *)NULL);
		goto error;
	    }
	} else if (parsePtr->token != VALUE) {
	    Tcl_AppendResult(interp, "missing operand", (char *)NULL);
	    goto error;
	}
    }
    if (!gotOp) {
	result = NextToken(interp, parsePtr, &value2);
	if (result != TCL_OK) {
	    goto done;
	}
    }
    /*
     * Got the first operand.  Now fetch (operator, operand) pairs.
     */
    for (;;) {
	operator = parsePtr->token;

	value2.pv.next = value2.pv.buffer;
	if ((operator < MULT) || (operator >= UNARY_MINUS)) {
	    if ((operator == END) || (operator == CLOSE_PAREN)) {
		result = TCL_OK;
		goto done;
	    } else {
		Tcl_AppendResult(interp, "bad operator", (char *)NULL);
		goto error;
	    }
	}
	if (precTable[operator] <= prec) {
	    result = TCL_OK;
	    goto done;
	}
	result = NextValue(interp, parsePtr, precTable[operator], &value2);
	if (result != TCL_OK) {
	    goto done;
	}
	if ((parsePtr->token < MULT) && (parsePtr->token != VALUE) &&
	    (parsePtr->token != END) && (parsePtr->token != CLOSE_PAREN)) {
	    Tcl_AppendResult(interp, "unexpected token in expression",
		(char *)NULL);
	    goto error;
	}
	/*
	 * At this point we've got two vectors and an operator.
	 */

	if (v2Ptr->length == 1) {
	    register double *opnd;
	    register double scalar;

	    /*
	     * 2nd operand is a scalar.
	     */
	    scalar = v2Ptr->valueArr[0];
	    opnd = vPtr->valueArr;
	    switch (operator) {
	    case MULT:
		for (i = 0; i < vPtr->length; i++) {
		    opnd[i] *= scalar;
		}
		break;

	    case DIVIDE:
		if (scalar == 0.0) {
		    Tcl_AppendResult(interp, "divide by zero", (char *)NULL);
		    goto error;
		}
		for (i = 0; i < vPtr->length; i++) {
		    opnd[i] /= scalar;
		}
		break;

	    case PLUS:
		for (i = 0; i < vPtr->length; i++) {
		    opnd[i] += scalar;
		}
		break;

	    case MINUS:
		for (i = 0; i < vPtr->length; i++) {
		    opnd[i] -= scalar;
		}
		break;

	    case EXPONENT:
		for (i = 0; i < vPtr->length; i++) {
		    opnd[i] = pow(opnd[i], scalar);
		}
		break;

	    case MOD:
		for (i = 0; i < vPtr->length; i++) {
		    opnd[i] = Fmod(opnd[i], scalar);
		}
		break;

	    case LESS:
		for (i = 0; i < vPtr->length; i++) {
		    opnd[i] = (double)(opnd[i] < scalar);
		}
		break;

	    case GREATER:
		for (i = 0; i < vPtr->length; i++) {
		    opnd[i] = (double)(opnd[i] > scalar);
		}
		break;

	    case LEQ:
		for (i = 0; i < vPtr->length; i++) {
		    opnd[i] = (double)(opnd[i] <= scalar);
		}
		break;

	    case GEQ:
		for (i = 0; i < vPtr->length; i++) {
		    opnd[i] = (double)(opnd[i] >= scalar);
		}
		break;

	    case EQUAL:
		for (i = 0; i < vPtr->length; i++) {
		    opnd[i] = (double)(opnd[i] == scalar);
		}
		break;

	    case NEQ:
		for (i = 0; i < vPtr->length; i++) {
		    opnd[i] = (double)(opnd[i] != scalar);
		}
		break;

	    case AND:
		for (i = 0; i < vPtr->length; i++) {
		    opnd[i] = (double)(opnd[i] && scalar);
		}
		break;

	    case OR:
		for (i = 0; i < vPtr->length; i++) {
		    opnd[i] = (double)(opnd[i] || scalar);
		}
		break;

	    default:
		Tcl_AppendResult(interp, "unknown operator in expression",
		    (char *)NULL);
		goto error;
	    }

	} else if (vPtr->length == 1) {
	    register double *opnd;
	    register double scalar;

	    /*
	     * 1st operand is a scalar.
	     */
	    scalar = vPtr->valueArr[0];
	    CopyVector(vPtr, v2Ptr);
	    opnd = vPtr->valueArr;
	    switch (operator) {
	    case MULT:
		for (i = 0; i < vPtr->length; i++) {
		    opnd[i] *= scalar;
		}
		break;

	    case PLUS:
		for (i = 0; i < vPtr->length; i++) {
		    opnd[i] += scalar;
		}
		break;

	    case DIVIDE:
		for (i = 0; i < vPtr->length; i++) {
		    if (opnd[i] == 0.0) {
			Tcl_AppendResult(interp, "divide by zero",
			    (char *)NULL);
			goto error;
		    }
		    opnd[i] = (scalar / opnd[i]);
		}
		break;

	    case MINUS:
		for (i = 0; i < vPtr->length; i++) {
		    opnd[i] = scalar - opnd[i];
		}
		break;

	    case EXPONENT:
		for (i = 0; i < vPtr->length; i++) {
		    opnd[i] = pow(scalar, opnd[i]);
		}
		break;

	    case MOD:
		for (i = 0; i < vPtr->length; i++) {
		    opnd[i] = Fmod(scalar, opnd[i]);
		}
		break;

	    case LESS:
		for (i = 0; i < vPtr->length; i++) {
		    opnd[i] = (double)(scalar < opnd[i]);
		}
		break;

	    case GREATER:
		for (i = 0; i < vPtr->length; i++) {
		    opnd[i] = (double)(scalar > opnd[i]);
		}
		break;

	    case LEQ:
		for (i = 0; i < vPtr->length; i++) {
		    opnd[i] = (double)(scalar >= opnd[i]);
		}
		break;

	    case GEQ:
		for (i = 0; i < vPtr->length; i++) {
		    opnd[i] = (double)(scalar <= opnd[i]);
		}
		break;

	    case EQUAL:
		for (i = 0; i < vPtr->length; i++) {
		    opnd[i] = (double)(opnd[i] == scalar);
		}
		break;

	    case NEQ:
		for (i = 0; i < vPtr->length; i++) {
		    opnd[i] = (double)(opnd[i] != scalar);
		}
		break;

	    case AND:
		for (i = 0; i < vPtr->length; i++) {
		    opnd[i] = (double)(opnd[i] && scalar);
		}
		break;

	    case OR:
		for (i = 0; i < vPtr->length; i++) {
		    opnd[i] = (double)(opnd[i] || scalar);
		}
		break;

	    default:
		Tcl_AppendResult(interp, "unknown operator in expression",
		    (char *)NULL);
		goto error;
	    }
	} else {
	    register double *opnd1, *opnd2;
	    /*
	     * Carry out the function of the specified operator.
	     */
	    if (vPtr->length != v2Ptr->length) {
		Tcl_AppendResult(interp, "vectors are different lengths",
		    (char *)NULL);
		goto error;
	    }
	    opnd1 = vPtr->valueArr, opnd2 = v2Ptr->valueArr;
	    switch (operator) {
	    case MULT:
		for (i = 0; i < vPtr->length; i++) {
		    opnd1[i] *= opnd2[i];
		}
		break;

	    case DIVIDE:
		for (i = 0; i < vPtr->length; i++) {
		    if (opnd2[i] == 0.0) {
			Tcl_AppendResult(interp,
			    "can't divide by 0.0 vector component",
			    (char *)NULL);
			goto error;
		    }
		    opnd1[i] /= opnd2[i];
		}
		break;

	    case PLUS:
		for (i = 0; i < vPtr->length; i++) {
		    opnd1[i] += opnd2[i];
		}
		break;

	    case MINUS:
		for (i = 0; i < vPtr->length; i++) {
		    opnd1[i] -= opnd2[i];
		}
		break;

	    case MOD:
		for (i = 0; i < vPtr->length; i++) {
		    opnd1[i] = Fmod(opnd1[i], opnd2[i]);
		}
		break;

	    case EXPONENT:
		for (i = 0; i < vPtr->length; i++) {
		    opnd1[i] = pow(opnd1[i], opnd2[i]);
		}
		break;

	    case LESS:
		for (i = 0; i < vPtr->length; i++) {
		    opnd1[i] = (double)(opnd1[i] < opnd2[i]);
		}
		break;

	    case GREATER:
		for (i = 0; i < vPtr->length; i++) {
		    opnd1[i] = (double)(opnd1[i] > opnd2[i]);
		}
		break;

	    case LEQ:
		for (i = 0; i < vPtr->length; i++) {
		    opnd1[i] = (double)(opnd1[i] <= opnd2[i]);
		}
		break;

	    case GEQ:
		for (i = 0; i < vPtr->length; i++) {
		    opnd1[i] = (double)(opnd1[i] >= opnd2[i]);
		}
		break;

	    case EQUAL:
		for (i = 0; i < vPtr->length; i++) {
		    opnd1[i] = (double)(opnd1[i] == opnd2[i]);
		}
		break;

	    case NEQ:
		for (i = 0; i < vPtr->length; i++) {
		    opnd1[i] = (double)(opnd1[i] != opnd2[i]);
		}
		break;

	    case AND:
		for (i = 0; i < vPtr->length; i++) {
		    opnd1[i] = (double)(opnd1[i] && opnd2[i]);
		}
		break;

	    case OR:
		for (i = 0; i < vPtr->length; i++) {
		    opnd1[i] = (double)(opnd1[i] || opnd2[i]);
		}
		break;

	    default:
		Tcl_AppendResult(interp, "unknown operator in expression",
		    (char *)NULL);
		goto error;
	    }
	}
    }
  done:
    if (value2.pv.buffer != value2.staticSpace) {
	free(value2.pv.buffer);
    }
    FreeVector(v2Ptr);
    return result;

  error:
    if (value2.pv.buffer != value2.staticSpace) {
	free(value2.pv.buffer);
    }
    FreeVector(v2Ptr);
    return TCL_ERROR;
}

/*
 *--------------------------------------------------------------
 *
 * EvaluateExpression --
 *
 *	This procedure provides top-level functionality shared by
 *	procedures like Tcl_ExprInt, Tcl_ExprDouble, etc.
 *
 * Results:
 *	The result is a standard Tcl return value.  If an error
 *	occurs then an error message is left in interp->result.
 *	The value of the expression is returned in *valuePtr, in
 *	whatever form it ends up in (could be string or integer
 *	or double).  Caller may need to convert result.  Caller
 *	is also responsible for freeing string memory in *valuePtr,
 *	if any was allocated.
 *
 * Side effects:
 *	None.
 *
 *--------------------------------------------------------------
 */
static int
EvaluateExpression(interp, string, valuePtr)
    Tcl_Interp *interp;		/* Context in which to evaluate the
					 * expression. */
    char *string;		/* Expression to evaluate. */
    Value *valuePtr;		/* Where to store result.  Should
					 * not be initialized by caller. */
{
    ParseInfo info;
    int result;
    Vector *vPtr;
    register int i;

    info.expr = info.nextPtr = string;
    valuePtr->pv.buffer = valuePtr->pv.next = valuePtr->staticSpace;
    valuePtr->pv.end = valuePtr->pv.buffer + STATIC_STRING_SPACE - 1;
    valuePtr->pv.expandProc = TclExpandParseValue;
    valuePtr->pv.clientData = (ClientData)NULL;

    result = NextValue(interp, &info, -1, valuePtr);
    if (result != TCL_OK) {
	return result;
    }
    if (info.token != END) {
	Tcl_AppendResult(interp, ": syntax error in expression \"",
	    string, "\"", (char *)NULL);
	return TCL_ERROR;
    }
    vPtr = valuePtr->vPtr;

    /* Check for NaN's and overflows. */
    for (i = 0; i < vPtr->length; i++) {
	if ((IS_NAN(vPtr->valueArr[i]) || IS_INF(vPtr->valueArr[i]))) {
	    /*
	     * IEEE floating-point error.
	     */
	    MathError(interp, vPtr->valueArr[i]);
	    return TCL_ERROR;
	}
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Math Functions --
 *
 *	This page contains the procedures that implement all of the
 *	built-in math functions for expressions.
 *
 * Results:
 *	Each procedure returns TCL_OK if it succeeds and places result
 *	information at *resultPtr.  If it fails it returns TCL_ERROR
 *	and leaves an error message in interp->result.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */
static int
ComponentFunc(clientData, interp, vPtr)
    ClientData clientData;	/* Contains address of procedure that
					 * takes one double argument and
					 * returns a double result. */
    Tcl_Interp *interp;
    Vector *vPtr;
{
    ComponentProc *procPtr = (ComponentProc *) clientData;
    register int i;

    errno = 0;
    for (i = 0; i < vPtr->length; i++) {
	vPtr->valueArr[i] = (*procPtr) (vPtr->valueArr[i]);
	if (errno != 0) {
	    MathError(interp, vPtr->valueArr[i]);
	    return TCL_ERROR;
	}
	if ((IS_NAN(vPtr->valueArr[i]) || IS_INF(vPtr->valueArr[i]))) {
	    /*
	     * IEEE floating-point error.
	     */
	    MathError(interp, vPtr->valueArr[i]);
	    return TCL_ERROR;
	}
    }
    return TCL_OK;
}

static int
ScalarFunc(clientData, interp, vPtr)
    ClientData clientData;
    Tcl_Interp *interp;
    Vector *vPtr;
{
    double value;
    ScalarProc *procPtr = (ScalarProc *) clientData;

    errno = 0;
    value = (*procPtr) (vPtr);
    if (errno != 0) {
	MathError(interp, value);
	return TCL_ERROR;
    }
    if (ResizeVector(vPtr, 1) != TCL_OK) {
	return TCL_ERROR;
    }
    vPtr->valueArr[0] = value;
    return TCL_OK;
}

/*ARGSUSED*/
static int
VectorFunc(clientData, interp, vPtr)
    ClientData clientData;
    Tcl_Interp *interp;		/* Not used. */
    Vector *vPtr;
{
    VectorProc *procPtr = (VectorProc *) clientData;

    return (*procPtr) (vPtr);
}


static void
InstallIndexProc(tablePtr, string, procPtr)
    Tcl_HashTable *tablePtr;
    char *string;
    Blt_VectorIndexProc *procPtr; /* Pointer to function to be called
				   * when the vector finds the named index.
				   * If NULL, this indicates to remove
				   * the index from the table.
				   */
{
    Tcl_HashEntry *hPtr;
    int dummy;

    hPtr = Tcl_CreateHashEntry(tablePtr, string, &dummy);
    if (procPtr == NULL) {
	Tcl_DeleteHashEntry(hPtr);
    } else {
	Tcl_SetHashValue(hPtr, (ClientData)procPtr);
    }
}

static void
InstallSpecialIndices(dataPtr)
    VectorInterpData *dataPtr;	/* Interpreter-specific data. */
{
    InstallIndexProc(&(dataPtr->indexProcTable), "min", Min);
    InstallIndexProc(&(dataPtr->indexProcTable), "max", Max);
    InstallIndexProc(&(dataPtr->indexProcTable), "mean", Mean);
    InstallIndexProc(&(dataPtr->indexProcTable), "sum", Sum);
    InstallIndexProc(&(dataPtr->indexProcTable), "prod", Product);
}

static MathFunction mathFunctions[] =
{
    {"abs", (GenericMathProc *) ComponentFunc, (ClientData)Fabs},
    {"acos", (GenericMathProc *) ComponentFunc, (ClientData)acos},
    {"asin", (GenericMathProc *) ComponentFunc, (ClientData)asin},
    {"atan", (GenericMathProc *) ComponentFunc, (ClientData)atan},
    {"adev", (GenericMathProc *) ScalarFunc, (ClientData)AvgDeviation},
    {"ceil", (GenericMathProc *) ComponentFunc, (ClientData)ceil},
    {"cos", (GenericMathProc *) ComponentFunc, (ClientData)cos},
    {"cosh", (GenericMathProc *) ComponentFunc, (ClientData)cosh},
    {"exp", (GenericMathProc *) ComponentFunc, (ClientData)exp},
    {"floor", (GenericMathProc *) ComponentFunc, (ClientData)floor},
    {"kurtosis", (GenericMathProc *) ScalarFunc, (ClientData)Kurtosis},
    {"length", (GenericMathProc *) ScalarFunc, (ClientData)Length},
    {"log", (GenericMathProc *) ComponentFunc, (ClientData)log},
    {"log10", (GenericMathProc *) ComponentFunc, (ClientData)log10},
    {"max", (GenericMathProc *) ScalarFunc, (ClientData)Max},
    {"mean", (GenericMathProc *) ScalarFunc, (ClientData)Mean},
    {"median", (GenericMathProc *) ScalarFunc, (ClientData)Median},
    {"min", (GenericMathProc *) ScalarFunc, (ClientData)Min},
    {"norm", (GenericMathProc *) VectorFunc, (ClientData)Norm},
    {"nz", (GenericMathProc *) ScalarFunc, (ClientData)Nonzeros},
    {"q1", (GenericMathProc *) ScalarFunc, (ClientData)Q1},
    {"q3", (GenericMathProc *) ScalarFunc, (ClientData)Q3},
    {"prod", (GenericMathProc *) ScalarFunc, (ClientData)Product},
#ifdef HAVE_DRAND48
    {"random", (GenericMathProc *) ComponentFunc, (ClientData)drand48},
#endif
    {"round", (GenericMathProc *) ComponentFunc, (ClientData)Round},
    {"sdev", (GenericMathProc *) ScalarFunc, (ClientData)StdDeviation},
    {"sin", (GenericMathProc *) ComponentFunc, (ClientData)sin},
    {"sinh", (GenericMathProc *) ComponentFunc, (ClientData)sinh},
    {"skew", (GenericMathProc *) ScalarFunc, (ClientData)Skew},
    {"sort", (GenericMathProc *) VectorFunc, (ClientData)Sort},
    {"sqrt", (GenericMathProc *) ComponentFunc, (ClientData)sqrt},
    {"sum", (GenericMathProc *) ScalarFunc, (ClientData)Sum},
    {"tan", (GenericMathProc *) ComponentFunc, (ClientData)tan},
    {"tanh", (GenericMathProc *) ComponentFunc, (ClientData)tanh},
    {"var", (GenericMathProc *) ScalarFunc, (ClientData)Variance},
    {(char *)NULL,},
};

static void
InstallMathFunctions(dataPtr)
    VectorInterpData *dataPtr;	/* Interpreter-specific data. */
{
    Tcl_HashEntry *hPtr;
    Tcl_HashTable *tablePtr = &(dataPtr->mathProcTable);
    register MathFunction *mathPtr;
    int dummy;

    for (mathPtr = mathFunctions; mathPtr->name != NULL; mathPtr++) {
	hPtr = Tcl_CreateHashEntry(tablePtr, mathPtr->name, &dummy);
	Tcl_SetHashValue(hPtr, (ClientData)mathPtr);
    }
}

static VectorInterpData *
GetVectorInterpData(interp)
    Tcl_Interp *interp;
{
    VectorInterpData *dataPtr;
    Tcl_InterpDeleteProc *proc;

    dataPtr = (VectorInterpData *)
	Tcl_GetAssocData(interp, VECTOR_THREAD_KEY, &proc);
    if (dataPtr == NULL) {
	dataPtr = (VectorInterpData *)malloc(sizeof(VectorInterpData));
	assert(dataPtr);
	dataPtr->interp = interp;
	Tcl_SetAssocData(interp, VECTOR_THREAD_KEY, VectorInterpDeleteProc,
		 (ClientData)dataPtr);
	Tcl_InitHashTable(&(dataPtr->vectorTable), TCL_STRING_KEYS);
	Tcl_InitHashTable(&(dataPtr->mathProcTable), TCL_STRING_KEYS);
	Tcl_InitHashTable(&(dataPtr->indexProcTable), TCL_STRING_KEYS);
	InstallMathFunctions(dataPtr);
	InstallSpecialIndices(dataPtr);
#ifdef HAVE_SRAND48
	srand48(time((time_t *) NULL));
#endif
    }
    return dataPtr;
}

/*
 * -----------------------------------------------------------------------
 *
 * Blt_VectorInit --
 *
 *	This procedure is invoked to initialize the "vector" command.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Creates the new command and adds a new entry into a global Tcl
 *	associative array.
 *
 * ------------------------------------------------------------------------
 */

int
Blt_VectorInit(interp)
    Tcl_Interp *interp;
{
    VectorInterpData *dataPtr;	/* Interpreter-specific data. */
    static Blt_CmdSpec cmdSpec = {"vector", VectorCmd, };
    
    dataPtr = GetVectorInterpData(interp);
    /* 
     * This routine may be run several times in the same interpreter. 
     * For example, if someone tries to initial the BLT commands from 
     * another namespace. Keep a reference count, so we know when it's 
     * safe to clean up.
     */
    cmdSpec.clientData = (ClientData)dataPtr;
    if (Blt_InitCmd(interp, "blt", &cmdSpec) == NULL) {
	return TCL_ERROR;
    }
    return TCL_OK;
}

/* C Application interface to vectors */

/*
 * -----------------------------------------------------------------------
 *
 * Blt_CreateVector --
 *
 *	Creates a new vector by the name and size.
 *
 * Results:
 *	A standard Tcl result.  If the new array size is invalid or a
 *	vector already exists by that name, TCL_ERROR is returned.
 *	Otherwise TCL_OK is returned and the new vector is created.
 *
 * Side Effects:
 *	Memory will be allocated for the new vector.  A new Tcl command
 *	and Tcl array variable will be created.
 *
 * -----------------------------------------------------------------------
 */

/*LINTLIBRARY*/
int
Blt_CreateVector2(interp, vecName, cmdName, varName, initialSize, vecPtrPtr)
    Tcl_Interp *interp;
    char *vecName;
    char *cmdName, *varName;
    int initialSize;
    Blt_Vector **vecPtrPtr;
{
    VectorInterpData *dataPtr;	/* Interpreter-specific data. */
    Vector *vPtr;
    int isNew;
    char *nameCopy;

    if (initialSize < 0) {
	Tcl_AppendResult(interp, "bad vector size \"", Blt_Itoa(initialSize),
	    "\"", (char *)NULL);
	return TCL_ERROR;
    }
    dataPtr = GetVectorInterpData(interp);

    nameCopy = strdup(vecName);
    vPtr = CreateVector(dataPtr, nameCopy, cmdName, varName, &isNew);
    free(nameCopy);

    if (vPtr == NULL) {
	return TCL_ERROR;
    }
    if (initialSize > 0) {
	if (ResizeVector(vPtr, initialSize) != TCL_OK) {
	    return TCL_ERROR;
	}
    }
    if (vecPtrPtr != NULL) {
	*vecPtrPtr = (Blt_Vector *) vPtr;
    }
    return TCL_OK;
}

int
Blt_CreateVector(interp, name, size, vecPtrPtr)
    Tcl_Interp *interp;
    char *name;
    int size;
    Blt_Vector **vecPtrPtr;
{
    return Blt_CreateVector2(interp, name, name, name, size, vecPtrPtr);
}

/*
 * -----------------------------------------------------------------------
 *
 * Blt_DeleteVector --
 *
 *	Deletes the vector of the given name.  All clients with
 *	designated callback routines will be notified.
 *
 * Results:
 *	A standard Tcl result.  If no vector exists by that name,
 *	TCL_ERROR is returned.  Otherwise TCL_OK is returned and
 *	vector is deleted.
 *
 * Side Effects:
 *	Memory will be released for the new vector.  Both the Tcl
 *	command and array variable will be deleted.  All clients which
 *	set call back procedures will be notified.
 *
 * -----------------------------------------------------------------------
 */
/*LINTLIBRARY*/
int
Blt_DeleteVector(vecPtr)
    Blt_Vector *vecPtr;
{
    Vector *vPtr = (Vector *)vecPtr;

    FreeVector(vPtr);
    return TCL_OK;
}

/*
 * -----------------------------------------------------------------------
 *
 * Blt_DeleteVectorByName --
 *
 *	Deletes the vector of the given name.  All clients with
 *	designated callback routines will be notified.
 *
 * Results:
 *	A standard Tcl result.  If no vector exists by that name,
 *	TCL_ERROR is returned.  Otherwise TCL_OK is returned and
 *	vector is deleted.
 *
 * Side Effects:
 *	Memory will be released for the new vector.  Both the Tcl
 *	command and array variable will be deleted.  All clients which
 *	set call back procedures will be notified.
 *
 * -----------------------------------------------------------------------
 */
/*LINTLIBRARY*/
int
Blt_DeleteVectorByName(interp, name)
    Tcl_Interp *interp;
    char *name;
{
    VectorInterpData *dataPtr;	/* Interpreter-specific data. */
    Vector *vPtr;
    char *nameCopy;
    int result;

    /*
     * If the vector name was passed via a read-only string (e.g. "x"),
     * the ParseVector routine will segfault when it tries to write
     * into the string.  Therefore make a writable copy and free it
     * when we're done.
     */
    nameCopy = strdup(name);
    dataPtr = GetVectorInterpData(interp);
    result = StringToVector(dataPtr, nameCopy, &vPtr);
    free(nameCopy);

    if (result != TCL_OK) {
	return TCL_ERROR;
    }
    FreeVector(vPtr);
    return TCL_OK;
}

/*
 * ----------------------------------------------------------------------
 *
 * Blt_VectorExists2 --
 *
 *	Returns whether the vector associated with the client token
 *	still exists.
 *
 * Results:
 *	Returns 1 is the vector still exists, 0 otherwise.
 *
 * ----------------------------------------------------------------------
 */
int
Blt_VectorExists2(interp, vecName)
    Tcl_Interp *interp;
    char *vecName;
{
    VectorInterpData *dataPtr;	/* Interpreter-specific data. */

    dataPtr = GetVectorInterpData(interp);
    return (FindVector(dataPtr, vecName, NS_SEARCH_BOTH) != NULL);
}

/*
 * ----------------------------------------------------------------------
 *
 * Blt_VectorExists --
 *
 *	Returns whether the vector associated with the client token
 *	still exists.
 *
 * Results:
 *	Returns 1 is the vector still exists, 0 otherwise.
 *
 * ----------------------------------------------------------------------
 */
int
Blt_VectorExists(interp, vecName)
    Tcl_Interp *interp;
    char *vecName;
{
    char *nameCopy;
    int result;

    /*
     * If the vector name was passed via a read-only string (e.g. "x"),
     * the ParseVector routine will segfault when it tries to write
     * into the string.  Therefore make a writable copy and free it
     * when we're done.
     */
    nameCopy = strdup(vecName);
    result = Blt_VectorExists2(interp, nameCopy);
    free(nameCopy);
    return result;
}

/*
 * -----------------------------------------------------------------------
 *
 * Blt_GetVector --
 *
 *	Returns a pointer to the vector associated with the given name.
 *
 * Results:
 *	A standard Tcl result.  If there is no vector "name", TCL_ERROR
 *	is returned.  Otherwise TCL_OK is returned and vecPtrPtr will
 *	point to the vector.
 *
 * -----------------------------------------------------------------------
 */
int
Blt_GetVector(interp, name, vecPtrPtr)
    Tcl_Interp *interp;
    char *name;
    Blt_Vector **vecPtrPtr;
{
    VectorInterpData *dataPtr;	/* Interpreter-specific data. */
    Vector *vPtr;
    char *nameCopy;
    int result;

    dataPtr = GetVectorInterpData(interp);
    /*
     * If the vector name was passed via a read-only string (e.g. "x"),
     * the ParseVector routine will segfault when it tries to write
     * into the string.  Therefore make a writable copy and free it
     * when we're done.
     */
    nameCopy = strdup(name);
    result = StringToVector(dataPtr, nameCopy, &vPtr);
    free(nameCopy);
    if (result != TCL_OK) {
	return TCL_ERROR;
    }
    if (vPtr->notifyFlags & UPDATE_RANGE) {
	UpdateRange(vPtr);
    }
    *vecPtrPtr = (Blt_Vector *) vPtr;
    return TCL_OK;
}

/*
 * -----------------------------------------------------------------------
 *
 * Blt_ResetVector --
 *
 *	Resets the vector data.  This is called by a client to
 *	indicate that the vector data has changed.  The vector does
 *	not need to point to different memory.  Any clients of the
 *	vector will be notified of the change.
 *
 * Results:
 *	A standard Tcl result.  If the new array size is invalid,
 *	TCL_ERROR is returned.  Otherwise TCL_OK is returned and the
 *	new vector data is recorded.
 *
 * Side Effects:
 *	Any client designated callbacks will be posted.  Memory may
 *	be changed for the vector array.
 *
 * -----------------------------------------------------------------------
 */
int
Blt_ResetVector(vecPtr, valueArr, length, size, freeProc)
    Blt_Vector *vecPtr;
    double *valueArr;		/* Array containing the elements of the
				 * vector. If NULL, indicates to reset the 
				 * vector.*/
    int length;			/* The number of elements that the vector 
				 * currently holds. */
    int size;			/* The maximum number of elements that the
				 * array can hold. */
    Tcl_FreeProc *freeProc;	/* Address of memory deallocation routine
				 * for the array of values.  Can also be
				 * TCL_STATIC, TCL_DYNAMIC, or TCL_VOLATILE. */
{
    Vector *vPtr;

    vPtr = (Vector *)vecPtr;

    if (size < 0) {
	Tcl_AppendResult(vPtr->interp, "bad array size", (char *)NULL);
	return TCL_ERROR;
    }
    if (vPtr->valueArr != valueArr) {	/* New array of values resides
					 * in different memory than
					 * the current vector.  */
	if ((valueArr == NULL) || (size == 0)) {
	    /* Empty array. Set up default values */
	    freeProc = TCL_STATIC;
	    valueArr = NULL;
	    size = length = 0;
	} else if (freeProc == TCL_VOLATILE) {
	    double *newArr;
	    /* Data is volatile. Make a copy of the value array.  */
	    newArr = (double *)malloc(size * sizeof(double));
	    if (newArr == NULL) {
		Tcl_AppendResult(vPtr->interp, "can't allocate ", 
			Blt_Itoa(size), " elements for vector \"", 
			vPtr->name, "\"", (char *)NULL);
		return TCL_ERROR;
	    }
	    memcpy((char *)newArr, (char *)valueArr, 
		   sizeof(double) * length);
	    valueArr = newArr;
	    freeProc = TCL_DYNAMIC;
	} 

	if (vPtr->freeProc != TCL_STATIC) {
	    /* Old data was dynamically allocated. Free it before
	     * attaching new data.  */
	    if (vPtr->freeProc == TCL_DYNAMIC) {
		free((char *)vPtr->valueArr);
	    } else {
		(*freeProc) ((char *)vPtr->valueArr);
	    }
	}
	vPtr->freeProc = freeProc;
	vPtr->valueArr = valueArr;
	vPtr->size = size;
    }

    vPtr->length = length;
    if (vPtr->flush) {
	FlushCache(vPtr);
    }
    UpdateRange(vPtr);
    UpdateClients(vPtr);
    return TCL_OK;
}

/*
 * -----------------------------------------------------------------------
 *
 * Blt_ResizeVector --
 *
 *	Changes the size of the vector.  All clients with designated
 *	callback routines will be notified of the size change.
 *
 * Results:
 *	A standard Tcl result.  If no vector exists by that name,
 *	TCL_ERROR is returned.  Otherwise TCL_OK is returned and
 *	vector is resized.
 *
 * Side Effects:
 *	Memory may be reallocated for the new vector size.  All clients
 *	which set call back procedures will be notified.
 *
 * -----------------------------------------------------------------------
 */
int
Blt_ResizeVector(vecPtr, length)
    Blt_Vector *vecPtr;
    int length;
{
    Vector *vPtr = (Vector *)vecPtr;

    if (ResizeVector(vPtr, length) != TCL_OK) {
	Tcl_AppendResult(vPtr->interp, "can't resize vector \"", vPtr->name,
	    "\"", (char *)NULL);
	return TCL_ERROR;
    }
    if (vPtr->flush) {
	FlushCache(vPtr);
    }
    UpdateRange(vPtr);
    UpdateClients(vPtr);
    return TCL_OK;
}

/*
 *--------------------------------------------------------------
 *
 * Blt_AllocVectorId --
 *
 *	Creates an identifier token for an existing vector.  The
 *	identifier is used by the client routines to get call backs
 *	when (and if) the vector changes.
 *
 * Results:
 *	A standard Tcl result.  If "vecName" is not associated with
 *	a vector, TCL_ERROR is returned and interp->result is filled
 *	with an error message.
 *
 *--------------------------------------------------------------
 */
Blt_VectorId
Blt_AllocVectorId(interp, name)
    Tcl_Interp *interp;
    char *name;
{
    VectorInterpData *dataPtr;	/* Interpreter-specific data. */
    Vector *vPtr;
    ClientInfo *clientPtr;
    Blt_VectorId clientId;
    int result;
    char *nameCopy;

    dataPtr = GetVectorInterpData(interp);
    /*
     * If the vector name was passed via a read-only string (e.g. "x"),
     * the ParseVector routine will segfault when it tries to write
     * into the string.  Therefore make a writable copy and free it
     * when we're done.
     */
    nameCopy = strdup(name);
    result = StringToVector(dataPtr, nameCopy, &vPtr);
    free(nameCopy);

    if (result != TCL_OK) {
	return (Blt_VectorId) 0;
    }
    /* Allocate a new client structure */
    clientPtr = (ClientInfo *)calloc(1, sizeof(ClientInfo));
    assert(clientPtr);
    clientPtr->magic = VECTOR_MAGIC;

    /* Add the new client to the server's list of clients */
    clientPtr->linkPtr = Blt_ChainAppend(vPtr->chainPtr, (ClientData)clientPtr);
    clientPtr->serverPtr = vPtr;
    clientId = (Blt_VectorId) clientPtr;
    return clientId;
}

/*
 * -----------------------------------------------------------------------
 *
 * Blt_SetVectorChangedProc --
 *
 *	Sets the routine to be called back when the vector is changed
 *	or deleted.  *clientData* will be provided as an argument. If
 *	*proc* is NULL, no callback will be made.
 *
 * Results:
 *	None.
 *
 * Side Effects:
 *	The designated routine will be called when the vector is changed
 *	or deleted.
 *
 * -----------------------------------------------------------------------
 */
void
Blt_SetVectorChangedProc(clientId, proc, clientData)
    Blt_VectorId clientId;	/* Client token identifying the vector */
    Blt_VectorChangedProc *proc;/* Address of routine to call when the contents
				 * of the vector change. If NULL, no routine
				 * will be called */
    ClientData clientData;	/* One word of information to pass along when
				 * the above routine is called */
{
    ClientInfo *clientPtr = (ClientInfo *)clientId;

    if (clientPtr->magic != VECTOR_MAGIC) {
	return;			/* Not a valid token */
    }
    clientPtr->clientData = clientData;
    clientPtr->proc = proc;
}

/*
 *--------------------------------------------------------------
 *
 * Blt_FreeVectorId --
 *
 *	Releases the token for an existing vector.  This indicates
 *	that the client is no longer interested the vector.  Any
 *	previously specified callback routine will no longer be
 *	invoked when (and if) the vector changes.
 *
 * Results:
 *	None.
 *
 * Side Effects:
 *	Any previously specified callback routine will no longer be
 *	invoked when (and if) the vector changes.
 *
 *--------------------------------------------------------------
 */
void
Blt_FreeVectorId(clientId)
    Blt_VectorId clientId;	/* Client token identifying the vector */
{
    ClientInfo *clientPtr = (ClientInfo *)clientId;

    if (clientPtr->magic != VECTOR_MAGIC) {
	return;			/* Not a valid token */
    }
    if (clientPtr->serverPtr != NULL) {
	/* Remove the client from the server's list */
	Blt_ChainDeleteLink(clientPtr->serverPtr->chainPtr, clientPtr->linkPtr);
    }
    free((char *)clientPtr);
}

/*
 *--------------------------------------------------------------
 *
 * Blt_NameOfVectorId --
 *
 *	Returns the name of the vector (and array variable).
 *
 * Results:
 *	The name of the array variable is returned.
 *
 *--------------------------------------------------------------
 */
char *
Blt_NameOfVectorId(clientId)
    Blt_VectorId clientId;	/* Client token identifying the vector */
{
    ClientInfo *clientPtr = (ClientInfo *)clientId;

    if ((clientPtr->magic != VECTOR_MAGIC) || (clientPtr->serverPtr == NULL)) {
	return NULL;
    }
    return clientPtr->serverPtr->name;
}

char *
Blt_NameOfVector(vecPtr)
    Blt_Vector *vecPtr;		/* Vector to query. */
{
    Vector *vPtr = (Vector *)vecPtr;
    return vPtr->name;
}

/*
 *--------------------------------------------------------------
 *
 * Blt_VectorNotifyPending --
 *
 *	Returns the name of the vector (and array variable).
 *
 * Results:
 *	The name of the array variable is returned.
 *
 *--------------------------------------------------------------
 */
int
Blt_VectorNotifyPending(clientId)
    Blt_VectorId clientId;	/* Client token identifying the vector */
{
    ClientInfo *clientPtr = (ClientInfo *)clientId;

    if ((clientPtr->magic != VECTOR_MAGIC) || (clientPtr->serverPtr == NULL)) {
	return 0;
    }
    return (clientPtr->serverPtr->notifyFlags & NOTIFY_PENDING);
}

/*
 * -----------------------------------------------------------------------
 *
 * Blt_GetVectorById --
 *
 *	Returns a pointer to the vector associated with the client
 *	token.
 *
 * Results:
 *	A standard Tcl result.  If the client token is not associated
 *	with a vector any longer, TCL_ERROR is returned. Otherwise,
 *	TCL_OK is returned and vecPtrPtr will point to vector.
 *
 * -----------------------------------------------------------------------
 */
int
Blt_GetVectorById(interp, clientId, vecPtrPtr)
    Tcl_Interp *interp;
    Blt_VectorId clientId;	/* Client token identifying the vector */
    Blt_Vector **vecPtrPtr;
{
    ClientInfo *clientPtr = (ClientInfo *)clientId;

    if (clientPtr->magic != VECTOR_MAGIC) {
	Tcl_AppendResult(interp, "bad vector token", (char *)NULL);
	return TCL_ERROR;
    }
    if (clientPtr->serverPtr == NULL) {
	Tcl_AppendResult(interp, "vector no longer exists", (char *)NULL);
	return TCL_ERROR;
    }
    if (clientPtr->serverPtr->notifyFlags & UPDATE_RANGE) {
	UpdateRange(clientPtr->serverPtr);
    }
    *vecPtrPtr = (Blt_Vector *) clientPtr->serverPtr;
    return TCL_OK;
}

/*
 *--------------------------------------------------------------
 *
 * Blt_ExprVector --
 *
 *	Evaluates an vector expression and returns its value(s).
 *
 * Results:
 *	Each of the procedures below returns a standard Tcl result.
 *	If an error occurs then an error message is left in
 *	interp->result.  Otherwise the value of the expression,
 *	in the appropriate form, is stored at *resultPtr.  If
 *	the expression had a result that was incompatible with the
 *	desired form then an error is returned.
 *
 * Side effects:
 *	None.
 *
 *--------------------------------------------------------------
 */
int
Blt_ExprVector(interp, string, vecPtr)
    Tcl_Interp *interp;		/* Context in which to evaluate the
				 * expression. */
    char *string;		/* Expression to evaluate. */
    Blt_Vector *vecPtr;		/* Where to store result. */
{
    VectorInterpData *dataPtr;	/* Interpreter-specific data. */
    Vector *vPtr = (Vector *)vecPtr;
    Value value;

    dataPtr = (vecPtr != NULL) ? vPtr->dataPtr : GetVectorInterpData(interp);
    value.vPtr = NewVector(dataPtr);
    if (EvaluateExpression(interp, string, &value) != TCL_OK) {
	FreeVector(value.vPtr);
	return TCL_ERROR;
    }
    if (vPtr != NULL) {
	CopyVector(vPtr, value.vPtr);
    } else {
	register int i;
	/* No result vector.  Put values in interp->result.  */
	for (i = 0; i < value.vPtr->length; i++) {
	    Tcl_AppendElement(interp, 
			      Blt_Dtoa(interp, value.vPtr->valueArr[i]));
	}
    }
    FreeVector(value.vPtr);
    return TCL_OK;
}

int
Blt_InstallMathFunction(interp, name, type, clientData)
    Tcl_Interp *interp;
    char *name;
    Blt_MathFuncType type;
    ClientData clientData;
{
    VectorInterpData *dataPtr;	/* Interpreter-specific data. */
    Tcl_HashEntry *hPtr;
    MathFunction *mathPtr;
    GenericMathProc *proc;
    int isNew;
    
    dataPtr = GetVectorInterpData(interp);
    
    hPtr = Tcl_CreateHashEntry(&(dataPtr->mathProcTable), name, &isNew);
    if (!isNew) {
	mathPtr = (MathFunction *) Tcl_GetHashValue(hPtr);
	if (mathPtr->name == NULL) {
	    free((char *)mathPtr);
	}
    }
    if (clientData == (ClientData)NULL) {
	Tcl_DeleteHashEntry(hPtr);
	return TCL_OK;
    }
    switch (type) {
    case BLT_MATH_FUNC_SCALAR:
	proc = (GenericMathProc *) ScalarFunc;
	break;
	
    case BLT_MATH_FUNC_VECTOR:
	proc = (GenericMathProc *) VectorFunc;
	break;
	
    default:
	Tcl_AppendResult(interp, "unknown function return type", (char *)NULL);
	return TCL_ERROR;
    }
    mathPtr = (MathFunction *) malloc(sizeof(MathFunction));
    assert(mathPtr);
    mathPtr->name = NULL;
    mathPtr->proc = proc;
    mathPtr->clientData = clientData;
    Tcl_SetHashValue(hPtr, (ClientData)mathPtr);
    return TCL_OK;
}

/*LINTLIBRARY*/
void
Blt_InstallIndexProc(interp, string, procPtr)
    Tcl_Interp *interp;
    char *string;
    Blt_VectorIndexProc *procPtr; /* Pointer to function to be called
				   * when the vector finds the named index.
				   * If NULL, this indicates to remove
				   * the index from the table.
				   */
{
    VectorInterpData *dataPtr;	/* Interpreter-specific data. */

    dataPtr = GetVectorInterpData(interp);
    InstallIndexProc(&(dataPtr->indexProcTable), string, procPtr);
}
