tclcompexpr.c

linux系统下的音频通信

/* 
 * tclCompExpr.c --
 *
 *	This file contains the code to compile Tcl expressions.
 *
 * Copyright (c) 1996-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: @(#) tclCompExpr.c 1.34 97/11/03 14:29:18
 */

#include "tclInt.h"
#include "tclCompile.h"

/*
 * The stuff below is a bit of a hack so that this file can be used in
 * environments that include no UNIX, i.e. no errno: just arrange to use
 * the errno from tclExecute.c here.
 */

#ifndef TCL_GENERIC_ONLY
#include "tclPort.h"
#else
#define NO_ERRNO_H
#endif

#ifdef NO_ERRNO_H
extern int errno;			/* Use errno from tclExecute.c. */
#define ERANGE 34
#endif

/*
 * Boolean variable that controls whether expression compilation tracing
 * is enabled.
 */

#ifdef TCL_COMPILE_DEBUG
static int traceCompileExpr = 0;
#endif /* TCL_COMPILE_DEBUG */

/*
 * The ExprInfo structure describes the state of compiling an expression.
 * A pointer to an ExprInfo record is passed among the routines in
 * this module.
 */

typedef struct ExprInfo {
    int token;			/* Type of the last token parsed in expr.
				 * See below for definitions. Corresponds
				 * to the characters just before next. */
    int objIndex;		/* If token is a literal value, the index of
				 * an object holding the value in the code's
				 * object table; otherwise is NULL. */
    char *funcName;		/* If the token is FUNC_NAME, points to the
				 * first character of the math function's
				 * name; otherwise is NULL. */
    char *next;			/* Position of the next character to be
				 * scanned in the expression string. */
    char *originalExpr;		/* The entire expression that was originally
				 * passed to Tcl_ExprString et al. */
    char *lastChar;		/* Pointer to terminating null in
				 * originalExpr. */
    int hasOperators;		/* Set 1 if the expr has operators; 0 if
				 * expr is only a primary. If 1 after
				 * compiling an expr, a tryCvtToNumeric
				 * instruction is emitted to convert the
				 * primary to a number if possible. */
    int exprIsJustVarRef;	/* Set 1 if the expr consists of just a
				 * variable reference as in the expression
				 * of "if $b then...". Otherwise 0. If 1 the
				 * expr is compiled out-of-line in order to
				 * implement expr's 2 level substitution
				 * semantics properly. */
    int exprIsComparison;	/* Set 1 if the top-level operator in the
				 * expr is a comparison. Otherwise 0. If 1,
				 * because the operands might be strings,
				 * the expr is compiled out-of-line in order
				 * to implement expr's 2 level substitution
				 * semantics properly. */
} ExprInfo;

/*
 * Definitions of the different tokens that appear in expressions. The order
 * of these must match the corresponding entries in the operatorStrings
 * array below.
 */

#define LITERAL		0
#define FUNC_NAME	(LITERAL + 1)
#define OPEN_BRACKET	(LITERAL + 2)
#define CLOSE_BRACKET	(LITERAL + 3)
#define OPEN_PAREN	(LITERAL + 4)
#define CLOSE_PAREN	(LITERAL + 5)
#define DOLLAR		(LITERAL + 6)
#define QUOTE		(LITERAL + 7)
#define COMMA		(LITERAL + 8)
#define END		(LITERAL + 9)
#define UNKNOWN		(LITERAL + 10)

/*
 * Binary operators:
 */

#define MULT		(UNKNOWN + 1)
#define DIVIDE		(MULT + 1)
#define MOD		(MULT + 2)
#define PLUS		(MULT + 3)
#define MINUS		(MULT + 4)
#define LEFT_SHIFT	(MULT + 5)
#define RIGHT_SHIFT	(MULT + 6)
#define LESS		(MULT + 7)
#define GREATER		(MULT + 8)
#define LEQ		(MULT + 9)
#define GEQ		(MULT + 10)
#define EQUAL		(MULT + 11)
#define NEQ		(MULT + 12)
#define BIT_AND		(MULT + 13)
#define BIT_XOR		(MULT + 14)
#define BIT_OR		(MULT + 15)
#define AND		(MULT + 16)
#define OR		(MULT + 17)
#define QUESTY		(MULT + 18)
#define COLON		(MULT + 19)

