tclvar.c

linux系统下的音频通信

	        (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
	Tcl_InitHashTable(varPtr->value.tablePtr, TCL_STRING_KEYS);
    } else if (!TclIsVarArray(varPtr)) {
	if (flags & TCL_LEAVE_ERR_MSG) {
	    VarErrMsg(interp, part1, part2, msg, needArray);
	}
	varPtr = NULL;
	goto done;
    }
    *arrayPtrPtr = varPtr;
    if (closeParen != NULL) {
	*closeParen = 0;
    }
    if (createPart2) {
	hPtr = Tcl_CreateHashEntry(varPtr->value.tablePtr, elName, &new);
	if (closeParen != NULL) {
	    *closeParen = ')';
	}
	if (new) {
	    if (varPtr->searchPtr != NULL) {
		DeleteSearches(varPtr);
	    }
	    varPtr = NewVar();
	    Tcl_SetHashValue(hPtr, varPtr);
	    varPtr->hPtr = hPtr;
	    varPtr->nsPtr = varNsPtr;
	    TclSetVarArrayElement(varPtr);
	}
    } else {
	hPtr = Tcl_FindHashEntry(varPtr->value.tablePtr, elName);
	if (closeParen != NULL) {
	    *closeParen = ')';
	}
	if (hPtr == NULL) {
	    if (flags & TCL_LEAVE_ERR_MSG) {
		VarErrMsg(interp, part1, part2, msg, noSuchElement);
	    }
	    varPtr = NULL;
	    goto done;
	}
    }
    varPtr = (Var *) Tcl_GetHashValue(hPtr);

    done:
    if (openParen != NULL) {
        *openParen = '(';
    }
    return varPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetVar --
 *
 *	Return the value of a Tcl variable as a string.
 *
 * Results:
 *	The return value points to the current value of varName as a string.
 *	If the variable is not defined or can't be read because of a clash
 *	in array usage then a NULL pointer is returned and an error message
 *	is left in interp->result if the TCL_LEAVE_ERR_MSG flag is set.
 *	Note: the return value is only valid up until the next change to the
 *	variable; if you depend on the value lasting longer than that, then
 *	make yourself a private copy.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

