os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/generic/tclCompExpr.c
1.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
1.2 +++ b/os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/generic/tclCompExpr.c Fri Jun 15 03:10:57 2012 +0200
1.3 @@ -0,0 +1,973 @@
1.4 +/*
1.5 + * tclCompExpr.c --
1.6 + *
1.7 + * This file contains the code to compile Tcl expressions.
1.8 + *
1.9 + * Copyright (c) 1997 Sun Microsystems, Inc.
1.10 + * Copyright (c) 1998-2000 by Scriptics Corporation.
1.11 + * Portions Copyright (c) 2007 Nokia Corporation and/or its subsidiaries. All rights reserved.
1.12 + *
1.13 + * See the file "license.terms" for information on usage and redistribution
1.14 + * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
1.15 + *
1.16 + * RCS: @(#) $Id: tclCompExpr.c,v 1.13.2.3 2006/11/28 22:20:00 andreas_kupries Exp $
1.17 + */
1.18 +
1.19 +#include "tclInt.h"
1.20 +#include "tclCompile.h"
1.21 +#if defined(__SYMBIAN32__)
1.22 +#include "tclSymbianGlobals.h"
1.23 +#endif
1.24 +
1.25 +/*
1.26 + * The stuff below is a bit of a hack so that this file can be used in
1.27 + * environments that include no UNIX, i.e. no errno: just arrange to use
1.28 + * the errno from tclExecute.c here.
1.29 + */
1.30 +
1.31 +#ifndef TCL_GENERIC_ONLY
1.32 +#include "tclPort.h"
1.33 +#else
1.34 +#define NO_ERRNO_H
1.35 +#endif
1.36 +
1.37 +#ifdef NO_ERRNO_H
1.38 +extern int errno; /* Use errno from tclExecute.c. */
1.39 +#define ERANGE 34
1.40 +#endif
1.41 +
1.42 +/*
1.43 + * Boolean variable that controls whether expression compilation tracing
1.44 + * is enabled.
1.45 + */
1.46 +
1.47 +#ifdef TCL_COMPILE_DEBUG
1.48 +static int traceExprComp = 0;
1.49 +#endif /* TCL_COMPILE_DEBUG */
1.50 +
1.51 +/*
1.52 + * The ExprInfo structure describes the state of compiling an expression.
1.53 + * A pointer to an ExprInfo record is passed among the routines in
1.54 + * this module.
1.55 + */
1.56 +
1.57 +typedef struct ExprInfo {
1.58 + Tcl_Interp *interp; /* Used for error reporting. */
1.59 + Tcl_Parse *parsePtr; /* Structure filled with information about
1.60 + * the parsed expression. */
1.61 + CONST char *expr; /* The expression that was originally passed
1.62 + * to TclCompileExpr. */
1.63 + CONST char *lastChar; /* Points just after last byte of expr. */
1.64 + int hasOperators; /* Set 1 if the expr has operators; 0 if
1.65 + * expr is only a primary. If 1 after
1.66 + * compiling an expr, a tryCvtToNumeric
1.67 + * instruction is emitted to convert the
1.68 + * primary to a number if possible. */
1.69 +} ExprInfo;
1.70 +
1.71 +/*
1.72 + * Definitions of numeric codes representing each expression operator.
1.73 + * The order of these must match the entries in the operatorTable below.
1.74 + * Also the codes for the relational operators (OP_LESS, OP_GREATER,
1.75 + * OP_LE, OP_GE, OP_EQ, and OP_NE) must be consecutive and in that order.
1.76 + * Note that OP_PLUS and OP_MINUS represent both unary and binary operators.
1.77 + */
1.78 +
1.79 +#define OP_MULT 0
1.80 +#define OP_DIVIDE 1
1.81 +#define OP_MOD 2
1.82 +#define OP_PLUS 3
1.83 +#define OP_MINUS 4
1.84 +#define OP_LSHIFT 5
1.85 +#define OP_RSHIFT 6
1.86 +#define OP_LESS 7
1.87 +#define OP_GREATER 8
1.88 +#define OP_LE 9
1.89 +#define OP_GE 10
1.90 +#define OP_EQ 11
1.91 +#define OP_NEQ 12
1.92 +#define OP_BITAND 13
1.93 +#define OP_BITXOR 14
1.94 +#define OP_BITOR 15
1.95 +#define OP_LAND 16
1.96 +#define OP_LOR 17
1.97 +#define OP_QUESTY 18
1.98 +#define OP_LNOT 19
1.99 +#define OP_BITNOT 20
1.100 +#define OP_STREQ 21
1.101 +#define OP_STRNEQ 22
1.102 +
1.103 +/*
1.104 + * Table describing the expression operators. Entries in this table must
1.105 + * correspond to the definitions of numeric codes for operators just above.
1.106 + */
1.107 +#if !defined(__SYMBIAN32__) || !defined(__WINSCW__)
1.108 +static int opTableInitialized = 0; /* 0 means not yet initialized. */
1.109 +#endif
1.110 +
1.111 +TCL_DECLARE_MUTEX(opMutex)
1.112 +
1.113 +typedef struct OperatorDesc {
1.114 + char *name; /* Name of the operator. */
1.115 + int numOperands; /* Number of operands. 0 if the operator
1.116 + * requires special handling. */
1.117 + int instruction; /* Instruction opcode for the operator.
1.118 + * Ignored if numOperands is 0. */
1.119 +} OperatorDesc;
1.120 +
1.121 +static OperatorDesc operatorTable[] = {
1.122 + {"*", 2, INST_MULT},
1.123 + {"/", 2, INST_DIV},
1.124 + {"%", 2, INST_MOD},
1.125 + {"+", 0},
1.126 + {"-", 0},
1.127 + {"<<", 2, INST_LSHIFT},
1.128 + {">>", 2, INST_RSHIFT},
1.129 + {"<", 2, INST_LT},
1.130 + {">", 2, INST_GT},
1.131 + {"<=", 2, INST_LE},
1.132 + {">=", 2, INST_GE},
1.133 + {"==", 2, INST_EQ},
1.134 + {"!=", 2, INST_NEQ},
1.135 + {"&", 2, INST_BITAND},
1.136 + {"^", 2, INST_BITXOR},
1.137 + {"|", 2, INST_BITOR},
1.138 + {"&&", 0},
1.139 + {"||", 0},
1.140 + {"?", 0},
1.141 + {"!", 1, INST_LNOT},
1.142 + {"~", 1, INST_BITNOT},
1.143 + {"eq", 2, INST_STR_EQ},
1.144 + {"ne", 2, INST_STR_NEQ},
1.145 + {NULL}
1.146 +};
1.147 +
1.148 +#if !defined(__SYMBIAN32__) || !defined(__WINSCW__)
1.149 +/*
1.150 + * Hashtable used to map the names of expression operators to the index
1.151 + * of their OperatorDesc description.
1.152 + */
1.153 +static Tcl_HashTable opHashTable;
1.154 +#endif
1.155 +
1.156 +/*
1.157 + * Declarations for local procedures to this file:
1.158 + */
1.159 +
1.160 +static int CompileCondExpr _ANSI_ARGS_((
1.161 + Tcl_Token *exprTokenPtr, ExprInfo *infoPtr,
1.162 + CompileEnv *envPtr, Tcl_Token **endPtrPtr));
1.163 +static int CompileLandOrLorExpr _ANSI_ARGS_((
1.164 + Tcl_Token *exprTokenPtr, int opIndex,
1.165 + ExprInfo *infoPtr, CompileEnv *envPtr,
1.166 + Tcl_Token **endPtrPtr));
1.167 +static int CompileMathFuncCall _ANSI_ARGS_((
1.168 + Tcl_Token *exprTokenPtr, CONST char *funcName,
1.169 + ExprInfo *infoPtr, CompileEnv *envPtr,
1.170 + Tcl_Token **endPtrPtr));
1.171 +static int CompileSubExpr _ANSI_ARGS_((
1.172 + Tcl_Token *exprTokenPtr, ExprInfo *infoPtr,
1.173 + CompileEnv *envPtr));
1.174 +static void LogSyntaxError _ANSI_ARGS_((ExprInfo *infoPtr));
1.175 +
1.176 +/*
1.177 + * Macro used to debug the execution of the expression compiler.
1.178 + */
1.179 +
1.180 +#ifdef TCL_COMPILE_DEBUG
1.181 +#define TRACE(exprBytes, exprLength, tokenBytes, tokenLength) \
1.182 + if (traceExprComp) { \
1.183 + fprintf(stderr, "CompileSubExpr: \"%.*s\", token \"%.*s\"\n", \
1.184 + (exprLength), (exprBytes), (tokenLength), (tokenBytes)); \
1.185 + }
1.186 +#else
1.187 +#define TRACE(exprBytes, exprLength, tokenBytes, tokenLength)
1.188 +#endif /* TCL_COMPILE_DEBUG */
1.189 +
1.190 +/*
1.191 + *----------------------------------------------------------------------
1.192 + *
1.193 + * TclCompileExpr --
1.194 + *
1.195 + * This procedure compiles a string containing a Tcl expression into
1.196 + * Tcl bytecodes. This procedure is the top-level interface to the
1.197 + * the expression compilation module, and is used by such public
1.198 + * procedures as Tcl_ExprString, Tcl_ExprStringObj, Tcl_ExprLong,
1.199 + * Tcl_ExprDouble, Tcl_ExprBoolean, and Tcl_ExprBooleanObj.
1.200 + *
1.201 + * Results:
1.202 + * The return value is TCL_OK on a successful compilation and TCL_ERROR
1.203 + * on failure. If TCL_ERROR is returned, then the interpreter's result
1.204 + * contains an error message.
1.205 + *
1.206 + * Side effects:
1.207 + * Adds instructions to envPtr to evaluate the expression at runtime.
1.208 + *
1.209 + *----------------------------------------------------------------------
1.210 + */
1.211 +
1.212 +int
1.213 +TclCompileExpr(interp, script, numBytes, envPtr)
1.214 + Tcl_Interp *interp; /* Used for error reporting. */
1.215 + CONST char *script; /* The source script to compile. */
1.216 + int numBytes; /* Number of bytes in script. If < 0, the
1.217 + * string consists of all bytes up to the
1.218 + * first null character. */
1.219 + CompileEnv *envPtr; /* Holds resulting instructions. */
1.220 +{
1.221 + ExprInfo info;
1.222 + Tcl_Parse parse;
1.223 + Tcl_HashEntry *hPtr;
1.224 + int new, i, code;
1.225 +
1.226 + /*
1.227 + * If this is the first time we've been called, initialize the table
1.228 + * of expression operators.
1.229 + */
1.230 +
1.231 + if (numBytes < 0) {
1.232 + numBytes = (script? strlen(script) : 0);
1.233 + }
1.234 + if (!opTableInitialized) {
1.235 + Tcl_MutexLock(&opMutex);
1.236 + if (!opTableInitialized) {
1.237 + Tcl_InitHashTable(&opHashTable, TCL_STRING_KEYS);
1.238 + for (i = 0; operatorTable[i].name != NULL; i++) {
1.239 + hPtr = Tcl_CreateHashEntry(&opHashTable,
1.240 + operatorTable[i].name, &new);
1.241 + if (new) {
1.242 + Tcl_SetHashValue(hPtr, (ClientData) i);
1.243 + }
1.244 + }
1.245 + opTableInitialized = 1;
1.246 + }
1.247 + Tcl_MutexUnlock(&opMutex);
1.248 + }
1.249 +
1.250 + /*
1.251 + * Initialize the structure containing information abvout this
1.252 + * expression compilation.
1.253 + */
1.254 +
1.255 + info.interp = interp;
1.256 + info.parsePtr = &parse;
1.257 + info.expr = script;
1.258 + info.lastChar = (script + numBytes);
1.259 + info.hasOperators = 0;
1.260 +
1.261 + /*
1.262 + * Parse the expression then compile it.
1.263 + */
1.264 +
1.265 + code = Tcl_ParseExpr(interp, script, numBytes, &parse);
1.266 + if (code != TCL_OK) {
1.267 + goto done;
1.268 + }
1.269 +
1.270 +#ifdef TCL_TIP280
1.271 + /* TIP #280 : Track Lines within the expression */
1.272 + TclAdvanceLines (&envPtr->line, script, parse.tokenPtr->start);
1.273 +#endif
1.274 +
1.275 + code = CompileSubExpr(parse.tokenPtr, &info, envPtr);
1.276 + if (code != TCL_OK) {
1.277 + Tcl_FreeParse(&parse);
1.278 + goto done;
1.279 + }
1.280 +
1.281 + if (!info.hasOperators) {
1.282 + /*
1.283 + * Attempt to convert the primary's object to an int or double.
1.284 + * This is done in order to support Tcl's policy of interpreting
1.285 + * operands if at all possible as first integers, else
1.286 + * floating-point numbers.
1.287 + */
1.288 +
1.289 + TclEmitOpcode(INST_TRY_CVT_TO_NUMERIC, envPtr);
1.290 + }
1.291 + Tcl_FreeParse(&parse);
1.292 +
1.293 + done:
1.294 + return code;
1.295 +}
1.296 +
1.297 +/*
1.298 + *----------------------------------------------------------------------
1.299 + *
1.300 + * TclFinalizeCompilation --
1.301 + *
1.302 + * Clean up the compilation environment so it can later be
1.303 + * properly reinitialized. This procedure is called by Tcl_Finalize().
1.304 + *
1.305 + * Results:
1.306 + * None.
1.307 + *
1.308 + * Side effects:
1.309 + * Cleans up the compilation environment. At the moment, just the
1.310 + * table of expression operators is freed.
1.311 + *
1.312 + *----------------------------------------------------------------------
1.313 + */
1.314 +
1.315 +void
1.316 +TclFinalizeCompilation()
1.317 +{
1.318 + Tcl_MutexLock(&opMutex);
1.319 + if (opTableInitialized) {
1.320 + Tcl_DeleteHashTable(&opHashTable);
1.321 + opTableInitialized = 0;
1.322 + }
1.323 + Tcl_MutexUnlock(&opMutex);
1.324 +}
1.325 +
1.326 +/*
1.327 + *----------------------------------------------------------------------
1.328 + *
1.329 + * CompileSubExpr --
1.330 + *
1.331 + * Given a pointer to a TCL_TOKEN_SUB_EXPR token describing a
1.332 + * subexpression, this procedure emits instructions to evaluate the
1.333 + * subexpression at runtime.
1.334 + *
1.335 + * Results:
1.336 + * The return value is TCL_OK on a successful compilation and TCL_ERROR
1.337 + * on failure. If TCL_ERROR is returned, then the interpreter's result
1.338 + * contains an error message.
1.339 + *
1.340 + * Side effects:
1.341 + * Adds instructions to envPtr to evaluate the subexpression.
1.342 + *
1.343 + *----------------------------------------------------------------------
1.344 + */
1.345 +
1.346 +static int
1.347 +CompileSubExpr(exprTokenPtr, infoPtr, envPtr)
1.348 + Tcl_Token *exprTokenPtr; /* Points to TCL_TOKEN_SUB_EXPR token
1.349 + * to compile. */
1.350 + ExprInfo *infoPtr; /* Describes the compilation state for the
1.351 + * expression being compiled. */
1.352 + CompileEnv *envPtr; /* Holds resulting instructions. */
1.353 +{
1.354 + Tcl_Interp *interp = infoPtr->interp;
1.355 + Tcl_Token *tokenPtr, *endPtr = NULL; /* silence gcc 4 warning */
1.356 + Tcl_Token *afterSubexprPtr;
1.357 + OperatorDesc *opDescPtr;
1.358 + Tcl_HashEntry *hPtr;
1.359 + CONST char *operator;
1.360 + Tcl_DString opBuf;
1.361 + int objIndex, opIndex, length, code;
1.362 + char buffer[TCL_UTF_MAX];
1.363 +
1.364 + if (exprTokenPtr->type != TCL_TOKEN_SUB_EXPR) {
1.365 + panic("CompileSubExpr: token type %d not TCL_TOKEN_SUB_EXPR\n",
1.366 + exprTokenPtr->type);
1.367 + }
1.368 + code = TCL_OK;
1.369 +
1.370 + /*
1.371 + * Switch on the type of the first token after the subexpression token.
1.372 + * After processing it, advance tokenPtr to point just after the
1.373 + * subexpression's last token.
1.374 + */
1.375 +
1.376 + tokenPtr = exprTokenPtr+1;
1.377 + TRACE(exprTokenPtr->start, exprTokenPtr->size,
1.378 + tokenPtr->start, tokenPtr->size);
1.379 + switch (tokenPtr->type) {
1.380 + case TCL_TOKEN_WORD:
1.381 + code = TclCompileTokens(interp, tokenPtr+1,
1.382 + tokenPtr->numComponents, envPtr);
1.383 + if (code != TCL_OK) {
1.384 + goto done;
1.385 + }
1.386 + tokenPtr += (tokenPtr->numComponents + 1);
1.387 + break;
1.388 +
1.389 + case TCL_TOKEN_TEXT:
1.390 + if (tokenPtr->size > 0) {
1.391 + objIndex = TclRegisterNewLiteral(envPtr, tokenPtr->start,
1.392 + tokenPtr->size);
1.393 + } else {
1.394 + objIndex = TclRegisterNewLiteral(envPtr, "", 0);
1.395 + }
1.396 + TclEmitPush(objIndex, envPtr);
1.397 + tokenPtr += 1;
1.398 + break;
1.399 +
1.400 + case TCL_TOKEN_BS:
1.401 + length = Tcl_UtfBackslash(tokenPtr->start, (int *) NULL,
1.402 + buffer);
1.403 + if (length > 0) {
1.404 + objIndex = TclRegisterNewLiteral(envPtr, buffer, length);
1.405 + } else {
1.406 + objIndex = TclRegisterNewLiteral(envPtr, "", 0);
1.407 + }
1.408 + TclEmitPush(objIndex, envPtr);
1.409 + tokenPtr += 1;
1.410 + break;
1.411 +
1.412 + case TCL_TOKEN_COMMAND:
1.413 + code = TclCompileScript(interp, tokenPtr->start+1,
1.414 + tokenPtr->size-2, /*nested*/ 0, envPtr);
1.415 + if (code != TCL_OK) {
1.416 + goto done;
1.417 + }
1.418 + tokenPtr += 1;
1.419 + break;
1.420 +
1.421 + case TCL_TOKEN_VARIABLE:
1.422 + code = TclCompileTokens(interp, tokenPtr, 1, envPtr);
1.423 + if (code != TCL_OK) {
1.424 + goto done;
1.425 + }
1.426 + tokenPtr += (tokenPtr->numComponents + 1);
1.427 + break;
1.428 +
1.429 + case TCL_TOKEN_SUB_EXPR:
1.430 + code = CompileSubExpr(tokenPtr, infoPtr, envPtr);
1.431 + if (code != TCL_OK) {
1.432 + goto done;
1.433 + }
1.434 + tokenPtr += (tokenPtr->numComponents + 1);
1.435 + break;
1.436 +
1.437 + case TCL_TOKEN_OPERATOR:
1.438 + /*
1.439 + * Look up the operator. If the operator isn't found, treat it
1.440 + * as a math function.
1.441 + */
1.442 + Tcl_DStringInit(&opBuf);
1.443 + operator = Tcl_DStringAppend(&opBuf,
1.444 + tokenPtr->start, tokenPtr->size);
1.445 + hPtr = Tcl_FindHashEntry(&opHashTable, operator);
1.446 + if (hPtr == NULL) {
1.447 + code = CompileMathFuncCall(exprTokenPtr, operator, infoPtr,
1.448 + envPtr, &endPtr);
1.449 + Tcl_DStringFree(&opBuf);
1.450 + if (code != TCL_OK) {
1.451 + goto done;
1.452 + }
1.453 + tokenPtr = endPtr;
1.454 + break;
1.455 + }
1.456 + Tcl_DStringFree(&opBuf);
1.457 + opIndex = (int) Tcl_GetHashValue(hPtr);
1.458 + opDescPtr = &(operatorTable[opIndex]);
1.459 +
1.460 + /*
1.461 + * If the operator is "normal", compile it using information
1.462 + * from the operator table.
1.463 + */
1.464 +
1.465 + if (opDescPtr->numOperands > 0) {
1.466 + tokenPtr++;
1.467 + code = CompileSubExpr(tokenPtr, infoPtr, envPtr);
1.468 + if (code != TCL_OK) {
1.469 + goto done;
1.470 + }
1.471 + tokenPtr += (tokenPtr->numComponents + 1);
1.472 +
1.473 + if (opDescPtr->numOperands == 2) {
1.474 + code = CompileSubExpr(tokenPtr, infoPtr, envPtr);
1.475 + if (code != TCL_OK) {
1.476 + goto done;
1.477 + }
1.478 + tokenPtr += (tokenPtr->numComponents + 1);
1.479 + }
1.480 + TclEmitOpcode(opDescPtr->instruction, envPtr);
1.481 + infoPtr->hasOperators = 1;
1.482 + break;
1.483 + }
1.484 +
1.485 + /*
1.486 + * The operator requires special treatment, and is either
1.487 + * "+" or "-", or one of "&&", "||" or "?".
1.488 + */
1.489 +
1.490 + switch (opIndex) {
1.491 + case OP_PLUS:
1.492 + case OP_MINUS:
1.493 + tokenPtr++;
1.494 + code = CompileSubExpr(tokenPtr, infoPtr, envPtr);
1.495 + if (code != TCL_OK) {
1.496 + goto done;
1.497 + }
1.498 + tokenPtr += (tokenPtr->numComponents + 1);
1.499 +
1.500 + /*
1.501 + * Check whether the "+" or "-" is unary.
1.502 + */
1.503 +
1.504 + afterSubexprPtr = exprTokenPtr
1.505 + + exprTokenPtr->numComponents+1;
1.506 + if (tokenPtr == afterSubexprPtr) {
1.507 + TclEmitOpcode(((opIndex==OP_PLUS)?
1.508 + INST_UPLUS : INST_UMINUS),
1.509 + envPtr);
1.510 + break;
1.511 + }
1.512 +
1.513 + /*
1.514 + * The "+" or "-" is binary.
1.515 + */
1.516 +
1.517 + code = CompileSubExpr(tokenPtr, infoPtr, envPtr);
1.518 + if (code != TCL_OK) {
1.519 + goto done;
1.520 + }
1.521 + tokenPtr += (tokenPtr->numComponents + 1);
1.522 + TclEmitOpcode(((opIndex==OP_PLUS)? INST_ADD : INST_SUB),
1.523 + envPtr);
1.524 + break;
1.525 +
1.526 + case OP_LAND:
1.527 + case OP_LOR:
1.528 + code = CompileLandOrLorExpr(exprTokenPtr, opIndex,
1.529 + infoPtr, envPtr, &endPtr);
1.530 + if (code != TCL_OK) {
1.531 + goto done;
1.532 + }
1.533 + tokenPtr = endPtr;
1.534 + break;
1.535 +
1.536 + case OP_QUESTY:
1.537 + code = CompileCondExpr(exprTokenPtr, infoPtr,
1.538 + envPtr, &endPtr);
1.539 + if (code != TCL_OK) {
1.540 + goto done;
1.541 + }
1.542 + tokenPtr = endPtr;
1.543 + break;
1.544 +
1.545 + default:
1.546 + panic("CompileSubExpr: unexpected operator %d requiring special treatment\n",
1.547 + opIndex);
1.548 + } /* end switch on operator requiring special treatment */
1.549 + infoPtr->hasOperators = 1;
1.550 + break;
1.551 +
1.552 + default:
1.553 + panic("CompileSubExpr: unexpected token type %d\n",
1.554 + tokenPtr->type);
1.555 + }
1.556 +
1.557 + /*
1.558 + * Verify that the subexpression token had the required number of
1.559 + * subtokens: that we've advanced tokenPtr just beyond the
1.560 + * subexpression's last token. For example, a "*" subexpression must
1.561 + * contain the tokens for exactly two operands.
1.562 + */
1.563 +
1.564 + if (tokenPtr != (exprTokenPtr + exprTokenPtr->numComponents+1)) {
1.565 + LogSyntaxError(infoPtr);
1.566 + code = TCL_ERROR;
1.567 + }
1.568 +
1.569 + done:
1.570 + return code;
1.571 +}
1.572 +
1.573 +/*
1.574 + *----------------------------------------------------------------------
1.575 + *
1.576 + * CompileLandOrLorExpr --
1.577 + *
1.578 + * This procedure compiles a Tcl logical and ("&&") or logical or
1.579 + * ("||") subexpression.
1.580 + *
1.581 + * Results:
1.582 + * The return value is TCL_OK on a successful compilation and TCL_ERROR
1.583 + * on failure. If TCL_OK is returned, a pointer to the token just after
1.584 + * the last one in the subexpression is stored at the address in
1.585 + * endPtrPtr. If TCL_ERROR is returned, then the interpreter's result
1.586 + * contains an error message.
1.587 + *
1.588 + * Side effects:
1.589 + * Adds instructions to envPtr to evaluate the expression at runtime.
1.590 + *
1.591 + *----------------------------------------------------------------------
1.592 + */
1.593 +
1.594 +static int
1.595 +CompileLandOrLorExpr(exprTokenPtr, opIndex, infoPtr, envPtr, endPtrPtr)
1.596 + Tcl_Token *exprTokenPtr; /* Points to TCL_TOKEN_SUB_EXPR token
1.597 + * containing the "&&" or "||" operator. */
1.598 + int opIndex; /* A code describing the expression
1.599 + * operator: either OP_LAND or OP_LOR. */
1.600 + ExprInfo *infoPtr; /* Describes the compilation state for the
1.601 + * expression being compiled. */
1.602 + CompileEnv *envPtr; /* Holds resulting instructions. */
1.603 + Tcl_Token **endPtrPtr; /* If successful, a pointer to the token
1.604 + * just after the last token in the
1.605 + * subexpression is stored here. */
1.606 +{
1.607 + JumpFixup shortCircuitFixup; /* Used to fix up the short circuit jump
1.608 + * after the first subexpression. */
1.609 + JumpFixup lhsTrueFixup, lhsEndFixup;
1.610 + /* Used to fix up jumps used to convert the
1.611 + * first operand to 0 or 1. */
1.612 + Tcl_Token *tokenPtr;
1.613 + int dist, code;
1.614 + int savedStackDepth = envPtr->currStackDepth;
1.615 +
1.616 + /*
1.617 + * Emit code for the first operand.
1.618 + */
1.619 +
1.620 + tokenPtr = exprTokenPtr+2;
1.621 + code = CompileSubExpr(tokenPtr, infoPtr, envPtr);
1.622 + if (code != TCL_OK) {
1.623 + goto done;
1.624 + }
1.625 + tokenPtr += (tokenPtr->numComponents + 1);
1.626 +
1.627 + /*
1.628 + * Convert the first operand to the result that Tcl requires:
1.629 + * "0" or "1". Eventually we'll use a new instruction for this.
1.630 + */
1.631 +
1.632 + TclEmitForwardJump(envPtr, TCL_TRUE_JUMP, &lhsTrueFixup);
1.633 + TclEmitPush(TclRegisterNewLiteral(envPtr, "0", 1), envPtr);
1.634 + TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &lhsEndFixup);
1.635 + dist = (envPtr->codeNext - envPtr->codeStart) - lhsTrueFixup.codeOffset;
1.636 + if (TclFixupForwardJump(envPtr, &lhsTrueFixup, dist, 127)) {
1.637 + badDist:
1.638 + panic("CompileLandOrLorExpr: bad jump distance %d\n", dist);
1.639 + }
1.640 + envPtr->currStackDepth = savedStackDepth;
1.641 + TclEmitPush(TclRegisterNewLiteral(envPtr, "1", 1), envPtr);
1.642 + dist = (envPtr->codeNext - envPtr->codeStart) - lhsEndFixup.codeOffset;
1.643 + if (TclFixupForwardJump(envPtr, &lhsEndFixup, dist, 127)) {
1.644 + goto badDist;
1.645 + }
1.646 +
1.647 + /*
1.648 + * Emit the "short circuit" jump around the rest of the expression.
1.649 + * Duplicate the "0" or "1" on top of the stack first to keep the
1.650 + * jump from consuming it.
1.651 + */
1.652 +
1.653 + TclEmitOpcode(INST_DUP, envPtr);
1.654 + TclEmitForwardJump(envPtr,
1.655 + ((opIndex==OP_LAND)? TCL_FALSE_JUMP : TCL_TRUE_JUMP),
1.656 + &shortCircuitFixup);
1.657 +
1.658 + /*
1.659 + * Emit code for the second operand.
1.660 + */
1.661 +
1.662 + code = CompileSubExpr(tokenPtr, infoPtr, envPtr);
1.663 + if (code != TCL_OK) {
1.664 + goto done;
1.665 + }
1.666 + tokenPtr += (tokenPtr->numComponents + 1);
1.667 +
1.668 + /*
1.669 + * Emit a "logical and" or "logical or" instruction. This does not try
1.670 + * to "short- circuit" the evaluation of both operands, but instead
1.671 + * ensures that we either have a "1" or a "0" result.
1.672 + */
1.673 +
1.674 + TclEmitOpcode(((opIndex==OP_LAND)? INST_LAND : INST_LOR), envPtr);
1.675 +
1.676 + /*
1.677 + * Now that we know the target of the forward jump, update it with the
1.678 + * correct distance.
1.679 + */
1.680 +
1.681 + dist = (envPtr->codeNext - envPtr->codeStart)
1.682 + - shortCircuitFixup.codeOffset;
1.683 + TclFixupForwardJump(envPtr, &shortCircuitFixup, dist, 127);
1.684 + *endPtrPtr = tokenPtr;
1.685 +
1.686 + done:
1.687 + envPtr->currStackDepth = savedStackDepth + 1;
1.688 + return code;
1.689 +}
1.690 +
1.691 +/*
1.692 + *----------------------------------------------------------------------
1.693 + *
1.694 + * CompileCondExpr --
1.695 + *
1.696 + * This procedure compiles a Tcl conditional expression:
1.697 + * condExpr ::= lorExpr ['?' condExpr ':' condExpr]
1.698 + *
1.699 + * Results:
1.700 + * The return value is TCL_OK on a successful compilation and TCL_ERROR
1.701 + * on failure. If TCL_OK is returned, a pointer to the token just after
1.702 + * the last one in the subexpression is stored at the address in
1.703 + * endPtrPtr. If TCL_ERROR is returned, then the interpreter's result
1.704 + * contains an error message.
1.705 + *
1.706 + * Side effects:
1.707 + * Adds instructions to envPtr to evaluate the expression at runtime.
1.708 + *
1.709 + *----------------------------------------------------------------------
1.710 + */
1.711 +
1.712 +static int
1.713 +CompileCondExpr(exprTokenPtr, infoPtr, envPtr, endPtrPtr)
1.714 + Tcl_Token *exprTokenPtr; /* Points to TCL_TOKEN_SUB_EXPR token
1.715 + * containing the "?" operator. */
1.716 + ExprInfo *infoPtr; /* Describes the compilation state for the
1.717 + * expression being compiled. */
1.718 + CompileEnv *envPtr; /* Holds resulting instructions. */
1.719 + Tcl_Token **endPtrPtr; /* If successful, a pointer to the token
1.720 + * just after the last token in the
1.721 + * subexpression is stored here. */
1.722 +{
1.723 + JumpFixup jumpAroundThenFixup, jumpAroundElseFixup;
1.724 + /* Used to update or replace one-byte jumps
1.725 + * around the then and else expressions when
1.726 + * their target PCs are determined. */
1.727 + Tcl_Token *tokenPtr;
1.728 + int elseCodeOffset, dist, code;
1.729 + int savedStackDepth = envPtr->currStackDepth;
1.730 +
1.731 + /*
1.732 + * Emit code for the test.
1.733 + */
1.734 +
1.735 + tokenPtr = exprTokenPtr+2;
1.736 + code = CompileSubExpr(tokenPtr, infoPtr, envPtr);
1.737 + if (code != TCL_OK) {
1.738 + goto done;
1.739 + }
1.740 + tokenPtr += (tokenPtr->numComponents + 1);
1.741 +
1.742 + /*
1.743 + * Emit the jump to the "else" expression if the test was false.
1.744 + */
1.745 +
1.746 + TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, &jumpAroundThenFixup);
1.747 +
1.748 + /*
1.749 + * Compile the "then" expression. Note that if a subexpression is only
1.750 + * a primary, we need to try to convert it to numeric. We do this to
1.751 + * support Tcl's policy of interpreting operands if at all possible as
1.752 + * first integers, else floating-point numbers.
1.753 + */
1.754 +
1.755 + infoPtr->hasOperators = 0;
1.756 + code = CompileSubExpr(tokenPtr, infoPtr, envPtr);
1.757 + if (code != TCL_OK) {
1.758 + goto done;
1.759 + }
1.760 + tokenPtr += (tokenPtr->numComponents + 1);
1.761 + if (!infoPtr->hasOperators) {
1.762 + TclEmitOpcode(INST_TRY_CVT_TO_NUMERIC, envPtr);
1.763 + }
1.764 +
1.765 + /*
1.766 + * Emit an unconditional jump around the "else" condExpr.
1.767 + */
1.768 +
1.769 + TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP,
1.770 + &jumpAroundElseFixup);
1.771 +
1.772 + /*
1.773 + * Compile the "else" expression.
1.774 + */
1.775 +
1.776 + envPtr->currStackDepth = savedStackDepth;
1.777 + elseCodeOffset = (envPtr->codeNext - envPtr->codeStart);
1.778 + infoPtr->hasOperators = 0;
1.779 + code = CompileSubExpr(tokenPtr, infoPtr, envPtr);
1.780 + if (code != TCL_OK) {
1.781 + goto done;
1.782 + }
1.783 + tokenPtr += (tokenPtr->numComponents + 1);
1.784 + if (!infoPtr->hasOperators) {
1.785 + TclEmitOpcode(INST_TRY_CVT_TO_NUMERIC, envPtr);
1.786 + }
1.787 +
1.788 + /*
1.789 + * Fix up the second jump around the "else" expression.
1.790 + */
1.791 +
1.792 + dist = (envPtr->codeNext - envPtr->codeStart)
1.793 + - jumpAroundElseFixup.codeOffset;
1.794 + if (TclFixupForwardJump(envPtr, &jumpAroundElseFixup, dist, 127)) {
1.795 + /*
1.796 + * Update the else expression's starting code offset since it
1.797 + * moved down 3 bytes too.
1.798 + */
1.799 +
1.800 + elseCodeOffset += 3;
1.801 + }
1.802 +
1.803 + /*
1.804 + * Fix up the first jump to the "else" expression if the test was false.
1.805 + */
1.806 +
1.807 + dist = (elseCodeOffset - jumpAroundThenFixup.codeOffset);
1.808 + TclFixupForwardJump(envPtr, &jumpAroundThenFixup, dist, 127);
1.809 + *endPtrPtr = tokenPtr;
1.810 +
1.811 + done:
1.812 + envPtr->currStackDepth = savedStackDepth + 1;
1.813 + return code;
1.814 +}
1.815 +
1.816 +/*
1.817 + *----------------------------------------------------------------------
1.818 + *
1.819 + * CompileMathFuncCall --
1.820 + *
1.821 + * This procedure compiles a call on a math function in an expression:
1.822 + * mathFuncCall ::= funcName '(' [condExpr {',' condExpr}] ')'
1.823 + *
1.824 + * Results:
1.825 + * The return value is TCL_OK on a successful compilation and TCL_ERROR
1.826 + * on failure. If TCL_OK is returned, a pointer to the token just after
1.827 + * the last one in the subexpression is stored at the address in
1.828 + * endPtrPtr. If TCL_ERROR is returned, then the interpreter's result
1.829 + * contains an error message.
1.830 + *
1.831 + * Side effects:
1.832 + * Adds instructions to envPtr to evaluate the math function at
1.833 + * runtime.
1.834 + *
1.835 + *----------------------------------------------------------------------
1.836 + */
1.837 +
1.838 +static int
1.839 +CompileMathFuncCall(exprTokenPtr, funcName, infoPtr, envPtr, endPtrPtr)
1.840 + Tcl_Token *exprTokenPtr; /* Points to TCL_TOKEN_SUB_EXPR token
1.841 + * containing the math function call. */
1.842 + CONST char *funcName; /* Name of the math function. */
1.843 + ExprInfo *infoPtr; /* Describes the compilation state for the
1.844 + * expression being compiled. */
1.845 + CompileEnv *envPtr; /* Holds resulting instructions. */
1.846 + Tcl_Token **endPtrPtr; /* If successful, a pointer to the token
1.847 + * just after the last token in the
1.848 + * subexpression is stored here. */
1.849 +{
1.850 + Tcl_Interp *interp = infoPtr->interp;
1.851 + Interp *iPtr = (Interp *) interp;
1.852 + MathFunc *mathFuncPtr;
1.853 + Tcl_HashEntry *hPtr;
1.854 + Tcl_Token *tokenPtr, *afterSubexprPtr;
1.855 + int code, i;
1.856 +
1.857 + /*
1.858 + * Look up the MathFunc record for the function.
1.859 + */
1.860 +
1.861 + code = TCL_OK;
1.862 + hPtr = Tcl_FindHashEntry(&iPtr->mathFuncTable, funcName);
1.863 + if (hPtr == NULL) {
1.864 + Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
1.865 + "unknown math function \"", funcName, "\"", (char *) NULL);
1.866 + code = TCL_ERROR;
1.867 + goto done;
1.868 + }
1.869 + mathFuncPtr = (MathFunc *) Tcl_GetHashValue(hPtr);
1.870 +
1.871 + /*
1.872 + * If not a builtin function, push an object with the function's name.
1.873 + */
1.874 +
1.875 + if (mathFuncPtr->builtinFuncIndex < 0) {
1.876 + TclEmitPush(TclRegisterNewLiteral(envPtr, funcName, -1), envPtr);
1.877 + }
1.878 +
1.879 + /*
1.880 + * Compile any arguments for the function.
1.881 + */
1.882 +
1.883 + tokenPtr = exprTokenPtr+2;
1.884 + afterSubexprPtr = exprTokenPtr + (exprTokenPtr->numComponents + 1);
1.885 + if (mathFuncPtr->numArgs > 0) {
1.886 + for (i = 0; i < mathFuncPtr->numArgs; i++) {
1.887 + if (tokenPtr == afterSubexprPtr) {
1.888 + Tcl_ResetResult(interp);
1.889 + Tcl_AppendToObj(Tcl_GetObjResult(interp),
1.890 + "too few arguments for math function", -1);
1.891 + code = TCL_ERROR;
1.892 + goto done;
1.893 + }
1.894 + code = CompileSubExpr(tokenPtr, infoPtr, envPtr);
1.895 + if (code != TCL_OK) {
1.896 + goto done;
1.897 + }
1.898 + tokenPtr += (tokenPtr->numComponents + 1);
1.899 + }
1.900 + if (tokenPtr != afterSubexprPtr) {
1.901 + Tcl_ResetResult(interp);
1.902 + Tcl_AppendToObj(Tcl_GetObjResult(interp),
1.903 + "too many arguments for math function", -1);
1.904 + code = TCL_ERROR;
1.905 + goto done;
1.906 + }
1.907 + } else if (tokenPtr != afterSubexprPtr) {
1.908 + Tcl_ResetResult(interp);
1.909 + Tcl_AppendToObj(Tcl_GetObjResult(interp),
1.910 + "too many arguments for math function", -1);
1.911 + code = TCL_ERROR;
1.912 + goto done;
1.913 + }
1.914 +
1.915 + /*
1.916 + * Compile the call on the math function. Note that the "objc" argument
1.917 + * count for non-builtin functions is incremented by 1 to include the
1.918 + * function name itself.
1.919 + */
1.920 +
1.921 + if (mathFuncPtr->builtinFuncIndex >= 0) { /* a builtin function */
1.922 + /*
1.923 + * Adjust the current stack depth by the number of arguments
1.924 + * of the builtin function. This cannot be handled by the
1.925 + * TclEmitInstInt1 macro as the number of arguments is not
1.926 + * passed as an operand.
1.927 + */
1.928 +
1.929 + if (envPtr->maxStackDepth < envPtr->currStackDepth) {
1.930 + envPtr->maxStackDepth = envPtr->currStackDepth;
1.931 + }
1.932 + TclEmitInstInt1(INST_CALL_BUILTIN_FUNC1,
1.933 + mathFuncPtr->builtinFuncIndex, envPtr);
1.934 + envPtr->currStackDepth -= mathFuncPtr->numArgs;
1.935 + } else {
1.936 + TclEmitInstInt1(INST_CALL_FUNC1, (mathFuncPtr->numArgs+1), envPtr);
1.937 + }
1.938 + *endPtrPtr = afterSubexprPtr;
1.939 +
1.940 + done:
1.941 + return code;
1.942 +}
1.943 +
1.944 +/*
1.945 + *----------------------------------------------------------------------
1.946 + *
1.947 + * LogSyntaxError --
1.948 + *
1.949 + * This procedure is invoked after an error occurs when compiling an
1.950 + * expression. It sets the interpreter result to an error message
1.951 + * describing the error.
1.952 + *
1.953 + * Results:
1.954 + * None.
1.955 + *
1.956 + * Side effects:
1.957 + * Sets the interpreter result to an error message describing the
1.958 + * expression that was being compiled when the error occurred.
1.959 + *
1.960 + *----------------------------------------------------------------------
1.961 + */
1.962 +
1.963 +static void
1.964 +LogSyntaxError(infoPtr)
1.965 + ExprInfo *infoPtr; /* Describes the compilation state for the
1.966 + * expression being compiled. */
1.967 +{
1.968 + int numBytes = (infoPtr->lastChar - infoPtr->expr);
1.969 + char buffer[100];
1.970 +
1.971 + sprintf(buffer, "syntax error in expression \"%.*s\"",
1.972 + ((numBytes > 60)? 60 : numBytes), infoPtr->expr);
1.973 + Tcl_ResetResult(infoPtr->interp);
1.974 + Tcl_AppendStringsToObj(Tcl_GetObjResult(infoPtr->interp),
1.975 + buffer, (char *) NULL);
1.976 +}