/*
 * Unary operators. Unary minus and plus are represented by the (binary)
 * tokens MINUS and PLUS.
 */

#define NOT		(COLON + 1)
#define BIT_NOT		(NOT + 1)

/*
 * Mapping from tokens to strings; used for debugging messages. These
 * entries must match the order and number of the token definitions above.
 */

#ifdef TCL_COMPILE_DEBUG
static char *tokenStrings[] = {
    "LITERAL", "FUNCNAME",
    "[", "]", "(", ")", "$", "\"", ",", "END", "UNKNOWN",
    "*", "/", "%", "+", "-",
    "<<", ">>", "<", ">", "<=", ">=", "==", "!=",
    "&", "^", "|", "&&", "||", "?", ":",
    "!", "~"
};
#endif /* TCL_COMPILE_DEBUG */

/*
 * Declarations for local procedures to this file:
 */

static int		CompileAddExpr _ANSI_ARGS_((Tcl_Interp *interp,
			    ExprInfo *infoPtr, int flags,
			    CompileEnv *envPtr));
static int		CompileBitAndExpr _ANSI_ARGS_((Tcl_Interp *interp,
			    ExprInfo *infoPtr, int flags,
			    CompileEnv *envPtr));
static int		CompileBitOrExpr _ANSI_ARGS_((Tcl_Interp *interp,
			    ExprInfo *infoPtr, int flags,
			    CompileEnv *envPtr));
static int		CompileBitXorExpr _ANSI_ARGS_((Tcl_Interp *interp,
			    ExprInfo *infoPtr, int flags,
			    CompileEnv *envPtr));
static int		CompileCondExpr _ANSI_ARGS_((Tcl_Interp *interp,
			    ExprInfo *infoPtr, int flags,
			    CompileEnv *envPtr));
static int		CompileEqualityExpr _ANSI_ARGS_((Tcl_Interp *interp,
			    ExprInfo *infoPtr, int flags,
			    CompileEnv *envPtr));
static int		CompileLandExpr _ANSI_ARGS_((Tcl_Interp *interp,
			    ExprInfo *infoPtr, int flags,
			    CompileEnv *envPtr));
static int		CompileLorExpr _ANSI_ARGS_((Tcl_Interp *interp,
			    ExprInfo *infoPtr, int flags,
			    CompileEnv *envPtr));
static int		CompileMathFuncCall _ANSI_ARGS_((Tcl_Interp *interp,
			    ExprInfo *infoPtr, int flags,
			    CompileEnv *envPtr));
static int		CompileMultiplyExpr _ANSI_ARGS_((Tcl_Interp *interp,
			    ExprInfo *infoPtr, int flags,
			    CompileEnv *envPtr));
static int		CompilePrimaryExpr _ANSI_ARGS_((Tcl_Interp *interp,
			    ExprInfo *infoPtr, int flags,
			    CompileEnv *envPtr));
static int		CompileRelationalExpr _ANSI_ARGS_((
    			    Tcl_Interp *interp, ExprInfo *infoPtr,
			    int flags, CompileEnv *envPtr));
static int		CompileShiftExpr _ANSI_ARGS_((Tcl_Interp *interp,
			    ExprInfo *infoPtr, int flags,
			    CompileEnv *envPtr));
static int		CompileUnaryExpr _ANSI_ARGS_((Tcl_Interp *interp,
			    ExprInfo *infoPtr, int flags,
			    CompileEnv *envPtr));
static int		GetToken _ANSI_ARGS_((Tcl_Interp *interp,
			    ExprInfo *infoPtr, CompileEnv *envPtr));

/*
 * Macro used to debug the execution of the recursive descent parser used
 * to compile expressions.
 */

