1/* 2 * tclParseExpr.c -- 3 * 4 * This file contains procedures that parse Tcl expressions. They 5 * do so in a general-purpose fashion that can be used for many 6 * different purposes, including compilation, direct execution, 7 * code analysis, etc. 8 * 9 * Copyright (c) 1997 Sun Microsystems, Inc. 10 * Copyright (c) 1998-2000 by Scriptics Corporation. 11 * Contributions from Don Porter, NIST, 2002. (not subject to US copyright) 12 * 13 * See the file "license.terms" for information on usage and redistribution 14 * of this file, and for a DISCLAIMER OF ALL WARRANTIES. 15 * 16 * RCS: @(#) $Id: tclParseExpr.c,v 1.17.2.2 2005/05/20 17:19:10 vasiljevic Exp $ 17 */ 18 19#include "tclInt.h" 20 21/* 22 * The stuff below is a bit of a hack so that this file can be used in 23 * environments that include no UNIX, i.e. no errno: just arrange to use 24 * the errno from tclExecute.c here. 25 */ 26 27#ifndef TCL_GENERIC_ONLY 28#include "tclPort.h" 29#else 30#define NO_ERRNO_H 31#endif 32 33#ifdef NO_ERRNO_H 34extern int errno; /* Use errno from tclExecute.c. */ 35#define ERANGE 34 36#endif 37 38/* 39 * Boolean variable that controls whether expression parse tracing 40 * is enabled. 41 */ 42 43#ifdef TCL_COMPILE_DEBUG 44static int traceParseExpr = 0; 45#endif /* TCL_COMPILE_DEBUG */ 46 47/* 48 * The ParseInfo structure holds state while parsing an expression. 49 * A pointer to an ParseInfo record is passed among the routines in 50 * this module. 51 */ 52 53typedef struct ParseInfo { 54 Tcl_Parse *parsePtr; /* Points to structure to fill in with 55 * information about the expression. */ 56 int lexeme; /* Type of last lexeme scanned in expr. 57 * See below for definitions. Corresponds to 58 * size characters beginning at start. */ 59 CONST char *start; /* First character in lexeme. */ 60 int size; /* Number of bytes in lexeme. */ 61 CONST char *next; /* Position of the next character to be 62 * scanned in the expression string. */ 63 CONST char *prevEnd; /* Points to the character just after the 64 * last one in the previous lexeme. Used to 65 * compute size of subexpression tokens. */ 66 CONST char *originalExpr; /* Points to the start of the expression 67 * originally passed to Tcl_ParseExpr. */ 68 CONST char *lastChar; /* Points just after last byte of expr. */ 69} ParseInfo; 70 71/* 72 * Definitions of the different lexemes that appear in expressions. The 73 * order of these must match the corresponding entries in the 74 * operatorStrings array below. 75 * 76 * Basic lexemes: 77 */ 78 79#define LITERAL 0 80#define FUNC_NAME 1 81#define OPEN_BRACKET 2 82#define OPEN_BRACE 3 83#define OPEN_PAREN 4 84#define CLOSE_PAREN 5 85#define DOLLAR 6 86#define QUOTE 7 87#define COMMA 8 88#define END 9 89#define UNKNOWN 10 90#define UNKNOWN_CHAR 11 91 92/* 93 * Binary numeric operators: 94 */ 95 96#define MULT 12 97#define DIVIDE 13 98#define MOD 14 99#define PLUS 15 100#define MINUS 16 101#define LEFT_SHIFT 17 102#define RIGHT_SHIFT 18 103#define LESS 19 104#define GREATER 20 105#define LEQ 21 106#define GEQ 22 107#define EQUAL 23 108#define NEQ 24 109#define BIT_AND 25 110#define BIT_XOR 26 111#define BIT_OR 27 112#define AND 28 113#define OR 29 114#define QUESTY 30 115#define COLON 31 116 117/* 118 * Unary operators. Unary minus and plus are represented by the (binary) 119 * lexemes MINUS and PLUS. 120 */ 121 122#define NOT 32 123#define BIT_NOT 33 124 125/* 126 * Binary string operators: 127 */ 128 129#define STREQ 34 130#define STRNEQ 35 131 132/* 133 * Mapping from lexemes to strings; used for debugging messages. These 134 * entries must match the order and number of the lexeme definitions above. 135 */ 136 137static char *lexemeStrings[] = { 138 "LITERAL", "FUNCNAME", 139 "[", "{", "(", ")", "$", "\"", ",", "END", "UNKNOWN", "UNKNOWN_CHAR", 140 "*", "/", "%", "+", "-", 141 "<<", ">>", "<", ">", "<=", ">=", "==", "!=", 142 "&", "^", "|", "&&", "||", "?", ":", 143 "!", "~", "eq", "ne", 144}; 145 146/* 147 * Declarations for local procedures to this file: 148 */ 149 150static int GetLexeme _ANSI_ARGS_((ParseInfo *infoPtr)); 151static void LogSyntaxError _ANSI_ARGS_((ParseInfo *infoPtr, 152 CONST char *extraInfo)); 153static int ParseAddExpr _ANSI_ARGS_((ParseInfo *infoPtr)); 154static int ParseBitAndExpr _ANSI_ARGS_((ParseInfo *infoPtr)); 155static int ParseBitOrExpr _ANSI_ARGS_((ParseInfo *infoPtr)); 156static int ParseBitXorExpr _ANSI_ARGS_((ParseInfo *infoPtr)); 157static int ParseCondExpr _ANSI_ARGS_((ParseInfo *infoPtr)); 158static int ParseEqualityExpr _ANSI_ARGS_((ParseInfo *infoPtr)); 159static int ParseLandExpr _ANSI_ARGS_((ParseInfo *infoPtr)); 160static int ParseLorExpr _ANSI_ARGS_((ParseInfo *infoPtr)); 161static int ParseMaxDoubleLength _ANSI_ARGS_((CONST char *string, 162 CONST char *end)); 163static int ParseMultiplyExpr _ANSI_ARGS_((ParseInfo *infoPtr)); 164static int ParsePrimaryExpr _ANSI_ARGS_((ParseInfo *infoPtr)); 165static int ParseRelationalExpr _ANSI_ARGS_((ParseInfo *infoPtr)); 166static int ParseShiftExpr _ANSI_ARGS_((ParseInfo *infoPtr)); 167static int ParseUnaryExpr _ANSI_ARGS_((ParseInfo *infoPtr)); 168static void PrependSubExprTokens _ANSI_ARGS_((CONST char *op, 169 int opBytes, CONST char *src, int srcBytes, 170 int firstIndex, ParseInfo *infoPtr)); 171 172/* 173 * Macro used to debug the execution of the recursive descent parser used 174 * to parse expressions. 175 */ 176 177#ifdef TCL_COMPILE_DEBUG 178#define HERE(production, level) \ 179 if (traceParseExpr) { \ 180 fprintf(stderr, "%*s%s: lexeme=%s, next=\"%.20s\"\n", \ 181 (level), " ", (production), \ 182 lexemeStrings[infoPtr->lexeme], infoPtr->next); \ 183 } 184#else 185#define HERE(production, level) 186#endif /* TCL_COMPILE_DEBUG */ 187 188/* 189 *---------------------------------------------------------------------- 190 * 191 * Tcl_ParseExpr -- 192 * 193 * Given a string, this procedure parses the first Tcl expression 194 * in the string and returns information about the structure of 195 * the expression. This procedure is the top-level interface to the 196 * the expression parsing module. No more that numBytes bytes will 197 * be scanned. 198 * 199 * Results: 200 * The return value is TCL_OK if the command was parsed successfully 201 * and TCL_ERROR otherwise. If an error occurs and interp isn't NULL 202 * then an error message is left in its result. On a successful return, 203 * parsePtr is filled in with information about the expression that 204 * was parsed. 205 * 206 * Side effects: 207 * If there is insufficient space in parsePtr to hold all the 208 * information about the expression, then additional space is 209 * malloc-ed. If the procedure returns TCL_OK then the caller must 210 * eventually invoke Tcl_FreeParse to release any additional space 211 * that was allocated. 212 * 213 *---------------------------------------------------------------------- 214 */ 215 216int 217Tcl_ParseExpr(interp, string, numBytes, parsePtr) 218 Tcl_Interp *interp; /* Used for error reporting. */ 219 CONST char *string; /* The source string to parse. */ 220 int numBytes; /* Number of bytes in string. If < 0, the 221 * string consists of all bytes up to the 222 * first null character. */ 223 Tcl_Parse *parsePtr; /* Structure to fill with information about 224 * the parsed expression; any previous 225 * information in the structure is 226 * ignored. */ 227{ 228 ParseInfo info; 229 int code; 230 231 if (numBytes < 0) { 232 numBytes = (string? strlen(string) : 0); 233 } 234#ifdef TCL_COMPILE_DEBUG 235 if (traceParseExpr) { 236 fprintf(stderr, "Tcl_ParseExpr: string=\"%.*s\"\n", 237 numBytes, string); 238 } 239#endif /* TCL_COMPILE_DEBUG */ 240 241 parsePtr->commentStart = NULL; 242 parsePtr->commentSize = 0; 243 parsePtr->commandStart = NULL; 244 parsePtr->commandSize = 0; 245 parsePtr->numWords = 0; 246 parsePtr->tokenPtr = parsePtr->staticTokens; 247 parsePtr->numTokens = 0; 248 parsePtr->tokensAvailable = NUM_STATIC_TOKENS; 249 parsePtr->string = string; 250 parsePtr->end = (string + numBytes); 251 parsePtr->interp = interp; 252 parsePtr->term = string; 253 parsePtr->incomplete = 0; 254 255 /* 256 * Initialize the ParseInfo structure that holds state while parsing 257 * the expression. 258 */ 259 260 info.parsePtr = parsePtr; 261 info.lexeme = UNKNOWN; 262 info.start = NULL; 263 info.size = 0; 264 info.next = string; 265 info.prevEnd = string; 266 info.originalExpr = string; 267 info.lastChar = (string + numBytes); /* just after last char of expr */ 268 269 /* 270 * Get the first lexeme then parse the expression. 271 */ 272 273 code = GetLexeme(&info); 274 if (code != TCL_OK) { 275 goto error; 276 } 277 code = ParseCondExpr(&info); 278 if (code != TCL_OK) { 279 goto error; 280 } 281 if (info.lexeme != END) { 282 LogSyntaxError(&info, "extra tokens at end of expression"); 283 goto error; 284 } 285 return TCL_OK; 286 287 error: 288 if (parsePtr->tokenPtr != parsePtr->staticTokens) { 289 ckfree((char *) parsePtr->tokenPtr); 290 } 291 return TCL_ERROR; 292} 293 294/* 295 *---------------------------------------------------------------------- 296 * 297 * ParseCondExpr -- 298 * 299 * This procedure parses a Tcl conditional expression: 300 * condExpr ::= lorExpr ['?' condExpr ':' condExpr] 301 * 302 * Note that this is the topmost recursive-descent parsing routine used 303 * by Tcl_ParseExpr to parse expressions. This avoids an extra procedure 304 * call since such a procedure would only return the result of calling 305 * ParseCondExpr. Other recursive-descent procedures that need to parse 306 * complete expressions also call ParseCondExpr. 307 * 308 * Results: 309 * The return value is TCL_OK on a successful parse and TCL_ERROR 310 * on failure. If TCL_ERROR is returned, then the interpreter's result 311 * contains an error message. 312 * 313 * Side effects: 314 * If there is insufficient space in parsePtr to hold all the 315 * information about the subexpression, then additional space is 316 * malloc-ed. 317 * 318 *---------------------------------------------------------------------- 319 */ 320 321static int 322ParseCondExpr(infoPtr) 323 ParseInfo *infoPtr; /* Holds the parse state for the 324 * expression being parsed. */ 325{ 326 Tcl_Parse *parsePtr = infoPtr->parsePtr; 327 Tcl_Token *tokenPtr, *firstTokenPtr, *condTokenPtr; 328 int firstIndex, numToMove, code; 329 CONST char *srcStart; 330 331 HERE("condExpr", 1); 332 srcStart = infoPtr->start; 333 firstIndex = parsePtr->numTokens; 334 335 code = ParseLorExpr(infoPtr); 336 if (code != TCL_OK) { 337 return code; 338 } 339 340 if (infoPtr->lexeme == QUESTY) { 341 /* 342 * Emit two tokens: one TCL_TOKEN_SUB_EXPR token for the entire 343 * conditional expression, and a TCL_TOKEN_OPERATOR token for 344 * the "?" operator. Note that these two tokens must be inserted 345 * before the LOR operand tokens generated above. 346 */ 347 348 if ((parsePtr->numTokens + 1) >= parsePtr->tokensAvailable) { 349 TclExpandTokenArray(parsePtr); 350 } 351 firstTokenPtr = &parsePtr->tokenPtr[firstIndex]; 352 tokenPtr = (firstTokenPtr + 2); 353 numToMove = (parsePtr->numTokens - firstIndex); 354 memmove((VOID *) tokenPtr, (VOID *) firstTokenPtr, 355 (size_t) (numToMove * sizeof(Tcl_Token))); 356 parsePtr->numTokens += 2; 357 358 tokenPtr = firstTokenPtr; 359 tokenPtr->type = TCL_TOKEN_SUB_EXPR; 360 tokenPtr->start = srcStart; 361 362 tokenPtr++; 363 tokenPtr->type = TCL_TOKEN_OPERATOR; 364 tokenPtr->start = infoPtr->start; 365 tokenPtr->size = 1; 366 tokenPtr->numComponents = 0; 367 368 /* 369 * Skip over the '?'. 370 */ 371 372 code = GetLexeme(infoPtr); 373 if (code != TCL_OK) { 374 return code; 375 } 376 377 /* 378 * Parse the "then" expression. 379 */ 380 381 code = ParseCondExpr(infoPtr); 382 if (code != TCL_OK) { 383 return code; 384 } 385 if (infoPtr->lexeme != COLON) { 386 LogSyntaxError(infoPtr, "missing colon from ternary conditional"); 387 return TCL_ERROR; 388 } 389 code = GetLexeme(infoPtr); /* skip over the ':' */ 390 if (code != TCL_OK) { 391 return code; 392 } 393 394 /* 395 * Parse the "else" expression. 396 */ 397 398 code = ParseCondExpr(infoPtr); 399 if (code != TCL_OK) { 400 return code; 401 } 402 403 /* 404 * Now set the size-related fields in the '?' subexpression token. 405 */ 406 407 condTokenPtr = &parsePtr->tokenPtr[firstIndex]; 408 condTokenPtr->size = (infoPtr->prevEnd - srcStart); 409 condTokenPtr->numComponents = parsePtr->numTokens - (firstIndex+1); 410 } 411 return TCL_OK; 412} 413 414/* 415 *---------------------------------------------------------------------- 416 * 417 * ParseLorExpr -- 418 * 419 * This procedure parses a Tcl logical or expression: 420 * lorExpr ::= landExpr {'||' landExpr} 421 * 422 * Results: 423 * The return value is TCL_OK on a successful parse and TCL_ERROR 424 * on failure. If TCL_ERROR is returned, then the interpreter's result 425 * contains an error message. 426 * 427 * Side effects: 428 * If there is insufficient space in parsePtr to hold all the 429 * information about the subexpression, then additional space is 430 * malloc-ed. 431 * 432 *---------------------------------------------------------------------- 433 */ 434 435static int 436ParseLorExpr(infoPtr) 437 ParseInfo *infoPtr; /* Holds the parse state for the 438 * expression being parsed. */ 439{ 440 Tcl_Parse *parsePtr = infoPtr->parsePtr; 441 int firstIndex, code; 442 CONST char *srcStart, *operator; 443 444 HERE("lorExpr", 2); 445 srcStart = infoPtr->start; 446 firstIndex = parsePtr->numTokens; 447 448 code = ParseLandExpr(infoPtr); 449 if (code != TCL_OK) { 450 return code; 451 } 452 453 while (infoPtr->lexeme == OR) { 454 operator = infoPtr->start; 455 code = GetLexeme(infoPtr); /* skip over the '||' */ 456 if (code != TCL_OK) { 457 return code; 458 } 459 code = ParseLandExpr(infoPtr); 460 if (code != TCL_OK) { 461 return code; 462 } 463 464 /* 465 * Generate tokens for the LOR subexpression and the '||' operator. 466 */ 467 468 PrependSubExprTokens(operator, 2, srcStart, 469 (infoPtr->prevEnd - srcStart), firstIndex, infoPtr); 470 } 471 return TCL_OK; 472} 473 474/* 475 *---------------------------------------------------------------------- 476 * 477 * ParseLandExpr -- 478 * 479 * This procedure parses a Tcl logical and expression: 480 * landExpr ::= bitOrExpr {'&&' bitOrExpr} 481 * 482 * Results: 483 * The return value is TCL_OK on a successful parse and TCL_ERROR 484 * on failure. If TCL_ERROR is returned, then the interpreter's result 485 * contains an error message. 486 * 487 * Side effects: 488 * If there is insufficient space in parsePtr to hold all the 489 * information about the subexpression, then additional space is 490 * malloc-ed. 491 * 492 *---------------------------------------------------------------------- 493 */ 494 495static int 496ParseLandExpr(infoPtr) 497 ParseInfo *infoPtr; /* Holds the parse state for the 498 * expression being parsed. */ 499{ 500 Tcl_Parse *parsePtr = infoPtr->parsePtr; 501 int firstIndex, code; 502 CONST char *srcStart, *operator; 503 504 HERE("landExpr", 3); 505 srcStart = infoPtr->start; 506 firstIndex = parsePtr->numTokens; 507 508 code = ParseBitOrExpr(infoPtr); 509 if (code != TCL_OK) { 510 return code; 511 } 512 513 while (infoPtr->lexeme == AND) { 514 operator = infoPtr->start; 515 code = GetLexeme(infoPtr); /* skip over the '&&' */ 516 if (code != TCL_OK) { 517 return code; 518 } 519 code = ParseBitOrExpr(infoPtr); 520 if (code != TCL_OK) { 521 return code; 522 } 523 524 /* 525 * Generate tokens for the LAND subexpression and the '&&' operator. 526 */ 527 528 PrependSubExprTokens(operator, 2, srcStart, 529 (infoPtr->prevEnd - srcStart), firstIndex, infoPtr); 530 } 531 return TCL_OK; 532} 533 534/* 535 *---------------------------------------------------------------------- 536 * 537 * ParseBitOrExpr -- 538 * 539 * This procedure parses a Tcl bitwise or expression: 540 * bitOrExpr ::= bitXorExpr {'|' bitXorExpr} 541 * 542 * Results: 543 * The return value is TCL_OK on a successful parse and TCL_ERROR 544 * on failure. If TCL_ERROR is returned, then the interpreter's result 545 * contains an error message. 546 * 547 * Side effects: 548 * If there is insufficient space in parsePtr to hold all the 549 * information about the subexpression, then additional space is 550 * malloc-ed. 551 * 552 *---------------------------------------------------------------------- 553 */ 554 555static int 556ParseBitOrExpr(infoPtr) 557 ParseInfo *infoPtr; /* Holds the parse state for the 558 * expression being parsed. */ 559{ 560 Tcl_Parse *parsePtr = infoPtr->parsePtr; 561 int firstIndex, code; 562 CONST char *srcStart, *operator; 563 564 HERE("bitOrExpr", 4); 565 srcStart = infoPtr->start; 566 firstIndex = parsePtr->numTokens; 567 568 code = ParseBitXorExpr(infoPtr); 569 if (code != TCL_OK) { 570 return code; 571 } 572 573 while (infoPtr->lexeme == BIT_OR) { 574 operator = infoPtr->start; 575 code = GetLexeme(infoPtr); /* skip over the '|' */ 576 if (code != TCL_OK) { 577 return code; 578 } 579 580 code = ParseBitXorExpr(infoPtr); 581 if (code != TCL_OK) { 582 return code; 583 } 584 585 /* 586 * Generate tokens for the BITOR subexpression and the '|' operator. 587 */ 588 589 PrependSubExprTokens(operator, 1, srcStart, 590 (infoPtr->prevEnd - srcStart), firstIndex, infoPtr); 591 } 592 return TCL_OK; 593} 594 595/* 596 *---------------------------------------------------------------------- 597 * 598 * ParseBitXorExpr -- 599 * 600 * This procedure parses a Tcl bitwise exclusive or expression: 601 * bitXorExpr ::= bitAndExpr {'^' bitAndExpr} 602 * 603 * Results: 604 * The return value is TCL_OK on a successful parse and TCL_ERROR 605 * on failure. If TCL_ERROR is returned, then the interpreter's result 606 * contains an error message. 607 * 608 * Side effects: 609 * If there is insufficient space in parsePtr to hold all the 610 * information about the subexpression, then additional space is 611 * malloc-ed. 612 * 613 *---------------------------------------------------------------------- 614 */ 615 616static int 617ParseBitXorExpr(infoPtr) 618 ParseInfo *infoPtr; /* Holds the parse state for the 619 * expression being parsed. */ 620{ 621 Tcl_Parse *parsePtr = infoPtr->parsePtr; 622 int firstIndex, code; 623 CONST char *srcStart, *operator; 624 625 HERE("bitXorExpr", 5); 626 srcStart = infoPtr->start; 627 firstIndex = parsePtr->numTokens; 628 629 code = ParseBitAndExpr(infoPtr); 630 if (code != TCL_OK) { 631 return code; 632 } 633 634 while (infoPtr->lexeme == BIT_XOR) { 635 operator = infoPtr->start; 636 code = GetLexeme(infoPtr); /* skip over the '^' */ 637 if (code != TCL_OK) { 638 return code; 639 } 640 641 code = ParseBitAndExpr(infoPtr); 642 if (code != TCL_OK) { 643 return code; 644 } 645 646 /* 647 * Generate tokens for the XOR subexpression and the '^' operator. 648 */ 649 650 PrependSubExprTokens(operator, 1, srcStart, 651 (infoPtr->prevEnd - srcStart), firstIndex, infoPtr); 652 } 653 return TCL_OK; 654} 655 656/* 657 *---------------------------------------------------------------------- 658 * 659 * ParseBitAndExpr -- 660 * 661 * This procedure parses a Tcl bitwise and expression: 662 * bitAndExpr ::= equalityExpr {'&' equalityExpr} 663 * 664 * Results: 665 * The return value is TCL_OK on a successful parse and TCL_ERROR 666 * on failure. If TCL_ERROR is returned, then the interpreter's result 667 * contains an error message. 668 * 669 * Side effects: 670 * If there is insufficient space in parsePtr to hold all the 671 * information about the subexpression, then additional space is 672 * malloc-ed. 673 * 674 *---------------------------------------------------------------------- 675 */ 676 677static int 678ParseBitAndExpr(infoPtr) 679 ParseInfo *infoPtr; /* Holds the parse state for the 680 * expression being parsed. */ 681{ 682 Tcl_Parse *parsePtr = infoPtr->parsePtr; 683 int firstIndex, code; 684 CONST char *srcStart, *operator; 685 686 HERE("bitAndExpr", 6); 687 srcStart = infoPtr->start; 688 firstIndex = parsePtr->numTokens; 689 690 code = ParseEqualityExpr(infoPtr); 691 if (code != TCL_OK) { 692 return code; 693 } 694 695 while (infoPtr->lexeme == BIT_AND) { 696 operator = infoPtr->start; 697 code = GetLexeme(infoPtr); /* skip over the '&' */ 698 if (code != TCL_OK) { 699 return code; 700 } 701 code = ParseEqualityExpr(infoPtr); 702 if (code != TCL_OK) { 703 return code; 704 } 705 706 /* 707 * Generate tokens for the BITAND subexpression and '&' operator. 708 */ 709 710 PrependSubExprTokens(operator, 1, srcStart, 711 (infoPtr->prevEnd - srcStart), firstIndex, infoPtr); 712 } 713 return TCL_OK; 714} 715 716/* 717 *---------------------------------------------------------------------- 718 * 719 * ParseEqualityExpr -- 720 * 721 * This procedure parses a Tcl equality (inequality) expression: 722 * equalityExpr ::= relationalExpr 723 * {('==' | '!=' | 'ne' | 'eq') relationalExpr} 724 * 725 * Results: 726 * The return value is TCL_OK on a successful parse and TCL_ERROR 727 * on failure. If TCL_ERROR is returned, then the interpreter's result 728 * contains an error message. 729 * 730 * Side effects: 731 * If there is insufficient space in parsePtr to hold all the 732 * information about the subexpression, then additional space is 733 * malloc-ed. 734 * 735 *---------------------------------------------------------------------- 736 */ 737 738static int 739ParseEqualityExpr(infoPtr) 740 ParseInfo *infoPtr; /* Holds the parse state for the 741 * expression being parsed. */ 742{ 743 Tcl_Parse *parsePtr = infoPtr->parsePtr; 744 int firstIndex, lexeme, code; 745 CONST char *srcStart, *operator; 746 747 HERE("equalityExpr", 7); 748 srcStart = infoPtr->start; 749 firstIndex = parsePtr->numTokens; 750 751 code = ParseRelationalExpr(infoPtr); 752 if (code != TCL_OK) { 753 return code; 754 } 755 756 lexeme = infoPtr->lexeme; 757 while ((lexeme == EQUAL) || (lexeme == NEQ) 758 || (lexeme == STREQ) || (lexeme == STRNEQ)) { 759 operator = infoPtr->start; 760 code = GetLexeme(infoPtr); /* skip over ==, !=, 'eq' or 'ne' */ 761 if (code != TCL_OK) { 762 return code; 763 } 764 code = ParseRelationalExpr(infoPtr); 765 if (code != TCL_OK) { 766 return code; 767 } 768 769 /* 770 * Generate tokens for the subexpression and '==', '!=', 'eq' or 'ne' 771 * operator. 772 */ 773 774 PrependSubExprTokens(operator, 2, srcStart, 775 (infoPtr->prevEnd - srcStart), firstIndex, infoPtr); 776 lexeme = infoPtr->lexeme; 777 } 778 return TCL_OK; 779} 780 781/* 782 *---------------------------------------------------------------------- 783 * 784 * ParseRelationalExpr -- 785 * 786 * This procedure parses a Tcl relational expression: 787 * relationalExpr ::= shiftExpr {('<' | '>' | '<=' | '>=') shiftExpr} 788 * 789 * Results: 790 * The return value is TCL_OK on a successful parse and TCL_ERROR 791 * on failure. If TCL_ERROR is returned, then the interpreter's result 792 * contains an error message. 793 * 794 * Side effects: 795 * If there is insufficient space in parsePtr to hold all the 796 * information about the subexpression, then additional space is 797 * malloc-ed. 798 * 799 *---------------------------------------------------------------------- 800 */ 801 802static int 803ParseRelationalExpr(infoPtr) 804 ParseInfo *infoPtr; /* Holds the parse state for the 805 * expression being parsed. */ 806{ 807 Tcl_Parse *parsePtr = infoPtr->parsePtr; 808 int firstIndex, lexeme, operatorSize, code; 809 CONST char *srcStart, *operator; 810 811 HERE("relationalExpr", 8); 812 srcStart = infoPtr->start; 813 firstIndex = parsePtr->numTokens; 814 815 code = ParseShiftExpr(infoPtr); 816 if (code != TCL_OK) { 817 return code; 818 } 819 820 lexeme = infoPtr->lexeme; 821 while ((lexeme == LESS) || (lexeme == GREATER) || (lexeme == LEQ) 822 || (lexeme == GEQ)) { 823 operator = infoPtr->start; 824 if ((lexeme == LEQ) || (lexeme == GEQ)) { 825 operatorSize = 2; 826 } else { 827 operatorSize = 1; 828 } 829 code = GetLexeme(infoPtr); /* skip over the operator */ 830 if (code != TCL_OK) { 831 return code; 832 } 833 code = ParseShiftExpr(infoPtr); 834 if (code != TCL_OK) { 835 return code; 836 } 837 838 /* 839 * Generate tokens for the subexpression and the operator. 840 */ 841 842 PrependSubExprTokens(operator, operatorSize, srcStart, 843 (infoPtr->prevEnd - srcStart), firstIndex, infoPtr); 844 lexeme = infoPtr->lexeme; 845 } 846 return TCL_OK; 847} 848 849/* 850 *---------------------------------------------------------------------- 851 * 852 * ParseShiftExpr -- 853 * 854 * This procedure parses a Tcl shift expression: 855 * shiftExpr ::= addExpr {('<<' | '>>') addExpr} 856 * 857 * Results: 858 * The return value is TCL_OK on a successful parse and TCL_ERROR 859 * on failure. If TCL_ERROR is returned, then the interpreter's result 860 * contains an error message. 861 * 862 * Side effects: 863 * If there is insufficient space in parsePtr to hold all the 864 * information about the subexpression, then additional space is 865 * malloc-ed. 866 * 867 *---------------------------------------------------------------------- 868 */ 869 870static int 871ParseShiftExpr(infoPtr) 872 ParseInfo *infoPtr; /* Holds the parse state for the 873 * expression being parsed. */ 874{ 875 Tcl_Parse *parsePtr = infoPtr->parsePtr; 876 int firstIndex, lexeme, code; 877 CONST char *srcStart, *operator; 878 879 HERE("shiftExpr", 9); 880 srcStart = infoPtr->start; 881 firstIndex = parsePtr->numTokens; 882 883 code = ParseAddExpr(infoPtr); 884 if (code != TCL_OK) { 885 return code; 886 } 887 888 lexeme = infoPtr->lexeme; 889 while ((lexeme == LEFT_SHIFT) || (lexeme == RIGHT_SHIFT)) { 890 operator = infoPtr->start; 891 code = GetLexeme(infoPtr); /* skip over << or >> */ 892 if (code != TCL_OK) { 893 return code; 894 } 895 code = ParseAddExpr(infoPtr); 896 if (code != TCL_OK) { 897 return code; 898 } 899 900 /* 901 * Generate tokens for the subexpression and '<<' or '>>' operator. 902 */ 903 904 PrependSubExprTokens(operator, 2, srcStart, 905 (infoPtr->prevEnd - srcStart), firstIndex, infoPtr); 906 lexeme = infoPtr->lexeme; 907 } 908 return TCL_OK; 909} 910 911/* 912 *---------------------------------------------------------------------- 913 * 914 * ParseAddExpr -- 915 * 916 * This procedure parses a Tcl addition expression: 917 * addExpr ::= multiplyExpr {('+' | '-') multiplyExpr} 918 * 919 * Results: 920 * The return value is TCL_OK on a successful parse and TCL_ERROR 921 * on failure. If TCL_ERROR is returned, then the interpreter's result 922 * contains an error message. 923 * 924 * Side effects: 925 * If there is insufficient space in parsePtr to hold all the 926 * information about the subexpression, then additional space is 927 * malloc-ed. 928 * 929 *---------------------------------------------------------------------- 930 */ 931 932static int 933ParseAddExpr(infoPtr) 934 ParseInfo *infoPtr; /* Holds the parse state for the 935 * expression being parsed. */ 936{ 937 Tcl_Parse *parsePtr = infoPtr->parsePtr; 938 int firstIndex, lexeme, code; 939 CONST char *srcStart, *operator; 940 941 HERE("addExpr", 10); 942 srcStart = infoPtr->start; 943 firstIndex = parsePtr->numTokens; 944 945 code = ParseMultiplyExpr(infoPtr); 946 if (code != TCL_OK) { 947 return code; 948 } 949 950 lexeme = infoPtr->lexeme; 951 while ((lexeme == PLUS) || (lexeme == MINUS)) { 952 operator = infoPtr->start; 953 code = GetLexeme(infoPtr); /* skip over + or - */ 954 if (code != TCL_OK) { 955 return code; 956 } 957 code = ParseMultiplyExpr(infoPtr); 958 if (code != TCL_OK) { 959 return code; 960 } 961 962 /* 963 * Generate tokens for the subexpression and '+' or '-' operator. 964 */ 965 966 PrependSubExprTokens(operator, 1, srcStart, 967 (infoPtr->prevEnd - srcStart), firstIndex, infoPtr); 968 lexeme = infoPtr->lexeme; 969 } 970 return TCL_OK; 971} 972 973/* 974 *---------------------------------------------------------------------- 975 * 976 * ParseMultiplyExpr -- 977 * 978 * This procedure parses a Tcl multiply expression: 979 * multiplyExpr ::= unaryExpr {('*' | '/' | '%') unaryExpr} 980 * 981 * Results: 982 * The return value is TCL_OK on a successful parse and TCL_ERROR 983 * on failure. If TCL_ERROR is returned, then the interpreter's result 984 * contains an error message. 985 * 986 * Side effects: 987 * If there is insufficient space in parsePtr to hold all the 988 * information about the subexpression, then additional space is 989 * malloc-ed. 990 * 991 *---------------------------------------------------------------------- 992 */ 993 994static int 995ParseMultiplyExpr(infoPtr) 996 ParseInfo *infoPtr; /* Holds the parse state for the 997 * expression being parsed. */ 998{ 999 Tcl_Parse *parsePtr = infoPtr->parsePtr; 1000 int firstIndex, lexeme, code; 1001 CONST char *srcStart, *operator; 1002 1003 HERE("multiplyExpr", 11); 1004 srcStart = infoPtr->start; 1005 firstIndex = parsePtr->numTokens; 1006 1007 code = ParseUnaryExpr(infoPtr); 1008 if (code != TCL_OK) { 1009 return code; 1010 } 1011 1012 lexeme = infoPtr->lexeme; 1013 while ((lexeme == MULT) || (lexeme == DIVIDE) || (lexeme == MOD)) { 1014 operator = infoPtr->start; 1015 code = GetLexeme(infoPtr); /* skip over * or / or % */ 1016 if (code != TCL_OK) { 1017 return code; 1018 } 1019 code = ParseUnaryExpr(infoPtr); 1020 if (code != TCL_OK) { 1021 return code; 1022 } 1023 1024 /* 1025 * Generate tokens for the subexpression and * or / or % operator. 1026 */ 1027 1028 PrependSubExprTokens(operator, 1, srcStart, 1029 (infoPtr->prevEnd - srcStart), firstIndex, infoPtr); 1030 lexeme = infoPtr->lexeme; 1031 } 1032 return TCL_OK; 1033} 1034 1035/* 1036 *---------------------------------------------------------------------- 1037 * 1038 * ParseUnaryExpr -- 1039 * 1040 * This procedure parses a Tcl unary expression: 1041 * unaryExpr ::= ('+' | '-' | '~' | '!') unaryExpr | primaryExpr 1042 * 1043 * Results: 1044 * The return value is TCL_OK on a successful parse and TCL_ERROR 1045 * on failure. If TCL_ERROR is returned, then the interpreter's result 1046 * contains an error message. 1047 * 1048 * Side effects: 1049 * If there is insufficient space in parsePtr to hold all the 1050 * information about the subexpression, then additional space is 1051 * malloc-ed. 1052 * 1053 *---------------------------------------------------------------------- 1054 */ 1055 1056static int 1057ParseUnaryExpr(infoPtr) 1058 ParseInfo *infoPtr; /* Holds the parse state for the 1059 * expression being parsed. */ 1060{ 1061 Tcl_Parse *parsePtr = infoPtr->parsePtr; 1062 int firstIndex, lexeme, code; 1063 CONST char *srcStart, *operator; 1064 1065 HERE("unaryExpr", 12); 1066 srcStart = infoPtr->start; 1067 firstIndex = parsePtr->numTokens; 1068 1069 lexeme = infoPtr->lexeme; 1070 if ((lexeme == PLUS) || (lexeme == MINUS) || (lexeme == BIT_NOT) 1071 || (lexeme == NOT)) { 1072 operator = infoPtr->start; 1073 code = GetLexeme(infoPtr); /* skip over the unary operator */ 1074 if (code != TCL_OK) { 1075 return code; 1076 } 1077 code = ParseUnaryExpr(infoPtr); 1078 if (code != TCL_OK) { 1079 return code; 1080 } 1081 1082 /* 1083 * Generate tokens for the subexpression and the operator. 1084 */ 1085 1086 PrependSubExprTokens(operator, 1, srcStart, 1087 (infoPtr->prevEnd - srcStart), firstIndex, infoPtr); 1088 } else { /* must be a primaryExpr */ 1089 code = ParsePrimaryExpr(infoPtr); 1090 if (code != TCL_OK) { 1091 return code; 1092 } 1093 } 1094 return TCL_OK; 1095} 1096 1097/* 1098 *---------------------------------------------------------------------- 1099 * 1100 * ParsePrimaryExpr -- 1101 * 1102 * This procedure parses a Tcl primary expression: 1103 * primaryExpr ::= literal | varReference | quotedString | 1104 * '[' command ']' | mathFuncCall | '(' condExpr ')' 1105 * 1106 * Results: 1107 * The return value is TCL_OK on a successful parse and TCL_ERROR 1108 * on failure. If TCL_ERROR is returned, then the interpreter's result 1109 * contains an error message. 1110 * 1111 * Side effects: 1112 * If there is insufficient space in parsePtr to hold all the 1113 * information about the subexpression, then additional space is 1114 * malloc-ed. 1115 * 1116 *---------------------------------------------------------------------- 1117 */ 1118 1119static int 1120ParsePrimaryExpr(infoPtr) 1121 ParseInfo *infoPtr; /* Holds the parse state for the 1122 * expression being parsed. */ 1123{ 1124 Tcl_Parse *parsePtr = infoPtr->parsePtr; 1125 Tcl_Interp *interp = parsePtr->interp; 1126 Tcl_Token *tokenPtr, *exprTokenPtr; 1127 Tcl_Parse nested; 1128 CONST char *dollarPtr, *stringStart, *termPtr, *src; 1129 int lexeme, exprIndex, firstIndex, numToMove, code; 1130 1131 /* 1132 * We simply recurse on parenthesized subexpressions. 1133 */ 1134 1135 HERE("primaryExpr", 13); 1136 lexeme = infoPtr->lexeme; 1137 if (lexeme == OPEN_PAREN) { 1138 code = GetLexeme(infoPtr); /* skip over the '(' */ 1139 if (code != TCL_OK) { 1140 return code; 1141 } 1142 code = ParseCondExpr(infoPtr); 1143 if (code != TCL_OK) { 1144 return code; 1145 } 1146 if (infoPtr->lexeme != CLOSE_PAREN) { 1147 LogSyntaxError(infoPtr, "looking for close parenthesis"); 1148 return TCL_ERROR; 1149 } 1150 code = GetLexeme(infoPtr); /* skip over the ')' */ 1151 if (code != TCL_OK) { 1152 return code; 1153 } 1154 return TCL_OK; 1155 } 1156 1157 /* 1158 * Start a TCL_TOKEN_SUB_EXPR token for the primary. 1159 */ 1160 1161 if (parsePtr->numTokens == parsePtr->tokensAvailable) { 1162 TclExpandTokenArray(parsePtr); 1163 } 1164 exprIndex = parsePtr->numTokens; 1165 exprTokenPtr = &parsePtr->tokenPtr[exprIndex]; 1166 exprTokenPtr->type = TCL_TOKEN_SUB_EXPR; 1167 exprTokenPtr->start = infoPtr->start; 1168 parsePtr->numTokens++; 1169 1170 /* 1171 * Process the primary then finish setting the fields of the 1172 * TCL_TOKEN_SUB_EXPR token. Note that we can't use the pointer now 1173 * stored in "exprTokenPtr" in the code below since the token array 1174 * might be reallocated. 1175 */ 1176 1177 firstIndex = parsePtr->numTokens; 1178 switch (lexeme) { 1179 case LITERAL: 1180 /* 1181 * Int or double number. 1182 */ 1183 1184 tokenizeLiteral: 1185 if (parsePtr->numTokens == parsePtr->tokensAvailable) { 1186 TclExpandTokenArray(parsePtr); 1187 } 1188 tokenPtr = &parsePtr->tokenPtr[parsePtr->numTokens]; 1189 tokenPtr->type = TCL_TOKEN_TEXT; 1190 tokenPtr->start = infoPtr->start; 1191 tokenPtr->size = infoPtr->size; 1192 tokenPtr->numComponents = 0; 1193 parsePtr->numTokens++; 1194 1195 exprTokenPtr = &parsePtr->tokenPtr[exprIndex]; 1196 exprTokenPtr->size = infoPtr->size; 1197 exprTokenPtr->numComponents = 1; 1198 break; 1199 1200 case DOLLAR: 1201 /* 1202 * $var variable reference. 1203 */ 1204 1205 dollarPtr = (infoPtr->next - 1); 1206 code = Tcl_ParseVarName(interp, dollarPtr, 1207 (infoPtr->lastChar - dollarPtr), parsePtr, 1); 1208 if (code != TCL_OK) { 1209 return code; 1210 } 1211 infoPtr->next = dollarPtr + parsePtr->tokenPtr[firstIndex].size; 1212 1213 exprTokenPtr = &parsePtr->tokenPtr[exprIndex]; 1214 exprTokenPtr->size = parsePtr->tokenPtr[firstIndex].size; 1215 exprTokenPtr->numComponents = 1216 (parsePtr->tokenPtr[firstIndex].numComponents + 1); 1217 break; 1218 1219 case QUOTE: 1220 /* 1221 * '"' string '"' 1222 */ 1223 1224 stringStart = infoPtr->next; 1225 code = Tcl_ParseQuotedString(interp, infoPtr->start, 1226 (infoPtr->lastChar - stringStart), parsePtr, 1, &termPtr); 1227 if (code != TCL_OK) { 1228 return code; 1229 } 1230 infoPtr->next = termPtr; 1231 1232 exprTokenPtr = &parsePtr->tokenPtr[exprIndex]; 1233 exprTokenPtr->size = (termPtr - exprTokenPtr->start); 1234 exprTokenPtr->numComponents = parsePtr->numTokens - firstIndex; 1235 1236 /* 1237 * If parsing the quoted string resulted in more than one token, 1238 * insert a TCL_TOKEN_WORD token before them. This indicates that 1239 * the quoted string represents a concatenation of multiple tokens. 1240 */ 1241 1242 if (exprTokenPtr->numComponents > 1) { 1243 if (parsePtr->numTokens >= parsePtr->tokensAvailable) { 1244 TclExpandTokenArray(parsePtr); 1245 } 1246 tokenPtr = &parsePtr->tokenPtr[firstIndex]; 1247 numToMove = (parsePtr->numTokens - firstIndex); 1248 memmove((VOID *) (tokenPtr + 1), (VOID *) tokenPtr, 1249 (size_t) (numToMove * sizeof(Tcl_Token))); 1250 parsePtr->numTokens++; 1251 1252 exprTokenPtr = &parsePtr->tokenPtr[exprIndex]; 1253 exprTokenPtr->numComponents++; 1254 1255 tokenPtr->type = TCL_TOKEN_WORD; 1256 tokenPtr->start = exprTokenPtr->start; 1257 tokenPtr->size = exprTokenPtr->size; 1258 tokenPtr->numComponents = (exprTokenPtr->numComponents - 1); 1259 } 1260 break; 1261 1262 case OPEN_BRACKET: 1263 /* 1264 * '[' command {command} ']' 1265 */ 1266 1267 if (parsePtr->numTokens == parsePtr->tokensAvailable) { 1268 TclExpandTokenArray(parsePtr); 1269 } 1270 tokenPtr = &parsePtr->tokenPtr[parsePtr->numTokens]; 1271 tokenPtr->type = TCL_TOKEN_COMMAND; 1272 tokenPtr->start = infoPtr->start; 1273 tokenPtr->numComponents = 0; 1274 parsePtr->numTokens++; 1275 1276 /* 1277 * Call Tcl_ParseCommand repeatedly to parse the nested command(s) 1278 * to find their end, then throw away that parse information. 1279 */ 1280 1281 src = infoPtr->next; 1282 while (1) { 1283 if (Tcl_ParseCommand(interp, src, (parsePtr->end - src), 1, 1284 &nested) != TCL_OK) { 1285 parsePtr->term = nested.term; 1286 parsePtr->errorType = nested.errorType; 1287 parsePtr->incomplete = nested.incomplete; 1288 return TCL_ERROR; 1289 } 1290 src = (nested.commandStart + nested.commandSize); 1291 1292 /* 1293 * This is equivalent to Tcl_FreeParse(&nested), but 1294 * presumably inlined here for sake of runtime optimization 1295 */ 1296 1297 if (nested.tokenPtr != nested.staticTokens) { 1298 ckfree((char *) nested.tokenPtr); 1299 } 1300 1301 /* 1302 * Check for the closing ']' that ends the command substitution. 1303 * It must have been the last character of the parsed command. 1304 */ 1305 1306 if ((nested.term < parsePtr->end) && (*nested.term == ']') 1307 && !nested.incomplete) { 1308 break; 1309 } 1310 if (src == parsePtr->end) { 1311 if (parsePtr->interp != NULL) { 1312 Tcl_SetResult(interp, "missing close-bracket", 1313 TCL_STATIC); 1314 } 1315 parsePtr->term = tokenPtr->start; 1316 parsePtr->errorType = TCL_PARSE_MISSING_BRACKET; 1317 parsePtr->incomplete = 1; 1318 return TCL_ERROR; 1319 } 1320 } 1321 tokenPtr->size = (src - tokenPtr->start); 1322 infoPtr->next = src; 1323 1324 exprTokenPtr = &parsePtr->tokenPtr[exprIndex]; 1325 exprTokenPtr->size = (src - tokenPtr->start); 1326 exprTokenPtr->numComponents = 1; 1327 break; 1328 1329 case OPEN_BRACE: 1330 /* 1331 * '{' string '}' 1332 */ 1333 1334 code = Tcl_ParseBraces(interp, infoPtr->start, 1335 (infoPtr->lastChar - infoPtr->start), parsePtr, 1, 1336 &termPtr); 1337 if (code != TCL_OK) { 1338 return code; 1339 } 1340 infoPtr->next = termPtr; 1341 1342 exprTokenPtr = &parsePtr->tokenPtr[exprIndex]; 1343 exprTokenPtr->size = (termPtr - infoPtr->start); 1344 exprTokenPtr->numComponents = parsePtr->numTokens - firstIndex; 1345 1346 /* 1347 * If parsing the braced string resulted in more than one token, 1348 * insert a TCL_TOKEN_WORD token before them. This indicates that 1349 * the braced string represents a concatenation of multiple tokens. 1350 */ 1351 1352 if (exprTokenPtr->numComponents > 1) { 1353 if (parsePtr->numTokens >= parsePtr->tokensAvailable) { 1354 TclExpandTokenArray(parsePtr); 1355 } 1356 tokenPtr = &parsePtr->tokenPtr[firstIndex]; 1357 numToMove = (parsePtr->numTokens - firstIndex); 1358 memmove((VOID *) (tokenPtr + 1), (VOID *) tokenPtr, 1359 (size_t) (numToMove * sizeof(Tcl_Token))); 1360 parsePtr->numTokens++; 1361 1362 exprTokenPtr = &parsePtr->tokenPtr[exprIndex]; 1363 exprTokenPtr->numComponents++; 1364 1365 tokenPtr->type = TCL_TOKEN_WORD; 1366 tokenPtr->start = exprTokenPtr->start; 1367 tokenPtr->size = exprTokenPtr->size; 1368 tokenPtr->numComponents = exprTokenPtr->numComponents-1; 1369 } 1370 break; 1371 1372/* 1373 * Disable attempt to support functions named "eq" or "ne". This 1374 * is unworkable in the Tcl 8.4.* releases. See Tcl Bugs 1971879 1375 * and 1201589. 1376 * 1377 case STREQ: 1378 case STRNEQ: 1379*/ 1380 case FUNC_NAME: { 1381 /* 1382 * math_func '(' expr {',' expr} ')' 1383 */ 1384 1385 ParseInfo savedInfo = *infoPtr; 1386 1387 code = GetLexeme(infoPtr); /* skip over function name */ 1388 if (code != TCL_OK) { 1389 return code; 1390 } 1391 if (infoPtr->lexeme != OPEN_PAREN) { 1392 int code; 1393 Tcl_DString functionName; 1394 Tcl_HashEntry *hPtr; 1395 Interp *iPtr = (Interp *) infoPtr->parsePtr->interp; 1396 Tcl_Obj *objPtr = Tcl_NewStringObj(savedInfo.start, savedInfo.size); 1397 1398 /* Check for boolean literals (true, false, yes, no, on, off) */ 1399 Tcl_IncrRefCount(objPtr); 1400 code = Tcl_ConvertToType(NULL, objPtr, &tclBooleanType); 1401 Tcl_DecrRefCount(objPtr); 1402 if (code == TCL_OK) { 1403 *infoPtr = savedInfo; 1404 goto tokenizeLiteral; 1405 } 1406 1407 /* 1408 * Guess what kind of error we have by trying to tell 1409 * whether we have a function or variable name here. 1410 * Alas, this makes the parser more tightly bound with the 1411 * rest of the interpreter, but that is the only way to 1412 * give a sensible message here. Still, it is not too 1413 * serious as this is only done when generating an error. 1414 */ 1415 1416 /* 1417 * Look up the name as a function name. We need a writable 1418 * copy (DString) so we can terminate it with a NULL for 1419 * the benefit of Tcl_FindHashEntry which operates on 1420 * NULL-terminated string keys. 1421 */ 1422 Tcl_DStringInit(&functionName); 1423 hPtr = Tcl_FindHashEntry(&iPtr->mathFuncTable, 1424 Tcl_DStringAppend(&functionName, 1425 savedInfo.start, savedInfo.size)); 1426 Tcl_DStringFree(&functionName); 1427 1428 /* 1429 * Assume that we have an attempted variable reference 1430 * unless we've got a function name, as the set of 1431 * potential function names is typically much smaller. 1432 */ 1433 if (hPtr != NULL) { 1434 LogSyntaxError(infoPtr, 1435 "expected parenthesis enclosing function arguments"); 1436 } else { 1437 LogSyntaxError(infoPtr, 1438 "variable references require preceding $"); 1439 } 1440 return TCL_ERROR; 1441 } 1442 1443 if (parsePtr->numTokens == parsePtr->tokensAvailable) { 1444 TclExpandTokenArray(parsePtr); 1445 } 1446 tokenPtr = &parsePtr->tokenPtr[parsePtr->numTokens]; 1447 tokenPtr->type = TCL_TOKEN_OPERATOR; 1448 tokenPtr->start = savedInfo.start; 1449 tokenPtr->size = savedInfo.size; 1450 tokenPtr->numComponents = 0; 1451 parsePtr->numTokens++; 1452 1453 code = GetLexeme(infoPtr); /* skip over '(' */ 1454 if (code != TCL_OK) { 1455 return code; 1456 } 1457 1458 while (infoPtr->lexeme != CLOSE_PAREN) { 1459 code = ParseCondExpr(infoPtr); 1460 if (code != TCL_OK) { 1461 return code; 1462 } 1463 1464 if (infoPtr->lexeme == COMMA) { 1465 code = GetLexeme(infoPtr); /* skip over , */ 1466 if (code != TCL_OK) { 1467 return code; 1468 } 1469 } else if (infoPtr->lexeme != CLOSE_PAREN) { 1470 LogSyntaxError(infoPtr, 1471 "missing close parenthesis at end of function call"); 1472 return TCL_ERROR; 1473 } 1474 } 1475 1476 exprTokenPtr = &parsePtr->tokenPtr[exprIndex]; 1477 exprTokenPtr->size = (infoPtr->next - exprTokenPtr->start); 1478 exprTokenPtr->numComponents = parsePtr->numTokens - firstIndex; 1479 break; 1480 } 1481 1482 case COMMA: 1483 LogSyntaxError(infoPtr, 1484 "commas can only separate function arguments"); 1485 return TCL_ERROR; 1486 case END: 1487 LogSyntaxError(infoPtr, "premature end of expression"); 1488 return TCL_ERROR; 1489 case UNKNOWN: 1490 LogSyntaxError(infoPtr, "single equality character not legal in expressions"); 1491 return TCL_ERROR; 1492 case UNKNOWN_CHAR: 1493 LogSyntaxError(infoPtr, "character not legal in expressions"); 1494 return TCL_ERROR; 1495 case QUESTY: 1496 LogSyntaxError(infoPtr, "unexpected ternary 'then' separator"); 1497 return TCL_ERROR; 1498 case COLON: 1499 LogSyntaxError(infoPtr, "unexpected ternary 'else' separator"); 1500 return TCL_ERROR; 1501 case CLOSE_PAREN: 1502 LogSyntaxError(infoPtr, "unexpected close parenthesis"); 1503 return TCL_ERROR; 1504 1505 default: { 1506 char buf[64]; 1507 1508 sprintf(buf, "unexpected operator %s", lexemeStrings[lexeme]); 1509 LogSyntaxError(infoPtr, buf); 1510 return TCL_ERROR; 1511 } 1512 } 1513 1514 /* 1515 * Advance to the next lexeme before returning. 1516 */ 1517 1518 code = GetLexeme(infoPtr); 1519 if (code != TCL_OK) { 1520 return code; 1521 } 1522 parsePtr->term = infoPtr->next; 1523 return TCL_OK; 1524} 1525 1526/* 1527 *---------------------------------------------------------------------- 1528 * 1529 * GetLexeme -- 1530 * 1531 * Lexical scanner for Tcl expressions: scans a single operator or 1532 * other syntactic element from an expression string. 1533 * 1534 * Results: 1535 * TCL_OK is returned unless an error occurred. In that case a standard 1536 * Tcl error code is returned and, if infoPtr->parsePtr->interp is 1537 * non-NULL, the interpreter's result is set to hold an error 1538 * message. TCL_ERROR is returned if an integer overflow, or a 1539 * floating-point overflow or underflow occurred while reading in a 1540 * number. If the lexical analysis is successful, infoPtr->lexeme 1541 * refers to the next symbol in the expression string, and 1542 * infoPtr->next is advanced past the lexeme. Also, if the lexeme is a 1543 * LITERAL or FUNC_NAME, then infoPtr->start is set to the first 1544 * character of the lexeme; otherwise it is set NULL. 1545 * 1546 * Side effects: 1547 * If there is insufficient space in parsePtr to hold all the 1548 * information about the subexpression, then additional space is 1549 * malloc-ed.. 1550 * 1551 *---------------------------------------------------------------------- 1552 */ 1553 1554static int 1555GetLexeme(infoPtr) 1556 ParseInfo *infoPtr; /* Holds state needed to parse the expr, 1557 * including the resulting lexeme. */ 1558{ 1559 register CONST char *src; /* Points to current source char. */ 1560 char c; 1561 int offset, length, numBytes; 1562 Tcl_Parse *parsePtr = infoPtr->parsePtr; 1563 Tcl_Interp *interp = parsePtr->interp; 1564 Tcl_UniChar ch; 1565 1566 /* 1567 * Record where the previous lexeme ended. Since we always read one 1568 * lexeme ahead during parsing, this helps us know the source length of 1569 * subexpression tokens. 1570 */ 1571 1572 infoPtr->prevEnd = infoPtr->next; 1573 1574 /* 1575 * Scan over leading white space at the start of a lexeme. 1576 */ 1577 1578 src = infoPtr->next; 1579 numBytes = parsePtr->end - src; 1580 do { 1581 char type; 1582 int scanned = TclParseWhiteSpace(src, numBytes, parsePtr, &type); 1583 src += scanned; numBytes -= scanned; 1584 } while (numBytes && (*src == '\n') && (src++,numBytes--)); 1585 parsePtr->term = src; 1586 if (numBytes == 0) { 1587 infoPtr->lexeme = END; 1588 infoPtr->next = src; 1589 return TCL_OK; 1590 } 1591 1592 /* 1593 * Try to parse the lexeme first as an integer or floating-point 1594 * number. Don't check for a number if the first character c is 1595 * "+" or "-". If we did, we might treat a binary operator as unary 1596 * by mistake, which would eventually cause a syntax error. 1597 */ 1598 1599 c = *src; 1600 if ((c != '+') && (c != '-')) { 1601 CONST char *end = infoPtr->lastChar; 1602 if ((length = TclParseInteger(src, (end - src)))) { 1603 /* 1604 * First length bytes look like an integer. Verify by 1605 * attempting the conversion to the largest integer we have. 1606 */ 1607 int code; 1608 Tcl_WideInt wide; 1609 Tcl_Obj *value = Tcl_NewStringObj(src, length); 1610 1611 Tcl_IncrRefCount(value); 1612 code = Tcl_GetWideIntFromObj(interp, value, &wide); 1613 Tcl_DecrRefCount(value); 1614 if (code == TCL_ERROR) { 1615 parsePtr->errorType = TCL_PARSE_BAD_NUMBER; 1616 return TCL_ERROR; 1617 } 1618 infoPtr->lexeme = LITERAL; 1619 infoPtr->start = src; 1620 infoPtr->size = length; 1621 infoPtr->next = (src + length); 1622 parsePtr->term = infoPtr->next; 1623 return TCL_OK; 1624 } else if ((length = ParseMaxDoubleLength(src, end))) { 1625 /* 1626 * There are length characters that could be a double. 1627 * Let strtod() tells us for sure. Need a writable copy 1628 * so we can set an terminating NULL to keep strtod from 1629 * scanning too far. 1630 */ 1631 char *startPtr, *termPtr; 1632 double doubleValue; 1633 Tcl_DString toParse; 1634 1635 errno = 0; 1636 Tcl_DStringInit(&toParse); 1637 startPtr = Tcl_DStringAppend(&toParse, src, length); 1638 doubleValue = strtod(startPtr, &termPtr); 1639 Tcl_DStringFree(&toParse); 1640 if (termPtr != startPtr) { 1641 if (errno != 0) { 1642 if (interp != NULL) { 1643 TclExprFloatError(interp, doubleValue); 1644 } 1645 parsePtr->errorType = TCL_PARSE_BAD_NUMBER; 1646 return TCL_ERROR; 1647 } 1648 1649 /* 1650 * startPtr was the start of a valid double, copied 1651 * from src. 1652 */ 1653 1654 infoPtr->lexeme = LITERAL; 1655 infoPtr->start = src; 1656 if ((termPtr - startPtr) > length) { 1657 infoPtr->size = length; 1658 } else { 1659 infoPtr->size = (termPtr - startPtr); 1660 } 1661 infoPtr->next = src + infoPtr->size; 1662 parsePtr->term = infoPtr->next; 1663 return TCL_OK; 1664 } 1665 } 1666 } 1667 1668 /* 1669 * Not an integer or double literal. Initialize the lexeme's fields 1670 * assuming the common case of a single character lexeme. 1671 */ 1672 1673 infoPtr->start = src; 1674 infoPtr->size = 1; 1675 infoPtr->next = src+1; 1676 parsePtr->term = infoPtr->next; 1677 1678 switch (*src) { 1679 case '[': 1680 infoPtr->lexeme = OPEN_BRACKET; 1681 return TCL_OK; 1682 1683 case '{': 1684 infoPtr->lexeme = OPEN_BRACE; 1685 return TCL_OK; 1686 1687 case '(': 1688 infoPtr->lexeme = OPEN_PAREN; 1689 return TCL_OK; 1690 1691 case ')': 1692 infoPtr->lexeme = CLOSE_PAREN; 1693 return TCL_OK; 1694 1695 case '$': 1696 infoPtr->lexeme = DOLLAR; 1697 return TCL_OK; 1698 1699 case '\"': 1700 infoPtr->lexeme = QUOTE; 1701 return TCL_OK; 1702 1703 case ',': 1704 infoPtr->lexeme = COMMA; 1705 return TCL_OK; 1706 1707 case '*': 1708 infoPtr->lexeme = MULT; 1709 return TCL_OK; 1710 1711 case '/': 1712 infoPtr->lexeme = DIVIDE; 1713 return TCL_OK; 1714 1715 case '%': 1716 infoPtr->lexeme = MOD; 1717 return TCL_OK; 1718 1719 case '+': 1720 infoPtr->lexeme = PLUS; 1721 return TCL_OK; 1722 1723 case '-': 1724 infoPtr->lexeme = MINUS; 1725 return TCL_OK; 1726 1727 case '?': 1728 infoPtr->lexeme = QUESTY; 1729 return TCL_OK; 1730 1731 case ':': 1732 infoPtr->lexeme = COLON; 1733 return TCL_OK; 1734 1735 case '<': 1736 infoPtr->lexeme = LESS; 1737 if ((infoPtr->lastChar - src) > 1) { 1738 switch (src[1]) { 1739 case '<': 1740 infoPtr->lexeme = LEFT_SHIFT; 1741 infoPtr->size = 2; 1742 infoPtr->next = src+2; 1743 break; 1744 case '=': 1745 infoPtr->lexeme = LEQ; 1746 infoPtr->size = 2; 1747 infoPtr->next = src+2; 1748 break; 1749 } 1750 } 1751 parsePtr->term = infoPtr->next; 1752 return TCL_OK; 1753 1754 case '>': 1755 infoPtr->lexeme = GREATER; 1756 if ((infoPtr->lastChar - src) > 1) { 1757 switch (src[1]) { 1758 case '>': 1759 infoPtr->lexeme = RIGHT_SHIFT; 1760 infoPtr->size = 2; 1761 infoPtr->next = src+2; 1762 break; 1763 case '=': 1764 infoPtr->lexeme = GEQ; 1765 infoPtr->size = 2; 1766 infoPtr->next = src+2; 1767 break; 1768 } 1769 } 1770 parsePtr->term = infoPtr->next; 1771 return TCL_OK; 1772 1773 case '=': 1774 infoPtr->lexeme = UNKNOWN; 1775 if ((src[1] == '=') && ((infoPtr->lastChar - src) > 1)) { 1776 infoPtr->lexeme = EQUAL; 1777 infoPtr->size = 2; 1778 infoPtr->next = src+2; 1779 } 1780 parsePtr->term = infoPtr->next; 1781 return TCL_OK; 1782 1783 case '!': 1784 infoPtr->lexeme = NOT; 1785 if ((src[1] == '=') && ((infoPtr->lastChar - src) > 1)) { 1786 infoPtr->lexeme = NEQ; 1787 infoPtr->size = 2; 1788 infoPtr->next = src+2; 1789 } 1790 parsePtr->term = infoPtr->next; 1791 return TCL_OK; 1792 1793 case '&': 1794 infoPtr->lexeme = BIT_AND; 1795 if ((src[1] == '&') && ((infoPtr->lastChar - src) > 1)) { 1796 infoPtr->lexeme = AND; 1797 infoPtr->size = 2; 1798 infoPtr->next = src+2; 1799 } 1800 parsePtr->term = infoPtr->next; 1801 return TCL_OK; 1802 1803 case '^': 1804 infoPtr->lexeme = BIT_XOR; 1805 return TCL_OK; 1806 1807 case '|': 1808 infoPtr->lexeme = BIT_OR; 1809 if ((src[1] == '|') && ((infoPtr->lastChar - src) > 1)) { 1810 infoPtr->lexeme = OR; 1811 infoPtr->size = 2; 1812 infoPtr->next = src+2; 1813 } 1814 parsePtr->term = infoPtr->next; 1815 return TCL_OK; 1816 1817 case '~': 1818 infoPtr->lexeme = BIT_NOT; 1819 return TCL_OK; 1820 1821 case 'e': 1822 if ((src[1] == 'q') && ((infoPtr->lastChar - src) > 1)) { 1823 infoPtr->lexeme = STREQ; 1824 infoPtr->size = 2; 1825 infoPtr->next = src+2; 1826 parsePtr->term = infoPtr->next; 1827 return TCL_OK; 1828 } else { 1829 goto checkFuncName; 1830 } 1831 1832 case 'n': 1833 if ((src[1] == 'e') && ((infoPtr->lastChar - src) > 1)) { 1834 infoPtr->lexeme = STRNEQ; 1835 infoPtr->size = 2; 1836 infoPtr->next = src+2; 1837 parsePtr->term = infoPtr->next; 1838 return TCL_OK; 1839 } else { 1840 goto checkFuncName; 1841 } 1842 1843 default: 1844 checkFuncName: 1845 length = (infoPtr->lastChar - src); 1846 if (Tcl_UtfCharComplete(src, length)) { 1847 offset = Tcl_UtfToUniChar(src, &ch); 1848 } else { 1849 char utfBytes[TCL_UTF_MAX]; 1850 memcpy(utfBytes, src, (size_t) length); 1851 utfBytes[length] = '\0'; 1852 offset = Tcl_UtfToUniChar(utfBytes, &ch); 1853 } 1854 c = UCHAR(ch); 1855 if (isalpha(UCHAR(c))) { /* INTL: ISO only. */ 1856 infoPtr->lexeme = FUNC_NAME; 1857 while (isalnum(UCHAR(c)) || (c == '_')) { /* INTL: ISO only. */ 1858 src += offset; length -= offset; 1859 if (Tcl_UtfCharComplete(src, length)) { 1860 offset = Tcl_UtfToUniChar(src, &ch); 1861 } else { 1862 char utfBytes[TCL_UTF_MAX]; 1863 memcpy(utfBytes, src, (size_t) length); 1864 utfBytes[length] = '\0'; 1865 offset = Tcl_UtfToUniChar(utfBytes, &ch); 1866 } 1867 c = UCHAR(ch); 1868 } 1869 infoPtr->size = (src - infoPtr->start); 1870 infoPtr->next = src; 1871 parsePtr->term = infoPtr->next; 1872 return TCL_OK; 1873 } 1874 infoPtr->lexeme = UNKNOWN_CHAR; 1875 return TCL_OK; 1876 } 1877} 1878 1879/* 1880 *---------------------------------------------------------------------- 1881 * 1882 * TclParseInteger -- 1883 * 1884 * Scans up to numBytes bytes starting at src, and checks whether 1885 * the leading bytes look like an integer's string representation. 1886 * 1887 * Results: 1888 * Returns 0 if the leading bytes do not look like an integer. 1889 * Otherwise, returns the number of bytes examined that look 1890 * like an integer. This may be less than numBytes if the integer 1891 * is only the leading part of the string. 1892 * 1893 * Side effects: 1894 * None. 1895 * 1896 *---------------------------------------------------------------------- 1897 */ 1898 1899int 1900TclParseInteger(string, numBytes) 1901 register CONST char *string;/* The string to examine. */ 1902 register int numBytes; /* Max number of bytes to scan. */ 1903{ 1904 register CONST char *p = string; 1905 1906 /* Take care of introductory "0x" */ 1907 if ((numBytes > 1) && (p[0] == '0') && ((p[1] == 'x') || (p[1] == 'X'))) { 1908 int scanned; 1909 Tcl_UniChar ch; 1910 p+=2; numBytes -= 2; 1911 scanned = TclParseHex(p, numBytes, &ch); 1912 if (scanned) { 1913 return scanned + 2; 1914 } 1915 1916 /* Recognize the 0 as valid integer, but x is left behind */ 1917 return 1; 1918 } 1919 while (numBytes && isdigit(UCHAR(*p))) { /* INTL: digit */ 1920 numBytes--; p++; 1921 } 1922 if (numBytes == 0) { 1923 return (p - string); 1924 } 1925 if ((*p != '.') && (*p != 'e') && (*p != 'E')) { 1926 return (p - string); 1927 } 1928 return 0; 1929} 1930 1931/* 1932 *---------------------------------------------------------------------- 1933 * 1934 * ParseMaxDoubleLength -- 1935 * 1936 * Scans a sequence of bytes checking that the characters could 1937 * be in a string rep of a double. 1938 * 1939 * Results: 1940 * Returns the number of bytes starting with string, runing to, but 1941 * not including end, all of which could be part of a string rep. 1942 * of a double. Only character identity is used, no actual 1943 * parsing is done. 1944 * 1945 * The legal bytes are '0' - '9', 'A' - 'F', 'a' - 'f', 1946 * '.', '+', '-', 'i', 'I', 'n', 'N', 'p', 'P', 'x', and 'X'. 1947 * This covers the values "Inf" and "Nan" as well as the 1948 * decimal and hexadecimal representations recognized by a 1949 * C99-compliant strtod(). 1950 * 1951 * Side effects: 1952 * None. 1953 * 1954 *---------------------------------------------------------------------- 1955 */ 1956 1957static int 1958ParseMaxDoubleLength(string, end) 1959 register CONST char *string;/* The string to examine. */ 1960 CONST char *end; /* Point to the first character past the end 1961 * of the string we are examining. */ 1962{ 1963 CONST char *p = string; 1964 while (p < end) { 1965 switch (*p) { 1966 case '0': case '1': case '2': case '3': case '4': case '5': 1967 case '6': case '7': case '8': case '9': case 'A': case 'B': 1968 case 'C': case 'D': case 'E': case 'F': case 'I': case 'N': 1969 case 'P': case 'X': case 'a': case 'b': case 'c': case 'd': 1970 case 'e': case 'f': case 'i': case 'n': case 'p': case 'x': 1971 case '.': case '+': case '-': 1972 p++; 1973 break; 1974 default: 1975 goto done; 1976 } 1977 } 1978 done: 1979 return (p - string); 1980} 1981 1982/* 1983 *---------------------------------------------------------------------- 1984 * 1985 * PrependSubExprTokens -- 1986 * 1987 * This procedure is called after the operands of an subexpression have 1988 * been parsed. It generates two tokens: a TCL_TOKEN_SUB_EXPR token for 1989 * the subexpression, and a TCL_TOKEN_OPERATOR token for its operator. 1990 * These two tokens are inserted before the operand tokens. 1991 * 1992 * Results: 1993 * None. 1994 * 1995 * Side effects: 1996 * If there is insufficient space in parsePtr to hold the new tokens, 1997 * additional space is malloc-ed. 1998 * 1999 *---------------------------------------------------------------------- 2000 */ 2001 2002static void 2003PrependSubExprTokens(op, opBytes, src, srcBytes, firstIndex, infoPtr) 2004 CONST char *op; /* Points to first byte of the operator 2005 * in the source script. */ 2006 int opBytes; /* Number of bytes in the operator. */ 2007 CONST char *src; /* Points to first byte of the subexpression 2008 * in the source script. */ 2009 int srcBytes; /* Number of bytes in subexpression's 2010 * source. */ 2011 int firstIndex; /* Index of first token already emitted for 2012 * operator's first (or only) operand. */ 2013 ParseInfo *infoPtr; /* Holds the parse state for the 2014 * expression being parsed. */ 2015{ 2016 Tcl_Parse *parsePtr = infoPtr->parsePtr; 2017 Tcl_Token *tokenPtr, *firstTokenPtr; 2018 int numToMove; 2019 2020 if ((parsePtr->numTokens + 1) >= parsePtr->tokensAvailable) { 2021 TclExpandTokenArray(parsePtr); 2022 } 2023 firstTokenPtr = &parsePtr->tokenPtr[firstIndex]; 2024 tokenPtr = (firstTokenPtr + 2); 2025 numToMove = (parsePtr->numTokens - firstIndex); 2026 memmove((VOID *) tokenPtr, (VOID *) firstTokenPtr, 2027 (size_t) (numToMove * sizeof(Tcl_Token))); 2028 parsePtr->numTokens += 2; 2029 2030 tokenPtr = firstTokenPtr; 2031 tokenPtr->type = TCL_TOKEN_SUB_EXPR; 2032 tokenPtr->start = src; 2033 tokenPtr->size = srcBytes; 2034 tokenPtr->numComponents = parsePtr->numTokens - (firstIndex + 1); 2035 2036 tokenPtr++; 2037 tokenPtr->type = TCL_TOKEN_OPERATOR; 2038 tokenPtr->start = op; 2039 tokenPtr->size = opBytes; 2040 tokenPtr->numComponents = 0; 2041} 2042 2043/* 2044 *---------------------------------------------------------------------- 2045 * 2046 * LogSyntaxError -- 2047 * 2048 * This procedure is invoked after an error occurs when parsing an 2049 * expression. It sets the interpreter result to an error message 2050 * describing the error. 2051 * 2052 * Results: 2053 * None. 2054 * 2055 * Side effects: 2056 * Sets the interpreter result to an error message describing the 2057 * expression that was being parsed when the error occurred, and why 2058 * the parser considers that to be a syntax error at all. 2059 * 2060 *---------------------------------------------------------------------- 2061 */ 2062 2063static void 2064LogSyntaxError(infoPtr, extraInfo) 2065 ParseInfo *infoPtr; /* Holds the parse state for the 2066 * expression being parsed. */ 2067 CONST char *extraInfo; /* String to provide extra information 2068 * about the syntax error. */ 2069{ 2070 int numBytes = (infoPtr->lastChar - infoPtr->originalExpr); 2071 char buffer[100]; 2072 2073 if (numBytes > 60) { 2074 sprintf(buffer, "syntax error in expression \"%.60s...\"", 2075 infoPtr->originalExpr); 2076 } else { 2077 sprintf(buffer, "syntax error in expression \"%.*s\"", 2078 numBytes, infoPtr->originalExpr); 2079 } 2080 Tcl_ResetResult(infoPtr->parsePtr->interp); 2081 Tcl_AppendStringsToObj(Tcl_GetObjResult(infoPtr->parsePtr->interp), 2082 buffer, ": ", extraInfo, (char *) NULL); 2083 infoPtr->parsePtr->errorType = TCL_PARSE_SYNTAX; 2084 infoPtr->parsePtr->term = infoPtr->start; 2085} 2086