os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/generic/tclParseExpr.c
1.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
1.2 +++ b/os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/generic/tclParseExpr.c Fri Jun 15 03:10:57 2012 +0200
1.3 @@ -0,0 +1,2080 @@
1.4 +/*
1.5 + * tclParseExpr.c --
1.6 + *
1.7 + * This file contains procedures that parse Tcl expressions. They
1.8 + * do so in a general-purpose fashion that can be used for many
1.9 + * different purposes, including compilation, direct execution,
1.10 + * code analysis, etc.
1.11 + *
1.12 + * Copyright (c) 1997 Sun Microsystems, Inc.
1.13 + * Copyright (c) 1998-2000 by Scriptics Corporation.
1.14 + * Portions Copyright (c) 2007-2008 Nokia Corporation and/or its subsidiaries. All rights reserved.
1.15 + * Contributions from Don Porter, NIST, 2002. (not subject to US copyright)
1.16 + *
1.17 + * See the file "license.terms" for information on usage and redistribution
1.18 + * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
1.19 + *
1.20 + * RCS: @(#) $Id: tclParseExpr.c,v 1.17.2.2 2005/05/20 17:19:10 vasiljevic Exp $
1.21 + */
1.22 +
1.23 +#include "tclInt.h"
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 parse tracing
1.44 + * is enabled.
1.45 + */
1.46 +
1.47 +#ifdef TCL_COMPILE_DEBUG
1.48 +static int traceParseExpr = 0;
1.49 +#endif /* TCL_COMPILE_DEBUG */
1.50 +
1.51 +/*
1.52 + * The ParseInfo structure holds state while parsing an expression.
1.53 + * A pointer to an ParseInfo record is passed among the routines in
1.54 + * this module.
1.55 + */
1.56 +
1.57 +typedef struct ParseInfo {
1.58 + Tcl_Parse *parsePtr; /* Points to structure to fill in with
1.59 + * information about the expression. */
1.60 + int lexeme; /* Type of last lexeme scanned in expr.
1.61 + * See below for definitions. Corresponds to
1.62 + * size characters beginning at start. */
1.63 + CONST char *start; /* First character in lexeme. */
1.64 + int size; /* Number of bytes in lexeme. */
1.65 + CONST char *next; /* Position of the next character to be
1.66 + * scanned in the expression string. */
1.67 + CONST char *prevEnd; /* Points to the character just after the
1.68 + * last one in the previous lexeme. Used to
1.69 + * compute size of subexpression tokens. */
1.70 + CONST char *originalExpr; /* Points to the start of the expression
1.71 + * originally passed to Tcl_ParseExpr. */
1.72 + CONST char *lastChar; /* Points just after last byte of expr. */
1.73 +} ParseInfo;
1.74 +
1.75 +/*
1.76 + * Definitions of the different lexemes that appear in expressions. The
1.77 + * order of these must match the corresponding entries in the
1.78 + * operatorStrings array below.
1.79 + *
1.80 + * Basic lexemes:
1.81 + */
1.82 +
1.83 +#define LITERAL 0
1.84 +#define FUNC_NAME 1
1.85 +#define OPEN_BRACKET 2
1.86 +#define OPEN_BRACE 3
1.87 +#define OPEN_PAREN 4
1.88 +#define CLOSE_PAREN 5
1.89 +#define DOLLAR 6
1.90 +#define QUOTE 7
1.91 +#define COMMA 8
1.92 +#define END 9
1.93 +#define UNKNOWN 10
1.94 +#define UNKNOWN_CHAR 11
1.95 +
1.96 +/*
1.97 + * Binary numeric operators:
1.98 + */
1.99 +
1.100 +#define MULT 12
1.101 +#define DIVIDE 13
1.102 +#define MOD 14
1.103 +#define PLUS 15
1.104 +#define MINUS 16
1.105 +#define LEFT_SHIFT 17
1.106 +#define RIGHT_SHIFT 18
1.107 +#define LESS 19
1.108 +#define GREATER 20
1.109 +#define LEQ 21
1.110 +#define GEQ 22
1.111 +#define EQUAL 23
1.112 +#define NEQ 24
1.113 +#define BIT_AND 25
1.114 +#define BIT_XOR 26
1.115 +#define BIT_OR 27
1.116 +#define AND 28
1.117 +#define OR 29
1.118 +#define QUESTY 30
1.119 +#define COLON 31
1.120 +
1.121 +/*
1.122 + * Unary operators. Unary minus and plus are represented by the (binary)
1.123 + * lexemes MINUS and PLUS.
1.124 + */
1.125 +
1.126 +#define NOT 32
1.127 +#define BIT_NOT 33
1.128 +
1.129 +/*
1.130 + * Binary string operators:
1.131 + */
1.132 +
1.133 +#define STREQ 34
1.134 +#define STRNEQ 35
1.135 +
1.136 +/*
1.137 + * Mapping from lexemes to strings; used for debugging messages. These
1.138 + * entries must match the order and number of the lexeme definitions above.
1.139 + */
1.140 +
1.141 +static char *lexemeStrings[] = {
1.142 + "LITERAL", "FUNCNAME",
1.143 + "[", "{", "(", ")", "$", "\"", ",", "END", "UNKNOWN", "UNKNOWN_CHAR",
1.144 + "*", "/", "%", "+", "-",
1.145 + "<<", ">>", "<", ">", "<=", ">=", "==", "!=",
1.146 + "&", "^", "|", "&&", "||", "?", ":",
1.147 + "!", "~", "eq", "ne",
1.148 +};
1.149 +
1.150 +/*
1.151 + * Declarations for local procedures to this file:
1.152 + */
1.153 +
1.154 +static int GetLexeme _ANSI_ARGS_((ParseInfo *infoPtr));
1.155 +static void LogSyntaxError _ANSI_ARGS_((ParseInfo *infoPtr,
1.156 + CONST char *extraInfo));
1.157 +static int ParseAddExpr _ANSI_ARGS_((ParseInfo *infoPtr));
1.158 +static int ParseBitAndExpr _ANSI_ARGS_((ParseInfo *infoPtr));
1.159 +static int ParseBitOrExpr _ANSI_ARGS_((ParseInfo *infoPtr));
1.160 +static int ParseBitXorExpr _ANSI_ARGS_((ParseInfo *infoPtr));
1.161 +static int ParseCondExpr _ANSI_ARGS_((ParseInfo *infoPtr));
1.162 +static int ParseEqualityExpr _ANSI_ARGS_((ParseInfo *infoPtr));
1.163 +static int ParseLandExpr _ANSI_ARGS_((ParseInfo *infoPtr));
1.164 +static int ParseLorExpr _ANSI_ARGS_((ParseInfo *infoPtr));
1.165 +static int ParseMaxDoubleLength _ANSI_ARGS_((CONST char *string,
1.166 + CONST char *end));
1.167 +static int ParseMultiplyExpr _ANSI_ARGS_((ParseInfo *infoPtr));
1.168 +static int ParsePrimaryExpr _ANSI_ARGS_((ParseInfo *infoPtr));
1.169 +static int ParseRelationalExpr _ANSI_ARGS_((ParseInfo *infoPtr));
1.170 +static int ParseShiftExpr _ANSI_ARGS_((ParseInfo *infoPtr));
1.171 +static int ParseUnaryExpr _ANSI_ARGS_((ParseInfo *infoPtr));
1.172 +static void PrependSubExprTokens _ANSI_ARGS_((CONST char *op,
1.173 + int opBytes, CONST char *src, int srcBytes,
1.174 + int firstIndex, ParseInfo *infoPtr));
1.175 +
1.176 +/*
1.177 + * Macro used to debug the execution of the recursive descent parser used
1.178 + * to parse expressions.
1.179 + */
1.180 +
1.181 +#ifdef TCL_COMPILE_DEBUG
1.182 +#define HERE(production, level) \
1.183 + if (traceParseExpr) { \
1.184 + fprintf(stderr, "%*s%s: lexeme=%s, next=\"%.20s\"\n", \
1.185 + (level), " ", (production), \
1.186 + lexemeStrings[infoPtr->lexeme], infoPtr->next); \
1.187 + }
1.188 +#else
1.189 +#define HERE(production, level)
1.190 +#endif /* TCL_COMPILE_DEBUG */
1.191 +
1.192 +/*
1.193 + *----------------------------------------------------------------------
1.194 + *
1.195 + * Tcl_ParseExpr --
1.196 + *
1.197 + * Given a string, this procedure parses the first Tcl expression
1.198 + * in the string and returns information about the structure of
1.199 + * the expression. This procedure is the top-level interface to the
1.200 + * the expression parsing module. No more that numBytes bytes will
1.201 + * be scanned.
1.202 + *
1.203 + * Results:
1.204 + * The return value is TCL_OK if the command was parsed successfully
1.205 + * and TCL_ERROR otherwise. If an error occurs and interp isn't NULL
1.206 + * then an error message is left in its result. On a successful return,
1.207 + * parsePtr is filled in with information about the expression that
1.208 + * was parsed.
1.209 + *
1.210 + * Side effects:
1.211 + * If there is insufficient space in parsePtr to hold all the
1.212 + * information about the expression, then additional space is
1.213 + * malloc-ed. If the procedure returns TCL_OK then the caller must
1.214 + * eventually invoke Tcl_FreeParse to release any additional space
1.215 + * that was allocated.
1.216 + *
1.217 + *----------------------------------------------------------------------
1.218 + */
1.219 +
1.220 +EXPORT_C int
1.221 +Tcl_ParseExpr(interp, string, numBytes, parsePtr)
1.222 + Tcl_Interp *interp; /* Used for error reporting. */
1.223 + CONST char *string; /* The source string to parse. */
1.224 + int numBytes; /* Number of bytes in string. If < 0, the
1.225 + * string consists of all bytes up to the
1.226 + * first null character. */
1.227 + Tcl_Parse *parsePtr; /* Structure to fill with information about
1.228 + * the parsed expression; any previous
1.229 + * information in the structure is
1.230 + * ignored. */
1.231 +{
1.232 + ParseInfo info;
1.233 + int code;
1.234 +
1.235 + if (numBytes < 0) {
1.236 + numBytes = (string? strlen(string) : 0);
1.237 + }
1.238 +#ifdef TCL_COMPILE_DEBUG
1.239 + if (traceParseExpr) {
1.240 + fprintf(stderr, "Tcl_ParseExpr: string=\"%.*s\"\n",
1.241 + numBytes, string);
1.242 + }
1.243 +#endif /* TCL_COMPILE_DEBUG */
1.244 +
1.245 + parsePtr->commentStart = NULL;
1.246 + parsePtr->commentSize = 0;
1.247 + parsePtr->commandStart = NULL;
1.248 + parsePtr->commandSize = 0;
1.249 + parsePtr->numWords = 0;
1.250 + parsePtr->tokenPtr = parsePtr->staticTokens;
1.251 + parsePtr->numTokens = 0;
1.252 + parsePtr->tokensAvailable = NUM_STATIC_TOKENS;
1.253 + parsePtr->string = string;
1.254 + parsePtr->end = (string + numBytes);
1.255 + parsePtr->interp = interp;
1.256 + parsePtr->term = string;
1.257 + parsePtr->incomplete = 0;
1.258 +
1.259 + /*
1.260 + * Initialize the ParseInfo structure that holds state while parsing
1.261 + * the expression.
1.262 + */
1.263 +
1.264 + info.parsePtr = parsePtr;
1.265 + info.lexeme = UNKNOWN;
1.266 + info.start = NULL;
1.267 + info.size = 0;
1.268 + info.next = string;
1.269 + info.prevEnd = string;
1.270 + info.originalExpr = string;
1.271 + info.lastChar = (string + numBytes); /* just after last char of expr */
1.272 +
1.273 + /*
1.274 + * Get the first lexeme then parse the expression.
1.275 + */
1.276 +
1.277 + code = GetLexeme(&info);
1.278 + if (code != TCL_OK) {
1.279 + goto error;
1.280 + }
1.281 + code = ParseCondExpr(&info);
1.282 + if (code != TCL_OK) {
1.283 + goto error;
1.284 + }
1.285 + if (info.lexeme != END) {
1.286 + LogSyntaxError(&info, "extra tokens at end of expression");
1.287 + goto error;
1.288 + }
1.289 + return TCL_OK;
1.290 +
1.291 + error:
1.292 + if (parsePtr->tokenPtr != parsePtr->staticTokens) {
1.293 + ckfree((char *) parsePtr->tokenPtr);
1.294 + }
1.295 + return TCL_ERROR;
1.296 +}
1.297 +
1.298 +/*
1.299 + *----------------------------------------------------------------------
1.300 + *
1.301 + * ParseCondExpr --
1.302 + *
1.303 + * This procedure parses a Tcl conditional expression:
1.304 + * condExpr ::= lorExpr ['?' condExpr ':' condExpr]
1.305 + *
1.306 + * Note that this is the topmost recursive-descent parsing routine used
1.307 + * by Tcl_ParseExpr to parse expressions. This avoids an extra procedure
1.308 + * call since such a procedure would only return the result of calling
1.309 + * ParseCondExpr. Other recursive-descent procedures that need to parse
1.310 + * complete expressions also call ParseCondExpr.
1.311 + *
1.312 + * Results:
1.313 + * The return value is TCL_OK on a successful parse and TCL_ERROR
1.314 + * on failure. If TCL_ERROR is returned, then the interpreter's result
1.315 + * contains an error message.
1.316 + *
1.317 + * Side effects:
1.318 + * If there is insufficient space in parsePtr to hold all the
1.319 + * information about the subexpression, then additional space is
1.320 + * malloc-ed.
1.321 + *
1.322 + *----------------------------------------------------------------------
1.323 + */
1.324 +
1.325 +static int
1.326 +ParseCondExpr(infoPtr)
1.327 + ParseInfo *infoPtr; /* Holds the parse state for the
1.328 + * expression being parsed. */
1.329 +{
1.330 + Tcl_Parse *parsePtr = infoPtr->parsePtr;
1.331 + Tcl_Token *tokenPtr, *firstTokenPtr, *condTokenPtr;
1.332 + int firstIndex, numToMove, code;
1.333 + CONST char *srcStart;
1.334 +
1.335 + HERE("condExpr", 1);
1.336 + srcStart = infoPtr->start;
1.337 + firstIndex = parsePtr->numTokens;
1.338 +
1.339 + code = ParseLorExpr(infoPtr);
1.340 + if (code != TCL_OK) {
1.341 + return code;
1.342 + }
1.343 +
1.344 + if (infoPtr->lexeme == QUESTY) {
1.345 + /*
1.346 + * Emit two tokens: one TCL_TOKEN_SUB_EXPR token for the entire
1.347 + * conditional expression, and a TCL_TOKEN_OPERATOR token for
1.348 + * the "?" operator. Note that these two tokens must be inserted
1.349 + * before the LOR operand tokens generated above.
1.350 + */
1.351 +
1.352 + if ((parsePtr->numTokens + 1) >= parsePtr->tokensAvailable) {
1.353 + TclExpandTokenArray(parsePtr);
1.354 + }
1.355 + firstTokenPtr = &parsePtr->tokenPtr[firstIndex];
1.356 + tokenPtr = (firstTokenPtr + 2);
1.357 + numToMove = (parsePtr->numTokens - firstIndex);
1.358 + memmove((VOID *) tokenPtr, (VOID *) firstTokenPtr,
1.359 + (size_t) (numToMove * sizeof(Tcl_Token)));
1.360 + parsePtr->numTokens += 2;
1.361 +
1.362 + tokenPtr = firstTokenPtr;
1.363 + tokenPtr->type = TCL_TOKEN_SUB_EXPR;
1.364 + tokenPtr->start = srcStart;
1.365 +
1.366 + tokenPtr++;
1.367 + tokenPtr->type = TCL_TOKEN_OPERATOR;
1.368 + tokenPtr->start = infoPtr->start;
1.369 + tokenPtr->size = 1;
1.370 + tokenPtr->numComponents = 0;
1.371 +
1.372 + /*
1.373 + * Skip over the '?'.
1.374 + */
1.375 +
1.376 + code = GetLexeme(infoPtr);
1.377 + if (code != TCL_OK) {
1.378 + return code;
1.379 + }
1.380 +
1.381 + /*
1.382 + * Parse the "then" expression.
1.383 + */
1.384 +
1.385 + code = ParseCondExpr(infoPtr);
1.386 + if (code != TCL_OK) {
1.387 + return code;
1.388 + }
1.389 + if (infoPtr->lexeme != COLON) {
1.390 + LogSyntaxError(infoPtr, "missing colon from ternary conditional");
1.391 + return TCL_ERROR;
1.392 + }
1.393 + code = GetLexeme(infoPtr); /* skip over the ':' */
1.394 + if (code != TCL_OK) {
1.395 + return code;
1.396 + }
1.397 +
1.398 + /*
1.399 + * Parse the "else" expression.
1.400 + */
1.401 +
1.402 + code = ParseCondExpr(infoPtr);
1.403 + if (code != TCL_OK) {
1.404 + return code;
1.405 + }
1.406 +
1.407 + /*
1.408 + * Now set the size-related fields in the '?' subexpression token.
1.409 + */
1.410 +
1.411 + condTokenPtr = &parsePtr->tokenPtr[firstIndex];
1.412 + condTokenPtr->size = (infoPtr->prevEnd - srcStart);
1.413 + condTokenPtr->numComponents = parsePtr->numTokens - (firstIndex+1);
1.414 + }
1.415 + return TCL_OK;
1.416 +}
1.417 +
1.418 +/*
1.419 + *----------------------------------------------------------------------
1.420 + *
1.421 + * ParseLorExpr --
1.422 + *
1.423 + * This procedure parses a Tcl logical or expression:
1.424 + * lorExpr ::= landExpr {'||' landExpr}
1.425 + *
1.426 + * Results:
1.427 + * The return value is TCL_OK on a successful parse and TCL_ERROR
1.428 + * on failure. If TCL_ERROR is returned, then the interpreter's result
1.429 + * contains an error message.
1.430 + *
1.431 + * Side effects:
1.432 + * If there is insufficient space in parsePtr to hold all the
1.433 + * information about the subexpression, then additional space is
1.434 + * malloc-ed.
1.435 + *
1.436 + *----------------------------------------------------------------------
1.437 + */
1.438 +
1.439 +static int
1.440 +ParseLorExpr(infoPtr)
1.441 + ParseInfo *infoPtr; /* Holds the parse state for the
1.442 + * expression being parsed. */
1.443 +{
1.444 + Tcl_Parse *parsePtr = infoPtr->parsePtr;
1.445 + int firstIndex, code;
1.446 + CONST char *srcStart, *operator;
1.447 +
1.448 + HERE("lorExpr", 2);
1.449 + srcStart = infoPtr->start;
1.450 + firstIndex = parsePtr->numTokens;
1.451 +
1.452 + code = ParseLandExpr(infoPtr);
1.453 + if (code != TCL_OK) {
1.454 + return code;
1.455 + }
1.456 +
1.457 + while (infoPtr->lexeme == OR) {
1.458 + operator = infoPtr->start;
1.459 + code = GetLexeme(infoPtr); /* skip over the '||' */
1.460 + if (code != TCL_OK) {
1.461 + return code;
1.462 + }
1.463 + code = ParseLandExpr(infoPtr);
1.464 + if (code != TCL_OK) {
1.465 + return code;
1.466 + }
1.467 +
1.468 + /*
1.469 + * Generate tokens for the LOR subexpression and the '||' operator.
1.470 + */
1.471 +
1.472 + PrependSubExprTokens(operator, 2, srcStart,
1.473 + (infoPtr->prevEnd - srcStart), firstIndex, infoPtr);
1.474 + }
1.475 + return TCL_OK;
1.476 +}
1.477 +
1.478 +/*
1.479 + *----------------------------------------------------------------------
1.480 + *
1.481 + * ParseLandExpr --
1.482 + *
1.483 + * This procedure parses a Tcl logical and expression:
1.484 + * landExpr ::= bitOrExpr {'&&' bitOrExpr}
1.485 + *
1.486 + * Results:
1.487 + * The return value is TCL_OK on a successful parse and TCL_ERROR
1.488 + * on failure. If TCL_ERROR is returned, then the interpreter's result
1.489 + * contains an error message.
1.490 + *
1.491 + * Side effects:
1.492 + * If there is insufficient space in parsePtr to hold all the
1.493 + * information about the subexpression, then additional space is
1.494 + * malloc-ed.
1.495 + *
1.496 + *----------------------------------------------------------------------
1.497 + */
1.498 +
1.499 +static int
1.500 +ParseLandExpr(infoPtr)
1.501 + ParseInfo *infoPtr; /* Holds the parse state for the
1.502 + * expression being parsed. */
1.503 +{
1.504 + Tcl_Parse *parsePtr = infoPtr->parsePtr;
1.505 + int firstIndex, code;
1.506 + CONST char *srcStart, *operator;
1.507 +
1.508 + HERE("landExpr", 3);
1.509 + srcStart = infoPtr->start;
1.510 + firstIndex = parsePtr->numTokens;
1.511 +
1.512 + code = ParseBitOrExpr(infoPtr);
1.513 + if (code != TCL_OK) {
1.514 + return code;
1.515 + }
1.516 +
1.517 + while (infoPtr->lexeme == AND) {
1.518 + operator = infoPtr->start;
1.519 + code = GetLexeme(infoPtr); /* skip over the '&&' */
1.520 + if (code != TCL_OK) {
1.521 + return code;
1.522 + }
1.523 + code = ParseBitOrExpr(infoPtr);
1.524 + if (code != TCL_OK) {
1.525 + return code;
1.526 + }
1.527 +
1.528 + /*
1.529 + * Generate tokens for the LAND subexpression and the '&&' operator.
1.530 + */
1.531 +
1.532 + PrependSubExprTokens(operator, 2, srcStart,
1.533 + (infoPtr->prevEnd - srcStart), firstIndex, infoPtr);
1.534 + }
1.535 + return TCL_OK;
1.536 +}
1.537 +
1.538 +/*
1.539 + *----------------------------------------------------------------------
1.540 + *
1.541 + * ParseBitOrExpr --
1.542 + *
1.543 + * This procedure parses a Tcl bitwise or expression:
1.544 + * bitOrExpr ::= bitXorExpr {'|' bitXorExpr}
1.545 + *
1.546 + * Results:
1.547 + * The return value is TCL_OK on a successful parse and TCL_ERROR
1.548 + * on failure. If TCL_ERROR is returned, then the interpreter's result
1.549 + * contains an error message.
1.550 + *
1.551 + * Side effects:
1.552 + * If there is insufficient space in parsePtr to hold all the
1.553 + * information about the subexpression, then additional space is
1.554 + * malloc-ed.
1.555 + *
1.556 + *----------------------------------------------------------------------
1.557 + */
1.558 +
1.559 +static int
1.560 +ParseBitOrExpr(infoPtr)
1.561 + ParseInfo *infoPtr; /* Holds the parse state for the
1.562 + * expression being parsed. */
1.563 +{
1.564 + Tcl_Parse *parsePtr = infoPtr->parsePtr;
1.565 + int firstIndex, code;
1.566 + CONST char *srcStart, *operator;
1.567 +
1.568 + HERE("bitOrExpr", 4);
1.569 + srcStart = infoPtr->start;
1.570 + firstIndex = parsePtr->numTokens;
1.571 +
1.572 + code = ParseBitXorExpr(infoPtr);
1.573 + if (code != TCL_OK) {
1.574 + return code;
1.575 + }
1.576 +
1.577 + while (infoPtr->lexeme == BIT_OR) {
1.578 + operator = infoPtr->start;
1.579 + code = GetLexeme(infoPtr); /* skip over the '|' */
1.580 + if (code != TCL_OK) {
1.581 + return code;
1.582 + }
1.583 +
1.584 + code = ParseBitXorExpr(infoPtr);
1.585 + if (code != TCL_OK) {
1.586 + return code;
1.587 + }
1.588 +
1.589 + /*
1.590 + * Generate tokens for the BITOR subexpression and the '|' operator.
1.591 + */
1.592 +
1.593 + PrependSubExprTokens(operator, 1, srcStart,
1.594 + (infoPtr->prevEnd - srcStart), firstIndex, infoPtr);
1.595 + }
1.596 + return TCL_OK;
1.597 +}
1.598 +
1.599 +/*
1.600 + *----------------------------------------------------------------------
1.601 + *
1.602 + * ParseBitXorExpr --
1.603 + *
1.604 + * This procedure parses a Tcl bitwise exclusive or expression:
1.605 + * bitXorExpr ::= bitAndExpr {'^' bitAndExpr}
1.606 + *
1.607 + * Results:
1.608 + * The return value is TCL_OK on a successful parse and TCL_ERROR
1.609 + * on failure. If TCL_ERROR is returned, then the interpreter's result
1.610 + * contains an error message.
1.611 + *
1.612 + * Side effects:
1.613 + * If there is insufficient space in parsePtr to hold all the
1.614 + * information about the subexpression, then additional space is
1.615 + * malloc-ed.
1.616 + *
1.617 + *----------------------------------------------------------------------
1.618 + */
1.619 +
1.620 +static int
1.621 +ParseBitXorExpr(infoPtr)
1.622 + ParseInfo *infoPtr; /* Holds the parse state for the
1.623 + * expression being parsed. */
1.624 +{
1.625 + Tcl_Parse *parsePtr = infoPtr->parsePtr;
1.626 + int firstIndex, code;
1.627 + CONST char *srcStart, *operator;
1.628 +
1.629 + HERE("bitXorExpr", 5);
1.630 + srcStart = infoPtr->start;
1.631 + firstIndex = parsePtr->numTokens;
1.632 +
1.633 + code = ParseBitAndExpr(infoPtr);
1.634 + if (code != TCL_OK) {
1.635 + return code;
1.636 + }
1.637 +
1.638 + while (infoPtr->lexeme == BIT_XOR) {
1.639 + operator = infoPtr->start;
1.640 + code = GetLexeme(infoPtr); /* skip over the '^' */
1.641 + if (code != TCL_OK) {
1.642 + return code;
1.643 + }
1.644 +
1.645 + code = ParseBitAndExpr(infoPtr);
1.646 + if (code != TCL_OK) {
1.647 + return code;
1.648 + }
1.649 +
1.650 + /*
1.651 + * Generate tokens for the XOR subexpression and the '^' operator.
1.652 + */
1.653 +
1.654 + PrependSubExprTokens(operator, 1, srcStart,
1.655 + (infoPtr->prevEnd - srcStart), firstIndex, infoPtr);
1.656 + }
1.657 + return TCL_OK;
1.658 +}
1.659 +
1.660 +/*
1.661 + *----------------------------------------------------------------------
1.662 + *
1.663 + * ParseBitAndExpr --
1.664 + *
1.665 + * This procedure parses a Tcl bitwise and expression:
1.666 + * bitAndExpr ::= equalityExpr {'&' equalityExpr}
1.667 + *
1.668 + * Results:
1.669 + * The return value is TCL_OK on a successful parse and TCL_ERROR
1.670 + * on failure. If TCL_ERROR is returned, then the interpreter's result
1.671 + * contains an error message.
1.672 + *
1.673 + * Side effects:
1.674 + * If there is insufficient space in parsePtr to hold all the
1.675 + * information about the subexpression, then additional space is
1.676 + * malloc-ed.
1.677 + *
1.678 + *----------------------------------------------------------------------
1.679 + */
1.680 +
1.681 +static int
1.682 +ParseBitAndExpr(infoPtr)
1.683 + ParseInfo *infoPtr; /* Holds the parse state for the
1.684 + * expression being parsed. */
1.685 +{
1.686 + Tcl_Parse *parsePtr = infoPtr->parsePtr;
1.687 + int firstIndex, code;
1.688 + CONST char *srcStart, *operator;
1.689 +
1.690 + HERE("bitAndExpr", 6);
1.691 + srcStart = infoPtr->start;
1.692 + firstIndex = parsePtr->numTokens;
1.693 +
1.694 + code = ParseEqualityExpr(infoPtr);
1.695 + if (code != TCL_OK) {
1.696 + return code;
1.697 + }
1.698 +
1.699 + while (infoPtr->lexeme == BIT_AND) {
1.700 + operator = infoPtr->start;
1.701 + code = GetLexeme(infoPtr); /* skip over the '&' */
1.702 + if (code != TCL_OK) {
1.703 + return code;
1.704 + }
1.705 + code = ParseEqualityExpr(infoPtr);
1.706 + if (code != TCL_OK) {
1.707 + return code;
1.708 + }
1.709 +
1.710 + /*
1.711 + * Generate tokens for the BITAND subexpression and '&' operator.
1.712 + */
1.713 +
1.714 + PrependSubExprTokens(operator, 1, srcStart,
1.715 + (infoPtr->prevEnd - srcStart), firstIndex, infoPtr);
1.716 + }
1.717 + return TCL_OK;
1.718 +}
1.719 +
1.720 +/*
1.721 + *----------------------------------------------------------------------
1.722 + *
1.723 + * ParseEqualityExpr --
1.724 + *
1.725 + * This procedure parses a Tcl equality (inequality) expression:
1.726 + * equalityExpr ::= relationalExpr
1.727 + * {('==' | '!=' | 'ne' | 'eq') relationalExpr}
1.728 + *
1.729 + * Results:
1.730 + * The return value is TCL_OK on a successful parse and TCL_ERROR
1.731 + * on failure. If TCL_ERROR is returned, then the interpreter's result
1.732 + * contains an error message.
1.733 + *
1.734 + * Side effects:
1.735 + * If there is insufficient space in parsePtr to hold all the
1.736 + * information about the subexpression, then additional space is
1.737 + * malloc-ed.
1.738 + *
1.739 + *----------------------------------------------------------------------
1.740 + */
1.741 +
1.742 +static int
1.743 +ParseEqualityExpr(infoPtr)
1.744 + ParseInfo *infoPtr; /* Holds the parse state for the
1.745 + * expression being parsed. */
1.746 +{
1.747 + Tcl_Parse *parsePtr = infoPtr->parsePtr;
1.748 + int firstIndex, lexeme, code;
1.749 + CONST char *srcStart, *operator;
1.750 +
1.751 + HERE("equalityExpr", 7);
1.752 + srcStart = infoPtr->start;
1.753 + firstIndex = parsePtr->numTokens;
1.754 +
1.755 + code = ParseRelationalExpr(infoPtr);
1.756 + if (code != TCL_OK) {
1.757 + return code;
1.758 + }
1.759 +
1.760 + lexeme = infoPtr->lexeme;
1.761 + while ((lexeme == EQUAL) || (lexeme == NEQ)
1.762 + || (lexeme == STREQ) || (lexeme == STRNEQ)) {
1.763 + operator = infoPtr->start;
1.764 + code = GetLexeme(infoPtr); /* skip over ==, !=, 'eq' or 'ne' */
1.765 + if (code != TCL_OK) {
1.766 + return code;
1.767 + }
1.768 + code = ParseRelationalExpr(infoPtr);
1.769 + if (code != TCL_OK) {
1.770 + return code;
1.771 + }
1.772 +
1.773 + /*
1.774 + * Generate tokens for the subexpression and '==', '!=', 'eq' or 'ne'
1.775 + * operator.
1.776 + */
1.777 +
1.778 + PrependSubExprTokens(operator, 2, srcStart,
1.779 + (infoPtr->prevEnd - srcStart), firstIndex, infoPtr);
1.780 + lexeme = infoPtr->lexeme;
1.781 + }
1.782 + return TCL_OK;
1.783 +}
1.784 +
1.785 +/*
1.786 + *----------------------------------------------------------------------
1.787 + *
1.788 + * ParseRelationalExpr --
1.789 + *
1.790 + * This procedure parses a Tcl relational expression:
1.791 + * relationalExpr ::= shiftExpr {('<' | '>' | '<=' | '>=') shiftExpr}
1.792 + *
1.793 + * Results:
1.794 + * The return value is TCL_OK on a successful parse and TCL_ERROR
1.795 + * on failure. If TCL_ERROR is returned, then the interpreter's result
1.796 + * contains an error message.
1.797 + *
1.798 + * Side effects:
1.799 + * If there is insufficient space in parsePtr to hold all the
1.800 + * information about the subexpression, then additional space is
1.801 + * malloc-ed.
1.802 + *
1.803 + *----------------------------------------------------------------------
1.804 + */
1.805 +
1.806 +static int
1.807 +ParseRelationalExpr(infoPtr)
1.808 + ParseInfo *infoPtr; /* Holds the parse state for the
1.809 + * expression being parsed. */
1.810 +{
1.811 + Tcl_Parse *parsePtr = infoPtr->parsePtr;
1.812 + int firstIndex, lexeme, operatorSize, code;
1.813 + CONST char *srcStart, *operator;
1.814 +
1.815 + HERE("relationalExpr", 8);
1.816 + srcStart = infoPtr->start;
1.817 + firstIndex = parsePtr->numTokens;
1.818 +
1.819 + code = ParseShiftExpr(infoPtr);
1.820 + if (code != TCL_OK) {
1.821 + return code;
1.822 + }
1.823 +
1.824 + lexeme = infoPtr->lexeme;
1.825 + while ((lexeme == LESS) || (lexeme == GREATER) || (lexeme == LEQ)
1.826 + || (lexeme == GEQ)) {
1.827 + operator = infoPtr->start;
1.828 + if ((lexeme == LEQ) || (lexeme == GEQ)) {
1.829 + operatorSize = 2;
1.830 + } else {
1.831 + operatorSize = 1;
1.832 + }
1.833 + code = GetLexeme(infoPtr); /* skip over the operator */
1.834 + if (code != TCL_OK) {
1.835 + return code;
1.836 + }
1.837 + code = ParseShiftExpr(infoPtr);
1.838 + if (code != TCL_OK) {
1.839 + return code;
1.840 + }
1.841 +
1.842 + /*
1.843 + * Generate tokens for the subexpression and the operator.
1.844 + */
1.845 +
1.846 + PrependSubExprTokens(operator, operatorSize, srcStart,
1.847 + (infoPtr->prevEnd - srcStart), firstIndex, infoPtr);
1.848 + lexeme = infoPtr->lexeme;
1.849 + }
1.850 + return TCL_OK;
1.851 +}
1.852 +
1.853 +/*
1.854 + *----------------------------------------------------------------------
1.855 + *
1.856 + * ParseShiftExpr --
1.857 + *
1.858 + * This procedure parses a Tcl shift expression:
1.859 + * shiftExpr ::= addExpr {('<<' | '>>') addExpr}
1.860 + *
1.861 + * Results:
1.862 + * The return value is TCL_OK on a successful parse and TCL_ERROR
1.863 + * on failure. If TCL_ERROR is returned, then the interpreter's result
1.864 + * contains an error message.
1.865 + *
1.866 + * Side effects:
1.867 + * If there is insufficient space in parsePtr to hold all the
1.868 + * information about the subexpression, then additional space is
1.869 + * malloc-ed.
1.870 + *
1.871 + *----------------------------------------------------------------------
1.872 + */
1.873 +
1.874 +static int
1.875 +ParseShiftExpr(infoPtr)
1.876 + ParseInfo *infoPtr; /* Holds the parse state for the
1.877 + * expression being parsed. */
1.878 +{
1.879 + Tcl_Parse *parsePtr = infoPtr->parsePtr;
1.880 + int firstIndex, lexeme, code;
1.881 + CONST char *srcStart, *operator;
1.882 +
1.883 + HERE("shiftExpr", 9);
1.884 + srcStart = infoPtr->start;
1.885 + firstIndex = parsePtr->numTokens;
1.886 +
1.887 + code = ParseAddExpr(infoPtr);
1.888 + if (code != TCL_OK) {
1.889 + return code;
1.890 + }
1.891 +
1.892 + lexeme = infoPtr->lexeme;
1.893 + while ((lexeme == LEFT_SHIFT) || (lexeme == RIGHT_SHIFT)) {
1.894 + operator = infoPtr->start;
1.895 + code = GetLexeme(infoPtr); /* skip over << or >> */
1.896 + if (code != TCL_OK) {
1.897 + return code;
1.898 + }
1.899 + code = ParseAddExpr(infoPtr);
1.900 + if (code != TCL_OK) {
1.901 + return code;
1.902 + }
1.903 +
1.904 + /*
1.905 + * Generate tokens for the subexpression and '<<' or '>>' operator.
1.906 + */
1.907 +
1.908 + PrependSubExprTokens(operator, 2, srcStart,
1.909 + (infoPtr->prevEnd - srcStart), firstIndex, infoPtr);
1.910 + lexeme = infoPtr->lexeme;
1.911 + }
1.912 + return TCL_OK;
1.913 +}
1.914 +
1.915 +/*
1.916 + *----------------------------------------------------------------------
1.917 + *
1.918 + * ParseAddExpr --
1.919 + *
1.920 + * This procedure parses a Tcl addition expression:
1.921 + * addExpr ::= multiplyExpr {('+' | '-') multiplyExpr}
1.922 + *
1.923 + * Results:
1.924 + * The return value is TCL_OK on a successful parse and TCL_ERROR
1.925 + * on failure. If TCL_ERROR is returned, then the interpreter's result
1.926 + * contains an error message.
1.927 + *
1.928 + * Side effects:
1.929 + * If there is insufficient space in parsePtr to hold all the
1.930 + * information about the subexpression, then additional space is
1.931 + * malloc-ed.
1.932 + *
1.933 + *----------------------------------------------------------------------
1.934 + */
1.935 +
1.936 +static int
1.937 +ParseAddExpr(infoPtr)
1.938 + ParseInfo *infoPtr; /* Holds the parse state for the
1.939 + * expression being parsed. */
1.940 +{
1.941 + Tcl_Parse *parsePtr = infoPtr->parsePtr;
1.942 + int firstIndex, lexeme, code;
1.943 + CONST char *srcStart, *operator;
1.944 +
1.945 + HERE("addExpr", 10);
1.946 + srcStart = infoPtr->start;
1.947 + firstIndex = parsePtr->numTokens;
1.948 +
1.949 + code = ParseMultiplyExpr(infoPtr);
1.950 + if (code != TCL_OK) {
1.951 + return code;
1.952 + }
1.953 +
1.954 + lexeme = infoPtr->lexeme;
1.955 + while ((lexeme == PLUS) || (lexeme == MINUS)) {
1.956 + operator = infoPtr->start;
1.957 + code = GetLexeme(infoPtr); /* skip over + or - */
1.958 + if (code != TCL_OK) {
1.959 + return code;
1.960 + }
1.961 + code = ParseMultiplyExpr(infoPtr);
1.962 + if (code != TCL_OK) {
1.963 + return code;
1.964 + }
1.965 +
1.966 + /*
1.967 + * Generate tokens for the subexpression and '+' or '-' operator.
1.968 + */
1.969 +
1.970 + PrependSubExprTokens(operator, 1, srcStart,
1.971 + (infoPtr->prevEnd - srcStart), firstIndex, infoPtr);
1.972 + lexeme = infoPtr->lexeme;
1.973 + }
1.974 + return TCL_OK;
1.975 +}
1.976 +
1.977 +/*
1.978 + *----------------------------------------------------------------------
1.979 + *
1.980 + * ParseMultiplyExpr --
1.981 + *
1.982 + * This procedure parses a Tcl multiply expression:
1.983 + * multiplyExpr ::= unaryExpr {('*' | '/' | '%') unaryExpr}
1.984 + *
1.985 + * Results:
1.986 + * The return value is TCL_OK on a successful parse and TCL_ERROR
1.987 + * on failure. If TCL_ERROR is returned, then the interpreter's result
1.988 + * contains an error message.
1.989 + *
1.990 + * Side effects:
1.991 + * If there is insufficient space in parsePtr to hold all the
1.992 + * information about the subexpression, then additional space is
1.993 + * malloc-ed.
1.994 + *
1.995 + *----------------------------------------------------------------------
1.996 + */
1.997 +
1.998 +static int
1.999 +ParseMultiplyExpr(infoPtr)
1.1000 + ParseInfo *infoPtr; /* Holds the parse state for the
1.1001 + * expression being parsed. */
1.1002 +{
1.1003 + Tcl_Parse *parsePtr = infoPtr->parsePtr;
1.1004 + int firstIndex, lexeme, code;
1.1005 + CONST char *srcStart, *operator;
1.1006 +
1.1007 + HERE("multiplyExpr", 11);
1.1008 + srcStart = infoPtr->start;
1.1009 + firstIndex = parsePtr->numTokens;
1.1010 +
1.1011 + code = ParseUnaryExpr(infoPtr);
1.1012 + if (code != TCL_OK) {
1.1013 + return code;
1.1014 + }
1.1015 +
1.1016 + lexeme = infoPtr->lexeme;
1.1017 + while ((lexeme == MULT) || (lexeme == DIVIDE) || (lexeme == MOD)) {
1.1018 + operator = infoPtr->start;
1.1019 + code = GetLexeme(infoPtr); /* skip over * or / or % */
1.1020 + if (code != TCL_OK) {
1.1021 + return code;
1.1022 + }
1.1023 + code = ParseUnaryExpr(infoPtr);
1.1024 + if (code != TCL_OK) {
1.1025 + return code;
1.1026 + }
1.1027 +
1.1028 + /*
1.1029 + * Generate tokens for the subexpression and * or / or % operator.
1.1030 + */
1.1031 +
1.1032 + PrependSubExprTokens(operator, 1, srcStart,
1.1033 + (infoPtr->prevEnd - srcStart), firstIndex, infoPtr);
1.1034 + lexeme = infoPtr->lexeme;
1.1035 + }
1.1036 + return TCL_OK;
1.1037 +}
1.1038 +
1.1039 +/*
1.1040 + *----------------------------------------------------------------------
1.1041 + *
1.1042 + * ParseUnaryExpr --
1.1043 + *
1.1044 + * This procedure parses a Tcl unary expression:
1.1045 + * unaryExpr ::= ('+' | '-' | '~' | '!') unaryExpr | primaryExpr
1.1046 + *
1.1047 + * Results:
1.1048 + * The return value is TCL_OK on a successful parse and TCL_ERROR
1.1049 + * on failure. If TCL_ERROR is returned, then the interpreter's result
1.1050 + * contains an error message.
1.1051 + *
1.1052 + * Side effects:
1.1053 + * If there is insufficient space in parsePtr to hold all the
1.1054 + * information about the subexpression, then additional space is
1.1055 + * malloc-ed.
1.1056 + *
1.1057 + *----------------------------------------------------------------------
1.1058 + */
1.1059 +
1.1060 +static int
1.1061 +ParseUnaryExpr(infoPtr)
1.1062 + ParseInfo *infoPtr; /* Holds the parse state for the
1.1063 + * expression being parsed. */
1.1064 +{
1.1065 + Tcl_Parse *parsePtr = infoPtr->parsePtr;
1.1066 + int firstIndex, lexeme, code;
1.1067 + CONST char *srcStart, *operator;
1.1068 +
1.1069 + HERE("unaryExpr", 12);
1.1070 + srcStart = infoPtr->start;
1.1071 + firstIndex = parsePtr->numTokens;
1.1072 +
1.1073 + lexeme = infoPtr->lexeme;
1.1074 + if ((lexeme == PLUS) || (lexeme == MINUS) || (lexeme == BIT_NOT)
1.1075 + || (lexeme == NOT)) {
1.1076 + operator = infoPtr->start;
1.1077 + code = GetLexeme(infoPtr); /* skip over the unary operator */
1.1078 + if (code != TCL_OK) {
1.1079 + return code;
1.1080 + }
1.1081 + code = ParseUnaryExpr(infoPtr);
1.1082 + if (code != TCL_OK) {
1.1083 + return code;
1.1084 + }
1.1085 +
1.1086 + /*
1.1087 + * Generate tokens for the subexpression and the operator.
1.1088 + */
1.1089 +
1.1090 + PrependSubExprTokens(operator, 1, srcStart,
1.1091 + (infoPtr->prevEnd - srcStart), firstIndex, infoPtr);
1.1092 + } else { /* must be a primaryExpr */
1.1093 + code = ParsePrimaryExpr(infoPtr);
1.1094 + if (code != TCL_OK) {
1.1095 + return code;
1.1096 + }
1.1097 + }
1.1098 + return TCL_OK;
1.1099 +}
1.1100 +
1.1101 +/*
1.1102 + *----------------------------------------------------------------------
1.1103 + *
1.1104 + * ParsePrimaryExpr --
1.1105 + *
1.1106 + * This procedure parses a Tcl primary expression:
1.1107 + * primaryExpr ::= literal | varReference | quotedString |
1.1108 + * '[' command ']' | mathFuncCall | '(' condExpr ')'
1.1109 + *
1.1110 + * Results:
1.1111 + * The return value is TCL_OK on a successful parse and TCL_ERROR
1.1112 + * on failure. If TCL_ERROR is returned, then the interpreter's result
1.1113 + * contains an error message.
1.1114 + *
1.1115 + * Side effects:
1.1116 + * If there is insufficient space in parsePtr to hold all the
1.1117 + * information about the subexpression, then additional space is
1.1118 + * malloc-ed.
1.1119 + *
1.1120 + *----------------------------------------------------------------------
1.1121 + */
1.1122 +
1.1123 +static int
1.1124 +ParsePrimaryExpr(infoPtr)
1.1125 + ParseInfo *infoPtr; /* Holds the parse state for the
1.1126 + * expression being parsed. */
1.1127 +{
1.1128 + Tcl_Parse *parsePtr = infoPtr->parsePtr;
1.1129 + Tcl_Interp *interp = parsePtr->interp;
1.1130 + Tcl_Token *tokenPtr, *exprTokenPtr;
1.1131 + Tcl_Parse nested;
1.1132 + CONST char *dollarPtr, *stringStart, *termPtr, *src;
1.1133 + int lexeme, exprIndex, firstIndex, numToMove, code;
1.1134 +
1.1135 + /*
1.1136 + * We simply recurse on parenthesized subexpressions.
1.1137 + */
1.1138 +
1.1139 + HERE("primaryExpr", 13);
1.1140 + lexeme = infoPtr->lexeme;
1.1141 + if (lexeme == OPEN_PAREN) {
1.1142 + code = GetLexeme(infoPtr); /* skip over the '(' */
1.1143 + if (code != TCL_OK) {
1.1144 + return code;
1.1145 + }
1.1146 + code = ParseCondExpr(infoPtr);
1.1147 + if (code != TCL_OK) {
1.1148 + return code;
1.1149 + }
1.1150 + if (infoPtr->lexeme != CLOSE_PAREN) {
1.1151 + LogSyntaxError(infoPtr, "looking for close parenthesis");
1.1152 + return TCL_ERROR;
1.1153 + }
1.1154 + code = GetLexeme(infoPtr); /* skip over the ')' */
1.1155 + if (code != TCL_OK) {
1.1156 + return code;
1.1157 + }
1.1158 + return TCL_OK;
1.1159 + }
1.1160 +
1.1161 + /*
1.1162 + * Start a TCL_TOKEN_SUB_EXPR token for the primary.
1.1163 + */
1.1164 +
1.1165 + if (parsePtr->numTokens == parsePtr->tokensAvailable) {
1.1166 + TclExpandTokenArray(parsePtr);
1.1167 + }
1.1168 + exprIndex = parsePtr->numTokens;
1.1169 + exprTokenPtr = &parsePtr->tokenPtr[exprIndex];
1.1170 + exprTokenPtr->type = TCL_TOKEN_SUB_EXPR;
1.1171 + exprTokenPtr->start = infoPtr->start;
1.1172 + parsePtr->numTokens++;
1.1173 +
1.1174 + /*
1.1175 + * Process the primary then finish setting the fields of the
1.1176 + * TCL_TOKEN_SUB_EXPR token. Note that we can't use the pointer now
1.1177 + * stored in "exprTokenPtr" in the code below since the token array
1.1178 + * might be reallocated.
1.1179 + */
1.1180 +
1.1181 + firstIndex = parsePtr->numTokens;
1.1182 + switch (lexeme) {
1.1183 + case LITERAL:
1.1184 + /*
1.1185 + * Int or double number.
1.1186 + */
1.1187 +
1.1188 + tokenizeLiteral:
1.1189 + if (parsePtr->numTokens == parsePtr->tokensAvailable) {
1.1190 + TclExpandTokenArray(parsePtr);
1.1191 + }
1.1192 + tokenPtr = &parsePtr->tokenPtr[parsePtr->numTokens];
1.1193 + tokenPtr->type = TCL_TOKEN_TEXT;
1.1194 + tokenPtr->start = infoPtr->start;
1.1195 + tokenPtr->size = infoPtr->size;
1.1196 + tokenPtr->numComponents = 0;
1.1197 + parsePtr->numTokens++;
1.1198 +
1.1199 + exprTokenPtr = &parsePtr->tokenPtr[exprIndex];
1.1200 + exprTokenPtr->size = infoPtr->size;
1.1201 + exprTokenPtr->numComponents = 1;
1.1202 + break;
1.1203 +
1.1204 + case DOLLAR:
1.1205 + /*
1.1206 + * $var variable reference.
1.1207 + */
1.1208 +
1.1209 + dollarPtr = (infoPtr->next - 1);
1.1210 + code = Tcl_ParseVarName(interp, dollarPtr,
1.1211 + (infoPtr->lastChar - dollarPtr), parsePtr, 1);
1.1212 + if (code != TCL_OK) {
1.1213 + return code;
1.1214 + }
1.1215 + infoPtr->next = dollarPtr + parsePtr->tokenPtr[firstIndex].size;
1.1216 +
1.1217 + exprTokenPtr = &parsePtr->tokenPtr[exprIndex];
1.1218 + exprTokenPtr->size = parsePtr->tokenPtr[firstIndex].size;
1.1219 + exprTokenPtr->numComponents =
1.1220 + (parsePtr->tokenPtr[firstIndex].numComponents + 1);
1.1221 + break;
1.1222 +
1.1223 + case QUOTE:
1.1224 + /*
1.1225 + * '"' string '"'
1.1226 + */
1.1227 +
1.1228 + stringStart = infoPtr->next;
1.1229 + code = Tcl_ParseQuotedString(interp, infoPtr->start,
1.1230 + (infoPtr->lastChar - stringStart), parsePtr, 1, &termPtr);
1.1231 + if (code != TCL_OK) {
1.1232 + return code;
1.1233 + }
1.1234 + infoPtr->next = termPtr;
1.1235 +
1.1236 + exprTokenPtr = &parsePtr->tokenPtr[exprIndex];
1.1237 + exprTokenPtr->size = (termPtr - exprTokenPtr->start);
1.1238 + exprTokenPtr->numComponents = parsePtr->numTokens - firstIndex;
1.1239 +
1.1240 + /*
1.1241 + * If parsing the quoted string resulted in more than one token,
1.1242 + * insert a TCL_TOKEN_WORD token before them. This indicates that
1.1243 + * the quoted string represents a concatenation of multiple tokens.
1.1244 + */
1.1245 +
1.1246 + if (exprTokenPtr->numComponents > 1) {
1.1247 + if (parsePtr->numTokens >= parsePtr->tokensAvailable) {
1.1248 + TclExpandTokenArray(parsePtr);
1.1249 + }
1.1250 + tokenPtr = &parsePtr->tokenPtr[firstIndex];
1.1251 + numToMove = (parsePtr->numTokens - firstIndex);
1.1252 + memmove((VOID *) (tokenPtr + 1), (VOID *) tokenPtr,
1.1253 + (size_t) (numToMove * sizeof(Tcl_Token)));
1.1254 + parsePtr->numTokens++;
1.1255 +
1.1256 + exprTokenPtr = &parsePtr->tokenPtr[exprIndex];
1.1257 + exprTokenPtr->numComponents++;
1.1258 +
1.1259 + tokenPtr->type = TCL_TOKEN_WORD;
1.1260 + tokenPtr->start = exprTokenPtr->start;
1.1261 + tokenPtr->size = exprTokenPtr->size;
1.1262 + tokenPtr->numComponents = (exprTokenPtr->numComponents - 1);
1.1263 + }
1.1264 + break;
1.1265 +
1.1266 + case OPEN_BRACKET:
1.1267 + /*
1.1268 + * '[' command {command} ']'
1.1269 + */
1.1270 +
1.1271 + if (parsePtr->numTokens == parsePtr->tokensAvailable) {
1.1272 + TclExpandTokenArray(parsePtr);
1.1273 + }
1.1274 + tokenPtr = &parsePtr->tokenPtr[parsePtr->numTokens];
1.1275 + tokenPtr->type = TCL_TOKEN_COMMAND;
1.1276 + tokenPtr->start = infoPtr->start;
1.1277 + tokenPtr->numComponents = 0;
1.1278 + parsePtr->numTokens++;
1.1279 +
1.1280 + /*
1.1281 + * Call Tcl_ParseCommand repeatedly to parse the nested command(s)
1.1282 + * to find their end, then throw away that parse information.
1.1283 + */
1.1284 +
1.1285 + src = infoPtr->next;
1.1286 + while (1) {
1.1287 + if (Tcl_ParseCommand(interp, src, (parsePtr->end - src), 1,
1.1288 + &nested) != TCL_OK) {
1.1289 + parsePtr->term = nested.term;
1.1290 + parsePtr->errorType = nested.errorType;
1.1291 + parsePtr->incomplete = nested.incomplete;
1.1292 + return TCL_ERROR;
1.1293 + }
1.1294 + src = (nested.commandStart + nested.commandSize);
1.1295 +
1.1296 + /*
1.1297 + * This is equivalent to Tcl_FreeParse(&nested), but
1.1298 + * presumably inlined here for sake of runtime optimization
1.1299 + */
1.1300 +
1.1301 + if (nested.tokenPtr != nested.staticTokens) {
1.1302 + ckfree((char *) nested.tokenPtr);
1.1303 + }
1.1304 +
1.1305 + /*
1.1306 + * Check for the closing ']' that ends the command substitution.
1.1307 + * It must have been the last character of the parsed command.
1.1308 + */
1.1309 +
1.1310 + if ((nested.term < parsePtr->end) && (*nested.term == ']')
1.1311 + && !nested.incomplete) {
1.1312 + break;
1.1313 + }
1.1314 + if (src == parsePtr->end) {
1.1315 + if (parsePtr->interp != NULL) {
1.1316 + Tcl_SetResult(interp, "missing close-bracket",
1.1317 + TCL_STATIC);
1.1318 + }
1.1319 + parsePtr->term = tokenPtr->start;
1.1320 + parsePtr->errorType = TCL_PARSE_MISSING_BRACKET;
1.1321 + parsePtr->incomplete = 1;
1.1322 + return TCL_ERROR;
1.1323 + }
1.1324 + }
1.1325 + tokenPtr->size = (src - tokenPtr->start);
1.1326 + infoPtr->next = src;
1.1327 +
1.1328 + exprTokenPtr = &parsePtr->tokenPtr[exprIndex];
1.1329 + exprTokenPtr->size = (src - tokenPtr->start);
1.1330 + exprTokenPtr->numComponents = 1;
1.1331 + break;
1.1332 +
1.1333 + case OPEN_BRACE:
1.1334 + /*
1.1335 + * '{' string '}'
1.1336 + */
1.1337 +
1.1338 + code = Tcl_ParseBraces(interp, infoPtr->start,
1.1339 + (infoPtr->lastChar - infoPtr->start), parsePtr, 1,
1.1340 + &termPtr);
1.1341 + if (code != TCL_OK) {
1.1342 + return code;
1.1343 + }
1.1344 + infoPtr->next = termPtr;
1.1345 +
1.1346 + exprTokenPtr = &parsePtr->tokenPtr[exprIndex];
1.1347 + exprTokenPtr->size = (termPtr - infoPtr->start);
1.1348 + exprTokenPtr->numComponents = parsePtr->numTokens - firstIndex;
1.1349 +
1.1350 + /*
1.1351 + * If parsing the braced string resulted in more than one token,
1.1352 + * insert a TCL_TOKEN_WORD token before them. This indicates that
1.1353 + * the braced string represents a concatenation of multiple tokens.
1.1354 + */
1.1355 +
1.1356 + if (exprTokenPtr->numComponents > 1) {
1.1357 + if (parsePtr->numTokens >= parsePtr->tokensAvailable) {
1.1358 + TclExpandTokenArray(parsePtr);
1.1359 + }
1.1360 + tokenPtr = &parsePtr->tokenPtr[firstIndex];
1.1361 + numToMove = (parsePtr->numTokens - firstIndex);
1.1362 + memmove((VOID *) (tokenPtr + 1), (VOID *) tokenPtr,
1.1363 + (size_t) (numToMove * sizeof(Tcl_Token)));
1.1364 + parsePtr->numTokens++;
1.1365 +
1.1366 + exprTokenPtr = &parsePtr->tokenPtr[exprIndex];
1.1367 + exprTokenPtr->numComponents++;
1.1368 +
1.1369 + tokenPtr->type = TCL_TOKEN_WORD;
1.1370 + tokenPtr->start = exprTokenPtr->start;
1.1371 + tokenPtr->size = exprTokenPtr->size;
1.1372 + tokenPtr->numComponents = exprTokenPtr->numComponents-1;
1.1373 + }
1.1374 + break;
1.1375 +
1.1376 + case STREQ:
1.1377 + case STRNEQ:
1.1378 + case FUNC_NAME: {
1.1379 + /*
1.1380 + * math_func '(' expr {',' expr} ')'
1.1381 + */
1.1382 +
1.1383 + ParseInfo savedInfo = *infoPtr;
1.1384 +
1.1385 + code = GetLexeme(infoPtr); /* skip over function name */
1.1386 + if (code != TCL_OK) {
1.1387 + return code;
1.1388 + }
1.1389 + if (infoPtr->lexeme != OPEN_PAREN) {
1.1390 + int code;
1.1391 + Tcl_DString functionName;
1.1392 + Tcl_HashEntry *hPtr;
1.1393 + Interp *iPtr = (Interp *) infoPtr->parsePtr->interp;
1.1394 + Tcl_Obj *objPtr = Tcl_NewStringObj(savedInfo.start, savedInfo.size);
1.1395 +
1.1396 + /* Check for boolean literals (true, false, yes, no, on, off) */
1.1397 + Tcl_IncrRefCount(objPtr);
1.1398 + code = Tcl_ConvertToType(NULL, objPtr, &tclBooleanType);
1.1399 + Tcl_DecrRefCount(objPtr);
1.1400 + if (code == TCL_OK) {
1.1401 + *infoPtr = savedInfo;
1.1402 + goto tokenizeLiteral;
1.1403 + }
1.1404 +
1.1405 + /*
1.1406 + * Guess what kind of error we have by trying to tell
1.1407 + * whether we have a function or variable name here.
1.1408 + * Alas, this makes the parser more tightly bound with the
1.1409 + * rest of the interpreter, but that is the only way to
1.1410 + * give a sensible message here. Still, it is not too
1.1411 + * serious as this is only done when generating an error.
1.1412 + */
1.1413 +
1.1414 + /*
1.1415 + * Look up the name as a function name. We need a writable
1.1416 + * copy (DString) so we can terminate it with a NULL for
1.1417 + * the benefit of Tcl_FindHashEntry which operates on
1.1418 + * NULL-terminated string keys.
1.1419 + */
1.1420 + Tcl_DStringInit(&functionName);
1.1421 + hPtr = Tcl_FindHashEntry(&iPtr->mathFuncTable,
1.1422 + Tcl_DStringAppend(&functionName,
1.1423 + savedInfo.start, savedInfo.size));
1.1424 + Tcl_DStringFree(&functionName);
1.1425 +
1.1426 + /*
1.1427 + * Assume that we have an attempted variable reference
1.1428 + * unless we've got a function name, as the set of
1.1429 + * potential function names is typically much smaller.
1.1430 + */
1.1431 + if (hPtr != NULL) {
1.1432 + LogSyntaxError(infoPtr,
1.1433 + "expected parenthesis enclosing function arguments");
1.1434 + } else {
1.1435 + LogSyntaxError(infoPtr,
1.1436 + "variable references require preceding $");
1.1437 + }
1.1438 + return TCL_ERROR;
1.1439 + }
1.1440 +
1.1441 + if (parsePtr->numTokens == parsePtr->tokensAvailable) {
1.1442 + TclExpandTokenArray(parsePtr);
1.1443 + }
1.1444 + tokenPtr = &parsePtr->tokenPtr[parsePtr->numTokens];
1.1445 + tokenPtr->type = TCL_TOKEN_OPERATOR;
1.1446 + tokenPtr->start = savedInfo.start;
1.1447 + tokenPtr->size = savedInfo.size;
1.1448 + tokenPtr->numComponents = 0;
1.1449 + parsePtr->numTokens++;
1.1450 +
1.1451 + code = GetLexeme(infoPtr); /* skip over '(' */
1.1452 + if (code != TCL_OK) {
1.1453 + return code;
1.1454 + }
1.1455 +
1.1456 + while (infoPtr->lexeme != CLOSE_PAREN) {
1.1457 + code = ParseCondExpr(infoPtr);
1.1458 + if (code != TCL_OK) {
1.1459 + return code;
1.1460 + }
1.1461 +
1.1462 + if (infoPtr->lexeme == COMMA) {
1.1463 + code = GetLexeme(infoPtr); /* skip over , */
1.1464 + if (code != TCL_OK) {
1.1465 + return code;
1.1466 + }
1.1467 + } else if (infoPtr->lexeme != CLOSE_PAREN) {
1.1468 + LogSyntaxError(infoPtr,
1.1469 + "missing close parenthesis at end of function call");
1.1470 + return TCL_ERROR;
1.1471 + }
1.1472 + }
1.1473 +
1.1474 + exprTokenPtr = &parsePtr->tokenPtr[exprIndex];
1.1475 + exprTokenPtr->size = (infoPtr->next - exprTokenPtr->start);
1.1476 + exprTokenPtr->numComponents = parsePtr->numTokens - firstIndex;
1.1477 + break;
1.1478 + }
1.1479 +
1.1480 + case COMMA:
1.1481 + LogSyntaxError(infoPtr,
1.1482 + "commas can only separate function arguments");
1.1483 + return TCL_ERROR;
1.1484 + case END:
1.1485 + LogSyntaxError(infoPtr, "premature end of expression");
1.1486 + return TCL_ERROR;
1.1487 + case UNKNOWN:
1.1488 + LogSyntaxError(infoPtr, "single equality character not legal in expressions");
1.1489 + return TCL_ERROR;
1.1490 + case UNKNOWN_CHAR:
1.1491 + LogSyntaxError(infoPtr, "character not legal in expressions");
1.1492 + return TCL_ERROR;
1.1493 + case QUESTY:
1.1494 + LogSyntaxError(infoPtr, "unexpected ternary 'then' separator");
1.1495 + return TCL_ERROR;
1.1496 + case COLON:
1.1497 + LogSyntaxError(infoPtr, "unexpected ternary 'else' separator");
1.1498 + return TCL_ERROR;
1.1499 + case CLOSE_PAREN:
1.1500 + LogSyntaxError(infoPtr, "unexpected close parenthesis");
1.1501 + return TCL_ERROR;
1.1502 +
1.1503 + default: {
1.1504 + char buf[64];
1.1505 +
1.1506 + sprintf(buf, "unexpected operator %s", lexemeStrings[lexeme]);
1.1507 + LogSyntaxError(infoPtr, buf);
1.1508 + return TCL_ERROR;
1.1509 + }
1.1510 + }
1.1511 +
1.1512 + /*
1.1513 + * Advance to the next lexeme before returning.
1.1514 + */
1.1515 +
1.1516 + code = GetLexeme(infoPtr);
1.1517 + if (code != TCL_OK) {
1.1518 + return code;
1.1519 + }
1.1520 + parsePtr->term = infoPtr->next;
1.1521 + return TCL_OK;
1.1522 +}
1.1523 +
1.1524 +/*
1.1525 + *----------------------------------------------------------------------
1.1526 + *
1.1527 + * GetLexeme --
1.1528 + *
1.1529 + * Lexical scanner for Tcl expressions: scans a single operator or
1.1530 + * other syntactic element from an expression string.
1.1531 + *
1.1532 + * Results:
1.1533 + * TCL_OK is returned unless an error occurred. In that case a standard
1.1534 + * Tcl error code is returned and, if infoPtr->parsePtr->interp is
1.1535 + * non-NULL, the interpreter's result is set to hold an error
1.1536 + * message. TCL_ERROR is returned if an integer overflow, or a
1.1537 + * floating-point overflow or underflow occurred while reading in a
1.1538 + * number. If the lexical analysis is successful, infoPtr->lexeme
1.1539 + * refers to the next symbol in the expression string, and
1.1540 + * infoPtr->next is advanced past the lexeme. Also, if the lexeme is a
1.1541 + * LITERAL or FUNC_NAME, then infoPtr->start is set to the first
1.1542 + * character of the lexeme; otherwise it is set NULL.
1.1543 + *
1.1544 + * Side effects:
1.1545 + * If there is insufficient space in parsePtr to hold all the
1.1546 + * information about the subexpression, then additional space is
1.1547 + * malloc-ed..
1.1548 + *
1.1549 + *----------------------------------------------------------------------
1.1550 + */
1.1551 +
1.1552 +static int
1.1553 +GetLexeme(infoPtr)
1.1554 + ParseInfo *infoPtr; /* Holds state needed to parse the expr,
1.1555 + * including the resulting lexeme. */
1.1556 +{
1.1557 + register CONST char *src; /* Points to current source char. */
1.1558 + char c;
1.1559 + int offset, length, numBytes;
1.1560 + Tcl_Parse *parsePtr = infoPtr->parsePtr;
1.1561 + Tcl_Interp *interp = parsePtr->interp;
1.1562 + Tcl_UniChar ch;
1.1563 +
1.1564 + /*
1.1565 + * Record where the previous lexeme ended. Since we always read one
1.1566 + * lexeme ahead during parsing, this helps us know the source length of
1.1567 + * subexpression tokens.
1.1568 + */
1.1569 +
1.1570 + infoPtr->prevEnd = infoPtr->next;
1.1571 +
1.1572 + /*
1.1573 + * Scan over leading white space at the start of a lexeme.
1.1574 + */
1.1575 +
1.1576 + src = infoPtr->next;
1.1577 + numBytes = parsePtr->end - src;
1.1578 + do {
1.1579 + char type;
1.1580 + int scanned = TclParseWhiteSpace(src, numBytes, parsePtr, &type);
1.1581 + src += scanned; numBytes -= scanned;
1.1582 + } while (numBytes && (*src == '\n') && (src++,numBytes--));
1.1583 + parsePtr->term = src;
1.1584 + if (numBytes == 0) {
1.1585 + infoPtr->lexeme = END;
1.1586 + infoPtr->next = src;
1.1587 + return TCL_OK;
1.1588 + }
1.1589 +
1.1590 + /*
1.1591 + * Try to parse the lexeme first as an integer or floating-point
1.1592 + * number. Don't check for a number if the first character c is
1.1593 + * "+" or "-". If we did, we might treat a binary operator as unary
1.1594 + * by mistake, which would eventually cause a syntax error.
1.1595 + */
1.1596 +
1.1597 + c = *src;
1.1598 + if ((c != '+') && (c != '-')) {
1.1599 + CONST char *end = infoPtr->lastChar;
1.1600 + if ((length = TclParseInteger(src, (end - src)))) {
1.1601 + /*
1.1602 + * First length bytes look like an integer. Verify by
1.1603 + * attempting the conversion to the largest integer we have.
1.1604 + */
1.1605 + int code;
1.1606 + Tcl_WideInt wide;
1.1607 + Tcl_Obj *value = Tcl_NewStringObj(src, length);
1.1608 +
1.1609 + Tcl_IncrRefCount(value);
1.1610 + code = Tcl_GetWideIntFromObj(interp, value, &wide);
1.1611 + Tcl_DecrRefCount(value);
1.1612 + if (code == TCL_ERROR) {
1.1613 + parsePtr->errorType = TCL_PARSE_BAD_NUMBER;
1.1614 + return TCL_ERROR;
1.1615 + }
1.1616 + infoPtr->lexeme = LITERAL;
1.1617 + infoPtr->start = src;
1.1618 + infoPtr->size = length;
1.1619 + infoPtr->next = (src + length);
1.1620 + parsePtr->term = infoPtr->next;
1.1621 + return TCL_OK;
1.1622 + } else if ((length = ParseMaxDoubleLength(src, end))) {
1.1623 + /*
1.1624 + * There are length characters that could be a double.
1.1625 + * Let strtod() tells us for sure. Need a writable copy
1.1626 + * so we can set an terminating NULL to keep strtod from
1.1627 + * scanning too far.
1.1628 + */
1.1629 + char *startPtr, *termPtr;
1.1630 + double doubleValue;
1.1631 + Tcl_DString toParse;
1.1632 +
1.1633 + errno = 0;
1.1634 + Tcl_DStringInit(&toParse);
1.1635 + startPtr = Tcl_DStringAppend(&toParse, src, length);
1.1636 + doubleValue = strtod(startPtr, &termPtr);
1.1637 + Tcl_DStringFree(&toParse);
1.1638 + if (termPtr != startPtr) {
1.1639 + if (errno != 0) {
1.1640 + if (interp != NULL) {
1.1641 + TclExprFloatError(interp, doubleValue);
1.1642 + }
1.1643 + parsePtr->errorType = TCL_PARSE_BAD_NUMBER;
1.1644 + return TCL_ERROR;
1.1645 + }
1.1646 +
1.1647 + /*
1.1648 + * startPtr was the start of a valid double, copied
1.1649 + * from src.
1.1650 + */
1.1651 +
1.1652 + infoPtr->lexeme = LITERAL;
1.1653 + infoPtr->start = src;
1.1654 + if ((termPtr - startPtr) > length) {
1.1655 + infoPtr->size = length;
1.1656 + } else {
1.1657 + infoPtr->size = (termPtr - startPtr);
1.1658 + }
1.1659 + infoPtr->next = src + infoPtr->size;
1.1660 + parsePtr->term = infoPtr->next;
1.1661 + return TCL_OK;
1.1662 + }
1.1663 + }
1.1664 + }
1.1665 +
1.1666 + /*
1.1667 + * Not an integer or double literal. Initialize the lexeme's fields
1.1668 + * assuming the common case of a single character lexeme.
1.1669 + */
1.1670 +
1.1671 + infoPtr->start = src;
1.1672 + infoPtr->size = 1;
1.1673 + infoPtr->next = src+1;
1.1674 + parsePtr->term = infoPtr->next;
1.1675 +
1.1676 + switch (*src) {
1.1677 + case '[':
1.1678 + infoPtr->lexeme = OPEN_BRACKET;
1.1679 + return TCL_OK;
1.1680 +
1.1681 + case '{':
1.1682 + infoPtr->lexeme = OPEN_BRACE;
1.1683 + return TCL_OK;
1.1684 +
1.1685 + case '(':
1.1686 + infoPtr->lexeme = OPEN_PAREN;
1.1687 + return TCL_OK;
1.1688 +
1.1689 + case ')':
1.1690 + infoPtr->lexeme = CLOSE_PAREN;
1.1691 + return TCL_OK;
1.1692 +
1.1693 + case '$':
1.1694 + infoPtr->lexeme = DOLLAR;
1.1695 + return TCL_OK;
1.1696 +
1.1697 + case '\"':
1.1698 + infoPtr->lexeme = QUOTE;
1.1699 + return TCL_OK;
1.1700 +
1.1701 + case ',':
1.1702 + infoPtr->lexeme = COMMA;
1.1703 + return TCL_OK;
1.1704 +
1.1705 + case '*':
1.1706 + infoPtr->lexeme = MULT;
1.1707 + return TCL_OK;
1.1708 +
1.1709 + case '/':
1.1710 + infoPtr->lexeme = DIVIDE;
1.1711 + return TCL_OK;
1.1712 +
1.1713 + case '%':
1.1714 + infoPtr->lexeme = MOD;
1.1715 + return TCL_OK;
1.1716 +
1.1717 + case '+':
1.1718 + infoPtr->lexeme = PLUS;
1.1719 + return TCL_OK;
1.1720 +
1.1721 + case '-':
1.1722 + infoPtr->lexeme = MINUS;
1.1723 + return TCL_OK;
1.1724 +
1.1725 + case '?':
1.1726 + infoPtr->lexeme = QUESTY;
1.1727 + return TCL_OK;
1.1728 +
1.1729 + case ':':
1.1730 + infoPtr->lexeme = COLON;
1.1731 + return TCL_OK;
1.1732 +
1.1733 + case '<':
1.1734 + infoPtr->lexeme = LESS;
1.1735 + if ((infoPtr->lastChar - src) > 1) {
1.1736 + switch (src[1]) {
1.1737 + case '<':
1.1738 + infoPtr->lexeme = LEFT_SHIFT;
1.1739 + infoPtr->size = 2;
1.1740 + infoPtr->next = src+2;
1.1741 + break;
1.1742 + case '=':
1.1743 + infoPtr->lexeme = LEQ;
1.1744 + infoPtr->size = 2;
1.1745 + infoPtr->next = src+2;
1.1746 + break;
1.1747 + }
1.1748 + }
1.1749 + parsePtr->term = infoPtr->next;
1.1750 + return TCL_OK;
1.1751 +
1.1752 + case '>':
1.1753 + infoPtr->lexeme = GREATER;
1.1754 + if ((infoPtr->lastChar - src) > 1) {
1.1755 + switch (src[1]) {
1.1756 + case '>':
1.1757 + infoPtr->lexeme = RIGHT_SHIFT;
1.1758 + infoPtr->size = 2;
1.1759 + infoPtr->next = src+2;
1.1760 + break;
1.1761 + case '=':
1.1762 + infoPtr->lexeme = GEQ;
1.1763 + infoPtr->size = 2;
1.1764 + infoPtr->next = src+2;
1.1765 + break;
1.1766 + }
1.1767 + }
1.1768 + parsePtr->term = infoPtr->next;
1.1769 + return TCL_OK;
1.1770 +
1.1771 + case '=':
1.1772 + infoPtr->lexeme = UNKNOWN;
1.1773 + if ((src[1] == '=') && ((infoPtr->lastChar - src) > 1)) {
1.1774 + infoPtr->lexeme = EQUAL;
1.1775 + infoPtr->size = 2;
1.1776 + infoPtr->next = src+2;
1.1777 + }
1.1778 + parsePtr->term = infoPtr->next;
1.1779 + return TCL_OK;
1.1780 +
1.1781 + case '!':
1.1782 + infoPtr->lexeme = NOT;
1.1783 + if ((src[1] == '=') && ((infoPtr->lastChar - src) > 1)) {
1.1784 + infoPtr->lexeme = NEQ;
1.1785 + infoPtr->size = 2;
1.1786 + infoPtr->next = src+2;
1.1787 + }
1.1788 + parsePtr->term = infoPtr->next;
1.1789 + return TCL_OK;
1.1790 +
1.1791 + case '&':
1.1792 + infoPtr->lexeme = BIT_AND;
1.1793 + if ((src[1] == '&') && ((infoPtr->lastChar - src) > 1)) {
1.1794 + infoPtr->lexeme = AND;
1.1795 + infoPtr->size = 2;
1.1796 + infoPtr->next = src+2;
1.1797 + }
1.1798 + parsePtr->term = infoPtr->next;
1.1799 + return TCL_OK;
1.1800 +
1.1801 + case '^':
1.1802 + infoPtr->lexeme = BIT_XOR;
1.1803 + return TCL_OK;
1.1804 +
1.1805 + case '|':
1.1806 + infoPtr->lexeme = BIT_OR;
1.1807 + if ((src[1] == '|') && ((infoPtr->lastChar - src) > 1)) {
1.1808 + infoPtr->lexeme = OR;
1.1809 + infoPtr->size = 2;
1.1810 + infoPtr->next = src+2;
1.1811 + }
1.1812 + parsePtr->term = infoPtr->next;
1.1813 + return TCL_OK;
1.1814 +
1.1815 + case '~':
1.1816 + infoPtr->lexeme = BIT_NOT;
1.1817 + return TCL_OK;
1.1818 +
1.1819 + case 'e':
1.1820 + if ((src[1] == 'q') && ((infoPtr->lastChar - src) > 1)) {
1.1821 + infoPtr->lexeme = STREQ;
1.1822 + infoPtr->size = 2;
1.1823 + infoPtr->next = src+2;
1.1824 + parsePtr->term = infoPtr->next;
1.1825 + return TCL_OK;
1.1826 + } else {
1.1827 + goto checkFuncName;
1.1828 + }
1.1829 +
1.1830 + case 'n':
1.1831 + if ((src[1] == 'e') && ((infoPtr->lastChar - src) > 1)) {
1.1832 + infoPtr->lexeme = STRNEQ;
1.1833 + infoPtr->size = 2;
1.1834 + infoPtr->next = src+2;
1.1835 + parsePtr->term = infoPtr->next;
1.1836 + return TCL_OK;
1.1837 + } else {
1.1838 + goto checkFuncName;
1.1839 + }
1.1840 +
1.1841 + default:
1.1842 + checkFuncName:
1.1843 + length = (infoPtr->lastChar - src);
1.1844 + if (Tcl_UtfCharComplete(src, length)) {
1.1845 + offset = Tcl_UtfToUniChar(src, &ch);
1.1846 + } else {
1.1847 + char utfBytes[TCL_UTF_MAX];
1.1848 + memcpy(utfBytes, src, (size_t) length);
1.1849 + utfBytes[length] = '\0';
1.1850 + offset = Tcl_UtfToUniChar(utfBytes, &ch);
1.1851 + }
1.1852 + c = UCHAR(ch);
1.1853 + if (isalpha(UCHAR(c))) { /* INTL: ISO only. */
1.1854 + infoPtr->lexeme = FUNC_NAME;
1.1855 + while (isalnum(UCHAR(c)) || (c == '_')) { /* INTL: ISO only. */
1.1856 + src += offset; length -= offset;
1.1857 + if (Tcl_UtfCharComplete(src, length)) {
1.1858 + offset = Tcl_UtfToUniChar(src, &ch);
1.1859 + } else {
1.1860 + char utfBytes[TCL_UTF_MAX];
1.1861 + memcpy(utfBytes, src, (size_t) length);
1.1862 + utfBytes[length] = '\0';
1.1863 + offset = Tcl_UtfToUniChar(utfBytes, &ch);
1.1864 + }
1.1865 + c = UCHAR(ch);
1.1866 + }
1.1867 + infoPtr->size = (src - infoPtr->start);
1.1868 + infoPtr->next = src;
1.1869 + parsePtr->term = infoPtr->next;
1.1870 + return TCL_OK;
1.1871 + }
1.1872 + infoPtr->lexeme = UNKNOWN_CHAR;
1.1873 + return TCL_OK;
1.1874 + }
1.1875 +}
1.1876 +
1.1877 +/*
1.1878 + *----------------------------------------------------------------------
1.1879 + *
1.1880 + * TclParseInteger --
1.1881 + *
1.1882 + * Scans up to numBytes bytes starting at src, and checks whether
1.1883 + * the leading bytes look like an integer's string representation.
1.1884 + *
1.1885 + * Results:
1.1886 + * Returns 0 if the leading bytes do not look like an integer.
1.1887 + * Otherwise, returns the number of bytes examined that look
1.1888 + * like an integer. This may be less than numBytes if the integer
1.1889 + * is only the leading part of the string.
1.1890 + *
1.1891 + * Side effects:
1.1892 + * None.
1.1893 + *
1.1894 + *----------------------------------------------------------------------
1.1895 + */
1.1896 +
1.1897 +int
1.1898 +TclParseInteger(string, numBytes)
1.1899 + register CONST char *string;/* The string to examine. */
1.1900 + register int numBytes; /* Max number of bytes to scan. */
1.1901 +{
1.1902 + register CONST char *p = string;
1.1903 +
1.1904 + /* Take care of introductory "0x" */
1.1905 + if ((numBytes > 1) && (p[0] == '0') && ((p[1] == 'x') || (p[1] == 'X'))) {
1.1906 + int scanned;
1.1907 + Tcl_UniChar ch;
1.1908 + p+=2; numBytes -= 2;
1.1909 + scanned = TclParseHex(p, numBytes, &ch);
1.1910 + if (scanned) {
1.1911 + return scanned + 2;
1.1912 + }
1.1913 +
1.1914 + /* Recognize the 0 as valid integer, but x is left behind */
1.1915 + return 1;
1.1916 + }
1.1917 + while (numBytes && isdigit(UCHAR(*p))) { /* INTL: digit */
1.1918 + numBytes--; p++;
1.1919 + }
1.1920 + if (numBytes == 0) {
1.1921 + return (p - string);
1.1922 + }
1.1923 + if ((*p != '.') && (*p != 'e') && (*p != 'E')) {
1.1924 + return (p - string);
1.1925 + }
1.1926 + return 0;
1.1927 +}
1.1928 +
1.1929 +/*
1.1930 + *----------------------------------------------------------------------
1.1931 + *
1.1932 + * ParseMaxDoubleLength --
1.1933 + *
1.1934 + * Scans a sequence of bytes checking that the characters could
1.1935 + * be in a string rep of a double.
1.1936 + *
1.1937 + * Results:
1.1938 + * Returns the number of bytes starting with string, runing to, but
1.1939 + * not including end, all of which could be part of a string rep.
1.1940 + * of a double. Only character identity is used, no actual
1.1941 + * parsing is done.
1.1942 + *
1.1943 + * The legal bytes are '0' - '9', 'A' - 'F', 'a' - 'f',
1.1944 + * '.', '+', '-', 'i', 'I', 'n', 'N', 'p', 'P', 'x', and 'X'.
1.1945 + * This covers the values "Inf" and "Nan" as well as the
1.1946 + * decimal and hexadecimal representations recognized by a
1.1947 + * C99-compliant strtod().
1.1948 + *
1.1949 + * Side effects:
1.1950 + * None.
1.1951 + *
1.1952 + *----------------------------------------------------------------------
1.1953 + */
1.1954 +
1.1955 +static int
1.1956 +ParseMaxDoubleLength(string, end)
1.1957 + register CONST char *string;/* The string to examine. */
1.1958 + CONST char *end; /* Point to the first character past the end
1.1959 + * of the string we are examining. */
1.1960 +{
1.1961 + CONST char *p = string;
1.1962 + while (p < end) {
1.1963 + switch (*p) {
1.1964 + case '0': case '1': case '2': case '3': case '4': case '5':
1.1965 + case '6': case '7': case '8': case '9': case 'A': case 'B':
1.1966 + case 'C': case 'D': case 'E': case 'F': case 'I': case 'N':
1.1967 + case 'P': case 'X': case 'a': case 'b': case 'c': case 'd':
1.1968 + case 'e': case 'f': case 'i': case 'n': case 'p': case 'x':
1.1969 + case '.': case '+': case '-':
1.1970 + p++;
1.1971 + break;
1.1972 + default:
1.1973 + goto done;
1.1974 + }
1.1975 + }
1.1976 + done:
1.1977 + return (p - string);
1.1978 +}
1.1979 +
1.1980 +/*
1.1981 + *----------------------------------------------------------------------
1.1982 + *
1.1983 + * PrependSubExprTokens --
1.1984 + *
1.1985 + * This procedure is called after the operands of an subexpression have
1.1986 + * been parsed. It generates two tokens: a TCL_TOKEN_SUB_EXPR token for
1.1987 + * the subexpression, and a TCL_TOKEN_OPERATOR token for its operator.
1.1988 + * These two tokens are inserted before the operand tokens.
1.1989 + *
1.1990 + * Results:
1.1991 + * None.
1.1992 + *
1.1993 + * Side effects:
1.1994 + * If there is insufficient space in parsePtr to hold the new tokens,
1.1995 + * additional space is malloc-ed.
1.1996 + *
1.1997 + *----------------------------------------------------------------------
1.1998 + */
1.1999 +
1.2000 +static void
1.2001 +PrependSubExprTokens(op, opBytes, src, srcBytes, firstIndex, infoPtr)
1.2002 + CONST char *op; /* Points to first byte of the operator
1.2003 + * in the source script. */
1.2004 + int opBytes; /* Number of bytes in the operator. */
1.2005 + CONST char *src; /* Points to first byte of the subexpression
1.2006 + * in the source script. */
1.2007 + int srcBytes; /* Number of bytes in subexpression's
1.2008 + * source. */
1.2009 + int firstIndex; /* Index of first token already emitted for
1.2010 + * operator's first (or only) operand. */
1.2011 + ParseInfo *infoPtr; /* Holds the parse state for the
1.2012 + * expression being parsed. */
1.2013 +{
1.2014 + Tcl_Parse *parsePtr = infoPtr->parsePtr;
1.2015 + Tcl_Token *tokenPtr, *firstTokenPtr;
1.2016 + int numToMove;
1.2017 +
1.2018 + if ((parsePtr->numTokens + 1) >= parsePtr->tokensAvailable) {
1.2019 + TclExpandTokenArray(parsePtr);
1.2020 + }
1.2021 + firstTokenPtr = &parsePtr->tokenPtr[firstIndex];
1.2022 + tokenPtr = (firstTokenPtr + 2);
1.2023 + numToMove = (parsePtr->numTokens - firstIndex);
1.2024 + memmove((VOID *) tokenPtr, (VOID *) firstTokenPtr,
1.2025 + (size_t) (numToMove * sizeof(Tcl_Token)));
1.2026 + parsePtr->numTokens += 2;
1.2027 +
1.2028 + tokenPtr = firstTokenPtr;
1.2029 + tokenPtr->type = TCL_TOKEN_SUB_EXPR;
1.2030 + tokenPtr->start = src;
1.2031 + tokenPtr->size = srcBytes;
1.2032 + tokenPtr->numComponents = parsePtr->numTokens - (firstIndex + 1);
1.2033 +
1.2034 + tokenPtr++;
1.2035 + tokenPtr->type = TCL_TOKEN_OPERATOR;
1.2036 + tokenPtr->start = op;
1.2037 + tokenPtr->size = opBytes;
1.2038 + tokenPtr->numComponents = 0;
1.2039 +}
1.2040 +
1.2041 +/*
1.2042 + *----------------------------------------------------------------------
1.2043 + *
1.2044 + * LogSyntaxError --
1.2045 + *
1.2046 + * This procedure is invoked after an error occurs when parsing an
1.2047 + * expression. It sets the interpreter result to an error message
1.2048 + * describing the error.
1.2049 + *
1.2050 + * Results:
1.2051 + * None.
1.2052 + *
1.2053 + * Side effects:
1.2054 + * Sets the interpreter result to an error message describing the
1.2055 + * expression that was being parsed when the error occurred, and why
1.2056 + * the parser considers that to be a syntax error at all.
1.2057 + *
1.2058 + *----------------------------------------------------------------------
1.2059 + */
1.2060 +
1.2061 +static void
1.2062 +LogSyntaxError(infoPtr, extraInfo)
1.2063 + ParseInfo *infoPtr; /* Holds the parse state for the
1.2064 + * expression being parsed. */
1.2065 + CONST char *extraInfo; /* String to provide extra information
1.2066 + * about the syntax error. */
1.2067 +{
1.2068 + int numBytes = (infoPtr->lastChar - infoPtr->originalExpr);
1.2069 + char buffer[100];
1.2070 +
1.2071 + if (numBytes > 60) {
1.2072 + sprintf(buffer, "syntax error in expression \"%.60s...\"",
1.2073 + infoPtr->originalExpr);
1.2074 + } else {
1.2075 + sprintf(buffer, "syntax error in expression \"%.*s\"",
1.2076 + numBytes, infoPtr->originalExpr);
1.2077 + }
1.2078 + Tcl_ResetResult(infoPtr->parsePtr->interp);
1.2079 + Tcl_AppendStringsToObj(Tcl_GetObjResult(infoPtr->parsePtr->interp),
1.2080 + buffer, ": ", extraInfo, (char *) NULL);
1.2081 + infoPtr->parsePtr->errorType = TCL_PARSE_SYNTAX;
1.2082 + infoPtr->parsePtr->term = infoPtr->start;
1.2083 +}