tclvar.c

linux系统下的音频通信

/* 
 * tclVar.c --
 *
 *	This file contains routines that implement Tcl variables
 *	(both scalars and arrays).
 *
 *	The implementation of arrays is modelled after an initial
 *	implementation by Mark Diekhans and Karl Lehenbauer.
 *
 * Copyright (c) 1987-1994 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tclVar.c 1.130 97/10/29 18:26:16
 */

#include "tclInt.h"
#include "tclPort.h"

/*
 * The strings below are used to indicate what went wrong when a
 * variable access is denied.
 */

static char *noSuchVar =	"no such variable";
static char *isArray =		"variable is array";
static char *needArray =	"variable isn't array";
static char *noSuchElement =	"no such element in array";
static char *danglingUpvar =	"upvar refers to element in deleted array";
static char *badNamespace =	"parent namespace doesn't exist";
static char *missingName =	"missing variable name";

/*
 * Forward references to procedures defined later in this file:
 */

static  char *		CallTraces _ANSI_ARGS_((Interp *iPtr, Var *arrayPtr,
			    Var *varPtr, char *part1, char *part2,
			    int flags));
static void		CleanupVar _ANSI_ARGS_((Var *varPtr,
			    Var *arrayPtr));
static void		DeleteSearches _ANSI_ARGS_((Var *arrayVarPtr));
static void		DeleteArray _ANSI_ARGS_((Interp *iPtr,
			    char *arrayName, Var *varPtr, int flags));
static int		MakeUpvar _ANSI_ARGS_((
			    Interp *iPtr, CallFrame *framePtr,
			    char *otherP1, char *otherP2, int otherFlags,
			    char *myName, int myFlags));
static Var *		NewVar _ANSI_ARGS_((void));
static ArraySearch *	ParseSearchId _ANSI_ARGS_((Tcl_Interp *interp,
			    Var *varPtr, char *varName, char *string));
static void		VarErrMsg _ANSI_ARGS_((Tcl_Interp *interp,
			    char *part1, char *part2, char *operation,
			    char *reason));

/*
 *----------------------------------------------------------------------
 *
 * TclLookupVar --
 *
 *	This procedure is used by virtually all of the variable code to
 *	locate a variable given its name(s).
 *
 * Results:
 *	The return value is a pointer to the variable structure indicated by
 *	part1 and part2, or NULL if the variable couldn't be found. If the
 *	variable is found, *arrayPtrPtr is filled in with the address of the
 *	variable structure for the array that contains the variable (or NULL
 *	if the variable is a scalar). If the variable can't be found and
 *	either createPart1 or createPart2 are 1, a new as-yet-undefined
 *	(VAR_UNDEFINED) variable structure is created, entered into a hash
 *	table, and returned.
 *
 *	If the variable isn't found and creation wasn't specified, or some
 *	other error occurs, NULL is returned and an error message is left in
 *	interp->result if TCL_LEAVE_ERR_MSG is set in flags. (The result
 *	isn't put in interp->objResultPtr because this procedure is used
 *	by so many string-based routines.)
 *
 *	Note: it's possible for the variable returned to be VAR_UNDEFINED
 *	even if createPart1 or createPart2 are 1 (these only cause the hash
 *	table entry or array to be created). For example, the variable might
 *	be a global that has been unset but is still referenced by a
 *	procedure, or a variable that has been unset but it only being kept
 *	in existence (if VAR_UNDEFINED) by a trace.
 *
 * Side effects:
 *	New hashtable entries may be created if createPart1 or createPart2
 *	are 1.
 *
 *----------------------------------------------------------------------
 */

