tclvar.c

linux系统下的音频通信

 *	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.
 *
 * Side effects:
 *	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 *
TclGetElementOfIndexedArray(interp, localIndex, elemPtr, leaveErrorMsg)
    Tcl_Interp *interp;		/* Command interpreter in which variable is
				 * to be looked up. */
    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 get in the array. */
    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. */
    Tcl_HashEntry *hPtr;
    Var *varPtr = NULL;		/* Points to the element's Var structure
				 * that we return. Initialized to avoid
				 * compiler warning. */
    char *elem, *msg;
    int new;

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

    if (compiledLocals == NULL) {
	fprintf(stderr, "\nTclGetElementOfIndexedArray: can't get element of local %i in frame 0x%x, no compiled locals\n",
		    localIndex, (unsigned int) varFramePtr);
	panic("TclGetIndexedScalar: no compiled locals in frame 0x%x",
	      (unsigned int) varFramePtr);
    }
    if ((localIndex < 0) || (localIndex >= localCt)) {
	fprintf(stderr, "\nTclGetIndexedScalar: can't get element of local %i in frame 0x%x with %i locals\n",
		    localIndex, (unsigned int) varFramePtr, localCt);
	panic("TclGetElementOfIndexedArray: 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 and that the array variable
     * exists (isn't undefined).
     */

    if (!TclIsVarArray(arrayPtr) || TclIsVarUndefined(arrayPtr)) {
	if (leaveErrorMsg) {
	    VarErrMsg(interp, arrayName, elem, "read", noSuchVar);
	}
	goto errorReturn;
    } 

    /*
     * Look up the element. Note that we must create the element (but leave
     * it marked undefined) if it does not already exist. This allows a
     * trace to create new array elements "on the fly" that did not exist
     * before. A trace is always passed a variable for the array element. If
     * the trace does not define the variable, it will be deleted below (at
     * errorReturn) and an error returned.
     */

    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);
    } else {
	varPtr = (Var *) Tcl_GetHashValue(hPtr);
    }

    /*
     * Invoke any traces that have been set for the element variable.
     */

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

    /*
     * Return the element if it's an existing scalar variable.
     */
    
    if (TclIsVarScalar(varPtr) && !TclIsVarUndefined(varPtr)) {
	return varPtr->value.objPtr;
    }
    
    if (leaveErrorMsg) {
	if (TclIsVarArray(varPtr)) {
	    msg = isArray;
	} else {
	    msg = noSuchVar;
	}
	VarErrMsg(interp, arrayName, elem, "read", msg);
    }

    /*
     * 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) && TclIsVarUndefined(varPtr)) {
	CleanupVar(varPtr, NULL); /* the array is not in a hashtable */
    }
    return NULL;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_SetCmd --
 *
 *	This procedure is invoked to process the "set" Tcl command.
 *	See the user documentation for details on what it does.
 *
 * Results:
 *	A standard Tcl result value.
 *
 * Side effects:
 *	A variable's value may be changed.
 *
 *----------------------------------------------------------------------
 */

	/* ARGSUSED */
