tclcompexpr.c

linux系统下的音频通信

    HERE("addExpr", 10);
    result = CompileMultiplyExpr(interp, infoPtr, flags, envPtr);
    if (result != TCL_OK) {
	goto done;
    }
    maxDepth = envPtr->maxStackDepth;

    op = infoPtr->token;
    while ((op == PLUS) || (op == MINUS)) {
	infoPtr->hasOperators = 1;
	infoPtr->exprIsJustVarRef = 0;
	result = GetToken(interp, infoPtr, envPtr); /* skip over + or - */
	if (result != TCL_OK) {
	    goto done;
	}

	result = CompileMultiplyExpr(interp, infoPtr, flags, envPtr);
	if (result != TCL_OK) {
	    goto done;
	}
	maxDepth = TclMax((envPtr->maxStackDepth + 1), maxDepth);

	if (op == PLUS) {
	    TclEmitOpcode(INST_ADD, envPtr);
	} else {
	    TclEmitOpcode(INST_SUB, envPtr);
	}

	op = infoPtr->token;

	/*
	 * A comparison is not the top-level operator in this expression.
	 */

	infoPtr->exprIsComparison = 0;
    }

    done:
    envPtr->maxStackDepth = maxDepth;
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * CompileMultiplyExpr --
 *
 *	This procedure compiles a Tcl multiply expression:
 *	multiplyExpr ::= unaryExpr {('*' | '/' | '%') unaryExpr}
 *
 * Results:
 *	The return value is TCL_OK on a successful compilation and TCL_ERROR
 *	on failure. If TCL_ERROR is returned, then the interpreter's result
 *	contains an error message.
 *
 *	envPtr->maxStackDepth is updated with the maximum number of stack
 *	elements needed to execute the expression.
 *
 * Side effects:
 *	Adds instructions to envPtr to evaluate the expression at runtime.
 *
 *----------------------------------------------------------------------
 */

