tcl/generic/tclParseExpr.c

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