#ifdef TCL_COMPILE_DEBUG
#define HERE(production, level) \
    if (traceCompileExpr) { \
	fprintf(stderr, "%*s%s: token=%s, next=\"%.20s\"\n", \
		(level), " ", (production), tokenStrings[infoPtr->token], \
		infoPtr->next); \
    }
#else
#define HERE(production, level)
#endif /* TCL_COMPILE_DEBUG */

/*
 *----------------------------------------------------------------------
 *
 * TclCompileExpr --
 *
 *	This procedure compiles a string containing a Tcl expression into
 *	Tcl bytecodes. This procedure is the top-level interface to the
 *	the expression compilation module, and is used by such public
 *	procedures as Tcl_ExprString, Tcl_ExprStringObj, Tcl_ExprLong,
 *	Tcl_ExprDouble, Tcl_ExprBoolean, and Tcl_ExprBooleanObj.
 *
 *	Note that the topmost recursive-descent parsing routine used by
 *	TclCompileExpr to compile expressions is called "CompileCondExpr"
 *	and not, e.g., "CompileExpr". This is done to avoid an extra
 *	procedure call since such a procedure would only return the result
 *	of calling CompileCondExpr. Other recursive-descent procedures
 *	that need to parse expressions also call CompileCondExpr.
 *
 * 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->termOffset is filled in with the offset of the character in
 *	"string" just after the last one successfully processed; this might
 *	be the offset of the ']' (if flags & TCL_BRACKET_TERM), or the
 *	offset of the '\0' at the end of the string.
 *
 *	envPtr->maxStackDepth is updated with the maximum number of stack
 *	elements needed to execute the expression.
 *
 *	envPtr->exprIsJustVarRef is set 1 if the expression consisted of
 *	a single variable reference as in the expression of "if $b then...".
 *	Otherwise it is set 0. This is used to implement Tcl's two level
 *	expression substitution semantics properly.
 *
 *	envPtr->exprIsComparison is set 1 if the top-level operator in the
 *	expr is a comparison. Otherwise it is set 0. If 1, because the
 *	operands might be strings, the expr is compiled out-of-line in order
 *	to implement expr's 2 level substitution semantics properly.
 *
 * Side effects:
 *	Adds instructions to envPtr to evaluate the expression at runtime.
 *
 *----------------------------------------------------------------------
 */

