xref: /dports/x11-toolkits/blt/blt2.5/generic/bltVector.c

/*
 * 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 "bltVecInt.h"
#include <bltMath.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 */

#ifndef TCL_NAMESPACE_ONLY
#define TCL_NAMESPACE_ONLY TCL_GLOBAL_ONLY
#endif

#define DEF_ARRAY_SIZE		64
#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)


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


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

    VectorObject *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. */
} VectorClient;

static Tcl_CmdDeleteProc VectorInstDeleteProc;
static Tcl_InterpDeleteProc VectorInterpDeleteProc;

#if (TCL_MAJOR_VERSION == 7)
static Tcl_CmdProc VectorCmd;
#endif

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

static VectorObject *
FindVectorInNamespace(dataPtr, nsPtr, vecName)
    VectorInterpData *dataPtr;	/* Interpreter-specific data. */
    Tcl_Namespace *nsPtr;
    CONST char *vecName;
{
    Tcl_DString dString;
    CONST char *name;
    Blt_HashEntry *hPtr;

    name = Blt_GetQualifiedName(nsPtr, vecName, &dString);
    hPtr = Blt_FindHashEntry(&(dataPtr->vectorTable), name);
    Tcl_DStringFree(&dString);
    if (hPtr != NULL) {
	return (VectorObject *)Blt_GetHashValue(hPtr);
    }
    return NULL;
}

/*
 * ----------------------------------------------------------------------
 *
 * 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 VectorObject *
GetVectorObject(dataPtr, name, flags)
    VectorInterpData *dataPtr;	/* Interpreter-specific data. */
    CONST char *name;
    int flags;
{
    CONST char *vecName;
    Tcl_Namespace *nsPtr;
    VectorObject *vPtr;

    nsPtr = NULL;
    vecName = name;
    if (Blt_ParseQualifiedName(dataPtr->interp, name, &nsPtr, &vecName)
	!= TCL_OK) {
	return NULL;		/* Can't find namespace. */
    }
    vPtr = NULL;
    if (nsPtr != NULL) {
	vPtr = FindVectorInNamespace(dataPtr, nsPtr, vecName);
    } else {
	if (flags & NS_SEARCH_CURRENT) {
	    nsPtr = Tcl_GetCurrentNamespace(dataPtr->interp);
	    vPtr = FindVectorInNamespace(dataPtr, nsPtr, vecName);
	}
	if ((vPtr == NULL) && (flags & NS_SEARCH_GLOBAL)) {
	    nsPtr = Tcl_GetGlobalNamespace(dataPtr->interp);
	    vPtr = FindVectorInNamespace(dataPtr, nsPtr, vecName);
	}
    }
    return vPtr;
}

void
Blt_VectorUpdateRange(vPtr)
    VectorObject *vPtr;
{
    double min, max;
    register int i;

    min = DBL_MAX, max = -DBL_MAX;
    for (i = 0; i < vPtr->length; i++) {
	if (FINITE(vPtr->valueArr[i])) {
	    min = max = vPtr->valueArr[i];
	    break;
	}
    }
    for (/* empty */; i < vPtr->length; i++) {
	if (FINITE(vPtr->valueArr[i])) {
	    if (min > vPtr->valueArr[i]) {
		min = vPtr->valueArr[i];
	    } else if (max < vPtr->valueArr[i]) {
		max = vPtr->valueArr[i];
	    }
	}
    }
    vPtr->min = min;
    vPtr->max = max;
    vPtr->notifyFlags &= ~UPDATE_RANGE;
}

static int
GetIntEnd(interp, string, iPtr, endVal)
    Tcl_Interp *interp;
    char *string;
    int *iPtr;
    int endVal;
{
    char *cp = string;
    int add = 0;

    if (strncmp("end", cp, 3) == 0) {
        if (*cp == 0) {
            *iPtr = endVal;
            return TCL_OK;
        }
        add = endVal;
        cp += 3;
    }
    if (Tcl_GetInt(interp, cp, iPtr) != TCL_OK) {
        long l;
        Tcl_ResetResult(interp);
        if (Tcl_ExprLong(interp, cp, &l) != TCL_OK) {
            return TCL_ERROR;
        }
        *iPtr = (int)l;
    }
    *iPtr += add;
    return TCL_OK;
}

/*
 * ----------------------------------------------------------------------
 *
 * Blt_VectorGetIndex --
 *
 *	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.
 *
 * ----------------------------------------------------------------------
 */