Var *
TclLookupVar(interp, part1, part2, flags, msg, createPart1, createPart2,
        arrayPtrPtr)
    Tcl_Interp *interp;		/* Interpreter to use for lookup. */
    char *part1;		/* If part2 isn't NULL, this is the name of
				 * an array. Otherwise, if the
				 * TCL_PARSE_PART1 flag bit is set this
				 * is a full variable name that could
				 * include a parenthesized array elemnt. If
				 * TCL_PARSE_PART1 isn't present, then
				 * this is the name of a scalar variable. */
    char *part2;		/* Name of element within array, or NULL. */
    int flags;			/* Only TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY,
				 * TCL_LEAVE_ERR_MSG, and
				 * TCL_PARSE_PART1 bits matter. */
    char *msg;			/* Verb to use in error messages, e.g.
				 * "read" or "set". Only needed if
				 * TCL_LEAVE_ERR_MSG is set in flags. */
    int createPart1;		/* If 1, create hash table entry for part 1
				 * of name, if it doesn't already exist. If
				 * 0, return error if it doesn't exist. */
    int createPart2;		/* If 1, create hash table entry for part 2
				 * of name, if it doesn't already exist. If
				 * 0, return error if it doesn't exist. */
    Var **arrayPtrPtr;		/* If the name refers to an element of an
				 * array, *arrayPtrPtr gets filled in with
				 * address of array variable. Otherwise
				 * this is set to NULL. */
{
    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. */
    Tcl_HashTable *tablePtr;	/* Points to the hashtable, if any, in which
				 * to look up the variable. */
    Tcl_Var var;                /* Used to search for global names. */
    Var *varPtr;		/* Points to the Var structure returned for
    				 * the variable. */
    char *elName;		/* Name of array element or NULL; may be
				 * same as part2, or may be openParen+1. */
    char *openParen, *closeParen;
                                /* If this procedure parses a name into
				 * array and index, these point to the
				 * parens around the index.  Otherwise they
				 * are NULL. These are needed to restore
				 * the parens after parsing the name. */
    Namespace *varNsPtr, *cxtNsPtr, *dummy1Ptr, *dummy2Ptr;
    ResolverScheme *resPtr;
    Tcl_HashEntry *hPtr;
    register char *p;
    int new, i, result;

    varPtr = NULL;
    *arrayPtrPtr = NULL;
    openParen = closeParen = NULL;
    varNsPtr = NULL;		/* set non-NULL if a nonlocal variable */

    /*
     * If the name hasn't been parsed into array name and index yet,
     * do it now.
     */

    elName = part2;
    if (flags & TCL_PARSE_PART1) {
	for (p = part1; ; p++) {
	    if (*p == 0) {
		elName = NULL;
		break;
	    }
	    if (*p == '(') {
		openParen = p;
		do {
		    p++;
		} while (*p != '\0');
		p--;
		if (*p == ')') {
		    closeParen = p;
		    *openParen = 0;
		    elName = openParen+1;
		} else {
		    openParen = NULL;
		    elName = NULL;
		}
		break;
	    }
	}
    }

    /*
     * If this namespace has a variable resolver, then give it first
     * crack at the variable resolution.  It may return a Tcl_Var
     * value, it may signal to continue onward, or it may signal
     * an error.
     */
    if ((flags & TCL_GLOBAL_ONLY) != 0 || iPtr->varFramePtr == NULL) {
        cxtNsPtr = iPtr->globalNsPtr;
    }
    else {
        cxtNsPtr = iPtr->varFramePtr->nsPtr;
    }

    if (cxtNsPtr->varResProc != NULL || iPtr->resolverPtr != NULL) {
        resPtr = iPtr->resolverPtr;

        if (cxtNsPtr->varResProc) {
            result = (*cxtNsPtr->varResProc)(interp, part1,
                (Tcl_Namespace *) cxtNsPtr, flags, &var);
        } else {
            result = TCL_CONTINUE;
        }

        while (result == TCL_CONTINUE && resPtr) {
            if (resPtr->varResProc) {
                result = (*resPtr->varResProc)(interp, part1,
                    (Tcl_Namespace *) cxtNsPtr, flags, &var);
            }
            resPtr = resPtr->nextPtr;
        }

        if (result == TCL_OK) {
            varPtr = (Var *) var;
            goto lookupVarPart2;
        }
        else if (result != TCL_CONTINUE) {
            return (Var *) NULL;
        }
    }

    /*
     * Look up part1. Look it up as either a namespace variable or as a
     * local variable in a procedure call frame (varFramePtr).
     * Interpret part1 as a namespace variable if:
     *    1) so requested by a TCL_GLOBAL_ONLY or TCL_NAMESPACE_ONLY flag,
     *    2) there is no active frame (we're at the global :: scope),
     *    3) the active frame was pushed to define the namespace context
     *       for a "namespace eval" or "namespace inscope" command,
     *    4) the name has namespace qualifiers ("::"s).
     * Otherwise, if part1 is a local variable, search first in the
     * frame's array of compiler-allocated local variables, then in its
     * hashtable for runtime-created local variables.
     *
     * If createPart1 and the variable isn't found, create the variable and,
     * if necessary, create varFramePtr's local var hashtable.
     */

    if (((flags & (TCL_GLOBAL_ONLY | TCL_NAMESPACE_ONLY)) != 0)
	        || (varFramePtr == NULL)
	        || !varFramePtr->isProcCallFrame
	        || (strstr(part1, "::") != NULL)) {
	char *tail;
	
	var = Tcl_FindNamespaceVar(interp, part1, (Tcl_Namespace *) NULL,
	        flags);
	if (var != (Tcl_Var) NULL) {
            varPtr = (Var *) var;
        }
	if (varPtr == NULL) {
	    if (flags & TCL_LEAVE_ERR_MSG) {
		Tcl_ResetResult(interp);
	    }
	    if (createPart1) {   /* var wasn't found so create it  */
		result = TclGetNamespaceForQualName(interp, part1,
		        (Namespace *) NULL, flags, &varNsPtr, &dummy1Ptr,
			&dummy2Ptr, &tail);
		if (result != TCL_OK) {
		    if (flags & TCL_LEAVE_ERR_MSG) {
			/*
			 * Move the interpreter's object result to the
			 * string result, then reset the object result.
			 * FAILS IF OBJECT RESULT'S STRING REP HAS NULLS.
			 */
			
			Tcl_SetResult(interp,
	                        TclGetStringFromObj(Tcl_GetObjResult(interp),
				    (int *) NULL),
	                        TCL_VOLATILE);
		    }
		    goto done;
		}
		if (varNsPtr == NULL) {
		    if (flags & TCL_LEAVE_ERR_MSG) {
			VarErrMsg(interp, part1, part2, msg, badNamespace);
		    }
		    goto done;
		}
		if (tail == NULL) {
		    if (flags & TCL_LEAVE_ERR_MSG) {
			VarErrMsg(interp, part1, part2, msg, missingName);
		    }
		    goto done;
		}
		hPtr = Tcl_CreateHashEntry(&varNsPtr->varTable, tail, &new);
		varPtr = NewVar();
		Tcl_SetHashValue(hPtr, varPtr);
		varPtr->hPtr = hPtr;
		varPtr->nsPtr = varNsPtr;
	    } else {		/* var wasn't found and not to create it */
		if (flags & TCL_LEAVE_ERR_MSG) {
		    VarErrMsg(interp, part1, part2, msg, noSuchVar);
		}
		goto done;
	    }
	}
    } else {			/* local var: look in frame varFramePtr */
	Proc *procPtr = varFramePtr->procPtr;
	int localCt = procPtr->numCompiledLocals;
	CompiledLocal *localPtr = procPtr->firstLocalPtr;
	Var *localVarPtr = varFramePtr->compiledLocals;
	int part1Len = strlen(part1);
	
	for (i = 0;  i < localCt;  i++) {
	    if (!TclIsVarTemporary(localPtr)) {
		char *localName = localVarPtr->name;
		if ((part1[0] == localName[0])
		        && (part1Len == localPtr->nameLength)
		        && (strcmp(part1, localName) == 0)) {
		    varPtr = localVarPtr;
		    break;
		}
	    }
	    localVarPtr++;
	    localPtr = localPtr->nextPtr;
	}
	if (varPtr == NULL) {	/* look in the frame's var hash table */
	    tablePtr = varFramePtr->varTablePtr;
	    if (createPart1) {
		if (tablePtr == NULL) {
		    tablePtr = (Tcl_HashTable *)
			    ckalloc(sizeof(Tcl_HashTable));
		    Tcl_InitHashTable(tablePtr, TCL_STRING_KEYS);
		    varFramePtr->varTablePtr = tablePtr;
		}
		hPtr = Tcl_CreateHashEntry(tablePtr, part1, &new);
		if (new) {
		    varPtr = NewVar();
		    Tcl_SetHashValue(hPtr, varPtr);
		    varPtr->hPtr = hPtr;
                    varPtr->nsPtr = NULL; /* a local variable */
		} else {
		    varPtr = (Var *) Tcl_GetHashValue(hPtr);
		}
	    } else {
		hPtr = NULL;
		if (tablePtr != NULL) {
		    hPtr = Tcl_FindHashEntry(tablePtr, part1);
		}
		if (hPtr == NULL) {
		    if (flags & TCL_LEAVE_ERR_MSG) {
			VarErrMsg(interp, part1, part2, msg, noSuchVar);
		    }
		    goto done;
		}
		varPtr = (Var *) Tcl_GetHashValue(hPtr);
	    }
	}
    }

lookupVarPart2:
    if (openParen != NULL) {
	*openParen = '(';
	openParen = NULL;
    }

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

    /*
     * If we're not dealing with an array element, return varPtr.
     */
    
    if (elName == NULL) {
        goto done;
    }

    /*
     * We're dealing with an array element. Make sure the variable is an
     * array and look up the element (create the element if desired).
     */

    if (TclIsVarUndefined(varPtr) && !TclIsVarArrayElement(varPtr)) {
	if (!createPart1) {
	    if (flags & TCL_LEAVE_ERR_MSG) {
		VarErrMsg(interp, part1, part2, msg, noSuchVar);
	    }
	    varPtr = NULL;
	    goto done;
	}
	TclSetVarArray(varPtr);
	TclClearVarUndefined(varPtr);
	varPtr->value.tablePtr =