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