int
Blt_VectorGetIndex(interp, vPtr, string, indexPtr, flags, procPtrPtr)
    Tcl_Interp *interp;
    VectorObject *vPtr;
    CONST char *string;
    int *indexPtr;
    int flags;
    Blt_VectorIndexProc **procPtrPtr;
{
    char c;
    int value = -1, value2 = -1, sz, result = TCL_OK;
    char *comma, *zBuf;
    char zStatic[201];

    /* Need a static copy of index. */
    sz = strlen(string);
    if (sz>=200) {
        zBuf = Blt_Malloc(sz+1);
        strcpy(zBuf, string);
        string = zBuf;
    } else {
        strcpy(zStatic, string);
        string = zStatic;
    }

    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);
	    }
	    result = TCL_ERROR;
	    goto cleanup;
	}
	*indexPtr = vPtr->length - 1;
	goto cleanup;
    } else if ((c == '+') && (strcmp(string, "++end") == 0)) {
	*indexPtr = vPtr->length;
	goto cleanup;
    }
    if (procPtrPtr != NULL) {
	Blt_HashEntry *hPtr;

	hPtr = Blt_FindHashEntry(&(vPtr->dataPtr->indexProcTable), string);
	if (hPtr != NULL) {
	    *indexPtr = SPECIAL_INDEX;
	    *procPtrPtr = (Blt_VectorIndexProc *) Blt_GetHashValue(hPtr);
	    goto cleanup;
	}
    }
    if ((comma=strchr(string, ','))) {
        char *ccp;
        *comma = 0;
        ccp = (char*)comma+1;
        if ((GetIntEnd(interp, ccp, &value2, vPtr->numcols-1) == TCL_OK) &&
            (GetIntEnd(interp, (char *)string, &value, vPtr->numcols-1) ==
             TCL_OK)) {
                if (value2<0 || value<0) {
                    if (flags & INDEX_VAR_TRACE) {
                        *indexPtr = SPECIAL_INDEX;
                        if (procPtrPtr != NULL) {
                            *procPtrPtr = NULL;
                        }
                        goto cleanup;
                    } else {
                        Tcl_AppendResult(interp, "negative index not allowed", 0);
                        result = TCL_ERROR;
                        goto cleanup;
                    }
                }
                if (value2>=vPtr->numcols) {
                    Tcl_AppendResult(interp, "col index is > numcols", 0);
                    result = TCL_ERROR;
                    goto cleanup;
                }
                value = (value*vPtr->numcols)+value2;
                *comma = ',';
        } else {
            *comma = ',';
            result = TCL_ERROR;
            goto cleanup;
        }

    } else if (Tcl_GetInt(interp, (char *)string, &value) != TCL_OK) {
	long int lvalue;
	/*
	 * Unlike Tcl_GetInt, Tcl_ExprLong needs a valid interpreter,
	 * but the interp passed in may be NULL.  So we have to use
	 * vPtr->interp and then reset the result.
	 */
	if (Tcl_ExprLong(vPtr->interp, (char *)string, &lvalue) != TCL_OK) {
	    Tcl_ResetResult(vPtr->interp);
	    if (interp != NULL) {
		Tcl_AppendResult(interp, "bad index \"", string, "\"",
				 (char *)NULL);
	    }
             result = TCL_ERROR;
             goto cleanup;
         }
	value = lvalue;
    }
    /*
     * 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);
	}
         result = TCL_ERROR;
         goto cleanup;
     }
    *indexPtr = (int)value;
cleanup:
    if (string != zStatic) {
        Blt_Free( (void *)string );
    }
    return result;
}

/*
 * ----------------------------------------------------------------------
 *
 * Blt_VectorGetIndexRange --
 *
 *	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.
 *
 * ----------------------------------------------------------------------
 */
int
Blt_VectorGetIndexRange(interp, vPtr, string, flags, procPtrPtr)
    Tcl_Interp *interp;
    VectorObject *vPtr;
    CONST char *string;
    int flags;
    Blt_VectorIndexProc **procPtrPtr;
{
    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 = Blt_VectorGetIndex(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 (Blt_VectorGetIndex(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 (Blt_VectorGetIndex(interp, vPtr, string, &ielem, flags,
		       procPtrPtr) != TCL_OK) {
	    return TCL_ERROR;
	}
	vPtr->last = vPtr->first = ielem;
    }
    return TCL_OK;
}

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

    p = (char *)start;
    /* Find the end of 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;
	}
	*p = '\0';
	result = Blt_VectorGetIndexRange(interp, vPtr, start,
		(INDEX_COLON | INDEX_CHECK), (Blt_VectorIndexProc **) NULL);
	*p = ')';
	if (result != TCL_OK) {
	    return NULL;
	}
	p++;
    }
    if (endPtr != NULL) {
      *endPtr = p;
    }
    return vPtr;
}


/*
 * ----------------------------------------------------------------------
 *
 * Blt_VectorNotifyClients --
 *
 *	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.
 *
 * ----------------------------------------------------------------------
 */
void
Blt_VectorNotifyClients(clientData)
    ClientData clientData;
{
    VectorObject *vPtr = clientData;
    Blt_ChainLink *linkPtr;
    VectorClient *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);

    for (linkPtr = Blt_ChainFirstLink(vPtr->chainPtr); linkPtr != NULL;
	linkPtr = Blt_ChainNextLink(linkPtr)) {
	clientPtr = 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 = Blt_ChainGetValue(linkPtr);
	    clientPtr->serverPtr = NULL;
	}
    }
    if (vPtr->callback) {
        Tcl_EvalObjEx( vPtr->interp, vPtr->callback, TCL_GLOBAL_ONLY);
    }
}

/*
 * ----------------------------------------------------------------------
 *
 * Blt_VectorUpdateClients --
 *
 *	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.
 *
 * ----------------------------------------------------------------------
 */
void
Blt_VectorUpdateClients(vPtr)
    VectorObject *vPtr;
{
    vPtr->dirty++;
    vPtr->max = vPtr->min = bltNaN;
    if (vPtr->notifyFlags & NOTIFY_NEVER) {
	return;
    }
    vPtr->notifyFlags |= NOTIFY_UPDATED;
    if (vPtr->notifyFlags & NOTIFY_ALWAYS) {
	Blt_VectorNotifyClients(vPtr);
	return;
    }
    if (!(vPtr->notifyFlags & NOTIFY_PENDING)) {
	vPtr->notifyFlags |= NOTIFY_PENDING;
	Tcl_DoWhenIdle(Blt_VectorNotifyClients, vPtr);
    }
}

/*
 * ----------------------------------------------------------------------
 *
 * Blt_VectorFlushCache --
 *
 *	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.
 *
 * ----------------------------------------------------------------------
 */