static int
CompileMultiplyExpr(interp, infoPtr, flags, envPtr)
    Tcl_Interp *interp;		/* Used for error reporting. */
    ExprInfo *infoPtr;		/* Describes the compilation state for the
				 * expression being compiled. */
    int flags;			/* Flags to control compilation (same as
				 * passed to Tcl_Eval). */
    CompileEnv *envPtr;		/* Holds resulting instructions. */
{
    int maxDepth = 0;		/* Maximum number of stack elements needed
				 * to execute the expression. */
    int op, result;

    HERE("multiplyExpr", 11);
    result = CompileUnaryExpr(interp, infoPtr, flags, envPtr);
    if (result != TCL_OK) {
	goto done;
    }
    maxDepth = envPtr->maxStackDepth;

    op = infoPtr->token;
    while ((op == MULT) || (op == DIVIDE) || (op == MOD)) {
	infoPtr->hasOperators = 1;
	infoPtr->exprIsJustVarRef = 0;
	result = GetToken(interp, infoPtr, envPtr); /* skip over * or / */
	if (result != TCL_OK) {
	    goto done;
	}

	result = CompileUnaryExpr(interp, infoPtr, flags, envPtr);
	if (result != TCL_OK) {
	    goto done;
	}
	maxDepth = TclMax((envPtr->maxStackDepth + 1), maxDepth);

	if (op == MULT) {
	    TclEmitOpcode(INST_MULT, envPtr);
	} else if (op == DIVIDE) {
	    TclEmitOpcode(INST_DIV, envPtr);
	} else {
	    TclEmitOpcode(INST_MOD, envPtr);
	}

	op = infoPtr->token;

	/*
	 * A comparison is not the top-level operator in this expression.
	 */

	infoPtr->exprIsComparison = 0;
    }

    done:
    envPtr->maxStackDepth = maxDepth;
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * CompileUnaryExpr --
 *
 *	This procedure compiles a Tcl unary expression:
 *	unaryExpr ::= ('+' | '-' | '~' | '!') unaryExpr | primaryExpr
 *
 * Results:
 *	The return value is TCL_OK on a successful compilation and TCL_ERROR
 *	on failure. If TCL_ERROR is returned, then the interpreter's result
 *	contains an error message.
 *
 *	envPtr->maxStackDepth is updated with the maximum number of stack
 *	elements needed to execute the expression.
 *
 * Side effects:
 *	Adds instructions to envPtr to evaluate the expression at runtime.
 *
 *----------------------------------------------------------------------
 */

static int
CompileUnaryExpr(interp, infoPtr, flags, envPtr)
    Tcl_Interp *interp;		/* Used for error reporting. */
    ExprInfo *infoPtr;		/* Describes the compilation state for the
				 * expression being compiled. */
    int flags;			/* Flags to control compilation (same as
				 * passed to Tcl_Eval). */
    CompileEnv *envPtr;		/* Holds resulting instructions. */
{
    int maxDepth = 0;		/* Maximum number of stack elements needed
				 * to execute the expression. */
    int op, result;

    HERE("unaryExpr", 12);
    op = infoPtr->token;
    if ((op == PLUS) || (op == MINUS) || (op == BIT_NOT) || (op == NOT)) {
	infoPtr->hasOperators = 1;
	infoPtr->exprIsJustVarRef = 0;
	result = GetToken(interp, infoPtr, envPtr); /* skip over the op */
	if (result != TCL_OK) {
	    goto done;
	}

	result = CompileUnaryExpr(interp, infoPtr, flags, envPtr);
	if (result != TCL_OK) {
	    goto done;
	}
	maxDepth = envPtr->maxStackDepth;

	switch (op) {
	case PLUS:
	    TclEmitOpcode(INST_UPLUS, envPtr);
	    break;
	case MINUS:
	    TclEmitOpcode(INST_UMINUS, envPtr);
	    break;
	case BIT_NOT:
	    TclEmitOpcode(INST_BITNOT, envPtr);
	    break;
	case NOT:
	    TclEmitOpcode(INST_LNOT, envPtr);
	    break;
	}

	/*
	 * A comparison is not the top-level operator in this expression.
	 */

	infoPtr->exprIsComparison = 0;
    } else {			/* must be a primaryExpr */
	result = CompilePrimaryExpr(interp, infoPtr, flags, envPtr);
	if (result != TCL_OK) {
	    goto done;
	}
	maxDepth = envPtr->maxStackDepth;
    }

    done:
    envPtr->maxStackDepth = maxDepth;
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * CompilePrimaryExpr --
 *
 *	This procedure compiles a Tcl primary expression:
 *	primaryExpr ::= literal | varReference | quotedString |
 *			'[' command ']' | mathFuncCall | '(' condExpr ')'
 *
 * Results:
 *	The return value is TCL_OK on a successful compilation and TCL_ERROR
 *	on failure. If TCL_ERROR is returned, then the interpreter's result
 *	contains an error message.
 *
 *	envPtr->maxStackDepth is updated with the maximum number of stack
 *	elements needed to execute the expression.
 *
 * Side effects:
 *	Adds instructions to envPtr to evaluate the expression at runtime.
 *
 *----------------------------------------------------------------------
 */

static int
CompilePrimaryExpr(interp, infoPtr, flags, envPtr)
    Tcl_Interp *interp;		/* Used for error reporting. */
    ExprInfo *infoPtr;		/* Describes the compilation state for the
				 * expression being compiled. */
    int flags;			/* Flags to control compilation (same as
				 * passed to Tcl_Eval). */
    CompileEnv *envPtr;		/* Holds resulting instructions. */
{
    int maxDepth = 0;		/* Maximum number of stack elements needed
				 * to execute the expression. */
    int theToken;
    char *dollarPtr, *quotePtr, *cmdPtr, *termPtr;
    int result = TCL_OK;

    /*
     * We emit tryCvtToNumeric instructions after most of these primary
     * expressions in order to support Tcl's policy of interpreting operands
     * as first integers if possible, otherwise floating-point numbers if
     * possible.
     */

    HERE("primaryExpr", 13);
    theToken = infoPtr->token;

    if ((theToken != DOLLAR) && (theToken != OPEN_PAREN)) {
	infoPtr->exprIsJustVarRef = 0;
    }
    switch (theToken) {
    case LITERAL:		/* int, double, or string in braces */
	TclEmitPush(infoPtr->objIndex, envPtr);
	maxDepth = 1;
	break;
	
    case DOLLAR:		/* $var variable reference */
	dollarPtr = (infoPtr->next - 1);
	envPtr->pushSimpleWords = 1;
	result = TclCompileDollarVar(interp, dollarPtr,
		infoPtr->lastChar, flags, envPtr);
	if (result != TCL_OK) {
	    goto done;
	}
	maxDepth = envPtr->maxStackDepth;
	infoPtr->next = (dollarPtr + envPtr->termOffset);
	break;
	
    case QUOTE:			/* quotedString */
	quotePtr = infoPtr->next;
	envPtr->pushSimpleWords = 1;
	result = TclCompileQuotes(interp, quotePtr,
		infoPtr->lastChar, '"', flags, envPtr);
	if (result != TCL_OK) {
	    goto done;
	}
	maxDepth = envPtr->maxStackDepth;
	infoPtr->next = (quotePtr + envPtr->termOffset);
	break;
	
    case OPEN_BRACKET:		/* '[' command ']' */
	cmdPtr = infoPtr->next;
	envPtr->pushSimpleWords = 1;
	result = TclCompileString(interp, cmdPtr,
		infoPtr->lastChar, (flags | TCL_BRACKET_TERM), envPtr);
	if (result != TCL_OK) {
	    goto done;
	}
	termPtr = (cmdPtr + envPtr->termOffset);
	if (*termPtr == ']') {
	    infoPtr->next = (termPtr + 1); /* advance over the ']'. */
	} else if (termPtr == infoPtr->lastChar) {
	    /*
	     * Missing ] at end of nested command.
	     */
	    
	    Tcl_ResetResult(interp);
	    Tcl_AppendToObj(Tcl_GetObjResult(interp),
	            "missing close-bracket", -1);
	    result = TCL_ERROR;
	    goto done;
	} else {
	    panic("CompilePrimaryExpr: unexpected termination char '%c' for nested command\n", *termPtr);
	}
	maxDepth = envPtr->maxStackDepth;
	break;
	
    case FUNC_NAME:
	result = CompileMathFuncCall(interp, infoPtr, flags, envPtr);
	if (result != TCL_OK) {
	    goto done;
	}
	maxDepth = envPtr->maxStackDepth;
	break;
	
    case OPEN_PAREN:
	result = GetToken(interp, infoPtr, envPtr); /* skip over the '(' */
	if (result != TCL_OK) {
	    goto done;
	}
	infoPtr->exprIsComparison = 0;
	result = CompileCondExpr(interp, infoPtr, flags, envPtr);
	if (result != TCL_OK) {
	    goto done;
	}
	maxDepth = envPtr->maxStackDepth;
	if (infoPtr->token != CLOSE_PAREN) {
	    goto syntaxError;
	}
	break;
	
    default:
	goto syntaxError;
    }

    if (theToken != FUNC_NAME) {
	/*
	 * Advance to the next token before returning.
	 */
	
	result = GetToken(interp, infoPtr, envPtr);
	if (result != TCL_OK) {
	    goto done;
	}
    }

    done:
    envPtr->maxStackDepth = maxDepth;
    return result;

    syntaxError:
    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
	    "syntax error in expression \"", infoPtr->originalExpr,
	    "\"", (char *) NULL);
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * CompileMathFuncCall --
 *
 *	This procedure compiles a call on a math function in an expression:
 *	mathFuncCall ::= funcName '(' [condExpr {',' condExpr}] ')'
 *
 * Results:
 *	The return value is TCL_OK on a successful compilation and TCL_ERROR
 *	on failure. If TCL_ERROR is returned, then the interpreter's result
 *	contains an error message.
 *
 *	envPtr->maxStackDepth is updated with the maximum number of stack
 *	elements needed to execute the function.
 *
 * Side effects:
 *	Adds instructions to envPtr to evaluate the math function at
 *	runtime.
 *
 *----------------------------------------------------------------------
 */

static int
CompileMathFuncCall(interp, infoPtr, flags, envPtr)
    Tcl_Interp *interp;		/* Used for error reporting. */
    ExprInfo *infoPtr;		/* Describes the compilation state for the
				 * expression being compiled. */
    int flags;			/* Flags to control compilation (same as
				 * passed to Tcl_Eval). */
    CompileEnv *envPtr;		/* Holds resulting instructions. */
{
    Interp *iPtr = (Interp *) interp;
    int maxDepth = 0;		/* Maximum number of stack elements needed
				 * to execute the expression. */
    MathFunc *mathFuncPtr;	/* Info about math function. */
    int objIndex;		/* The object array index for an object
				 * holding the function name if it is not
				 * builtin. */
    Tcl_HashEntry *hPtr;
    char *p, *funcName;
    char savedChar;
    int result, i;

    /*
     * infoPtr->funcName points to the first character of the math
     * function's name. Look for the end of its name and look up the
     * MathFunc record for the function.
     */

    funcName = p = infoPtr->funcName;
    while (isalnum(UCHAR(*p)) || (*p == '_')) {
	p++;
    }
    infoPtr->next = p;
    
    result = GetToken(interp, infoPtr, envPtr); /* skip over func name */
    if (result != TCL_OK) {
	goto done;
    }
    if (infoPtr->token != OPEN_PAREN) {
	goto syntaxError;
    }
    result = GetToken(interp, infoPtr, envPtr); /* skip over '(' */
    if (result != TCL_OK) {
	goto done;
    }
    
    savedChar = *p;
    *p = 0;
    hPtr = Tcl_FindHashEntry(&iPtr->mathFuncTable, funcName);
    if (hPtr == NULL) {
	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
		"unknown math function \"", funcName, "\"", (char *) NULL);
	result = TCL_ERROR;
	*p = savedChar;
	goto done;
    }
    mathFuncPtr = (MathFunc *) Tcl_GetHashValue(hPtr);

    /*
     * If not a builtin function, push an object with the function's name.
     */