tclvar.c

linux系统下的音频通信

 *	returned object is _not_ incremented to reflect the returned
 *	reference; if you want to keep a reference to the object you must
 *	increment its ref count yourself. This procedure will not create new
 *	array variables, but only sets elements of those arrays recognized
 *	at compile time. However, if the entry doesn't exist then a new
 *	variable is created.
 *
 *----------------------------------------------------------------------
 */

Tcl_Obj *
TclSetElementOfIndexedArray(interp, localIndex, elemPtr, newValuePtr,
        leaveErrorMsg)
    Tcl_Interp *interp;		/* Command interpreter in which the array is
				 * to be found. */
    int localIndex;		/* Index of array variable in procedure's
				 * array of local variables. */
    Tcl_Obj *elemPtr;		/* Points to an object holding the name of
				 * an element to set in the array. */
    Tcl_Obj *newValuePtr;	/* New value for variable. */
    int leaveErrorMsg;		/* 1 if to leave an error message in
				 * the interpreter's result on an error.
				 * Otherwise no error message is left. */
{
    Interp *iPtr = (Interp *) interp;
    CallFrame *varFramePtr = iPtr->varFramePtr;
				/* Points to the procedure call frame whose
				 * variables are currently in use. Same as
				 * the current procedure's frame, if any,
				 * unless an "uplevel" is executing. */
    Var *compiledLocals = varFramePtr->compiledLocals;
    Var *arrayPtr;		/* Points to the array's in-frame Var
				 * structure. */
    char *arrayName;		/* Name of the local array. */
    char *elem;
    Tcl_HashEntry *hPtr;
    Var *varPtr = NULL;		/* Points to the element's Var structure
				 * that we return. */
    Tcl_Obj *resultPtr = NULL;
    Tcl_Obj *oldValuePtr;
    int new;
    
#ifdef TCL_COMPILE_DEBUG
    Proc *procPtr = varFramePtr->procPtr;
    int localCt = procPtr->numCompiledLocals;

    if (compiledLocals == NULL) {
	fprintf(stderr, "\nTclSetElementOfIndexedArray: can't set element of local %i in frame 0x%x, no compiled locals\n",
		    localIndex, (unsigned int) varFramePtr);
	panic("TclSetIndexedScalar: no compiled locals in frame 0x%x",
	      (unsigned int) varFramePtr);
    }
    if ((localIndex < 0) || (localIndex >= localCt)) {
	fprintf(stderr, "\nTclSetIndexedScalar: can't set elememt of local %i in frame 0x%x with %i locals\n",
		    localIndex, (unsigned int) varFramePtr, localCt);
	panic("TclSetElementOfIndexedArray: bad local index %i in frame 0x%x",
	      localIndex, (unsigned int) varFramePtr);
    }
#endif /* TCL_COMPILE_DEBUG */

    /*
     * THIS FAILS IF THE ELEMENT NAME OBJECT'S STRING REP HAS A NULL BYTE.
     */
    
    elem = Tcl_GetStringFromObj(elemPtr, (int *) NULL);
    arrayPtr = &(compiledLocals[localIndex]);
    arrayName = arrayPtr->name;

    /*
     * If arrayPtr is a link variable, we have a reference to some variable
     * that was created through an "upvar" or "global" command, or we have a
     * reference to a variable in an enclosing namespace. Traverse through
     * any links until we find the referenced variable.
     */
	
    while (TclIsVarLink(arrayPtr)) {
	arrayPtr = arrayPtr->value.linkPtr;
    }

    /*
     * Make sure we're dealing with an array.
     */

    if (TclIsVarUndefined(arrayPtr) && !TclIsVarArrayElement(arrayPtr)) {
	TclSetVarArray(arrayPtr);
	arrayPtr->value.tablePtr =
	        (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
	Tcl_InitHashTable(arrayPtr->value.tablePtr, TCL_STRING_KEYS);
	TclClearVarUndefined(arrayPtr);
    } else if (!TclIsVarArray(arrayPtr)) {
	if (leaveErrorMsg) {
	    VarErrMsg(interp, arrayName, elem, "set", needArray);
	}
	goto errorReturn;
    } 

    /*
     * Look up the element.
     */

    hPtr = Tcl_CreateHashEntry(arrayPtr->value.tablePtr, elem, &new);
    if (new) {
	if (arrayPtr->searchPtr != NULL) {
	    DeleteSearches(arrayPtr);
	}
	varPtr = NewVar();
	Tcl_SetHashValue(hPtr, varPtr);
	varPtr->hPtr = hPtr;
        varPtr->nsPtr = varFramePtr->nsPtr;
	TclSetVarArrayElement(varPtr);
    }
    varPtr = (Var *) Tcl_GetHashValue(hPtr);

    /*
     * It's an error to try to set an array variable itself.
     */

    if (TclIsVarArray(varPtr)) {
	if (leaveErrorMsg) {
	    VarErrMsg(interp, arrayName, elem, "set", isArray);
	}
	goto errorReturn;
    }

    /*
     * Set the variable's new value and discard the old one. We don't
     * append with this "set" procedure so the old value isn't needed.
     */

    oldValuePtr = varPtr->value.objPtr;
    if (newValuePtr != oldValuePtr) {	     /* set new value */
	varPtr->value.objPtr = newValuePtr;
	Tcl_IncrRefCount(newValuePtr);       /* var is another ref to obj */
	if (oldValuePtr != NULL) {
	    TclDecrRefCount(oldValuePtr);    /* discard old value */
	}
    }
    TclSetVarScalar(varPtr);
    TclClearVarUndefined(varPtr);

    /*
     * Invoke any write traces for the element variable.
     */

    if ((varPtr->tracePtr != NULL)
	    || ((arrayPtr != NULL) && (arrayPtr->tracePtr != NULL))) {
	char *msg = CallTraces(iPtr, arrayPtr, varPtr, arrayName, elem,
		TCL_TRACE_WRITES);
	if (msg != NULL) {
	    if (leaveErrorMsg) {
		VarErrMsg(interp, arrayName, elem, "set", msg);
	    }
	    goto errorReturn;
	}
    }

    /*
     * Return the element's value unless it was changed in some gross way by
     * a trace (e.g. it was unset and then recreated as an array). If it was
     * changed is a gross way, just return an empty string object.
     */

    if (TclIsVarScalar(varPtr) && !TclIsVarUndefined(varPtr)) {
	return varPtr->value.objPtr;
    }
    
    resultPtr = Tcl_NewObj();

    /*
     * An error. If the variable doesn't exist anymore and no-one's using
     * it, then free up the relevant structures and hash table entries.
     */

    errorReturn:
    if (varPtr != NULL) {
	if (TclIsVarUndefined(varPtr)) {
	    CleanupVar(varPtr, NULL); /* note: array isn't in hashtable */
	}
    }
    return resultPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * TclIncrVar2 --
 *
 *	Given a two-part variable name, which may refer either to a scalar
 *	variable or an element of an array, increment the Tcl object value
 *	of the variable by a specified amount.
 *
 * Results:
 *	Returns a pointer to the Tcl_Obj holding the new value of the
 *	variable. If the specified variable doesn't exist, or there is a
 *	clash in array usage, or an error occurs while executing variable
 *	traces, then NULL is returned and a message will be left in
 *	the interpreter's result.
 *
 * Side effects:
 *	The value of the given variable is incremented by the specified
 *	amount. If either the array or the entry didn't exist then a new
 *	variable is created. The ref count for the returned object is _not_
 *	incremented to reflect the returned reference; if you want to keep a
 *	reference to the object you must increment its ref count yourself.
 *
 *----------------------------------------------------------------------
 */

Tcl_Obj *
TclIncrVar2(interp, part1Ptr, part2Ptr, incrAmount, part1NotParsed)
    Tcl_Interp *interp;		/* Command interpreter in which variable is
				 * to be found. */
    Tcl_Obj *part1Ptr;		/* Points to an object holding the name of
				 * an array (if part2 is non-NULL) or the
				 * name of a variable. */
    Tcl_Obj *part2Ptr;		/* If non-null, points to an object holding
				 * the name of an element in the array
				 * part1Ptr. */
    long incrAmount;		/* Amount to be added to variable. */
    int part1NotParsed;		/* 1 if part1 hasn't yet been parsed into
				 * an array name and index (if any). */
{
    register Tcl_Obj *varValuePtr;
    Tcl_Obj *resultPtr;
    int createdNewObj;		/* Set 1 if var's value object is shared
				 * so we must increment a copy (i.e. copy
				 * on write). */
    long i;
    int flags, result;

    flags = TCL_LEAVE_ERR_MSG;
    if (part1NotParsed) {
	flags |= TCL_PARSE_PART1;
    }
    
    varValuePtr = Tcl_ObjGetVar2(interp, part1Ptr, part2Ptr, flags);
    if (varValuePtr == NULL) {
	Tcl_AddObjErrorInfo(interp,
		"\n    (reading value of variable to increment)", -1);
	return NULL;
    }

    /*
     * Increment the variable's value. If the object is unshared we can
     * modify it directly, otherwise we must create a new copy to modify:
     * this is "copy on write". Then free the variable's old string
     * representation, if any, since it will no longer be valid.
     */

    createdNewObj = 0;
    if (Tcl_IsShared(varValuePtr)) {
	varValuePtr = Tcl_DuplicateObj(varValuePtr);
	createdNewObj = 1;
    }
    result = Tcl_GetLongFromObj(interp, varValuePtr, &i);
    if (result != TCL_OK) {
	if (createdNewObj) {
	    Tcl_DecrRefCount(varValuePtr); /* free unneeded copy */
	}
	return NULL;
    }
    Tcl_SetLongObj(varValuePtr, (i + incrAmount));

    /*
     * Store the variable's new value and run any write traces.
     */
    
    resultPtr = Tcl_ObjSetVar2(interp, part1Ptr, part2Ptr, varValuePtr,
	    flags);
    if (resultPtr == NULL) {
	return NULL;
    }
    return resultPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * TclIncrIndexedScalar --
 *
 *	Increments the Tcl object value of a local scalar variable in the
 *	active procedure, given its compile-time allocated index in the
 *	procedure's array of local variables.
 *
 * Results:
 *	Returns a pointer to the Tcl_Obj holding the new value of the
 *	variable given by localIndex. If the specified variable doesn't
 *	exist, or there is a clash in array usage, or an error occurs while
 *	executing variable traces, then NULL is returned and a message will
 *	be left in the interpreter's result. 
 *
 * Side effects:
 *	The value of the given variable is incremented by the specified
 *	amount. The ref count for the returned object is _not_ incremented
 *	to reflect the returned reference; if you want to keep a reference
 *	to the object you must increment its ref count yourself.
 *
 *----------------------------------------------------------------------
 */

Tcl_Obj *
TclIncrIndexedScalar(interp, localIndex, incrAmount)
    Tcl_Interp *interp;		/* Command interpreter in which variable is
				 * to be found. */
    int localIndex;		/* Index of variable in procedure's array
				 * of local variables. */
    long incrAmount;		/* Amount to be added to variable. */
{
    register Tcl_Obj *varValuePtr;
    Tcl_Obj *resultPtr;
    int createdNewObj;		/* Set 1 if var's value object is shared
				 * so we must increment a copy (i.e. copy
				 * on write). */
    long i;
    int result;

    varValuePtr = TclGetIndexedScalar(interp, localIndex,
                                      /*leaveErrorMsg*/ 1);
    if (varValuePtr == NULL) {
	Tcl_AddObjErrorInfo(interp,
		"\n    (reading value of variable to increment)", -1);
	return NULL;
    }

    /*
     * Reach into the object's representation to extract and increment the
     * variable's value. If the object is unshared we can modify it
     * directly, otherwise we must create a new copy to modify: this is
     * "copy on write". Then free the variable's old string representation,
     * if any, since it will no longer be valid.
     */

    createdNewObj = 0;
    if (Tcl_IsShared(varValuePtr)) {
	createdNewObj = 1;
	varValuePtr = Tcl_DuplicateObj(varValuePtr);
    }
    result = Tcl_GetLongFromObj(interp, varValuePtr, &i);
    if (result != TCL_OK) {
	if (createdNewObj) {
	    Tcl_DecrRefCount(varValuePtr); /* free unneeded copy */
	}
	return NULL;
    }
    Tcl_SetLongObj(varValuePtr, (i + incrAmount));

    /*
     * Store the variable's new value and run any write traces.
     */
    
    resultPtr = TclSetIndexedScalar(interp, localIndex, varValuePtr,
				    /*leaveErrorMsg*/ 1);
    if (resultPtr == NULL) {
	return NULL;
    }
    return resultPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * TclIncrElementOfIndexedArray --
 *
 *	Increments the Tcl object value of an element in a local array
 *	variable. The element is named by the object elemPtr while the array
 *	is specified by its index in the active procedure's array of
 *	compiler allocated local variables.
 *
 * Results:
 *	Returns a pointer to the Tcl_Obj holding the new value of the
 *	element. If the specified array or element doesn't exist, or there
 *	is a clash in array usage, or an error occurs while executing
 *	variable traces, then NULL is returned and a message will be left in
 *	the interpreter's result.
 *
 * Side effects:
 *	The value of the given array element is incremented by the specified
 *	amount. The ref count for the returned object is _not_ incremented
 *	to reflect the returned reference; if you want to keep a reference
 *	to the object you must increment its ref count yourself. If the
 *	entry doesn't exist then a new variable is created.
 *
 *----------------------------------------------------------------------
 */

Tcl_Obj *
TclIncrElementOfIndexedArray(interp, localIndex, elemPtr, incrAmount)
    Tcl_Interp *interp;		/* Command interpreter in which the array is
				 * to be found. */
    int localIndex;		/* Index of array variable in procedure's
				 * array of local variables. */
    Tcl_Obj *elemPtr;		/* Points to an object holding the name of
				 * an element to increment in the array. */
    long incrAmount;		/* Amou