void
Blt_VectorFlushCache(vPtr)
    VectorObject *vPtr;
{
    Tcl_CallFrame *framePtr;
    Tcl_Interp *interp = vPtr->interp;

    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, Blt_VectorVarTrace, vPtr);

    if (vPtr->numcols>1) {
        Tcl_Interp *i = vPtr->interp;
        Tcl_Obj *o = Tcl_NewListObj(0,0);
        /* Preserve non-numeric datat that Tktable stores. */

        Tcl_ListObjAppendElement(i, o, Tcl_NewStringObj("::array",-1));
        Tcl_ListObjAppendElement(i, o, Tcl_NewStringObj("unset",-1));
        Tcl_ListObjAppendElement(i, o, Tcl_NewStringObj(vPtr->arrayName,-1));
        Tcl_ListObjAppendElement(i, o, Tcl_NewStringObj("[0-9]*,[0-9]*",-1));
        Tcl_IncrRefCount(o);
        if (Tcl_EvalObjEx(i, o, 0) != TCL_OK) {
            /* printf("FAIL: %s\n", Tcl_GetStringResult(interp)); */
        }
        Tcl_DecrRefCount(o);
    } else {
        /* Clear all the element entries from the entire array */
        Tcl_UnsetVar2(interp, vPtr->arrayName, (char *)NULL, vPtr->varFlags);

        /* 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, Blt_VectorVarTrace, vPtr);

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

/*
 * ----------------------------------------------------------------------
 *
 * Blt_VectorLookupName --
 *
 *	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.
 *
 * ----------------------------------------------------------------------
 */
int
Blt_VectorLookupName(dataPtr, vecName, vPtrPtr)
    VectorInterpData *dataPtr;	/* Interpreter-specific data. */
    char *vecName;
    VectorObject **vPtrPtr;
{
    VectorObject *vPtr;
    char *endPtr;

    vPtr = Blt_VectorParseElement(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)
    VectorObject *vPtr;		/* Vector associated with the Tcl command. */
{
    Tcl_Interp *interp = vPtr->interp;
    char *qualName;		/* Name of Tcl command. */
    Tcl_CmdInfo cmdInfo;
    Tcl_DString dString;

    Tcl_DStringInit(&dString);
    qualName = Blt_GetQualifiedName(
	Blt_GetCommandNamespace(interp, vPtr->cmdToken),
	Tcl_GetCommandName(interp, vPtr->cmdToken), &dString);
    if (Tcl_GetCommandInfo(interp, qualName, &cmdInfo)) {
	cmdInfo.deleteProc = NULL;	/* Disable the callback before
					 * deleting the Tcl command.*/
	Tcl_SetCommandInfo(interp, qualName, &cmdInfo);
	Tcl_DeleteCommandFromToken(interp, vPtr->cmdToken);
    }
    Tcl_DStringFree(&dString);
    vPtr->cmdToken = 0;
}

/*
 * ----------------------------------------------------------------------
 *
 * UnmapVariable --
 *
 *	Destroys the trace on the current Tcl variable designated
 *	to access the vector.
 *
 * Results:
 *	None.
 *
 * ----------------------------------------------------------------------
 */
static void
UnmapVariable(vPtr)
    VectorObject *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), Blt_VectorVarTrace, 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) {
	Blt_Free(vPtr->arrayName);
	vPtr->arrayName = NULL;
    }
    vPtr->varNsPtr = NULL;
}

/*
 * ----------------------------------------------------------------------
 *
 * Blt_VectorMapVariable --
 *
 *	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.
 *
 * ----------------------------------------------------------------------
 */
int
Blt_VectorMapVariable(interp, vPtr, name)
    Tcl_Interp *interp;
    VectorObject *vPtr;
    CONST char *name;
{
    Tcl_Namespace *nsPtr;
    Tcl_CallFrame *framePtr;
    CONST char *varName;
    CONST char *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;
    }
    /* We need to use fully qualified names. */
    varName = name;
    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, (char *)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, (char *)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_GetVariableNamespace(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, (char *)varName, (char *)NULL,
		(TRACE_ALL | vPtr->varFlags), Blt_VectorVarTrace, vPtr);
    }
    if ((nsPtr != NULL) && (framePtr != NULL)) {
	Blt_LeaveNamespace(interp, framePtr);	/* Go back to current */
    }
    vPtr->arrayName = Blt_Strdup(varName);
    return (result == NULL) ? TCL_ERROR : TCL_OK;
}

/*
 * ----------------------------------------------------------------------
 *
 * Blt_VectorChangeLength --
 *
 *	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.
 *
 * ----------------------------------------------------------------------
 */

int
Blt_VectorChangeLength(vPtr, length)
    VectorObject *vPtr;
    int length;
{
    int newSize;		/* Size of array in elements */
    double *newArr;
    Tcl_FreeProc *freeProc;
    VectorInterpData *dataPtr = vPtr->dataPtr;


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

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

         if (vPtr->numcols>1 && length%vPtr->numcols) {
            length += (vPtr->numcols-(length%vPtr->numcols));
        }
        if (dataPtr->bltMaxSize>0 && length>dataPtr->bltMaxSize) {
            Tcl_AppendResult(vPtr->interp, "vector size too large",0);
            return TCL_ERROR;
        }
        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 = Blt_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) {
		Blt_Free(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;
}

/*
 * -----------------------------------------------------------------------
 *
 * 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_VectorReset(vPtr, valueArr, length, size, freeProc)
    VectorObject *vPtr;
    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. */
{
    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 = Blt_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) {
		Blt_Free(vPtr->valueArr);
	    } else {
		(*freeProc) ((char *)vPtr->valueArr);
	    }
	}
	vPtr->freeProc = freeProc;
	vPtr->valueArr = valueArr;
	vPtr->size = size;
    }

    vPtr->length = length;
    if (vPtr->flush) {
	Blt_VectorFlushCache(vPtr);
    }
    Blt_VectorUpdateClients(vPtr);
    return TCL_OK;
}

