diff -r 000000000000 -r bde4ae8d615e os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/generic/tclCompExpr.c --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/generic/tclCompExpr.c Fri Jun 15 03:10:57 2012 +0200 @@ -0,0 +1,973 @@ +/* + * tclCompExpr.c -- + * + * This file contains the code to compile Tcl expressions. + * + * Copyright (c) 1997 Sun Microsystems, Inc. + * Copyright (c) 1998-2000 by Scriptics Corporation. + * Portions Copyright (c) 2007 Nokia Corporation and/or its subsidiaries. All rights reserved. + * + * See the file "license.terms" for information on usage and redistribution + * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + * + * RCS: @(#) $Id: tclCompExpr.c,v 1.13.2.3 2006/11/28 22:20:00 andreas_kupries Exp $ + */ + +#include "tclInt.h" +#include "tclCompile.h" +#if defined(__SYMBIAN32__) +#include "tclSymbianGlobals.h" +#endif + +/* + * 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 traceExprComp = 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 { + Tcl_Interp *interp; /* Used for error reporting. */ + Tcl_Parse *parsePtr; /* Structure filled with information about + * the parsed expression. */ + CONST char *expr; /* The expression that was originally passed + * to TclCompileExpr. */ + CONST char *lastChar; /* Points just after last byte of expr. */ + 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. */ +} ExprInfo; + +/* + * Definitions of numeric codes representing each expression operator. + * The order of these must match the entries in the operatorTable below. + * Also the codes for the relational operators (OP_LESS, OP_GREATER, + * OP_LE, OP_GE, OP_EQ, and OP_NE) must be consecutive and in that order. + * Note that OP_PLUS and OP_MINUS represent both unary and binary operators. + */ + +#define OP_MULT 0 +#define OP_DIVIDE 1 +#define OP_MOD 2 +#define OP_PLUS 3 +#define OP_MINUS 4 +#define OP_LSHIFT 5 +#define OP_RSHIFT 6 +#define OP_LESS 7 +#define OP_GREATER 8 +#define OP_LE 9 +#define OP_GE 10 +#define OP_EQ 11 +#define OP_NEQ 12 +#define OP_BITAND 13 +#define OP_BITXOR 14 +#define OP_BITOR 15 +#define OP_LAND 16 +#define OP_LOR 17 +#define OP_QUESTY 18 +#define OP_LNOT 19 +#define OP_BITNOT 20 +#define OP_STREQ 21 +#define OP_STRNEQ 22 + +/* + * Table describing the expression operators. Entries in this table must + * correspond to the definitions of numeric codes for operators just above. + */ +#if !defined(__SYMBIAN32__) || !defined(__WINSCW__) +static int opTableInitialized = 0; /* 0 means not yet initialized. */ +#endif + +TCL_DECLARE_MUTEX(opMutex) + +typedef struct OperatorDesc { + char *name; /* Name of the operator. */ + int numOperands; /* Number of operands. 0 if the operator + * requires special handling. */ + int instruction; /* Instruction opcode for the operator. + * Ignored if numOperands is 0. */ +} OperatorDesc; + +static OperatorDesc operatorTable[] = { + {"*", 2, INST_MULT}, + {"/", 2, INST_DIV}, + {"%", 2, INST_MOD}, + {"+", 0}, + {"-", 0}, + {"<<", 2, INST_LSHIFT}, + {">>", 2, INST_RSHIFT}, + {"<", 2, INST_LT}, + {">", 2, INST_GT}, + {"<=", 2, INST_LE}, + {">=", 2, INST_GE}, + {"==", 2, INST_EQ}, + {"!=", 2, INST_NEQ}, + {"&", 2, INST_BITAND}, + {"^", 2, INST_BITXOR}, + {"|", 2, INST_BITOR}, + {"&&", 0}, + {"||", 0}, + {"?", 0}, + {"!", 1, INST_LNOT}, + {"~", 1, INST_BITNOT}, + {"eq", 2, INST_STR_EQ}, + {"ne", 2, INST_STR_NEQ}, + {NULL} +}; + +#if !defined(__SYMBIAN32__) || !defined(__WINSCW__) +/* + * Hashtable used to map the names of expression operators to the index + * of their OperatorDesc description. + */ +static Tcl_HashTable opHashTable; +#endif + +/* + * Declarations for local procedures to this file: + */ + +static int CompileCondExpr _ANSI_ARGS_(( + Tcl_Token *exprTokenPtr, ExprInfo *infoPtr, + CompileEnv *envPtr, Tcl_Token **endPtrPtr)); +static int CompileLandOrLorExpr _ANSI_ARGS_(( + Tcl_Token *exprTokenPtr, int opIndex, + ExprInfo *infoPtr, CompileEnv *envPtr, + Tcl_Token **endPtrPtr)); +static int CompileMathFuncCall _ANSI_ARGS_(( + Tcl_Token *exprTokenPtr, CONST char *funcName, + ExprInfo *infoPtr, CompileEnv *envPtr, + Tcl_Token **endPtrPtr)); +static int CompileSubExpr _ANSI_ARGS_(( + Tcl_Token *exprTokenPtr, ExprInfo *infoPtr, + CompileEnv *envPtr)); +static void LogSyntaxError _ANSI_ARGS_((ExprInfo *infoPtr)); + +/* + * Macro used to debug the execution of the expression compiler. + */ + +#ifdef TCL_COMPILE_DEBUG +#define TRACE(exprBytes, exprLength, tokenBytes, tokenLength) \ + if (traceExprComp) { \ + fprintf(stderr, "CompileSubExpr: \"%.*s\", token \"%.*s\"\n", \ + (exprLength), (exprBytes), (tokenLength), (tokenBytes)); \ + } +#else +#define TRACE(exprBytes, exprLength, tokenBytes, tokenLength) +#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. + * + * 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. + * + * Side effects: + * Adds instructions to envPtr to evaluate the expression at runtime. + * + *---------------------------------------------------------------------- + */ + +int +TclCompileExpr(interp, script, numBytes, envPtr) + Tcl_Interp *interp; /* Used for error reporting. */ + CONST char *script; /* The source script to compile. */ + int numBytes; /* Number of bytes in script. If < 0, the + * string consists of all bytes up to the + * first null character. */ + CompileEnv *envPtr; /* Holds resulting instructions. */ +{ + ExprInfo info; + Tcl_Parse parse; + Tcl_HashEntry *hPtr; + int new, i, code; + + /* + * If this is the first time we've been called, initialize the table + * of expression operators. + */ + + if (numBytes < 0) { + numBytes = (script? strlen(script) : 0); + } + if (!opTableInitialized) { + Tcl_MutexLock(&opMutex); + if (!opTableInitialized) { + Tcl_InitHashTable(&opHashTable, TCL_STRING_KEYS); + for (i = 0; operatorTable[i].name != NULL; i++) { + hPtr = Tcl_CreateHashEntry(&opHashTable, + operatorTable[i].name, &new); + if (new) { + Tcl_SetHashValue(hPtr, (ClientData) i); + } + } + opTableInitialized = 1; + } + Tcl_MutexUnlock(&opMutex); + } + + /* + * Initialize the structure containing information abvout this + * expression compilation. + */ + + info.interp = interp; + info.parsePtr = &parse; + info.expr = script; + info.lastChar = (script + numBytes); + info.hasOperators = 0; + + /* + * Parse the expression then compile it. + */ + + code = Tcl_ParseExpr(interp, script, numBytes, &parse); + if (code != TCL_OK) { + goto done; + } + +#ifdef TCL_TIP280 + /* TIP #280 : Track Lines within the expression */ + TclAdvanceLines (&envPtr->line, script, parse.tokenPtr->start); +#endif + + code = CompileSubExpr(parse.tokenPtr, &info, envPtr); + if (code != TCL_OK) { + Tcl_FreeParse(&parse); + 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); + } + Tcl_FreeParse(&parse); + + done: + return code; +} + +/* + *---------------------------------------------------------------------- + * + * TclFinalizeCompilation -- + * + * Clean up the compilation environment so it can later be + * properly reinitialized. This procedure is called by Tcl_Finalize(). + * + * Results: + * None. + * + * Side effects: + * Cleans up the compilation environment. At the moment, just the + * table of expression operators is freed. + * + *---------------------------------------------------------------------- + */ + +void +TclFinalizeCompilation() +{ + Tcl_MutexLock(&opMutex); + if (opTableInitialized) { + Tcl_DeleteHashTable(&opHashTable); + opTableInitialized = 0; + } + Tcl_MutexUnlock(&opMutex); +} + +/* + *---------------------------------------------------------------------- + * + * CompileSubExpr -- + * + * Given a pointer to a TCL_TOKEN_SUB_EXPR token describing a + * subexpression, this procedure emits instructions to evaluate the + * subexpression at runtime. + * + * 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. + * + * Side effects: + * Adds instructions to envPtr to evaluate the subexpression. + * + *---------------------------------------------------------------------- + */ + +static int +CompileSubExpr(exprTokenPtr, infoPtr, envPtr) + Tcl_Token *exprTokenPtr; /* Points to TCL_TOKEN_SUB_EXPR token + * to compile. */ + ExprInfo *infoPtr; /* Describes the compilation state for the + * expression being compiled. */ + CompileEnv *envPtr; /* Holds resulting instructions. */ +{ + Tcl_Interp *interp = infoPtr->interp; + Tcl_Token *tokenPtr, *endPtr = NULL; /* silence gcc 4 warning */ + Tcl_Token *afterSubexprPtr; + OperatorDesc *opDescPtr; + Tcl_HashEntry *hPtr; + CONST char *operator; + Tcl_DString opBuf; + int objIndex, opIndex, length, code; + char buffer[TCL_UTF_MAX]; + + if (exprTokenPtr->type != TCL_TOKEN_SUB_EXPR) { + panic("CompileSubExpr: token type %d not TCL_TOKEN_SUB_EXPR\n", + exprTokenPtr->type); + } + code = TCL_OK; + + /* + * Switch on the type of the first token after the subexpression token. + * After processing it, advance tokenPtr to point just after the + * subexpression's last token. + */ + + tokenPtr = exprTokenPtr+1; + TRACE(exprTokenPtr->start, exprTokenPtr->size, + tokenPtr->start, tokenPtr->size); + switch (tokenPtr->type) { + case TCL_TOKEN_WORD: + code = TclCompileTokens(interp, tokenPtr+1, + tokenPtr->numComponents, envPtr); + if (code != TCL_OK) { + goto done; + } + tokenPtr += (tokenPtr->numComponents + 1); + break; + + case TCL_TOKEN_TEXT: + if (tokenPtr->size > 0) { + objIndex = TclRegisterNewLiteral(envPtr, tokenPtr->start, + tokenPtr->size); + } else { + objIndex = TclRegisterNewLiteral(envPtr, "", 0); + } + TclEmitPush(objIndex, envPtr); + tokenPtr += 1; + break; + + case TCL_TOKEN_BS: + length = Tcl_UtfBackslash(tokenPtr->start, (int *) NULL, + buffer); + if (length > 0) { + objIndex = TclRegisterNewLiteral(envPtr, buffer, length); + } else { + objIndex = TclRegisterNewLiteral(envPtr, "", 0); + } + TclEmitPush(objIndex, envPtr); + tokenPtr += 1; + break; + + case TCL_TOKEN_COMMAND: + code = TclCompileScript(interp, tokenPtr->start+1, + tokenPtr->size-2, /*nested*/ 0, envPtr); + if (code != TCL_OK) { + goto done; + } + tokenPtr += 1; + break; + + case TCL_TOKEN_VARIABLE: + code = TclCompileTokens(interp, tokenPtr, 1, envPtr); + if (code != TCL_OK) { + goto done; + } + tokenPtr += (tokenPtr->numComponents + 1); + break; + + case TCL_TOKEN_SUB_EXPR: + code = CompileSubExpr(tokenPtr, infoPtr, envPtr); + if (code != TCL_OK) { + goto done; + } + tokenPtr += (tokenPtr->numComponents + 1); + break; + + case TCL_TOKEN_OPERATOR: + /* + * Look up the operator. If the operator isn't found, treat it + * as a math function. + */ + Tcl_DStringInit(&opBuf); + operator = Tcl_DStringAppend(&opBuf, + tokenPtr->start, tokenPtr->size); + hPtr = Tcl_FindHashEntry(&opHashTable, operator); + if (hPtr == NULL) { + code = CompileMathFuncCall(exprTokenPtr, operator, infoPtr, + envPtr, &endPtr); + Tcl_DStringFree(&opBuf); + if (code != TCL_OK) { + goto done; + } + tokenPtr = endPtr; + break; + } + Tcl_DStringFree(&opBuf); + opIndex = (int) Tcl_GetHashValue(hPtr); + opDescPtr = &(operatorTable[opIndex]); + + /* + * If the operator is "normal", compile it using information + * from the operator table. + */ + + if (opDescPtr->numOperands > 0) { + tokenPtr++; + code = CompileSubExpr(tokenPtr, infoPtr, envPtr); + if (code != TCL_OK) { + goto done; + } + tokenPtr += (tokenPtr->numComponents + 1); + + if (opDescPtr->numOperands == 2) { + code = CompileSubExpr(tokenPtr, infoPtr, envPtr); + if (code != TCL_OK) { + goto done; + } + tokenPtr += (tokenPtr->numComponents + 1); + } + TclEmitOpcode(opDescPtr->instruction, envPtr); + infoPtr->hasOperators = 1; + break; + } + + /* + * The operator requires special treatment, and is either + * "+" or "-", or one of "&&", "||" or "?". + */ + + switch (opIndex) { + case OP_PLUS: + case OP_MINUS: + tokenPtr++; + code = CompileSubExpr(tokenPtr, infoPtr, envPtr); + if (code != TCL_OK) { + goto done; + } + tokenPtr += (tokenPtr->numComponents + 1); + + /* + * Check whether the "+" or "-" is unary. + */ + + afterSubexprPtr = exprTokenPtr + + exprTokenPtr->numComponents+1; + if (tokenPtr == afterSubexprPtr) { + TclEmitOpcode(((opIndex==OP_PLUS)? + INST_UPLUS : INST_UMINUS), + envPtr); + break; + } + + /* + * The "+" or "-" is binary. + */ + + code = CompileSubExpr(tokenPtr, infoPtr, envPtr); + if (code != TCL_OK) { + goto done; + } + tokenPtr += (tokenPtr->numComponents + 1); + TclEmitOpcode(((opIndex==OP_PLUS)? INST_ADD : INST_SUB), + envPtr); + break; + + case OP_LAND: + case OP_LOR: + code = CompileLandOrLorExpr(exprTokenPtr, opIndex, + infoPtr, envPtr, &endPtr); + if (code != TCL_OK) { + goto done; + } + tokenPtr = endPtr; + break; + + case OP_QUESTY: + code = CompileCondExpr(exprTokenPtr, infoPtr, + envPtr, &endPtr); + if (code != TCL_OK) { + goto done; + } + tokenPtr = endPtr; + break; + + default: + panic("CompileSubExpr: unexpected operator %d requiring special treatment\n", + opIndex); + } /* end switch on operator requiring special treatment */ + infoPtr->hasOperators = 1; + break; + + default: + panic("CompileSubExpr: unexpected token type %d\n", + tokenPtr->type); + } + + /* + * Verify that the subexpression token had the required number of + * subtokens: that we've advanced tokenPtr just beyond the + * subexpression's last token. For example, a "*" subexpression must + * contain the tokens for exactly two operands. + */ + + if (tokenPtr != (exprTokenPtr + exprTokenPtr->numComponents+1)) { + LogSyntaxError(infoPtr); + code = TCL_ERROR; + } + + done: + return code; +} + +/* + *---------------------------------------------------------------------- + * + * CompileLandOrLorExpr -- + * + * This procedure compiles a Tcl logical and ("&&") or logical or + * ("||") subexpression. + * + * Results: + * The return value is TCL_OK on a successful compilation and TCL_ERROR + * on failure. If TCL_OK is returned, a pointer to the token just after + * the last one in the subexpression is stored at the address in + * endPtrPtr. If TCL_ERROR is returned, then the interpreter's result + * contains an error message. + * + * Side effects: + * Adds instructions to envPtr to evaluate the expression at runtime. + * + *---------------------------------------------------------------------- + */ + +static int +CompileLandOrLorExpr(exprTokenPtr, opIndex, infoPtr, envPtr, endPtrPtr) + Tcl_Token *exprTokenPtr; /* Points to TCL_TOKEN_SUB_EXPR token + * containing the "&&" or "||" operator. */ + int opIndex; /* A code describing the expression + * operator: either OP_LAND or OP_LOR. */ + ExprInfo *infoPtr; /* Describes the compilation state for the + * expression being compiled. */ + CompileEnv *envPtr; /* Holds resulting instructions. */ + Tcl_Token **endPtrPtr; /* If successful, a pointer to the token + * just after the last token in the + * subexpression is stored here. */ +{ + JumpFixup shortCircuitFixup; /* Used to fix up the short circuit jump + * after the first subexpression. */ + JumpFixup lhsTrueFixup, lhsEndFixup; + /* Used to fix up jumps used to convert the + * first operand to 0 or 1. */ + Tcl_Token *tokenPtr; + int dist, code; + int savedStackDepth = envPtr->currStackDepth; + + /* + * Emit code for the first operand. + */ + + tokenPtr = exprTokenPtr+2; + code = CompileSubExpr(tokenPtr, infoPtr, envPtr); + if (code != TCL_OK) { + goto done; + } + tokenPtr += (tokenPtr->numComponents + 1); + + /* + * Convert the first operand to the result that Tcl requires: + * "0" or "1". Eventually we'll use a new instruction for this. + */ + + TclEmitForwardJump(envPtr, TCL_TRUE_JUMP, &lhsTrueFixup); + TclEmitPush(TclRegisterNewLiteral(envPtr, "0", 1), envPtr); + TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &lhsEndFixup); + dist = (envPtr->codeNext - envPtr->codeStart) - lhsTrueFixup.codeOffset; + if (TclFixupForwardJump(envPtr, &lhsTrueFixup, dist, 127)) { + badDist: + panic("CompileLandOrLorExpr: bad jump distance %d\n", dist); + } + envPtr->currStackDepth = savedStackDepth; + TclEmitPush(TclRegisterNewLiteral(envPtr, "1", 1), envPtr); + dist = (envPtr->codeNext - envPtr->codeStart) - lhsEndFixup.codeOffset; + if (TclFixupForwardJump(envPtr, &lhsEndFixup, dist, 127)) { + goto badDist; + } + + /* + * Emit the "short circuit" jump around the rest of the expression. + * Duplicate the "0" or "1" on top of the stack first to keep the + * jump from consuming it. + */ + + TclEmitOpcode(INST_DUP, envPtr); + TclEmitForwardJump(envPtr, + ((opIndex==OP_LAND)? TCL_FALSE_JUMP : TCL_TRUE_JUMP), + &shortCircuitFixup); + + /* + * Emit code for the second operand. + */ + + code = CompileSubExpr(tokenPtr, infoPtr, envPtr); + if (code != TCL_OK) { + goto done; + } + tokenPtr += (tokenPtr->numComponents + 1); + + /* + * Emit a "logical and" or "logical or" instruction. This does not try + * to "short- circuit" the evaluation of both operands, but instead + * ensures that we either have a "1" or a "0" result. + */ + + TclEmitOpcode(((opIndex==OP_LAND)? INST_LAND : INST_LOR), envPtr); + + /* + * Now that we know the target of the forward jump, update it with the + * correct distance. + */ + + dist = (envPtr->codeNext - envPtr->codeStart) + - shortCircuitFixup.codeOffset; + TclFixupForwardJump(envPtr, &shortCircuitFixup, dist, 127); + *endPtrPtr = tokenPtr; + + done: + envPtr->currStackDepth = savedStackDepth + 1; + return code; +} + +/* + *---------------------------------------------------------------------- + * + * CompileCondExpr -- + * + * This procedure compiles a Tcl conditional expression: + * condExpr ::= lorExpr ['?' condExpr ':' condExpr] + * + * Results: + * The return value is TCL_OK on a successful compilation and TCL_ERROR + * on failure. If TCL_OK is returned, a pointer to the token just after + * the last one in the subexpression is stored at the address in + * endPtrPtr. If TCL_ERROR is returned, then the interpreter's result + * contains an error message. + * + * Side effects: + * Adds instructions to envPtr to evaluate the expression at runtime. + * + *---------------------------------------------------------------------- + */ + +static int +CompileCondExpr(exprTokenPtr, infoPtr, envPtr, endPtrPtr) + Tcl_Token *exprTokenPtr; /* Points to TCL_TOKEN_SUB_EXPR token + * containing the "?" operator. */ + ExprInfo *infoPtr; /* Describes the compilation state for the + * expression being compiled. */ + CompileEnv *envPtr; /* Holds resulting instructions. */ + Tcl_Token **endPtrPtr; /* If successful, a pointer to the token + * just after the last token in the + * subexpression is stored here. */ +{ + JumpFixup jumpAroundThenFixup, jumpAroundElseFixup; + /* Used to update or replace one-byte jumps + * around the then and else expressions when + * their target PCs are determined. */ + Tcl_Token *tokenPtr; + int elseCodeOffset, dist, code; + int savedStackDepth = envPtr->currStackDepth; + + /* + * Emit code for the test. + */ + + tokenPtr = exprTokenPtr+2; + code = CompileSubExpr(tokenPtr, infoPtr, envPtr); + if (code != TCL_OK) { + goto done; + } + tokenPtr += (tokenPtr->numComponents + 1); + + /* + * Emit the jump to the "else" expression if the test was false. + */ + + 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. We do this to + * support Tcl's policy of interpreting operands if at all possible as + * first integers, else floating-point numbers. + */ + + infoPtr->hasOperators = 0; + code = CompileSubExpr(tokenPtr, infoPtr, envPtr); + if (code != TCL_OK) { + goto done; + } + tokenPtr += (tokenPtr->numComponents + 1); + if (!infoPtr->hasOperators) { + TclEmitOpcode(INST_TRY_CVT_TO_NUMERIC, envPtr); + } + + /* + * Emit an unconditional jump around the "else" condExpr. + */ + + TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, + &jumpAroundElseFixup); + + /* + * Compile the "else" expression. + */ + + envPtr->currStackDepth = savedStackDepth; + elseCodeOffset = (envPtr->codeNext - envPtr->codeStart); + infoPtr->hasOperators = 0; + code = CompileSubExpr(tokenPtr, infoPtr, envPtr); + if (code != TCL_OK) { + goto done; + } + tokenPtr += (tokenPtr->numComponents + 1); + if (!infoPtr->hasOperators) { + TclEmitOpcode(INST_TRY_CVT_TO_NUMERIC, envPtr); + } + + /* + * Fix up the second jump around the "else" expression. + */ + + dist = (envPtr->codeNext - envPtr->codeStart) + - jumpAroundElseFixup.codeOffset; + if (TclFixupForwardJump(envPtr, &jumpAroundElseFixup, dist, 127)) { + /* + * Update the else expression's starting code offset since it + * moved down 3 bytes too. + */ + + elseCodeOffset += 3; + } + + /* + * Fix up the first jump to the "else" expression if the test was false. + */ + + dist = (elseCodeOffset - jumpAroundThenFixup.codeOffset); + TclFixupForwardJump(envPtr, &jumpAroundThenFixup, dist, 127); + *endPtrPtr = tokenPtr; + + done: + envPtr->currStackDepth = savedStackDepth + 1; + return code; +} + +/* + *---------------------------------------------------------------------- + * + * 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_OK is returned, a pointer to the token just after + * the last one in the subexpression is stored at the address in + * endPtrPtr. If TCL_ERROR is returned, then the interpreter's result + * contains an error message. + * + * Side effects: + * Adds instructions to envPtr to evaluate the math function at + * runtime. + * + *---------------------------------------------------------------------- + */ + +static int +CompileMathFuncCall(exprTokenPtr, funcName, infoPtr, envPtr, endPtrPtr) + Tcl_Token *exprTokenPtr; /* Points to TCL_TOKEN_SUB_EXPR token + * containing the math function call. */ + CONST char *funcName; /* Name of the math function. */ + ExprInfo *infoPtr; /* Describes the compilation state for the + * expression being compiled. */ + CompileEnv *envPtr; /* Holds resulting instructions. */ + Tcl_Token **endPtrPtr; /* If successful, a pointer to the token + * just after the last token in the + * subexpression is stored here. */ +{ + Tcl_Interp *interp = infoPtr->interp; + Interp *iPtr = (Interp *) interp; + MathFunc *mathFuncPtr; + Tcl_HashEntry *hPtr; + Tcl_Token *tokenPtr, *afterSubexprPtr; + int code, i; + + /* + * Look up the MathFunc record for the function. + */ + + code = TCL_OK; + hPtr = Tcl_FindHashEntry(&iPtr->mathFuncTable, funcName); + if (hPtr == NULL) { + Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), + "unknown math function \"", funcName, "\"", (char *) NULL); + code = TCL_ERROR; + goto done; + } + mathFuncPtr = (MathFunc *) Tcl_GetHashValue(hPtr); + + /* + * If not a builtin function, push an object with the function's name. + */ + + if (mathFuncPtr->builtinFuncIndex < 0) { + TclEmitPush(TclRegisterNewLiteral(envPtr, funcName, -1), envPtr); + } + + /* + * Compile any arguments for the function. + */ + + tokenPtr = exprTokenPtr+2; + afterSubexprPtr = exprTokenPtr + (exprTokenPtr->numComponents + 1); + if (mathFuncPtr->numArgs > 0) { + for (i = 0; i < mathFuncPtr->numArgs; i++) { + if (tokenPtr == afterSubexprPtr) { + Tcl_ResetResult(interp); + Tcl_AppendToObj(Tcl_GetObjResult(interp), + "too few arguments for math function", -1); + code = TCL_ERROR; + goto done; + } + code = CompileSubExpr(tokenPtr, infoPtr, envPtr); + if (code != TCL_OK) { + goto done; + } + tokenPtr += (tokenPtr->numComponents + 1); + } + if (tokenPtr != afterSubexprPtr) { + Tcl_ResetResult(interp); + Tcl_AppendToObj(Tcl_GetObjResult(interp), + "too many arguments for math function", -1); + code = TCL_ERROR; + goto done; + } + } else if (tokenPtr != afterSubexprPtr) { + Tcl_ResetResult(interp); + Tcl_AppendToObj(Tcl_GetObjResult(interp), + "too many arguments for math function", -1); + code = TCL_ERROR; + goto done; + } + + /* + * Compile the call on the math function. Note that the "objc" argument + * count for non-builtin functions is incremented by 1 to include the + * function name itself. + */ + + if (mathFuncPtr->builtinFuncIndex >= 0) { /* a builtin function */ + /* + * Adjust the current stack depth by the number of arguments + * of the builtin function. This cannot be handled by the + * TclEmitInstInt1 macro as the number of arguments is not + * passed as an operand. + */ + + if (envPtr->maxStackDepth < envPtr->currStackDepth) { + envPtr->maxStackDepth = envPtr->currStackDepth; + } + TclEmitInstInt1(INST_CALL_BUILTIN_FUNC1, + mathFuncPtr->builtinFuncIndex, envPtr); + envPtr->currStackDepth -= mathFuncPtr->numArgs; + } else { + TclEmitInstInt1(INST_CALL_FUNC1, (mathFuncPtr->numArgs+1), envPtr); + } + *endPtrPtr = afterSubexprPtr; + + done: + return code; +} + +/* + *---------------------------------------------------------------------- + * + * LogSyntaxError -- + * + * This procedure is invoked after an error occurs when compiling an + * expression. It sets the interpreter result to an error message + * describing the error. + * + * Results: + * None. + * + * Side effects: + * Sets the interpreter result to an error message describing the + * expression that was being compiled when the error occurred. + * + *---------------------------------------------------------------------- + */ + +static void +LogSyntaxError(infoPtr) + ExprInfo *infoPtr; /* Describes the compilation state for the + * expression being compiled. */ +{ + int numBytes = (infoPtr->lastChar - infoPtr->expr); + char buffer[100]; + + sprintf(buffer, "syntax error in expression \"%.*s\"", + ((numBytes > 60)? 60 : numBytes), infoPtr->expr); + Tcl_ResetResult(infoPtr->interp); + Tcl_AppendStringsToObj(Tcl_GetObjResult(infoPtr->interp), + buffer, (char *) NULL); +}