tclvar.c

linux系统下的音频通信

    register Tcl_Obj *part2Ptr;	/* If non-null, points to an object holding
				 * the name of an element in the array
				 * part1Ptr. */
    Tcl_Obj *newValuePtr;	/* New value for variable. */
    int flags;			/* Various flags that tell how to set value:
				 * any of TCL_GLOBAL_ONLY,
				 * TCL_NAMESPACE_ONLY, TCL_APPEND_VALUE,
				 * TCL_LIST_ELEMENT, TCL_LEAVE_ERR_MSG, or
				 * TCL_PARSE_PART1. */
{
    Interp *iPtr = (Interp *) interp;
    register Var *varPtr;
    Var *arrayPtr;
    Tcl_Obj *oldValuePtr;
    Tcl_Obj *resultPtr = NULL;
    char *part1, *bytes;
    char *part2 = NULL;
    int length, result;

    /*
     * THIS FAILS IF A NAME OBJECT'S STRING REP HAS A NULL BYTE.
     */

    part1 = TclGetStringFromObj(part1Ptr, (int *) NULL);
    if (part2Ptr != NULL) {
	part2 = TclGetStringFromObj(part2Ptr, (int *) NULL);
    }
    
    varPtr = TclLookupVar(interp, part1, part2, flags, "set",
	    /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr);
    if (varPtr == NULL) {
	return NULL;
    }

    /*
     * If the variable is in a hashtable and its hPtr field is NULL, then we
     * have an upvar to an array element where the array was deleted,
     * leaving the element dangling at the end of the upvar. Generate an
     * error (allowing the variable to be reset would screw up our storage
     * allocation and is meaningless anyway).
     */

    if ((varPtr->flags & VAR_IN_HASHTABLE) && (varPtr->hPtr == NULL)) {
	if (flags & TCL_LEAVE_ERR_MSG) {
	    VarErrMsg(interp, part1, part2, "set", danglingUpvar);
	}
	return NULL;
    }

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

    if (TclIsVarArray(varPtr) && !TclIsVarUndefined(varPtr)) {
	if (flags & TCL_LEAVE_ERR_MSG) {
	    VarErrMsg(interp, part1, part2, "set", isArray);
	}
	return NULL;
    }

    /*
     * At this point, if we were appending, we used to call read traces: we
     * treated append as a read-modify-write. However, it seemed unlikely to
     * us that a real program would be interested in such reads being done
     * during a set operation.
     */

    /*
     * Set the variable's new value. If appending, append the new value to
     * the variable, either as a list element or as a string. Also, if
     * appending, then if the variable's old value is unshared we can modify
     * it directly, otherwise we must create a new copy to modify: this is
     * "copy on write".
     */

    oldValuePtr = varPtr->value.objPtr;
    if (flags & TCL_APPEND_VALUE) {
	if (TclIsVarUndefined(varPtr) && (oldValuePtr != NULL)) {
	    Tcl_DecrRefCount(oldValuePtr);     /* discard old value */
	    varPtr->value.objPtr = NULL;
	    oldValuePtr = NULL;
	}
	if (flags & TCL_LIST_ELEMENT) {	       /* append list element */
	    if (oldValuePtr == NULL) {
		TclNewObj(oldValuePtr);
		varPtr->value.objPtr = oldValuePtr;
		Tcl_IncrRefCount(oldValuePtr); /* since var is reference */
	    } else if (Tcl_IsShared(oldValuePtr)) {
		varPtr->value.objPtr = Tcl_DuplicateObj(oldValuePtr);
		Tcl_DecrRefCount(oldValuePtr);
		oldValuePtr = varPtr->value.objPtr;
		Tcl_IncrRefCount(oldValuePtr); /* since var is reference */
	    }
	    result = Tcl_ListObjAppendElement(interp, oldValuePtr,
		    newValuePtr);
	    if (result != TCL_OK) {
		return NULL;
	    }
	} else {		               /* append string */
	    /*
	     * We append newValuePtr's bytes but don't change its ref count.
	     */

	    bytes = Tcl_GetStringFromObj(newValuePtr, &length);
	    if (oldValuePtr == NULL) {
		varPtr->value.objPtr = Tcl_NewStringObj(bytes, length);
		Tcl_IncrRefCount(varPtr->value.objPtr);
	    } else {
		if (Tcl_IsShared(oldValuePtr)) {   /* append to copy */
		    varPtr->value.objPtr = Tcl_DuplicateObj(oldValuePtr);
		    TclDecrRefCount(oldValuePtr);
		    oldValuePtr = varPtr->value.objPtr;
		    Tcl_IncrRefCount(oldValuePtr); /* since var is ref */
		}
		Tcl_AppendToObj(oldValuePtr, bytes, length);
	    }
	}
    } else {
	if (flags & TCL_LIST_ELEMENT) {	       /* set var to list element */
	    int neededBytes, listFlags;

	    /*
	     * We set the variable to the result of converting newValuePtr's
	     * string rep to a list element. We do not change newValuePtr's
	     * ref count.
	     */

	    if (oldValuePtr != NULL) {
		Tcl_DecrRefCount(oldValuePtr); /* discard old value */
	    }
	    bytes = Tcl_GetStringFromObj(newValuePtr, &length);
	    neededBytes = Tcl_ScanElement(bytes, &listFlags);
	    oldValuePtr = Tcl_NewObj();
	    oldValuePtr->bytes = (char *)
		    ckalloc((unsigned) (neededBytes + 1));
	    oldValuePtr->length = Tcl_ConvertElement(bytes,
		    oldValuePtr->bytes, listFlags);
	    varPtr->value.objPtr = oldValuePtr;
	    Tcl_IncrRefCount(varPtr->value.objPtr);
	} else if (newValuePtr != oldValuePtr) {
	    varPtr->value.objPtr = newValuePtr;
	    Tcl_IncrRefCount(newValuePtr);      /* var is another ref */
	    if (oldValuePtr != NULL) {
		TclDecrRefCount(oldValuePtr);   /* discard old value */
	    }
	}
    }
    TclSetVarScalar(varPtr);
    TclClearVarUndefined(varPtr);
    if (arrayPtr != NULL) {
	TclClearVarUndefined(arrayPtr);
    }

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

    if ((varPtr->tracePtr != NULL)
	    || ((arrayPtr != NULL) && (arrayPtr->tracePtr != NULL))) {
	char *msg = CallTraces(iPtr, arrayPtr, varPtr, part1, part2,
	        (flags & (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY|TCL_PARSE_PART1)) | TCL_TRACE_WRITES);
	if (msg != NULL) {
	    if (flags & TCL_LEAVE_ERR_MSG) {
		VarErrMsg(interp, part1, part2, "set", msg);
	    }
	    goto cleanup;
	}
    }

    /*
     * Return the variable's value unless the variable was changed in some
     * gross way by a trace (e.g. it was unset and then recreated as an
     * array). 
     */

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

    /*
     * A trace changed the value in some gross way. Return an empty string
     * object.
     */
    
    resultPtr = iPtr->emptyObjPtr;

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

    cleanup:
    if (TclIsVarUndefined(varPtr)) {
	CleanupVar(varPtr, arrayPtr);
    }
    return resultPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * TclSetIndexedScalar --
 *
 *	Change 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 if leaveErrorMsg is 1. Note
 *	that the returned object may not be the same one referenced by
 *	newValuePtr; this is because variable traces may modify the
 *	variable's value.
 *
 * Side effects:
 *	The value of the given variable is set. The reference count is
 *	decremented for any old value of the variable and incremented for
 *	its new value. If as a result of a variable trace the new value for
 *	the variable is not the same one referenced by newValuePtr, then
 *	newValuePtr's ref count is left unchanged. 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. This procedure does not create
 *	new variables, but only sets those recognized at compile time.
 *
 *----------------------------------------------------------------------
 */

Tcl_Obj *
TclSetIndexedScalar(interp, localIndex, newValuePtr, leaveErrorMsg)
    Tcl_Interp *interp;		/* Command interpreter in which variable is
				 * to be found. */
    int localIndex;		/* Index of variable in procedure's array
				 * of local variables. */
    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;
    register Var *varPtr;	/* Points to the variable's in-frame Var
				 * structure. */
    char *varName;		/* Name of the local variable. */
    Tcl_Obj *oldValuePtr;
    Tcl_Obj *resultPtr = NULL;

#ifdef TCL_COMPILE_DEBUG
    Proc *procPtr = varFramePtr->procPtr;
    int localCt = procPtr->numCompiledLocals;

    if (compiledLocals == NULL) {
	fprintf(stderr, "\nTclSetIndexedScalar: can't set 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 local %i in frame 0x%x with %i locals\n",
		    localIndex, (unsigned int) varFramePtr, localCt);
	panic("TclSetIndexedScalar: bad local index %i in frame 0x%x",
	      localIndex, (unsigned int) varFramePtr);
    }
#endif /* TCL_COMPILE_DEBUG */
    
    varPtr = &(compiledLocals[localIndex]);
    varName = varPtr->name;

    /*
     * If varPtr 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(varPtr)) {
	varPtr = varPtr->value.linkPtr;
    }

    /*
     * If the variable is in a hashtable and its hPtr field is NULL, then we
     * have an upvar to an array element where the array was deleted,
     * leaving the element dangling at the end of the upvar. Generate an
     * error (allowing the variable to be reset would screw up our storage
     * allocation and is meaningless anyway).
     */

    if ((varPtr->flags & VAR_IN_HASHTABLE) && (varPtr->hPtr == NULL)) {
	if (leaveErrorMsg) {
	    VarErrMsg(interp, varName, NULL, "set", danglingUpvar);
	}
	return NULL;
    }

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

    if (TclIsVarArray(varPtr) && !TclIsVarUndefined(varPtr)) {
	if (leaveErrorMsg) {
	    VarErrMsg(interp, varName, NULL, "set", isArray);
	}
	return NULL;
    }

    /*
     * Set the variable's new value and discard its old value. 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 variable.
     */

    if (varPtr->tracePtr != NULL) {
	char *msg = CallTraces(iPtr, /*arrayPtr*/ NULL, varPtr,
	        varName, (char *) NULL, TCL_TRACE_WRITES);
	if (msg != NULL) {
	    if (leaveErrorMsg) {
		VarErrMsg(interp, varName, NULL, "set", msg);
	    }
	    goto cleanup;
	}
    }

    /*
     * Return the variable's value unless the variable 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();

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

    cleanup:
    if (TclIsVarUndefined(varPtr)) {
	CleanupVar(varPtr, NULL);
    }
    return resultPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * TclSetElementOfIndexedArray --
 *
 *	Change 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 if leaveErrorMsg is 1. Note that the
 *	returned object may not be the same one referenced by newValuePtr;
 *	this is because variable traces may modify the variable's value.
 *
 * Side effects:
 *	The value of the given array element is set. The reference count is
 *	decremented for any old value of the element and incremented for its
 *	new value. If as a result of a variable trace the new value for the
 *	element is not the same one referenced by newValuePtr, then
 *	newValuePtr's ref count is left unchanged. The ref count for the