VectorObject *
Blt_VectorNew(dataPtr)
    VectorInterpData *dataPtr;	/* Interpreter-specific data. */
{
    VectorObject *vPtr;

    vPtr = Blt_Calloc(1, sizeof(VectorObject));
    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;
    vPtr->numcols = 1;
    vPtr->min = vPtr->max = bltNaN;
    return vPtr;
}

/*
 * ----------------------------------------------------------------------
 *
 * Blt_VectorFree --
 *
 *	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:
 *
 * ----------------------------------------------------------------------
 */
void
Blt_VectorFree(vPtr)
    VectorObject *vPtr;
{
    Blt_ChainLink *linkPtr;
    VectorClient *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(Blt_VectorNotifyClients, vPtr);
    }
    vPtr->notifyFlags |= NOTIFY_DESTROYED;
    Blt_VectorNotifyClients(vPtr);

    for (linkPtr = Blt_ChainFirstLink(vPtr->chainPtr); linkPtr != NULL;
	linkPtr = Blt_ChainNextLink(linkPtr)) {
	clientPtr = Blt_ChainGetValue(linkPtr);
	Blt_Free(clientPtr);
    }
    Blt_ChainDestroy(vPtr->chainPtr);
    if ((vPtr->valueArr != NULL) && (vPtr->freeProc != TCL_STATIC)) {
	if (vPtr->freeProc == TCL_DYNAMIC) {
	    Blt_Free(vPtr->valueArr);
	} else {
	    (*vPtr->freeProc) ((char *)vPtr->valueArr);
	}
    }
    if (vPtr->hashPtr != NULL) {
	Blt_DeleteHashEntry(&(vPtr->dataPtr->vectorTable), vPtr->hashPtr);
    }
#ifdef NAMESPACE_DELETE_NOTIFY
    if (vPtr->nsPtr != NULL) {
	Blt_DestroyNsDeleteNotify(vPtr->interp, vPtr->nsPtr, vPtr);
    }