char *
Tcl_GetVar(interp, varName, flags)
    Tcl_Interp *interp;		/* Command interpreter in which varName is
				 * to be looked up. */
    char *varName;		/* Name of a variable in interp. */
    int flags;			/* OR-ed combination of TCL_GLOBAL_ONLY,
				 * TCL_NAMESPACE_ONLY or TCL_LEAVE_ERR_MSG
				 * bits. */
{
    return Tcl_GetVar2(interp, varName, (char *) NULL,
		       (flags | TCL_PARSE_PART1));
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetVar2 --
 *
 *	Return the value of a Tcl variable as a string, given a two-part
 *	name consisting of array name and element within array.
 *
 * Results:
 *	The return value points to the current value of the variable given
 *	by part1 and part2 as a string. If the specified variable doesn't
 *	exist, or if there is a clash in array usage, then NULL is returned
 *	and a message will be left in interp->result if the
 *	TCL_LEAVE_ERR_MSG flag is set. Note: the return value is only valid
 *	up until the next change to the variable; if you depend on the value
 *	lasting longer than that, then make yourself a private copy.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

char *
Tcl_GetVar2(interp, part1, part2, flags)
    Tcl_Interp *interp;		/* Command interpreter in which variable is
				 * to be looked up. */
    char *part1;		/* Name of an array (if part2 is non-NULL)
				 * or the name of a variable. */
    char *part2;		/* If non-NULL, gives the name of an element
				 * in the array part1. */
    int flags;			/* OR-ed combination of TCL_GLOBAL_ONLY,
				 * TCL_NAMESPACE_ONLY, TCL_LEAVE_ERR_MSG,
                                 * and TCL_PARSE_PART1 bits. */
{
    register Tcl_Obj *part1Ptr;
    register Tcl_Obj *part2Ptr = NULL;
    Tcl_Obj *objPtr;
    int length;

    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);
    }
    
    objPtr = Tcl_ObjGetVar2(interp, part1Ptr, part2Ptr, flags);
    
    TclDecrRefCount(part1Ptr);	    /* done with the part1 name object */
    if (part2Ptr != NULL) {
	TclDecrRefCount(part2Ptr);  /* and the part2 name object */
    }
    
    if (objPtr == 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_ObjGetVar2's RESULT'S STRING REP HAS A NULL BYTE.
     */
    
    return TclGetStringFromObj(objPtr, (int *) NULL);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ObjGetVar2 --
 *
 *	Return the value of a Tcl variable as a Tcl object, given a
 *	two-part name consisting of array name and element within array.
 *
 * Results:
 *	The return value points to the current object value of the variable
 *	given by part1Ptr and part2Ptr. If the specified variable doesn't
 *	exist, or if there is a clash in array usage, then NULL is returned
 *	and a message will be left in the interpreter's result if the
 *	TCL_LEAVE_ERR_MSG flag is set.
 *
 * 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 *
Tcl_ObjGetVar2(interp, part1Ptr, part2Ptr, flags)
    Tcl_Interp *interp;		/* Command interpreter in which variable is
				 * to be looked up. */
    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. */
    register Tcl_Obj *part2Ptr;	/* If non-null, points to an object holding
				 * the name of an element in the array
				 * part1Ptr. */
    int flags;			/* OR-ed combination of TCL_GLOBAL_ONLY,
				 * TCL_LEAVE_ERR_MSG, and
				 * TCL_PARSE_PART1 bits. */
{
    Interp *iPtr = (Interp *) interp;
    register Var *varPtr;
    Var *arrayPtr;
    char *part1, *msg;
    char *part2 = NULL;

    /*
     * 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, "read",
            /*createPart1*/ 0, /*createPart2*/ 1, &arrayPtr);
    if (varPtr == NULL) {
	return NULL;
    }

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

    if ((varPtr->tracePtr != NULL)
	    || ((arrayPtr != NULL) && (arrayPtr->tracePtr != NULL))) {
	msg = CallTraces(iPtr, arrayPtr, varPtr, part1, part2,
		(flags & (TCL_NAMESPACE_ONLY|TCL_GLOBAL_ONLY|TCL_PARSE_PART1)) | TCL_TRACE_READS);
	if (msg != NULL) {
	    if (flags & TCL_LEAVE_ERR_MSG) {
		VarErrMsg(interp, part1, part2, "read", msg);
	    }
	    goto errorReturn;
	}
    }

    /*
     * Return the element if it's an existing scalar variable.
     */
    
    if (TclIsVarScalar(varPtr) && !TclIsVarUndefined(varPtr)) {
	return varPtr->value.objPtr;
    }
    
    if (flags & TCL_LEAVE_ERR_MSG) {
	if (TclIsVarUndefined(varPtr) && (arrayPtr != NULL)
	        && !TclIsVarUndefined(arrayPtr)) {
	    msg = noSuchElement;
	} else if (TclIsVarArray(varPtr)) {
	    msg = isArray;
	} else {
	    msg = noSuchVar;
	}
	VarErrMsg(interp, part1, part2, "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 (TclIsVarUndefined(varPtr)) {
	CleanupVar(varPtr, arrayPtr);
    }
    return NULL;
}

/*
 *----------------------------------------------------------------------
 *
 * TclGetIndexedScalar --
 *
 *	Return the Tcl object value of a local scalar variable in the active
 *	procedure, given its index in the procedure's array of compiler
 *	allocated local variables.
 *
 * Results:
 *	The return value points to the current object 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.
 *
 * 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 *
TclGetIndexedScalar(interp, localIndex, leaveErrorMsg)
    Tcl_Interp *interp;		/* Command interpreter in which variable is
				 * to be looked up. */
    int localIndex;		/* Index of variable in procedure's array
				 * of local variables. */
    int leaveErrorMsg;		/* 1 if to leave an error message in
				 * 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 *varPtr;		/* Points to the variable's in-frame Var
				 * structure. */
    char *varName;		/* Name of the local variable. */
    char *msg;

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

    if (compiledLocals == NULL) {
	fprintf(stderr, "\nTclGetIndexedScalar: can't get 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 local %i in frame 0x%x with %i locals\n",
		    localIndex, (unsigned int) varFramePtr, localCt);
	panic("TclGetIndexedScalar: 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;
    }

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

    if (varPtr->tracePtr != NULL) {
	msg = CallTraces(iPtr, /*arrayPtr*/ NULL, varPtr, varName, NULL,
	        TCL_TRACE_READS);
	if (msg != NULL) {
	    if (leaveErrorMsg) {
		VarErrMsg(interp, varName, NULL, "read", msg);
	    }
	    return NULL;
	}
    }

    /*
     * Make sure we're dealing with a scalar variable and not an array, and
     * that the variable exists (isn't undefined).
     */

    if (!TclIsVarScalar(varPtr) || TclIsVarUndefined(varPtr)) {
	if (leaveErrorMsg) {
	    if (TclIsVarArray(varPtr)) {
		msg = isArray;
	    } else {
		msg = noSuchVar;
	    }
	    VarErrMsg(interp, varName, NULL, "read", msg);
	}
	return NULL;
    }
    return varPtr->value.objPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * TclGetElementOfIndexedArray --
 *
 *	Return the Tcl object value for 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:
 *	The return value points to the current object value of the
 *	element. If the specified array or element doesn't exist, or there