int
Tcl_SetCmd(dummy, interp, argc, argv)
    ClientData dummy;			/* Not used. */
    register Tcl_Interp *interp;	/* Current interpreter. */
    int argc;				/* Number of arguments. */
    char **argv;			/* Argument strings. */
{
    if (argc == 2) {
	char *value;

	value = Tcl_GetVar2(interp, argv[1], (char *) NULL,
		TCL_LEAVE_ERR_MSG|TCL_PARSE_PART1);
	if (value == NULL) {
	    return TCL_ERROR;
	}
	Tcl_SetResult(interp, value, TCL_VOLATILE);
	return TCL_OK;
    } else if (argc == 3) {
	char *result;

	result = Tcl_SetVar2(interp, argv[1], (char *) NULL, argv[2],
		TCL_LEAVE_ERR_MSG|TCL_PARSE_PART1);
	if (result == NULL) {
	    return TCL_ERROR;
	}
	Tcl_SetResult(interp, result, TCL_VOLATILE);
	return TCL_OK;
    } else {
	Tcl_AppendResult(interp, "wrong # args: should be \"",
		argv[0], " varName ?newValue?\"", (char *) NULL);
	return TCL_ERROR;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_SetVar --
 *
 *	Change the value of a variable.
 *
 * Results:
 *	Returns a pointer to the malloc'ed string which is the character
 *	representation of the variable's new value. The caller must not
 *	modify this string. If the write operation was disallowed then NULL
 *	is returned; if the TCL_LEAVE_ERR_MSG flag is set, then an
 *	explanatory message will be left in interp->result. Note that the
 *	returned string may not be the same as newValue; this is because
 *	variable traces may modify the variable's value.
 *
 * Side effects:
 *	If varName is defined as a local or global variable in interp,
 *	its value is changed to newValue. If varName isn't currently
 *	defined, then a new global variable by that name is created.
 *
 *----------------------------------------------------------------------
 */

char *
Tcl_SetVar(interp, varName, newValue, flags)
    Tcl_Interp *interp;		/* Command interpreter in which varName is
				 * to be looked up. */
    char *varName;		/* Name of a variable in interp. */
    char *newValue;		/* New value for varName. */
    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. */
{
    return Tcl_SetVar2(interp, varName, (char *) NULL, newValue,
		       (flags | TCL_PARSE_PART1));
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_SetVar2 --
 *
 *      Given a two-part variable name, which may refer either to a
 *      scalar variable or an element of an array, change the value
 *      of the variable.  If the named scalar or array or element
 *      doesn't exist then create one.
 *
 * Results:
 *	Returns a pointer to the malloc'ed string which is the character
 *	representation of the variable's new value. The caller must not
 *	modify this string. If the write operation was disallowed because an
 *	array was expected but not found (or vice versa), then NULL is
 *	returned; if the TCL_LEAVE_ERR_MSG flag is set, then an explanatory
 *	message will be left in interp->result. Note that the returned
 *	string may not be the same as newValue; this is because variable
 *	traces may modify the variable's value.
 *
 * Side effects:
 *      The value of the given variable is set. If either the array
 *      or the entry didn't exist then a new one is created.
 *
 *----------------------------------------------------------------------
 */

char *
Tcl_SetVar2(interp, part1, part2, newValue, flags)
    Tcl_Interp *interp;         /* Command interpreter in which variable is
                                 * to be looked up. */
    char *part1;                /* If part2 is NULL, this is name of scalar
                                 * variable. Otherwise it is the name of
                                 * an array. */
    char *part2;                /* Name of an element within an array, or
				 * NULL. */
    char *newValue;             /* 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. */
{
    register Tcl_Obj *valuePtr;
    register Tcl_Obj *part1Ptr;
    register Tcl_Obj *part2Ptr = NULL;
    Tcl_Obj *varValuePtr;
    int length;

    /*
     * Create an object holding the variable's new value and use
     * Tcl_ObjSetVar2 to actually set the variable.
     */

    length = newValue ? strlen(newValue) : 0;
    TclNewObj(valuePtr);
    TclInitStringRep(valuePtr, newValue, length);
    Tcl_IncrRefCount(valuePtr);

    length = strlen(part1) ;
    TclNewObj(part1Ptr);
    TclInitStringRep(part1Ptr, part1, length);
    Tcl_IncrRefCount(part1Ptr);

    if (part2 != NULL) {
        length = strlen(part2);
        TclNewObj(part2Ptr);
        TclInitStringRep(part2Ptr, part2, length);
	Tcl_IncrRefCount(part2Ptr);
    }
    
    varValuePtr = Tcl_ObjSetVar2(interp, part1Ptr, part2Ptr, valuePtr,
	    flags);
    
    TclDecrRefCount(part1Ptr);      /* done with the part1 name object */
    if (part2Ptr != NULL) {
	TclDecrRefCount(part2Ptr);  /* and the part2 name object */
    }
    Tcl_DecrRefCount(valuePtr); /* done with the object */
    
    if (varValuePtr == NULL) {
	/*
	 * Move the interpreter's object result to the string result, 
	 * then reset the object result.
	 * FAILS IF OBJECT RESULT'S STRING REPRESENTATION CONTAINS NULLS.
	 */

	Tcl_SetResult(interp,
	        TclGetStringFromObj(Tcl_GetObjResult(interp), (int *) NULL),
	        TCL_VOLATILE);
	return NULL;
    }

    /*
     * THIS FAILS IF Tcl_ObjSetVar2's RESULT'S STRING REP HAS A NULL BYTE.
     */

    return TclGetStringFromObj(varValuePtr, (int *) NULL);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ObjSetVar2 --
 *
 *	Given a two-part variable name, which may refer either to a scalar
 *	variable or an element of an array, change the value of the variable
 *	to a new Tcl object value. If the named scalar or array or element
 *	doesn't exist then create one.
 *
 * Results:
 *	Returns a pointer to the Tcl_Obj holding the new value of the
 *	variable. If the write operation was disallowed because an array was
 *	expected but not found (or vice versa), then NULL is returned; if
 *	the TCL_LEAVE_ERR_MSG flag is set, then an explanatory message will
 *	be left in the interpreter's result. 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. If either the array or the
 *	entry didn't exist then a new variable is created.
 *
 *	The reference count is decremented for any old value of the variable
 *	and incremented for its new value. If the new value for the variable
 *	is not the same one referenced by newValuePtr (perhaps as a result
 *	of a variable trace), then newValuePtr's ref count is left unchanged
 *	by Tcl_ObjSetVar2. newValuePtr's ref count is also left unchanged if
 *	we are appending it as a string value: that is, if "flags" includes
 *	TCL_APPEND_VALUE but not TCL_LIST_ELEMENT.
 *
 *	The reference count for the returned object is _not_ incremented: if
 *	you want to keep a reference to the object you must increment its
 *	ref count yourself.
 *
 *----------------------------------------------------------------------
 */

Tcl_Obj *
Tcl_ObjSetVar2(interp, part1Ptr, part2Ptr, newValuePtr, flags)
    Tcl_Interp *interp;		/* Command interpreter in which variable is
				 * to be found. */
    register Tcl_Obj *part1Ptr;	/* Points to an object holding the name of
				 * an array (if part2 is non-NULL) or the
				 * name of a variable. */