#endif /* NAMESPACE_DELETE_NOTIFY */
    Blt_Free(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;
{
    VectorObject *vPtr = clientData;

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

/*
 * ----------------------------------------------------------------------
 *
 * Blt_VectorCreate --
 *
 *	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.
 *
 * ---------------------------------------------------------------------- */
VectorObject *
Blt_VectorCreate(dataPtr, vecName, cmdName, varName, newPtr)
    VectorInterpData *dataPtr;	/* Interpreter-specific data. */
    CONST char *vecName;	/* Namespace-qualified name of the vector */
    CONST char *cmdName;	/* Name of the Tcl command mapped to
				 * the vector */
    CONST char *varName;	/* Name of the Tcl array mapped to the
				 * vector */
    int *newPtr;
{
    Tcl_DString dString;
    VectorObject *vPtr;
    int isNew;
    CONST char *name;
    char *qualName;
    Tcl_Namespace *nsPtr;
    Blt_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)) {
	char string[200];

	do {	/* Generate a unique vector name. */
	    sprintf(string, "vector%d", dataPtr->nextId++);
	    qualName = Blt_GetQualifiedName(nsPtr, string, &dString);
	    hPtr = Blt_FindHashEntry(&(dataPtr->vectorTable), qualName);
	} while (hPtr != NULL);
    } else {
	register CONST 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 = Blt_VectorParseElement((Tcl_Interp *)NULL, dataPtr, qualName,
		(char **)NULL, NS_SEARCH_CURRENT);
    }
    if (vPtr == NULL) {
	hPtr = Blt_CreateHashEntry(&(dataPtr->vectorTable), qualName, &isNew);
	vPtr = Blt_VectorNew(dataPtr);
	vPtr->hashPtr = hPtr;
	vPtr->nsPtr = nsPtr;

	vPtr->name = Blt_GetHashKey(&(dataPtr->vectorTable), hPtr);
#ifdef NAMESPACE_DELETE_NOTIFY
	Blt_CreateNsDeleteNotify(interp, nsPtr, vPtr, VectorInstDeleteProc);
#endif /* NAMESPACE_DELETE_NOTIFY */
	Blt_SetHashValue(hPtr, vPtr);
    }
    if (cmdName != NULL && cmdName[0]) {
	Tcl_CmdInfo cmdInfo;

	if ((cmdName == vecName) ||
	    ((name[0] == '#') && (strcmp(name, "#auto") == 0))) {
	    cmdName = qualName;
	}
	if (Tcl_GetCommandInfo(interp, (char *)cmdName, &cmdInfo)) {
#if TCL_MAJOR_VERSION > 7
	    if (vPtr != cmdInfo.objClientData) {
#else
	    if (vPtr != cmdInfo.clientData) {
#endif
		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 && cmdName[0]) {
	DeleteCommand(vPtr);	/* Command already exists, delete old first */
    }
    if (cmdName != NULL) {
#if (TCL_MAJOR_VERSION == 7)
	vPtr->cmdToken = Blt_CreateCommand(interp, cmdName, Blt_VectorInstCmd,
		vPtr, VectorInstDeleteProc);
#else
	Tcl_DString dString2;

	Tcl_DStringInit(&dString2);
	if (cmdName != qualName) {
	    if (Blt_ParseQualifiedName(interp, cmdName, &nsPtr, &name)
		!= TCL_OK) {
		Tcl_AppendResult(interp, "can't find namespace in \"", cmdName,
				 "\"", (char *)NULL);
		goto error;
	    }
	    if (nsPtr == NULL) {
		nsPtr = Tcl_GetCurrentNamespace(interp);
	    }
	    cmdName = Blt_GetQualifiedName(nsPtr, name, &dString2);
	}
	vPtr->cmdToken = Tcl_CreateObjCommand(interp, (char *)cmdName,
		Blt_VectorInstCmd, vPtr, VectorInstDeleteProc);
	Tcl_DStringFree(&dString2);
#endif
    }
  checkVariable:
  if (varName != NULL&& varName[0]) {
	if ((varName[0] == '#') && (strcmp(varName, "#auto") == 0)) {
	    varName = qualName;
	}
         varName = qualName;
         if (Blt_VectorMapVariable(interp, vPtr, varName) != TCL_OK) {
	    goto error;
	}
    }

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

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


int
Blt_VectorDuplicate(destPtr, srcPtr)
    VectorObject *destPtr, *srcPtr;
{
    int nBytes;
    int length;

    if (destPtr == srcPtr) {
	/* Copying the same vector. */
    }
    length = srcPtr->last - srcPtr->first + 1;
    if (Blt_VectorChangeLength(destPtr, length) != TCL_OK) {
	return TCL_ERROR;
    }
    nBytes = length * sizeof(double);
    memcpy(destPtr->valueArr, srcPtr->valueArr + srcPtr->first, nBytes);
    destPtr->offset = srcPtr->offset;
    return TCL_OK;
}


/*
 *----------------------------------------------------------------------
 *
 * 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*/
#if (TCL_MAJOR_VERSION == 7)

static int
VectorNamesOp(clientData, interp, argc, argv)
    ClientData clientData;	/* Interpreter-specific data. */
    Tcl_Interp *interp;
    int argc;
    char **argv;
{
    VectorInterpData *dataPtr = clientData;
    Blt_HashEntry *hPtr;
    char *name;
    Blt_HashSearch cursor;

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

#else

static int
VectorNamesObjOp(clientData, interp, objc, objv)
ClientData clientData;	/* Interpreter-specific data. */
Tcl_Interp *interp;
int objc;
Tcl_Obj *CONST *objv;
{
    VectorInterpData *dataPtr = clientData;
    Blt_HashEntry *hPtr;
    char *name;
    Blt_HashSearch cursor;

    for (hPtr = Blt_FirstHashEntry(&(dataPtr->vectorTable), &cursor);
    hPtr != NULL; hPtr = Blt_NextHashEntry(&cursor)) {
        name = Blt_GetHashKey(&(dataPtr->vectorTable), hPtr);
        if ((objc == 2) || (Tcl_StringMatch(name, Tcl_GetString(objv[2])))) {
            Tcl_AppendElement(interp, name);
        }
    }
    return TCL_OK;
}

#endif

/*
 *----------------------------------------------------------------------
 *
 * 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 = clientData;
    VectorObject *vPtr;
    char *leftParen, *rightParen;
    int isNew, size, first, last;
    char *cmdName, *varName;
    int length;
    int inspectFlags, freeOnUnset, flush;
    char **nameArr;
    int count, numcols = 1;
    register int i;

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

    inspectFlags = TRUE;
    flush = dataPtr->bltFlushArray;
    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 (varName == NULL && dataPtr->bltNoVariable) {
        varName = "";
    }
    if (cmdName == NULL && dataPtr->bltNoCommand) {
        cmdName = "";
    }
    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, *comma;

	    *rightParen = '\0';
	    comma = strchr(leftParen + 1, ',');
	    colon = strchr(leftParen + 1, ':');
	    if (comma != NULL) {
	        int rows;
                *comma = '\0';
                result = Tcl_GetInt(interp, leftParen + 1, &rows);
		if ((*(comma + 1) != '\0') && (result == TCL_OK)) {
		    result = Tcl_GetInt(interp, comma + 1, &numcols);
		}
		size = rows*numcols;
                if (result != TCL_OK || rows<=0 || numcols<=0) {
                    Tcl_AppendResult(interp, "bad matrix vector \"",
			nameArr[i], "\"", (char *)NULL);
			result = TCL_ERROR;
	        }
            } else 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';
	}
	if (dataPtr->bltMaxSize>0 && size>dataPtr->bltMaxSize) {
             Tcl_AppendResult(interp, "vector size too large\"", nameArr[i], "\"",
                (char *)NULL);
                goto error;
	}
	/*
	 * By default, we create a Tcl command by the name of the vector.
	 */
	vPtr = Blt_VectorCreate(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 (first && first%vPtr->numcols) {
            first += (vPtr->numcols-(first%vPtr->numcols));
        }
	vPtr->numcols = numcols;
	if (size > 0) {
	    if (Blt_VectorChangeLength(vPtr, size) != TCL_OK) {
		goto error;
	    }
	}
	if (!isNew) {
	    if (vPtr->flush) {
		Blt_VectorFlushCache(vPtr);
	    }
	    Blt_VectorUpdateClients(vPtr);
	}
    }
    Blt_Free(nameArr);
    if (vPtr != NULL) {
	/* Return the name of the last vector created  */
	Tcl_SetResult(interp, vPtr->name, TCL_VOLATILE);
    }
    return TCL_OK;
  error:
    Blt_Free(nameArr);
    return TCL_ERROR;
}

static int
VectorObjCallOp(clientData, interp, objc, objv, proc)
ClientData clientData;
Tcl_Interp *interp;
int objc;
Tcl_Obj *CONST *objv;
Blt_Op proc;
{
    int i, result;
    const char **argv;
    argv = (const char **) ckalloc((unsigned)(objc + 1) * sizeof(char *));

    for (i = 0;  i < objc;  i++) {
        argv[i] = Tcl_GetString(objv[i]);
    }
    argv[objc] = 0;
    result = (*proc)(clientData, interp, objc, argv);
    ckfree((char*) argv);
    return result;
}

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

static int
VectorCreateObjOp(clientData, interp, objc, objv)
ClientData clientData;
Tcl_Interp *interp;
int objc;
Tcl_Obj *CONST *objv;
{
    return VectorObjCallOp(clientData, interp, objc, objv, VectorCreateOp);
}

/*
 *----------------------------------------------------------------------
 *
 * 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 = clientData;
    VectorObject *vPtr;
    register int i;

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

static int
VectorDestroyObjOp(clientData, interp, objc, objv)
ClientData clientData;
Tcl_Interp *interp;
int objc;
Tcl_Obj *CONST *objv;
{
    return VectorObjCallOp(clientData, interp, objc, objv, VectorDestroyOp);
}

#if (TCL_MAJOR_VERSION == 7)

static int
VectorOpOp(clientData, interp, argc, argv)
ClientData clientData;	/* Interpreter-specific data. */
Tcl_Interp *interp;
int argc;
char **argv;
{
    int i, result;
    const char **nargv;
    Blt_Vector *vecPtr;

    result = Blt_GetVector(interp, Tcl_GetString(argv[3]), &vecPtr);
    if (result != TCL_OK) {
        return result;
    }
    nargv = (const char **) ckalloc((unsigned)(argc) * sizeof(char *));

    nargv[0] = argv[3];
    nargv[1] = argv[2];
    for (i = 2;  i < (argc-2);  i++) {
        nargv[i] = argv[i+2];
    }
    nargv[argc-2] = 0;
    result = Blt_VectorInstCmd((ClientData)vecPtr, interp, argc-2, nargv);
    ckfree((char*) nargv);
    return result;
}

#else


/*
 * Set/get various options.  These include:
 *
 *    -oldcreate : compatibility mode of implicit 'create'.
 *    -flush     : flush array cells
 *    -watchunset: delete on var deletion.
 *    -maxsize   : max allocation.
 *
 * These are global settings to all interps.
 */

static int
VectorConfigureObjOp(clientData, interp, objc, objv)
ClientData clientData;
Tcl_Interp *interp;
int objc;
Tcl_Obj *CONST *objv;
{
    enum optionIndices {
            OPTION_FLUSH, OPTION_OLDCREATE, OPTION_WATCHUNSET, OPTION_MAXSIZE,
            OPTION_NOCOMMAND, OPTION_NOVARIABLE
    };
    static char *optionArr[] = {
        "-flush", "-oldcreate", "-watchunset", "-maxsize",
        "-nocommand", "-novariable", 0
    };
    int i;
    VectorInterpData *d = clientData;

    if (objc%2) {
        Tcl_WrongNumArgs(interp, 2, objv, "?-flush bool? ?-watchunset bool? ?-oldcreate bool?");
        return TCL_ERROR;
    }
    if (objc == 2) {
        Tcl_Obj * o = Tcl_NewListObj(0,0);
        Tcl_ListObjAppendElement(interp, o, Tcl_NewStringObj("-flush", -1));
        Tcl_ListObjAppendElement(interp, o, Tcl_NewBooleanObj(d->bltFlushArray));
        Tcl_ListObjAppendElement(interp, o, Tcl_NewStringObj("-watchunset", -1));
        Tcl_ListObjAppendElement(interp, o, Tcl_NewBooleanObj(d->bltFreeOnUnset));
        Tcl_ListObjAppendElement(interp, o, Tcl_NewStringObj("-oldcreate", -1));
        Tcl_ListObjAppendElement(interp, o, Tcl_NewBooleanObj(d->bltOldCreate));
        Tcl_ListObjAppendElement(interp, o, Tcl_NewStringObj("-nocommand", -1));
        Tcl_ListObjAppendElement(interp, o, Tcl_NewBooleanObj(d->bltNoCommand));
        Tcl_ListObjAppendElement(interp, o, Tcl_NewStringObj("-novariable", -1));
        Tcl_ListObjAppendElement(interp, o, Tcl_NewBooleanObj(d->bltNoVariable));
        Tcl_ListObjAppendElement(interp, o, Tcl_NewStringObj("-maxsize", -1));
        Tcl_ListObjAppendElement(interp, o, Tcl_NewIntObj(d->bltMaxSize));
        Tcl_SetObjResult(interp, o);
        return TCL_OK;
    }
    for (i=2; i<objc; i+=2) {
        int option, *ovar;
        if (Tcl_GetIndexFromObj(interp, objv[i], optionArr, "option",
            0, &option) != TCL_OK) {
                return TCL_OK;
        }

        switch (option) {
            case OPTION_FLUSH:      ovar=&d->bltFlushArray; break;
            case OPTION_OLDCREATE:  ovar=&d->bltOldCreate; break;
            case OPTION_WATCHUNSET: ovar=&d->bltFreeOnUnset; break;
            case OPTION_NOCOMMAND:  ovar=&d->bltNoCommand; break;
            case OPTION_NOVARIABLE: ovar=&d->bltNoVariable; break;
            case OPTION_MAXSIZE:
                if (Tcl_GetIntFromObj(interp, objv[i+1], &d->bltMaxSize) != TCL_OK) {
                    return TCL_ERROR;
                }
                return TCL_OK;
        }

        if (Tcl_GetBooleanFromObj(interp, objv[i+1], ovar) != TCL_OK) {
            return TCL_ERROR;
        }
    }
    return TCL_OK;
}

static int
VectorOpObjOp(clientData, interp, objc, objv)
    ClientData clientData;
    Tcl_Interp *interp;
    int objc;
    Tcl_Obj *CONST *objv;
{
    int i, j, o1 = 2, result;
    Tcl_Obj **nobjv;
    Blt_Vector *vecPtr;
    char *string;

    string = Tcl_GetString(objv[2]);
    if (!strncmp(string, "ma", 2)) {
        /* The "vector op matrix rowize VEC ?N?" command. */
        o1 = 3;
    }
    result = Blt_GetVector(interp, Tcl_GetString(objv[o1+1]), &vecPtr);
    if (result != TCL_OK) {
        return result;
    }
    nobjv = (Tcl_Obj **) ckalloc((unsigned)(objc) * sizeof(Tcl_Obj *));

    j = 0;
    nobjv[j++] = objv[o1+1];
    nobjv[j++] = objv[2];
    i = 4;
    if (o1 != 2) {
        nobjv[j++] = objv[3];
        i = 5;
    }
    for (;  i < objc;  j++, i++) {
        nobjv[j] = objv[i];
    }
    nobjv[j++] = 0;
    /* TODO: fix error messages in this call duplicating the arg. */
    result = Blt_VectorInstCmd((ClientData)vecPtr, interp, objc-2, nobjv);
    ckfree((char*) nobjv);
    return result;
}


#endif

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

static int
VectorExprObjOp(clientData, interp, objc, objv)
ClientData clientData;
Tcl_Interp *interp;
int objc;
Tcl_Obj *CONST *objv;
{
    return VectorObjCallOp(clientData, interp, objc, objv, VectorExprOp);
}

#if (TCL_MAJOR_VERSION == 7)

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

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_Op proc;

    /*
     * 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 doOp;
	    }
	}
	/*
	 * 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);
    }
  doOp:
    /* Do the usual vector operation lookup now. */
    proc = Blt_GetOp(interp, nCmdOps, vectorCmdOps, BLT_OP_ARG1, argc, argv,0);
    if (proc == NULL) {
	return TCL_ERROR;
    }
    return (*proc) (clientData, interp, argc, argv);
}

#else

static Blt_OpSpec vectorCmdOps[] =
{
    {"configure", 1, (Blt_Op)VectorConfigureObjOp, 2, 0, "?-flush bool? ?-watchunset bool? ?-oldcreate bool? ?-maxsize N? ?-nocommand bool? ?-novariable bool?",},
    {"create", 1, (Blt_Op)VectorCreateObjOp, 3, 0,
        "vecName ?vecName...? ?switches...?",},
    {"destroy", 1, (Blt_Op)VectorDestroyObjOp, 3, 0,
        "vecName ?vecName...?",},
    {"expr", 1, (Blt_Op)VectorExprObjOp, 3, 3, "expression",},
    {"names", 1, (Blt_Op)VectorNamesObjOp, 2, 3, "?pattern?",},
    {"op", 1, (Blt_Op)VectorOpObjOp, 4, 0, "cmd vecName ...",},
};

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

static int
VectorObjCmd(clientData, interp, objc, objv)
    ClientData clientData;	/* Interpreter-specific data. */
    Tcl_Interp *interp;
    int objc;
    Tcl_Obj *CONST *objv;
{
    Blt_Op proc;
    VectorInterpData *dataPtr = clientData;

    /*
    * Try to replicate the old vector command's behavior:
    */
    if (objc > 1 && dataPtr->bltOldCreate) {
        char c, *str;
        register int i;
        register Blt_OpSpec *specPtr;
        int result;
        int argc;
        char **argv;
        Tcl_Obj *listPtr;

        str = Tcl_GetString(objv[1]);
        c = str[0];
        for (specPtr = vectorCmdOps, i = 0; i < nCmdOps; i++, specPtr++) {
            if ((c == specPtr->name[0]) &&
            (strcmp(str, specPtr->name) == 0)) {
                goto doOp;
            }
        }
        /*
        * The first argument is not an operation, so assume that its
        * actually the name of a vector to be created
        */
        listPtr = Tcl_NewListObj(objc, objv);
        result = Tcl_SplitList( interp, Tcl_GetString(listPtr), &argc, &argv);
        if (result == TCL_OK) {
            result = VectorCreate2(clientData, interp, 1, argc, argv);
            ckfree((char*) argv);
        }
        Tcl_DecrRefCount(listPtr);
        return result;
    }
    doOp:
    /* Do the usual vector operation lookup now. */
    proc = Blt_GetOpFromObj(interp, nCmdOps, vectorCmdOps, BLT_OP_ARG1, objc, objv,0);
    if (proc == NULL) {
        return TCL_ERROR;
    }
    return (*proc) (clientData, interp, objc, objv);
}

#endif


/*
 * -----------------------------------------------------------------------
 *
 * 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 = clientData;
    Blt_HashEntry *hPtr;
    Blt_HashSearch cursor;
    VectorObject *vPtr;

    for (hPtr = Blt_FirstHashEntry(&(dataPtr->vectorTable), &cursor);
	 hPtr != NULL; hPtr = Blt_NextHashEntry(&cursor)) {
	vPtr = (VectorObject *)Blt_GetHashValue(hPtr);
	vPtr->hashPtr = NULL;
	Blt_VectorFree(vPtr);
    }
    Blt_DeleteHashTable(&(dataPtr->vectorTable));

    /* If any user-defined math functions were installed, remove them.  */
    Blt_VectorUninstallMathFunctions(&(dataPtr->mathProcTable));
    Blt_DeleteHashTable(&(dataPtr->mathProcTable));

    Blt_DeleteHashTable(&(dataPtr->indexProcTable));
    Tcl_DeleteAssocData(interp, VECTOR_THREAD_KEY);
    Blt_Free(dataPtr);
}

VectorInterpData *
Blt_VectorGetInterpData(interp)
    Tcl_Interp *interp;
{
    VectorInterpData *dataPtr;
    Tcl_InterpDeleteProc *proc;

    dataPtr = (VectorInterpData *)
	Tcl_GetAssocData(interp, VECTOR_THREAD_KEY, &proc);
    if (dataPtr == NULL) {
	dataPtr = Blt_Calloc(sizeof(VectorInterpData), 1);
	assert(dataPtr);
	dataPtr->interp = interp;
	dataPtr->nextId = 0;
	Tcl_SetAssocData(interp, VECTOR_THREAD_KEY, VectorInterpDeleteProc,
		 dataPtr);
	Blt_InitHashTable(&(dataPtr->vectorTable), BLT_STRING_KEYS);
	Blt_InitHashTable(&(dataPtr->mathProcTable), BLT_STRING_KEYS);
	Blt_InitHashTable(&(dataPtr->indexProcTable), BLT_STRING_KEYS);
	Blt_VectorInstallMathFunctions(&(dataPtr->mathProcTable));
	Blt_VectorInstallSpecialIndices(&(dataPtr->indexProcTable));
#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.
 *
 * ------------------------------------------------------------------------
 */

#if (TCL_MAJOR_VERSION == 7)

int
Blt_VectorInit(interp)
    Tcl_Interp *interp;
{
    VectorInterpData *dataPtr;	/* Interpreter-specific data. */
    static Blt_CmdSpec cmdSpec = {"vector", VectorCmd, };

    dataPtr = Blt_VectorGetInterpData(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 = dataPtr;
    if (Blt_InitCmd(interp, "blt", &cmdSpec) == NULL) {
	return TCL_ERROR;
    }
    return TCL_OK;
}

#else

int
Blt_VectorInit(interp)
Tcl_Interp *interp;
{
    VectorInterpData *dataPtr;	/* Interpreter-specific data. */
    static Blt_ObjCmdSpec cmdSpec = {"vector", VectorObjCmd, };

    dataPtr = Blt_VectorGetInterpData(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 = dataPtr;
    if (Blt_InitObjCmd(interp, "blt", &cmdSpec) == NULL) {
        return TCL_ERROR;
    }
    return TCL_OK;
}

#endif


/* 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. */
    VectorObject *vPtr;
    int isNew;
    char *nameCopy;

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

    nameCopy = Blt_Strdup(vecName);
    vPtr = Blt_VectorCreate(dataPtr, nameCopy, cmdName, varName, &isNew);
    Blt_Free(nameCopy);

    if (vPtr == NULL) {
	return TCL_ERROR;
    }
    if (initialSize > 0) {
	if (Blt_VectorChangeLength(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;
{
    VectorObject *vPtr = (VectorObject *)vecPtr;
    Blt_VectorFree(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. */
    VectorObject *vPtr;
    char *nameCopy;
    int result;

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

    if (result != TCL_OK) {
	return TCL_ERROR;
    }
    Blt_VectorFree(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 = Blt_VectorGetInterpData(interp);
    if (GetVectorObject(dataPtr, vecName, NS_SEARCH_BOTH) != NULL) {
	return TRUE;
    }
    return FALSE;
}

/*
 * ----------------------------------------------------------------------
 *
 * 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 Blt_VectorParseName routine will segfault when it tries to write
     * into the string.  Therefore make a writable copy and free it
     * when we're done.
     */
    nameCopy = Blt_Strdup(vecName);
    result = Blt_VectorExists2(interp, nameCopy);
    Blt_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. */
    VectorObject *vPtr;
    char *nameCopy;
    int result;

    dataPtr = Blt_VectorGetInterpData(interp);
    /*
     * If the vector name was passed via a read-only string (e.g. "x"),
     * the Blt_VectorParseName routine will segfault when it tries to write
     * into the string.  Therefore make a writable copy and free it
     * when we're done.
     */
    nameCopy = Blt_Strdup(name);
    result = Blt_VectorLookupName(dataPtr, nameCopy, &vPtr);
    Blt_Free(nameCopy);
    if (result != TCL_OK) {
	return TCL_ERROR;
    }
    Blt_VectorUpdateRange(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. */
{
    VectorObject *vPtr = (VectorObject *)vecPtr;

    if (size < 0) {
	Tcl_AppendResult(vPtr->interp, "bad array size", (char *)NULL);
	return TCL_ERROR;
    }
    return Blt_VectorReset(vPtr, valueArr, length, size, freeProc);
}

/*
 * -----------------------------------------------------------------------
 *
 * 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;
{
    VectorObject *vPtr = (VectorObject *)vecPtr;

    if (Blt_VectorChangeLength(vPtr, length) != TCL_OK) {
	Tcl_AppendResult(vPtr->interp, "can't resize vector \"", vPtr->name,
	    "\"", (char *)NULL);
	return TCL_ERROR;
    }
    if (vPtr->flush) {
	Blt_VectorFlushCache(vPtr);
    }
    Blt_VectorUpdateClients(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. */
    VectorObject *vPtr;
    VectorClient *clientPtr;
    Blt_VectorId clientId;
    int result;
    char *nameCopy;

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

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

    /* Add the new client to the server's list of clients */
    clientPtr->linkPtr = Blt_ChainAppend(vPtr->chainPtr, 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 */
{
    VectorClient *clientPtr = (VectorClient *)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 */
{
    VectorClient *clientPtr = (VectorClient *)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);
    }
    Blt_Free(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 */
{
    VectorClient *clientPtr = (VectorClient *)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. */
{
    VectorObject *vPtr = (VectorObject *)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 */
{
    VectorClient *clientPtr = (VectorClient *)clientId;

    if ((clientPtr == NULL) || (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;
{
    VectorClient *clientPtr = (VectorClient *)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;
    }
    Blt_VectorUpdateRange(clientPtr->serverPtr);
    *vecPtrPtr = (Blt_Vector *) clientPtr->serverPtr;
    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. */
    Blt_HashEntry *hPtr;
    int isNew;

    dataPtr = Blt_VectorGetInterpData(interp);
    hPtr = Blt_CreateHashEntry(&(dataPtr->indexProcTable), string, &isNew);
    if (procPtr == NULL) {
	Blt_DeleteHashEntry(&(dataPtr->indexProcTable), hPtr);
    } else {
	Blt_SetHashValue(hPtr, procPtr);
    }
}