|
|
1.1 ! root 1: /* ! 2: * tclExpr.c -- ! 3: * ! 4: * This file contains the code to evaluate expressions for ! 5: * Tcl. ! 6: * ! 7: * This implementation of floating-point support was modelled ! 8: * after an initial implementation by Bill Carpenter. ! 9: * ! 10: * Copyright 1987-1991 Regents of the University of California ! 11: * Permission to use, copy, modify, and distribute this ! 12: * software and its documentation for any purpose and without ! 13: * fee is hereby granted, provided that the above copyright ! 14: * notice appear in all copies. The University of California ! 15: * makes no representations about the suitability of this ! 16: * software for any purpose. It is provided "as is" without ! 17: * express or implied warranty. ! 18: */ ! 19: ! 20: #ifndef lint ! 21: static char rcsid[] = "$Header: /user6/ouster/tcl/RCS/tclExpr.c,v 1.35 92/03/23 09:53:46 ouster Exp $ SPRITE (Berkeley)"; ! 22: #endif ! 23: ! 24: #include "tclint.h" ! 25: ! 26: /* ! 27: * The stuff below is a bit of a workaround so that this file can be used ! 28: * in environments that include no UNIX, i.e. no errno. Just define ! 29: * errno here. ! 30: */ ! 31: ! 32: #ifndef TCL_GENERIC_ONLY ! 33: #include "tclunix.h" ! 34: #else ! 35: int errno; ! 36: #define ERANGE 34 ! 37: #endif ! 38: ! 39: /* ! 40: * The data structure below is used to describe an expression value, ! 41: * which can be either an integer (the usual case), a double-precision ! 42: * floating-point value, or a string. A given number has only one ! 43: * value at a time. ! 44: */ ! 45: ! 46: #define STATIC_STRING_SPACE 150 ! 47: ! 48: typedef struct { ! 49: long intValue; /* Integer value, if any. */ ! 50: double doubleValue; /* Floating-point value, if any. */ ! 51: ParseValue pv; /* Used to hold a string value, if any. */ ! 52: char staticSpace[STATIC_STRING_SPACE]; ! 53: /* Storage for small strings; large ones ! 54: * are malloc-ed. */ ! 55: int type; /* Type of value: TYPE_INT, TYPE_DOUBLE, ! 56: * or TYPE_STRING. */ ! 57: } Value; ! 58: ! 59: /* ! 60: * Valid values for type: ! 61: */ ! 62: ! 63: #define TYPE_INT 0 ! 64: #define TYPE_DOUBLE 1 ! 65: #define TYPE_STRING 2 ! 66: ! 67: ! 68: /* ! 69: * The data structure below describes the state of parsing an expression. ! 70: * It's passed among the routines in this module. ! 71: */ ! 72: ! 73: typedef struct { ! 74: char *originalExpr; /* The entire expression, as originally ! 75: * passed to Tcl_Expr. */ ! 76: char *expr; /* Position to the next character to be ! 77: * scanned from the expression string. */ ! 78: int token; /* Type of the last token to be parsed from ! 79: * expr. See below for definitions. ! 80: * Corresponds to the characters just ! 81: * before expr. */ ! 82: } ExprInfo; ! 83: ! 84: /* ! 85: * The token types are defined below. In addition, there is a table ! 86: * associating a precedence with each operator. The order of types ! 87: * is important. Consult the code before changing it. ! 88: */ ! 89: ! 90: #define VALUE 0 ! 91: #define OPEN_PAREN 1 ! 92: #define CLOSE_PAREN 2 ! 93: #define END 3 ! 94: #define UNKNOWN 4 ! 95: ! 96: /* ! 97: * Binary operators: ! 98: */ ! 99: ! 100: #define MULT 8 ! 101: #define DIVIDE 9 ! 102: #define MOD 10 ! 103: #define PLUS 11 ! 104: #define MINUS 12 ! 105: #define LEFT_SHIFT 13 ! 106: #define RIGHT_SHIFT 14 ! 107: #define LESS 15 ! 108: #define GREATER 16 ! 109: #define LEQ 17 ! 110: #define GEQ 18 ! 111: #define EQUAL 19 ! 112: #define NEQ 20 ! 113: #define BIT_AND 21 ! 114: #define BIT_XOR 22 ! 115: #define BIT_OR 23 ! 116: #define AND 24 ! 117: #define OR 25 ! 118: #define QUESTY 26 ! 119: #define COLON 27 ! 120: ! 121: /* ! 122: * Unary operators: ! 123: */ ! 124: ! 125: #define UNARY_MINUS 28 ! 126: #define NOT 29 ! 127: #define BIT_NOT 30 ! 128: ! 129: /* ! 130: * Precedence table. The values for non-operator token types are ignored. ! 131: */ ! 132: ! 133: int precTable[] = { ! 134: 0, 0, 0, 0, 0, 0, 0, 0, ! 135: 11, 11, 11, /* MULT, DIVIDE, MOD */ ! 136: 10, 10, /* PLUS, MINUS */ ! 137: 9, 9, /* LEFT_SHIFT, RIGHT_SHIFT */ ! 138: 8, 8, 8, 8, /* LESS, GREATER, LEQ, GEQ */ ! 139: 7, 7, /* EQUAL, NEQ */ ! 140: 6, /* BIT_AND */ ! 141: 5, /* BIT_XOR */ ! 142: 4, /* BIT_OR */ ! 143: 3, /* AND */ ! 144: 2, /* OR */ ! 145: 1, 1, /* QUESTY, COLON */ ! 146: 12, 12, 12 /* UNARY_MINUS, NOT, BIT_NOT */ ! 147: }; ! 148: ! 149: /* ! 150: * Mapping from operator numbers to strings; used for error messages. ! 151: */ ! 152: ! 153: char *operatorStrings[] = { ! 154: "VALUE", "(", ")", "END", "UNKNOWN", "5", "6", "7", ! 155: "*", "/", "%", "+", "-", "<<", ">>", "<", ">", "<=", ! 156: ">=", "==", "!=", "&", "^", "|", "&&", "||", "?", ":", ! 157: "-", "!", "~" ! 158: }; ! 159: ! 160: /* ! 161: * Declarations for local procedures to this file: ! 162: */ ! 163: ! 164: static int ExprGetValue _ANSI_ARGS_((Tcl_Interp *interp, ! 165: ExprInfo *infoPtr, int prec, Value *valuePtr)); ! 166: static int ExprLex _ANSI_ARGS_((Tcl_Interp *interp, ! 167: ExprInfo *infoPtr, Value *valuePtr)); ! 168: static void ExprMakeString _ANSI_ARGS_((Value *valuePtr)); ! 169: static int ExprParseString _ANSI_ARGS_((Tcl_Interp *interp, ! 170: char *string, Value *valuePtr)); ! 171: static int ExprTopLevel _ANSI_ARGS_((Tcl_Interp *interp, ! 172: char *string, Value *valuePtr)); ! 173: ! 174: /* ! 175: *-------------------------------------------------------------- ! 176: * ! 177: * ExprParseString -- ! 178: * ! 179: * Given a string (such as one coming from command or variable ! 180: * substitution), make a Value based on the string. The value ! 181: * will be a floating-point or integer, if possible, or else it ! 182: * will just be a copy of the string. ! 183: * ! 184: * Results: ! 185: * TCL_OK is returned under normal circumstances, and TCL_ERROR ! 186: * is returned if a floating-point overflow or underflow occurred ! 187: * while reading in a number. The value at *valuePtr is modified ! 188: * to hold a number, if possible. ! 189: * ! 190: * Side effects: ! 191: * None. ! 192: * ! 193: *-------------------------------------------------------------- ! 194: */ ! 195: ! 196: static int ! 197: ExprParseString(interp, string, valuePtr) ! 198: Tcl_Interp *interp; /* Where to store error message. */ ! 199: char *string; /* String to turn into value. */ ! 200: Value *valuePtr; /* Where to store value information. ! 201: * Caller must have initialized pv field. */ ! 202: { ! 203: register char c; ! 204: ! 205: /* ! 206: * Try to convert the string to a number. ! 207: */ ! 208: ! 209: c = *string; ! 210: if (((c >= '0') && (c <= '9')) || (c == '-') || (c == '.')) { ! 211: char *term; ! 212: ! 213: valuePtr->type = TYPE_INT; ! 214: errno = 0; ! 215: valuePtr->intValue = strtol(string, &term, 0); ! 216: c = *term; ! 217: if ((c == '\0') && (errno != ERANGE)) { ! 218: return TCL_OK; ! 219: } ! 220: if ((c == '.') || (c == 'e') || (c == 'E') || (errno == ERANGE)) { ! 221: errno = 0; ! 222: valuePtr->doubleValue = strtod(string, &term); ! 223: if (errno == ERANGE) { ! 224: Tcl_ResetResult(interp); ! 225: if (valuePtr->doubleValue == 0.0) { ! 226: Tcl_AppendResult(interp, "floating-point value \"", ! 227: string, "\" too small to represent", ! 228: (char *) NULL); ! 229: } else { ! 230: Tcl_AppendResult(interp, "floating-point value \"", ! 231: string, "\" too large to represent", ! 232: (char *) NULL); ! 233: } ! 234: return TCL_ERROR; ! 235: } ! 236: if (*term == '\0') { ! 237: valuePtr->type = TYPE_DOUBLE; ! 238: return TCL_OK; ! 239: } ! 240: } ! 241: } ! 242: ! 243: /* ! 244: * Not a valid number. Save a string value (but don't do anything ! 245: * if it's already the value). ! 246: */ ! 247: ! 248: valuePtr->type = TYPE_STRING; ! 249: if (string != valuePtr->pv.buffer) { ! 250: int length, shortfall; ! 251: ! 252: length = strlen(string); ! 253: valuePtr->pv.next = valuePtr->pv.buffer; ! 254: shortfall = length - (valuePtr->pv.end - valuePtr->pv.buffer); ! 255: if (shortfall > 0) { ! 256: (*valuePtr->pv.expandProc)(&valuePtr->pv, shortfall); ! 257: } ! 258: strcpy(valuePtr->pv.buffer, string); ! 259: } ! 260: return TCL_OK; ! 261: } ! 262: ! 263: /* ! 264: *---------------------------------------------------------------------- ! 265: * ! 266: * ExprLex -- ! 267: * ! 268: * Lexical analyzer for expression parser: parses a single value, ! 269: * operator, or other syntactic element from an expression string. ! 270: * ! 271: * Results: ! 272: * TCL_OK is returned unless an error occurred while doing lexical ! 273: * analysis or executing an embedded command. In that case a ! 274: * standard Tcl error is returned, using interp->result to hold ! 275: * an error message. In the event of a successful return, the token ! 276: * and field in infoPtr is updated to refer to the next symbol in ! 277: * the expression string, and the expr field is advanced past that ! 278: * token; if the token is a value, then the value is stored at ! 279: * valuePtr. ! 280: * ! 281: * Side effects: ! 282: * None. ! 283: * ! 284: *---------------------------------------------------------------------- ! 285: */ ! 286: ! 287: static int ! 288: ExprLex(interp, infoPtr, valuePtr) ! 289: Tcl_Interp *interp; /* Interpreter to use for error ! 290: * reporting. */ ! 291: register ExprInfo *infoPtr; /* Describes the state of the parse. */ ! 292: register Value *valuePtr; /* Where to store value, if that is ! 293: * what's parsed from string. Caller ! 294: * must have initialized pv field ! 295: * correctly. */ ! 296: { ! 297: register char *p, c; ! 298: char *var, *term; ! 299: int result; ! 300: ! 301: p = infoPtr->expr; ! 302: c = *p; ! 303: while (isspace(c)) { ! 304: p++; ! 305: c = *p; ! 306: } ! 307: infoPtr->expr = p+1; ! 308: switch (c) { ! 309: case '0': ! 310: case '1': ! 311: case '2': ! 312: case '3': ! 313: case '4': ! 314: case '5': ! 315: case '6': ! 316: case '7': ! 317: case '8': ! 318: case '9': ! 319: case '.': ! 320: ! 321: /* ! 322: * Number. First read an integer. Then if it looks like ! 323: * there's a floating-point number (or if it's too big a ! 324: * number to fit in an integer), parse it as a floating-point ! 325: * number. ! 326: */ ! 327: ! 328: infoPtr->token = VALUE; ! 329: valuePtr->type = TYPE_INT; ! 330: errno = 0; ! 331: valuePtr->intValue = strtoul(p, &term, 0); ! 332: c = *term; ! 333: if ((c == '.') || (c == 'e') || (c == 'E') || (errno == ERANGE)) { ! 334: char *term2; ! 335: ! 336: errno = 0; ! 337: valuePtr->doubleValue = strtod(p, &term2); ! 338: if (errno == ERANGE) { ! 339: Tcl_ResetResult(interp); ! 340: if (valuePtr->doubleValue == 0.0) { ! 341: interp->result = ! 342: "floating-point value too small to represent"; ! 343: } else { ! 344: interp->result = ! 345: "floating-point value too large to represent"; ! 346: } ! 347: return TCL_ERROR; ! 348: } ! 349: if (term2 == infoPtr->expr) { ! 350: interp->result = "poorly-formed floating-point value"; ! 351: return TCL_ERROR; ! 352: } ! 353: valuePtr->type = TYPE_DOUBLE; ! 354: infoPtr->expr = term2; ! 355: } else { ! 356: infoPtr->expr = term; ! 357: } ! 358: return TCL_OK; ! 359: ! 360: case '$': ! 361: ! 362: /* ! 363: * Variable. Fetch its value, then see if it makes sense ! 364: * as an integer or floating-point number. ! 365: */ ! 366: ! 367: infoPtr->token = VALUE; ! 368: var = Tcl_ParseVar(interp, p, &infoPtr->expr); ! 369: if (var == NULL) { ! 370: return TCL_ERROR; ! 371: } ! 372: if (((Interp *) interp)->noEval) { ! 373: valuePtr->type = TYPE_INT; ! 374: valuePtr->intValue = 0; ! 375: return TCL_OK; ! 376: } ! 377: return ExprParseString(interp, var, valuePtr); ! 378: ! 379: case '[': ! 380: infoPtr->token = VALUE; ! 381: result = Tcl_Eval(interp, p+1, TCL_BRACKET_TERM, ! 382: &infoPtr->expr); ! 383: if (result != TCL_OK) { ! 384: return result; ! 385: } ! 386: infoPtr->expr++; ! 387: if (((Interp *) interp)->noEval) { ! 388: valuePtr->type = TYPE_INT; ! 389: valuePtr->intValue = 0; ! 390: Tcl_ResetResult(interp); ! 391: return TCL_OK; ! 392: } ! 393: result = ExprParseString(interp, interp->result, valuePtr); ! 394: if (result != TCL_OK) { ! 395: return result; ! 396: } ! 397: Tcl_ResetResult(interp); ! 398: return TCL_OK; ! 399: ! 400: case '"': ! 401: infoPtr->token = VALUE; ! 402: result = TclParseQuotes(interp, infoPtr->expr, '"', 0, ! 403: &infoPtr->expr, &valuePtr->pv); ! 404: if (result != TCL_OK) { ! 405: return result; ! 406: } ! 407: return ExprParseString(interp, valuePtr->pv.buffer, valuePtr); ! 408: ! 409: case '{': ! 410: infoPtr->token = VALUE; ! 411: result = TclParseBraces(interp, infoPtr->expr, &infoPtr->expr, ! 412: &valuePtr->pv); ! 413: if (result != TCL_OK) { ! 414: return result; ! 415: } ! 416: return ExprParseString(interp, valuePtr->pv.buffer, valuePtr); ! 417: ! 418: case '(': ! 419: infoPtr->token = OPEN_PAREN; ! 420: return TCL_OK; ! 421: ! 422: case ')': ! 423: infoPtr->token = CLOSE_PAREN; ! 424: return TCL_OK; ! 425: ! 426: case '*': ! 427: infoPtr->token = MULT; ! 428: return TCL_OK; ! 429: ! 430: case '/': ! 431: infoPtr->token = DIVIDE; ! 432: return TCL_OK; ! 433: ! 434: case '%': ! 435: infoPtr->token = MOD; ! 436: return TCL_OK; ! 437: ! 438: case '+': ! 439: infoPtr->token = PLUS; ! 440: return TCL_OK; ! 441: ! 442: case '-': ! 443: infoPtr->token = MINUS; ! 444: return TCL_OK; ! 445: ! 446: case '?': ! 447: infoPtr->token = QUESTY; ! 448: return TCL_OK; ! 449: ! 450: case ':': ! 451: infoPtr->token = COLON; ! 452: return TCL_OK; ! 453: ! 454: case '<': ! 455: switch (p[1]) { ! 456: case '<': ! 457: infoPtr->expr = p+2; ! 458: infoPtr->token = LEFT_SHIFT; ! 459: break; ! 460: case '=': ! 461: infoPtr->expr = p+2; ! 462: infoPtr->token = LEQ; ! 463: break; ! 464: default: ! 465: infoPtr->token = LESS; ! 466: break; ! 467: } ! 468: return TCL_OK; ! 469: ! 470: case '>': ! 471: switch (p[1]) { ! 472: case '>': ! 473: infoPtr->expr = p+2; ! 474: infoPtr->token = RIGHT_SHIFT; ! 475: break; ! 476: case '=': ! 477: infoPtr->expr = p+2; ! 478: infoPtr->token = GEQ; ! 479: break; ! 480: default: ! 481: infoPtr->token = GREATER; ! 482: break; ! 483: } ! 484: return TCL_OK; ! 485: ! 486: case '=': ! 487: if (p[1] == '=') { ! 488: infoPtr->expr = p+2; ! 489: infoPtr->token = EQUAL; ! 490: } else { ! 491: infoPtr->token = UNKNOWN; ! 492: } ! 493: return TCL_OK; ! 494: ! 495: case '!': ! 496: if (p[1] == '=') { ! 497: infoPtr->expr = p+2; ! 498: infoPtr->token = NEQ; ! 499: } else { ! 500: infoPtr->token = NOT; ! 501: } ! 502: return TCL_OK; ! 503: ! 504: case '&': ! 505: if (p[1] == '&') { ! 506: infoPtr->expr = p+2; ! 507: infoPtr->token = AND; ! 508: } else { ! 509: infoPtr->token = BIT_AND; ! 510: } ! 511: return TCL_OK; ! 512: ! 513: case '^': ! 514: infoPtr->token = BIT_XOR; ! 515: return TCL_OK; ! 516: ! 517: case '|': ! 518: if (p[1] == '|') { ! 519: infoPtr->expr = p+2; ! 520: infoPtr->token = OR; ! 521: } else { ! 522: infoPtr->token = BIT_OR; ! 523: } ! 524: return TCL_OK; ! 525: ! 526: case '~': ! 527: infoPtr->token = BIT_NOT; ! 528: return TCL_OK; ! 529: ! 530: case 0: ! 531: infoPtr->token = END; ! 532: infoPtr->expr = p; ! 533: return TCL_OK; ! 534: ! 535: default: ! 536: infoPtr->expr = p+1; ! 537: infoPtr->token = UNKNOWN; ! 538: return TCL_OK; ! 539: } ! 540: } ! 541: ! 542: /* ! 543: *---------------------------------------------------------------------- ! 544: * ! 545: * ExprGetValue -- ! 546: * ! 547: * Parse a "value" from the remainder of the expression in infoPtr. ! 548: * ! 549: * Results: ! 550: * Normally TCL_OK is returned. The value of the expression is ! 551: * returned in *valuePtr. If an error occurred, then interp->result ! 552: * contains an error message and TCL_ERROR is returned. ! 553: * InfoPtr->token will be left pointing to the token AFTER the ! 554: * expression, and infoPtr->expr will point to the character just ! 555: * after the terminating token. ! 556: * ! 557: * Side effects: ! 558: * None. ! 559: * ! 560: *---------------------------------------------------------------------- ! 561: */ ! 562: ! 563: static int ! 564: ExprGetValue(interp, infoPtr, prec, valuePtr) ! 565: Tcl_Interp *interp; /* Interpreter to use for error ! 566: * reporting. */ ! 567: register ExprInfo *infoPtr; /* Describes the state of the parse ! 568: * just before the value (i.e. ExprLex ! 569: * will be called to get first token ! 570: * of value). */ ! 571: int prec; /* Treat any un-parenthesized operator ! 572: * with precedence <= this as the end ! 573: * of the expression. */ ! 574: Value *valuePtr; /* Where to store the value of the ! 575: * expression. Caller must have ! 576: * initialized pv field. */ ! 577: { ! 578: Interp *iPtr = (Interp *) interp; ! 579: Value value2; /* Second operand for current ! 580: * operator. */ ! 581: int operator; /* Current operator (either unary ! 582: * or binary). */ ! 583: int badType; /* Type of offending argument; used ! 584: * for error messages. */ ! 585: int gotOp; /* Non-zero means already lexed the ! 586: * operator (while picking up value ! 587: * for unary operator). Don't lex ! 588: * again. */ ! 589: int result; ! 590: ! 591: /* ! 592: * There are two phases to this procedure. First, pick off an initial ! 593: * value. Then, parse (binary operator, value) pairs until done. ! 594: */ ! 595: ! 596: gotOp = 0; ! 597: value2.pv.buffer = value2.pv.next = value2.staticSpace; ! 598: value2.pv.end = value2.pv.buffer + STATIC_STRING_SPACE - 1; ! 599: value2.pv.expandProc = TclExpandParseValue; ! 600: value2.pv.clientData = (ClientData) NULL; ! 601: result = ExprLex(interp, infoPtr, valuePtr); ! 602: if (result != TCL_OK) { ! 603: goto done; ! 604: } ! 605: if (infoPtr->token == OPEN_PAREN) { ! 606: ! 607: /* ! 608: * Parenthesized sub-expression. ! 609: */ ! 610: ! 611: result = ExprGetValue(interp, infoPtr, -1, valuePtr); ! 612: if (result != TCL_OK) { ! 613: goto done; ! 614: } ! 615: if (infoPtr->token != CLOSE_PAREN) { ! 616: Tcl_ResetResult(interp); ! 617: sprintf(interp->result, ! 618: "unmatched parentheses in expression \"%.50s\"", ! 619: infoPtr->originalExpr); ! 620: result = TCL_ERROR; ! 621: goto done; ! 622: } ! 623: } else { ! 624: if (infoPtr->token == MINUS) { ! 625: infoPtr->token = UNARY_MINUS; ! 626: } ! 627: if (infoPtr->token >= UNARY_MINUS) { ! 628: ! 629: /* ! 630: * Process unary operators. ! 631: */ ! 632: ! 633: operator = infoPtr->token; ! 634: result = ExprGetValue(interp, infoPtr, precTable[infoPtr->token], ! 635: valuePtr); ! 636: if (result != TCL_OK) { ! 637: goto done; ! 638: } ! 639: switch (operator) { ! 640: case UNARY_MINUS: ! 641: if (valuePtr->type == TYPE_INT) { ! 642: valuePtr->intValue = -valuePtr->intValue; ! 643: } else if (valuePtr->type == TYPE_DOUBLE){ ! 644: valuePtr->doubleValue = -valuePtr->doubleValue; ! 645: } else { ! 646: badType = valuePtr->type; ! 647: goto illegalType; ! 648: } ! 649: break; ! 650: case NOT: ! 651: if (valuePtr->type == TYPE_INT) { ! 652: valuePtr->intValue = !valuePtr->intValue; ! 653: } else if (valuePtr->type == TYPE_DOUBLE) { ! 654: /* ! 655: * Theoretically, should be able to use ! 656: * "!valuePtr->intValue", but apparently some ! 657: * compilers can't handle it. ! 658: */ ! 659: if (valuePtr->doubleValue == 0.0) { ! 660: valuePtr->intValue = 1; ! 661: } else { ! 662: valuePtr->intValue = 0; ! 663: } ! 664: valuePtr->type = TYPE_INT; ! 665: } else { ! 666: badType = valuePtr->type; ! 667: goto illegalType; ! 668: } ! 669: break; ! 670: case BIT_NOT: ! 671: if (valuePtr->type == TYPE_INT) { ! 672: valuePtr->intValue = ~valuePtr->intValue; ! 673: } else { ! 674: badType = valuePtr->type; ! 675: goto illegalType; ! 676: } ! 677: break; ! 678: } ! 679: gotOp = 1; ! 680: } else if (infoPtr->token != VALUE) { ! 681: goto syntaxError; ! 682: } ! 683: } ! 684: ! 685: /* ! 686: * Got the first operand. Now fetch (operator, operand) pairs. ! 687: */ ! 688: ! 689: if (!gotOp) { ! 690: result = ExprLex(interp, infoPtr, &value2); ! 691: if (result != TCL_OK) { ! 692: goto done; ! 693: } ! 694: } ! 695: while (1) { ! 696: operator = infoPtr->token; ! 697: value2.pv.next = value2.pv.buffer; ! 698: if ((operator < MULT) || (operator >= UNARY_MINUS)) { ! 699: if ((operator == END) || (operator == CLOSE_PAREN)) { ! 700: result = TCL_OK; ! 701: goto done; ! 702: } else { ! 703: goto syntaxError; ! 704: } ! 705: } ! 706: if (precTable[operator] <= prec) { ! 707: result = TCL_OK; ! 708: goto done; ! 709: } ! 710: ! 711: /* ! 712: * If we're doing an AND or OR and the first operand already ! 713: * determines the result, don't execute anything in the ! 714: * second operand: just parse. Same style for ?: pairs. ! 715: */ ! 716: ! 717: if ((operator == AND) || (operator == OR) || (operator == QUESTY)) { ! 718: if (valuePtr->type == TYPE_DOUBLE) { ! 719: valuePtr->intValue = valuePtr->doubleValue != 0; ! 720: valuePtr->type = TYPE_INT; ! 721: } else if (valuePtr->type == TYPE_STRING) { ! 722: badType = TYPE_STRING; ! 723: goto illegalType; ! 724: } ! 725: if (((operator == AND) && !valuePtr->intValue) ! 726: || ((operator == OR) && valuePtr->intValue)) { ! 727: iPtr->noEval++; ! 728: result = ExprGetValue(interp, infoPtr, precTable[operator], ! 729: &value2); ! 730: iPtr->noEval--; ! 731: } else if (operator == QUESTY) { ! 732: if (valuePtr->intValue != 0) { ! 733: valuePtr->pv.next = valuePtr->pv.buffer; ! 734: result = ExprGetValue(interp, infoPtr, precTable[operator], ! 735: valuePtr); ! 736: if (result != TCL_OK) { ! 737: goto done; ! 738: } ! 739: if (infoPtr->token != COLON) { ! 740: goto syntaxError; ! 741: } ! 742: value2.pv.next = value2.pv.buffer; ! 743: iPtr->noEval++; ! 744: result = ExprGetValue(interp, infoPtr, precTable[operator], ! 745: &value2); ! 746: iPtr->noEval--; ! 747: } else { ! 748: iPtr->noEval++; ! 749: result = ExprGetValue(interp, infoPtr, precTable[operator], ! 750: &value2); ! 751: iPtr->noEval--; ! 752: if (result != TCL_OK) { ! 753: goto done; ! 754: } ! 755: if (infoPtr->token != COLON) { ! 756: goto syntaxError; ! 757: } ! 758: valuePtr->pv.next = valuePtr->pv.buffer; ! 759: result = ExprGetValue(interp, infoPtr, precTable[operator], ! 760: valuePtr); ! 761: } ! 762: } else { ! 763: result = ExprGetValue(interp, infoPtr, precTable[operator], ! 764: &value2); ! 765: } ! 766: } else { ! 767: result = ExprGetValue(interp, infoPtr, precTable[operator], ! 768: &value2); ! 769: } ! 770: if (result != TCL_OK) { ! 771: goto done; ! 772: } ! 773: if ((infoPtr->token < MULT) && (infoPtr->token != VALUE) ! 774: && (infoPtr->token != END) ! 775: && (infoPtr->token != CLOSE_PAREN)) { ! 776: goto syntaxError; ! 777: } ! 778: ! 779: /* ! 780: * At this point we've got two values and an operator. Check ! 781: * to make sure that the particular data types are appropriate ! 782: * for the particular operator, and perform type conversion ! 783: * if necessary. ! 784: */ ! 785: ! 786: switch (operator) { ! 787: ! 788: /* ! 789: * For the operators below, no strings are allowed and ! 790: * ints get converted to floats if necessary. ! 791: */ ! 792: ! 793: case MULT: case DIVIDE: case PLUS: case MINUS: ! 794: if ((valuePtr->type == TYPE_STRING) ! 795: || (value2.type == TYPE_STRING)) { ! 796: badType = TYPE_STRING; ! 797: goto illegalType; ! 798: } ! 799: if (valuePtr->type == TYPE_DOUBLE) { ! 800: if (value2.type == TYPE_INT) { ! 801: value2.doubleValue = value2.intValue; ! 802: value2.type = TYPE_DOUBLE; ! 803: } ! 804: } else if (value2.type == TYPE_DOUBLE) { ! 805: if (valuePtr->type == TYPE_INT) { ! 806: valuePtr->doubleValue = valuePtr->intValue; ! 807: valuePtr->type = TYPE_DOUBLE; ! 808: } ! 809: } ! 810: break; ! 811: ! 812: /* ! 813: * For the operators below, only integers are allowed. ! 814: */ ! 815: ! 816: case MOD: case LEFT_SHIFT: case RIGHT_SHIFT: ! 817: case BIT_AND: case BIT_XOR: case BIT_OR: ! 818: if (valuePtr->type != TYPE_INT) { ! 819: badType = valuePtr->type; ! 820: goto illegalType; ! 821: } else if (value2.type != TYPE_INT) { ! 822: badType = value2.type; ! 823: goto illegalType; ! 824: } ! 825: break; ! 826: ! 827: /* ! 828: * For the operators below, any type is allowed but the ! 829: * two operands must have the same type. Convert integers ! 830: * to floats and either to strings, if necessary. ! 831: */ ! 832: ! 833: case LESS: case GREATER: case LEQ: case GEQ: ! 834: case EQUAL: case NEQ: ! 835: if (valuePtr->type == TYPE_STRING) { ! 836: if (value2.type != TYPE_STRING) { ! 837: ExprMakeString(&value2); ! 838: } ! 839: } else if (value2.type == TYPE_STRING) { ! 840: if (valuePtr->type != TYPE_STRING) { ! 841: ExprMakeString(valuePtr); ! 842: } ! 843: } else if (valuePtr->type == TYPE_DOUBLE) { ! 844: if (value2.type == TYPE_INT) { ! 845: value2.doubleValue = value2.intValue; ! 846: value2.type = TYPE_DOUBLE; ! 847: } ! 848: } else if (value2.type == TYPE_DOUBLE) { ! 849: if (valuePtr->type == TYPE_INT) { ! 850: valuePtr->doubleValue = valuePtr->intValue; ! 851: valuePtr->type = TYPE_DOUBLE; ! 852: } ! 853: } ! 854: break; ! 855: ! 856: /* ! 857: * For the operators below, no strings are allowed, but ! 858: * no int->double conversions are performed. ! 859: */ ! 860: ! 861: case AND: case OR: ! 862: if (valuePtr->type == TYPE_STRING) { ! 863: badType = valuePtr->type; ! 864: goto illegalType; ! 865: } ! 866: if (value2.type == TYPE_STRING) { ! 867: badType = value2.type; ! 868: goto illegalType; ! 869: } ! 870: break; ! 871: ! 872: /* ! 873: * For the operators below, type and conversions are ! 874: * irrelevant: they're handled elsewhere. ! 875: */ ! 876: ! 877: case QUESTY: case COLON: ! 878: break; ! 879: ! 880: /* ! 881: * Any other operator is an error. ! 882: */ ! 883: ! 884: default: ! 885: interp->result = "unknown operator in expression"; ! 886: result = TCL_ERROR; ! 887: goto done; ! 888: } ! 889: ! 890: /* ! 891: * If necessary, convert one of the operands to the type ! 892: * of the other. If the operands are incompatible with ! 893: * the operator (e.g. "+" on strings) then return an ! 894: * error. ! 895: */ ! 896: ! 897: switch (operator) { ! 898: case MULT: ! 899: if (valuePtr->type == TYPE_INT) { ! 900: valuePtr->intValue *= value2.intValue; ! 901: } else { ! 902: valuePtr->doubleValue *= value2.doubleValue; ! 903: } ! 904: break; ! 905: case DIVIDE: ! 906: if (valuePtr->type == TYPE_INT) { ! 907: if (value2.intValue == 0) { ! 908: divideByZero: ! 909: interp->result = "divide by zero"; ! 910: result = TCL_ERROR; ! 911: goto done; ! 912: } ! 913: valuePtr->intValue /= value2.intValue; ! 914: } else { ! 915: if (value2.doubleValue == 0.0) { ! 916: goto divideByZero; ! 917: } ! 918: valuePtr->doubleValue /= value2.doubleValue; ! 919: } ! 920: break; ! 921: case MOD: ! 922: if (value2.intValue == 0) { ! 923: goto divideByZero; ! 924: } ! 925: valuePtr->intValue %= value2.intValue; ! 926: break; ! 927: case PLUS: ! 928: if (valuePtr->type == TYPE_INT) { ! 929: valuePtr->intValue += value2.intValue; ! 930: } else { ! 931: valuePtr->doubleValue += value2.doubleValue; ! 932: } ! 933: break; ! 934: case MINUS: ! 935: if (valuePtr->type == TYPE_INT) { ! 936: valuePtr->intValue -= value2.intValue; ! 937: } else { ! 938: valuePtr->doubleValue -= value2.doubleValue; ! 939: } ! 940: break; ! 941: case LEFT_SHIFT: ! 942: valuePtr->intValue <<= value2.intValue; ! 943: break; ! 944: case RIGHT_SHIFT: ! 945: /* ! 946: * The following code is a bit tricky: it ensures that ! 947: * right shifts propagate the sign bit even on machines ! 948: * where ">>" won't do it by default. ! 949: */ ! 950: ! 951: if (valuePtr->intValue < 0) { ! 952: valuePtr->intValue = ! 953: ~((~valuePtr->intValue) >> value2.intValue); ! 954: } else { ! 955: valuePtr->intValue >>= value2.intValue; ! 956: } ! 957: break; ! 958: case LESS: ! 959: if (valuePtr->type == TYPE_INT) { ! 960: valuePtr->intValue = ! 961: valuePtr->intValue < value2.intValue; ! 962: } else if (valuePtr->type == TYPE_DOUBLE) { ! 963: valuePtr->intValue = ! 964: valuePtr->doubleValue < value2.doubleValue; ! 965: } else { ! 966: valuePtr->intValue = ! 967: strcmp(valuePtr->pv.buffer, value2.pv.buffer) < 0; ! 968: } ! 969: valuePtr->type = TYPE_INT; ! 970: break; ! 971: case GREATER: ! 972: if (valuePtr->type == TYPE_INT) { ! 973: valuePtr->intValue = ! 974: valuePtr->intValue > value2.intValue; ! 975: } else if (valuePtr->type == TYPE_DOUBLE) { ! 976: valuePtr->intValue = ! 977: valuePtr->doubleValue > value2.doubleValue; ! 978: } else { ! 979: valuePtr->intValue = ! 980: strcmp(valuePtr->pv.buffer, value2.pv.buffer) > 0; ! 981: } ! 982: valuePtr->type = TYPE_INT; ! 983: break; ! 984: case LEQ: ! 985: if (valuePtr->type == TYPE_INT) { ! 986: valuePtr->intValue = ! 987: valuePtr->intValue <= value2.intValue; ! 988: } else if (valuePtr->type == TYPE_DOUBLE) { ! 989: valuePtr->intValue = ! 990: valuePtr->doubleValue <= value2.doubleValue; ! 991: } else { ! 992: valuePtr->intValue = ! 993: strcmp(valuePtr->pv.buffer, value2.pv.buffer) <= 0; ! 994: } ! 995: valuePtr->type = TYPE_INT; ! 996: break; ! 997: case GEQ: ! 998: if (valuePtr->type == TYPE_INT) { ! 999: valuePtr->intValue = ! 1000: valuePtr->intValue >= value2.intValue; ! 1001: } else if (valuePtr->type == TYPE_DOUBLE) { ! 1002: valuePtr->intValue = ! 1003: valuePtr->doubleValue >= value2.doubleValue; ! 1004: } else { ! 1005: valuePtr->intValue = ! 1006: strcmp(valuePtr->pv.buffer, value2.pv.buffer) >= 0; ! 1007: } ! 1008: valuePtr->type = TYPE_INT; ! 1009: break; ! 1010: case EQUAL: ! 1011: if (valuePtr->type == TYPE_INT) { ! 1012: valuePtr->intValue = ! 1013: valuePtr->intValue == value2.intValue; ! 1014: } else if (valuePtr->type == TYPE_DOUBLE) { ! 1015: valuePtr->intValue = ! 1016: valuePtr->doubleValue == value2.doubleValue; ! 1017: } else { ! 1018: valuePtr->intValue = ! 1019: strcmp(valuePtr->pv.buffer, value2.pv.buffer) == 0; ! 1020: } ! 1021: valuePtr->type = TYPE_INT; ! 1022: break; ! 1023: case NEQ: ! 1024: if (valuePtr->type == TYPE_INT) { ! 1025: valuePtr->intValue = ! 1026: valuePtr->intValue != value2.intValue; ! 1027: } else if (valuePtr->type == TYPE_DOUBLE) { ! 1028: valuePtr->intValue = ! 1029: valuePtr->doubleValue != value2.doubleValue; ! 1030: } else { ! 1031: valuePtr->intValue = ! 1032: strcmp(valuePtr->pv.buffer, value2.pv.buffer) != 0; ! 1033: } ! 1034: valuePtr->type = TYPE_INT; ! 1035: break; ! 1036: case BIT_AND: ! 1037: valuePtr->intValue &= value2.intValue; ! 1038: break; ! 1039: case BIT_XOR: ! 1040: valuePtr->intValue ^= value2.intValue; ! 1041: break; ! 1042: case BIT_OR: ! 1043: valuePtr->intValue |= value2.intValue; ! 1044: break; ! 1045: ! 1046: /* ! 1047: * For AND and OR, we know that the first value has already ! 1048: * been converted to an integer. Thus we need only consider ! 1049: * the possibility of int vs. double for the second value. ! 1050: */ ! 1051: ! 1052: case AND: ! 1053: if (value2.type == TYPE_DOUBLE) { ! 1054: value2.intValue = value2.doubleValue != 0; ! 1055: value2.type = TYPE_INT; ! 1056: } ! 1057: valuePtr->intValue = valuePtr->intValue && value2.intValue; ! 1058: break; ! 1059: case OR: ! 1060: if (value2.type == TYPE_DOUBLE) { ! 1061: value2.intValue = value2.doubleValue != 0; ! 1062: value2.type = TYPE_INT; ! 1063: } ! 1064: valuePtr->intValue = valuePtr->intValue || value2.intValue; ! 1065: break; ! 1066: ! 1067: case COLON: ! 1068: interp->result = "can't have : operator without ? first"; ! 1069: result = TCL_ERROR; ! 1070: goto done; ! 1071: } ! 1072: } ! 1073: ! 1074: done: ! 1075: if (value2.pv.buffer != value2.staticSpace) { ! 1076: ckfree(value2.pv.buffer); ! 1077: } ! 1078: return result; ! 1079: ! 1080: syntaxError: ! 1081: Tcl_ResetResult(interp); ! 1082: Tcl_AppendResult(interp, "syntax error in expression \"", ! 1083: infoPtr->originalExpr, "\"", (char *) NULL); ! 1084: result = TCL_ERROR; ! 1085: goto done; ! 1086: ! 1087: illegalType: ! 1088: Tcl_AppendResult(interp, "can't use ", (badType == TYPE_DOUBLE) ? ! 1089: "floating-point value" : "non-numeric string", ! 1090: " as operand of \"", operatorStrings[operator], "\"", ! 1091: (char *) NULL); ! 1092: result = TCL_ERROR; ! 1093: goto done; ! 1094: } ! 1095: ! 1096: /* ! 1097: *-------------------------------------------------------------- ! 1098: * ! 1099: * ExprMakeString -- ! 1100: * ! 1101: * Convert a value from int or double representation to ! 1102: * a string. ! 1103: * ! 1104: * Results: ! 1105: * The information at *valuePtr gets converted to string ! 1106: * format, if it wasn't that way already. ! 1107: * ! 1108: * Side effects: ! 1109: * None. ! 1110: * ! 1111: *-------------------------------------------------------------- ! 1112: */ ! 1113: ! 1114: static void ! 1115: ExprMakeString(valuePtr) ! 1116: register Value *valuePtr; /* Value to be converted. */ ! 1117: { ! 1118: int shortfall; ! 1119: ! 1120: shortfall = 150 - (valuePtr->pv.end - valuePtr->pv.buffer); ! 1121: if (shortfall > 0) { ! 1122: (*valuePtr->pv.expandProc)(&valuePtr->pv, shortfall); ! 1123: } ! 1124: if (valuePtr->type == TYPE_INT) { ! 1125: sprintf(valuePtr->pv.buffer, "%ld", valuePtr->intValue); ! 1126: } else if (valuePtr->type == TYPE_DOUBLE) { ! 1127: sprintf(valuePtr->pv.buffer, "%g", valuePtr->doubleValue); ! 1128: } ! 1129: valuePtr->type = TYPE_STRING; ! 1130: } ! 1131: ! 1132: /* ! 1133: *-------------------------------------------------------------- ! 1134: * ! 1135: * ExprTopLevel -- ! 1136: * ! 1137: * This procedure provides top-level functionality shared by ! 1138: * procedures like Tcl_ExprInt, Tcl_ExprDouble, etc. ! 1139: * ! 1140: * Results: ! 1141: * The result is a standard Tcl return value. If an error ! 1142: * occurs then an error message is left in interp->result. ! 1143: * The value of the expression is returned in *valuePtr, in ! 1144: * whatever form it ends up in (could be string or integer ! 1145: * or double). Caller may need to convert result. Caller ! 1146: * is also responsible for freeing string memory in *valuePtr, ! 1147: * if any was allocated. ! 1148: * ! 1149: * Side effects: ! 1150: * None. ! 1151: * ! 1152: *-------------------------------------------------------------- ! 1153: */ ! 1154: ! 1155: static int ! 1156: ExprTopLevel(interp, string, valuePtr) ! 1157: Tcl_Interp *interp; /* Context in which to evaluate the ! 1158: * expression. */ ! 1159: char *string; /* Expression to evaluate. */ ! 1160: Value *valuePtr; /* Where to store result. Should ! 1161: * not be initialized by caller. */ ! 1162: { ! 1163: ExprInfo info; ! 1164: int result; ! 1165: ! 1166: info.originalExpr = string; ! 1167: info.expr = string; ! 1168: valuePtr->pv.buffer = valuePtr->pv.next = valuePtr->staticSpace; ! 1169: valuePtr->pv.end = valuePtr->pv.buffer + STATIC_STRING_SPACE - 1; ! 1170: valuePtr->pv.expandProc = TclExpandParseValue; ! 1171: valuePtr->pv.clientData = (ClientData) NULL; ! 1172: ! 1173: result = ExprGetValue(interp, &info, -1, valuePtr); ! 1174: if (result != TCL_OK) { ! 1175: return result; ! 1176: } ! 1177: if (info.token != END) { ! 1178: Tcl_AppendResult(interp, "syntax error in expression \"", ! 1179: string, "\"", (char *) NULL); ! 1180: return TCL_ERROR; ! 1181: } ! 1182: return TCL_OK; ! 1183: } ! 1184: ! 1185: /* ! 1186: *-------------------------------------------------------------- ! 1187: * ! 1188: * Tcl_ExprLong, Tcl_ExprDouble, Tcl_ExprBoolean -- ! 1189: * ! 1190: * Procedures to evaluate an expression and return its value ! 1191: * in a particular form. ! 1192: * ! 1193: * Results: ! 1194: * Each of the procedures below returns a standard Tcl result. ! 1195: * If an error occurs then an error message is left in ! 1196: * interp->result. Otherwise the value of the expression, ! 1197: * in the appropriate form, is stored at *resultPtr. If ! 1198: * the expression had a result that was incompatible with the ! 1199: * desired form then an error is returned. ! 1200: * ! 1201: * Side effects: ! 1202: * None. ! 1203: * ! 1204: *-------------------------------------------------------------- ! 1205: */ ! 1206: ! 1207: int ! 1208: Tcl_ExprLong(interp, string, ptr) ! 1209: Tcl_Interp *interp; /* Context in which to evaluate the ! 1210: * expression. */ ! 1211: char *string; /* Expression to evaluate. */ ! 1212: long *ptr; /* Where to store result. */ ! 1213: { ! 1214: Value value; ! 1215: int result; ! 1216: ! 1217: result = ExprTopLevel(interp, string, &value); ! 1218: if (result == TCL_OK) { ! 1219: if (value.type == TYPE_INT) { ! 1220: *ptr = value.intValue; ! 1221: } else if (value.type == TYPE_DOUBLE) { ! 1222: *ptr = value.doubleValue; ! 1223: } else { ! 1224: interp->result = "expression didn't have numeric value"; ! 1225: result = TCL_ERROR; ! 1226: } ! 1227: } ! 1228: if (value.pv.buffer != value.staticSpace) { ! 1229: ckfree(value.pv.buffer); ! 1230: } ! 1231: return result; ! 1232: } ! 1233: ! 1234: int ! 1235: Tcl_ExprDouble(interp, string, ptr) ! 1236: Tcl_Interp *interp; /* Context in which to evaluate the ! 1237: * expression. */ ! 1238: char *string; /* Expression to evaluate. */ ! 1239: double *ptr; /* Where to store result. */ ! 1240: { ! 1241: Value value; ! 1242: int result; ! 1243: ! 1244: result = ExprTopLevel(interp, string, &value); ! 1245: if (result == TCL_OK) { ! 1246: if (value.type == TYPE_INT) { ! 1247: *ptr = value.intValue; ! 1248: } else if (value.type == TYPE_DOUBLE) { ! 1249: *ptr = value.doubleValue; ! 1250: } else { ! 1251: interp->result = "expression didn't have numeric value"; ! 1252: result = TCL_ERROR; ! 1253: } ! 1254: } ! 1255: if (value.pv.buffer != value.staticSpace) { ! 1256: ckfree(value.pv.buffer); ! 1257: } ! 1258: return result; ! 1259: } ! 1260: ! 1261: int ! 1262: Tcl_ExprBoolean(interp, string, ptr) ! 1263: Tcl_Interp *interp; /* Context in which to evaluate the ! 1264: * expression. */ ! 1265: char *string; /* Expression to evaluate. */ ! 1266: int *ptr; /* Where to store 0/1 result. */ ! 1267: { ! 1268: Value value; ! 1269: int result; ! 1270: ! 1271: result = ExprTopLevel(interp, string, &value); ! 1272: if (result == TCL_OK) { ! 1273: if (value.type == TYPE_INT) { ! 1274: *ptr = value.intValue != 0; ! 1275: } else if (value.type == TYPE_DOUBLE) { ! 1276: *ptr = value.doubleValue != 0.0; ! 1277: } else { ! 1278: interp->result = "expression didn't have numeric value"; ! 1279: result = TCL_ERROR; ! 1280: } ! 1281: } ! 1282: if (value.pv.buffer != value.staticSpace) { ! 1283: ckfree(value.pv.buffer); ! 1284: } ! 1285: return result; ! 1286: } ! 1287: ! 1288: /* ! 1289: *-------------------------------------------------------------- ! 1290: * ! 1291: * Tcl_ExprString -- ! 1292: * ! 1293: * Evaluate an expression and return its value in string form. ! 1294: * ! 1295: * Results: ! 1296: * A standard Tcl result. If the result is TCL_OK, then the ! 1297: * interpreter's result is set to the string value of the ! 1298: * expression. If the result is TCL_OK, then interp->result ! 1299: * contains an error message. ! 1300: * ! 1301: * Side effects: ! 1302: * None. ! 1303: * ! 1304: *-------------------------------------------------------------- ! 1305: */ ! 1306: ! 1307: int ! 1308: Tcl_ExprString(interp, string) ! 1309: Tcl_Interp *interp; /* Context in which to evaluate the ! 1310: * expression. */ ! 1311: char *string; /* Expression to evaluate. */ ! 1312: { ! 1313: Value value; ! 1314: int result; ! 1315: ! 1316: result = ExprTopLevel(interp, string, &value); ! 1317: if (result == TCL_OK) { ! 1318: if (value.type == TYPE_INT) { ! 1319: sprintf(interp->result, "%ld", value.intValue); ! 1320: } else if (value.type == TYPE_DOUBLE) { ! 1321: sprintf(interp->result, "%g", value.doubleValue); ! 1322: } else { ! 1323: if (value.pv.buffer != value.staticSpace) { ! 1324: interp->result = value.pv.buffer; ! 1325: interp->freeProc = (Tcl_FreeProc *) free; ! 1326: value.pv.buffer = value.staticSpace; ! 1327: } else { ! 1328: Tcl_SetResult(interp, value.pv.buffer, TCL_VOLATILE); ! 1329: } ! 1330: } ! 1331: } ! 1332: if (value.pv.buffer != value.staticSpace) { ! 1333: ckfree(value.pv.buffer); ! 1334: } ! 1335: return result; ! 1336: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.