int
TclCompileExpr(interp, string, lastChar, flags, envPtr)
    Tcl_Interp *interp;		/* Used for error reporting. */
    char *string;		/* The source string to compile. */
    char *lastChar;		/* Pointer to terminating character of
				 * string. */
    int flags;			/* Flags to control compilation (same as
				 * passed to Tcl_Eval). */
    CompileEnv *envPtr;		/* Holds resulting instructions. */
{
    Interp *iPtr = (Interp *) interp;
    ExprInfo info;
    int maxDepth = 0;		/* Maximum number of stack elements needed
				 * to execute the expression. */
    int result;

#ifdef TCL_COMPILE_DEBUG
    if (traceCompileExpr) {
	fprintf(stderr, "expr: string=\"%.30s\"\n", string);
    }
#endif /* TCL_COMPILE_DEBUG */

    /*
     * Register the builtin math functions the first time an expression is
     * compiled.
     */

    if (!(iPtr->flags & EXPR_INITIALIZED)) {
	BuiltinFunc *funcPtr;
	Tcl_HashEntry *hPtr;
	MathFunc *mathFuncPtr;
	int i;

	iPtr->flags |= EXPR_INITIALIZED;
	i = 0;
	for (funcPtr = builtinFuncTable; funcPtr->name != NULL; funcPtr++) {
	    Tcl_CreateMathFunc(interp, funcPtr->name,
		    funcPtr->numArgs, funcPtr->argTypes,
		    (Tcl_MathProc *) NULL, (ClientData) 0);
	    
	    hPtr = Tcl_FindHashEntry(&iPtr->mathFuncTable, funcPtr->name);
	    if (hPtr == NULL) {
		panic("TclCompileExpr: Tcl_CreateMathFunc incorrectly registered '%s'", funcPtr->name);
		return TCL_ERROR;
	    }
	    mathFuncPtr = (MathFunc *) Tcl_GetHashValue(hPtr);
	    mathFuncPtr->builtinFuncIndex = i;
	    i++;
	}
    }

    info.token = UNKNOWN;
    info.objIndex = -1;
    info.funcName = NULL;
    info.next = string;
    info.originalExpr = string;
    info.lastChar = lastChar;
    info.hasOperators = 0;
    info.exprIsJustVarRef = 1;	/* will be set 0 if anything else is seen */
    info.exprIsComparison = 0;	/* set 1 if topmost operator is <,==,etc. */

    /*
     * Get the first token then compile an expression.
     */

    result = GetToken(interp, &info, envPtr);
    if (result != TCL_OK) {
	goto done;
    }
    
    result = CompileCondExpr(interp, &info, flags, envPtr);
    if (result != TCL_OK) {
	goto done;
    }
    if (info.token != END) {
	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
		"syntax error in expression \"", string, "\"", (char *) NULL);
	result = TCL_ERROR;
	goto done;
    }
    if (!info.hasOperators) {
	/*
	 * Attempt to convert the primary's object to an int or double.
	 * This is done in order to support Tcl's policy of interpreting
	 * operands if at all possible as first integers, else
	 * floating-point numbers.
	 */
	
	TclEmitOpcode(INST_TRY_CVT_TO_NUMERIC, envPtr);
    }
    maxDepth = envPtr->maxStackDepth;

    done:
    envPtr->termOffset = (info.next - string);
    envPtr->maxStackDepth = maxDepth;
    envPtr->exprIsJustVarRef = info.exprIsJustVarRef;
    envPtr->exprIsComparison = info.exprIsComparison;
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * CompileCondExpr --
 *
 *	This procedure compiles a Tcl conditional expression:
 *	condExpr ::= lorExpr ['?' condExpr ':' condExpr]
 *
 *	Note that this is the topmost recursive-descent parsing routine used
 *	by TclCompileExpr to compile expressions. It does not call an
 *	separate, higher-level "CompileExpr" procedure. This avoids an extra
 *	procedure call since such a procedure would only return the result
 *	of calling CompileCondExpr. Other recursive-descent procedures that
 *	need to parse expressions also call CompileCondExpr.
 *
 * 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
CompileCondExpr(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. */
    JumpFixup jumpAroundThenFixup, jumpAroundElseFixup;
				/* Used to update or replace one-byte jumps
				 * around the then and else expressions when
				 * their target PCs are determined. */
    int elseCodeOffset, currCodeOffset, jumpDist, result;
    
    HERE("condExpr", 1);
    result = CompileLorExpr(interp, infoPtr, flags, envPtr);
    if (result != TCL_OK) {
	goto done;
    }
    maxDepth = envPtr->maxStackDepth;
    
    if (infoPtr->token == QUESTY) {
	result = GetToken(interp, infoPtr, envPtr); /* skip over the '?' */
	if (result != TCL_OK) {
	    goto done;
	}

	/*
	 * Emit the jump around the "then" clause to the "else" condExpr if
	 * the test was false. We emit a one byte (relative) jump here, and
	 * replace it later with a four byte jump if the jump target is more
	 * than 127 bytes away.
	 */

	TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, &jumpAroundThenFixup);

	/*
	 * Compile the "then" expression. Note that if a subexpression
	 * is only a primary, we need to try to convert it to numeric.
	 * This is done in order to support Tcl's policy of interpreting
	 * operands if at all possible as first integers, else
	 * floating-point numbers.
	 */

	infoPtr->hasOperators = 0;
	infoPtr->exprIsJustVarRef = 0;
	infoPtr->exprIsComparison = 0;
	result = CompileCondExpr(interp, infoPtr, flags, envPtr);
	if (result != TCL_OK) {
	    goto done;
	}
	maxDepth = TclMax(envPtr->maxStackDepth, maxDepth);
	if (infoPtr->token != COLON) {
	    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),