1/* 2 * tclCompExpr.c -- 3 * 4 * This file contains the code to parse and compile Tcl expressions 5 * and implementations of the Tcl commands corresponding to expression 6 * operators, such as the command ::tcl::mathop::+ . 7 * 8 * Contributions from Don Porter, NIST, 2006-2007. (not subject to US copyright) 9 * 10 * See the file "license.terms" for information on usage and redistribution of 11 * this file, and for a DISCLAIMER OF ALL WARRANTIES. 12 * 13 * RCS: @(#) $Id: tclCompExpr.c,v 1.97.2.1 2010/01/06 21:35:25 nijtmans Exp $ 14 */ 15 16#include "tclInt.h" 17#include "tclCompile.h" /* CompileEnv */ 18 19/* 20 * Expression parsing takes place in the routine ParseExpr(). It takes a 21 * string as input, parses that string, and generates a representation of 22 * the expression in the form of a tree of operators, a list of literals, 23 * a list of function names, and an array of Tcl_Token's within a Tcl_Parse 24 * struct. The tree is composed of OpNodes. 25 */ 26 27typedef struct OpNode { 28 int left; /* "Pointer" to the left operand. */ 29 int right; /* "Pointer" to the right operand. */ 30 union { 31 int parent; /* "Pointer" to the parent operand. */ 32 int prev; /* "Pointer" joining incomplete tree stack */ 33 } p; 34 unsigned char lexeme; /* Code that identifies the operator. */ 35 unsigned char precedence; /* Precedence of the operator */ 36 unsigned char mark; /* Mark used to control traversal. */ 37 unsigned char constant; /* Flag marking constant subexpressions. */ 38} OpNode; 39 40/* 41 * The storage for the tree is dynamically allocated array of OpNodes. The 42 * array is grown as parsing needs dictate according to a scheme similar to 43 * Tcl's string growth algorithm, so that the resizing costs are O(N) and so 44 * that we use at least half the memory allocated as expressions get large. 45 * 46 * Each OpNode in the tree represents an operator in the expression, either 47 * unary or binary. When parsing is completed successfully, a binary operator 48 * OpNode will have its left and right fields filled with "pointers" to its 49 * left and right operands. A unary operator OpNode will have its right field 50 * filled with a pointer to its single operand. When an operand is a 51 * subexpression the "pointer" takes the form of the index -- a non-negative 52 * integer -- into the OpNode storage array where the root of that 53 * subexpression parse tree is found. 54 * 55 * Non-operator elements of the expression do not get stored in the OpNode 56 * tree. They are stored in the other structures according to their type. 57 * Literal values get appended to the literal list. Elements that denote 58 * forms of quoting or substitution known to the Tcl parser get stored as 59 * Tcl_Tokens. These non-operator elements of the expression are the 60 * leaves of the completed parse tree. When an operand of an OpNode is 61 * one of these leaf elements, the following negative integer codes are used 62 * to indicate which kind of elements it is. 63 */ 64 65enum OperandTypes { 66 OT_LITERAL = -3, /* Operand is a literal in the literal list */ 67 OT_TOKENS = -2, /* Operand is sequence of Tcl_Tokens */ 68 OT_EMPTY = -1 /* "Operand" is an empty string. This is a 69 * special case used only to represent the 70 * EMPTY lexeme. See below. */ 71}; 72 73/* 74 * Readable macros to test whether a "pointer" value points to an operator. 75 * They operate on the "non-negative integer -> operator; negative integer -> 76 * a non-operator OperandType" distinction. 77 */ 78 79#define IsOperator(l) ((l) >= 0) 80#define NotOperator(l) ((l) < 0) 81 82/* 83 * Note that it is sufficient to store in the tree just the type of leaf 84 * operand, without any explicit pointer to which leaf. This is true because 85 * the traversals of the completed tree we perform are known to visit 86 * the leaves in the same order as the original parse. 87 * 88 * In a completed parse tree, those OpNodes that are themselves (roots of 89 * subexpression trees that are) operands of some operator store in their 90 * p.parent field a "pointer" to the OpNode of that operator. The p.parent 91 * field permits a traversal of the tree within a * non-recursive routine 92 * (ConvertTreeToTokens() and CompileExprTree()). This means that even 93 * expression trees of great depth pose no risk of blowing the C stack. 94 * 95 * While the parse tree is being constructed, the same memory space is used 96 * to hold the p.prev field which chains together a stack of incomplete 97 * trees awaiting their right operands. 98 * 99 * The lexeme field is filled in with the lexeme of the operator that is 100 * returned by the ParseLexeme() routine. Only lexemes for unary and 101 * binary operators get stored in an OpNode. Other lexmes get different 102 * treatement. 103 * 104 * The precedence field provides a place to store the precedence of the 105 * operator, so it need not be looked up again and again. 106 * 107 * The mark field is use to control the traversal of the tree, so 108 * that it can be done non-recursively. The mark values are: 109 */ 110 111enum Marks { 112 MARK_LEFT, /* Next step of traversal is to visit left subtree */ 113 MARK_RIGHT, /* Next step of traversal is to visit right subtree */ 114 MARK_PARENT /* Next step of traversal is to return to parent */ 115}; 116 117/* 118 * The constant field is a boolean flag marking which subexpressions are 119 * completely known at compile time, and are eligible for computing then 120 * rather than waiting until run time. 121 */ 122 123/* 124 * Each lexeme belongs to one of four categories, which determine 125 * its place in the parse tree. We use the two high bits of the 126 * (unsigned char) value to store a NODE_TYPE code. 127 */ 128 129#define NODE_TYPE 0xC0 130 131/* 132 * The four category values are LEAF, UNARY, and BINARY, explained below, 133 * and "uncategorized", which is used either temporarily, until context 134 * determines which of the other three categories is correct, or for 135 * lexemes like INVALID, which aren't really lexemes at all, but indicators 136 * of a parsing error. Note that the codes must be distinct to distinguish 137 * categories, but need not take the form of a bit array. 138 */ 139 140#define BINARY 0x40 /* This lexeme is a binary operator. An 141 * OpNode representing it should go into the 142 * parse tree, and two operands should be 143 * parsed for it in the expression. */ 144#define UNARY 0x80 /* This lexeme is a unary operator. An OpNode 145 * representing it should go into the parse 146 * tree, and one operand should be parsed for 147 * it in the expression. */ 148#define LEAF 0xC0 /* This lexeme is a leaf operand in the parse 149 * tree. No OpNode will be placed in the tree 150 * for it. Either a literal value will be 151 * appended to the list of literals in this 152 * expression, or appropriate Tcl_Tokens will 153 * be appended in a Tcl_Parse struct to 154 * represent those leaves that require some 155 * form of substitution. 156 */ 157 158/* Uncategorized lexemes */ 159 160#define PLUS 1 /* Ambiguous. Resolves to UNARY_PLUS or 161 * BINARY_PLUS according to context. */ 162#define MINUS 2 /* Ambiguous. Resolves to UNARY_MINUS or 163 * BINARY_MINUS according to context. */ 164#define BAREWORD 3 /* Ambigous. Resolves to BOOLEAN or to 165 * FUNCTION or a parse error according to 166 * context and value. */ 167#define INCOMPLETE 4 /* A parse error. Used only when the single 168 * "=" is encountered. */ 169#define INVALID 5 /* A parse error. Used when any punctuation 170 * appears that's not a supported operator. */ 171 172/* Leaf lexemes */ 173 174#define NUMBER ( LEAF | 1) /* For literal numbers */ 175#define SCRIPT ( LEAF | 2) /* Script substitution; [foo] */ 176#define BOOLEAN ( LEAF | BAREWORD) /* For literal booleans */ 177#define BRACED ( LEAF | 4) /* Braced string; {foo bar} */ 178#define VARIABLE ( LEAF | 5) /* Variable substitution; $x */ 179#define QUOTED ( LEAF | 6) /* Quoted string; "foo $bar [soom]" */ 180#define EMPTY ( LEAF | 7) /* Used only for an empty argument 181 * list to a function. Represents 182 * the empty string within parens in 183 * the expression: rand() */ 184 185/* Unary operator lexemes */ 186 187#define UNARY_PLUS ( UNARY | PLUS) 188#define UNARY_MINUS ( UNARY | MINUS) 189#define FUNCTION ( UNARY | BAREWORD) /* This is a bit of "creative 190 * interpretation" on the part of the 191 * parser. A function call is parsed 192 * into the parse tree according to 193 * the perspective that the function 194 * name is a unary operator and its 195 * argument list, enclosed in parens, 196 * is its operand. The additional 197 * requirements not implied generally 198 * by treatment as a unary operator -- 199 * for example, the requirement that 200 * the operand be enclosed in parens -- 201 * are hard coded in the relevant 202 * portions of ParseExpr(). We trade 203 * off the need to include such 204 * exceptional handling in the code 205 * against the need we would otherwise 206 * have for more lexeme categories. */ 207#define START ( UNARY | 4) /* This lexeme isn't parsed from the 208 * expression text at all. It 209 * represents the start of the 210 * expression and sits at the root of 211 * the parse tree where it serves as 212 * the start/end point of traversals. */ 213#define OPEN_PAREN ( UNARY | 5) /* Another bit of creative 214 * interpretation, where we treat "(" 215 * as a unary operator with the 216 * sub-expression between it and its 217 * matching ")" as its operand. See 218 * CLOSE_PAREN below. */ 219#define NOT ( UNARY | 6) 220#define BIT_NOT ( UNARY | 7) 221 222/* Binary operator lexemes */ 223 224#define BINARY_PLUS ( BINARY | PLUS) 225#define BINARY_MINUS ( BINARY | MINUS) 226#define COMMA ( BINARY | 3) /* The "," operator is a low precedence 227 * binary operator that separates the 228 * arguments in a function call. The 229 * additional constraint that this 230 * operator can only legally appear 231 * at the right places within a 232 * function call argument list are 233 * hard coded within ParseExpr(). */ 234#define MULT ( BINARY | 4) 235#define DIVIDE ( BINARY | 5) 236#define MOD ( BINARY | 6) 237#define LESS ( BINARY | 7) 238#define GREATER ( BINARY | 8) 239#define BIT_AND ( BINARY | 9) 240#define BIT_XOR ( BINARY | 10) 241#define BIT_OR ( BINARY | 11) 242#define QUESTION ( BINARY | 12) /* These two lexemes make up the */ 243#define COLON ( BINARY | 13) /* ternary conditional operator, 244 * $x ? $y : $z . We treat them as 245 * two binary operators to avoid 246 * another lexeme category, and 247 * code the additional constraints 248 * directly in ParseExpr(). For 249 * instance, the right operand of 250 * a "?" operator must be a ":" 251 * operator. */ 252#define LEFT_SHIFT ( BINARY | 14) 253#define RIGHT_SHIFT ( BINARY | 15) 254#define LEQ ( BINARY | 16) 255#define GEQ ( BINARY | 17) 256#define EQUAL ( BINARY | 18) 257#define NEQ ( BINARY | 19) 258#define AND ( BINARY | 20) 259#define OR ( BINARY | 21) 260#define STREQ ( BINARY | 22) 261#define STRNEQ ( BINARY | 23) 262#define EXPON ( BINARY | 24) /* Unlike the other binary operators, 263 * EXPON is right associative and this 264 * distinction is coded directly in 265 * ParseExpr(). */ 266#define IN_LIST ( BINARY | 25) 267#define NOT_IN_LIST ( BINARY | 26) 268#define CLOSE_PAREN ( BINARY | 27) /* By categorizing the CLOSE_PAREN 269 * lexeme as a BINARY operator, the 270 * normal parsing rules for binary 271 * operators assure that a close paren 272 * will not directly follow another 273 * operator, and the machinery already 274 * in place to connect operands to 275 * operators according to precedence 276 * performs most of the work of 277 * matching open and close parens for 278 * us. In the end though, a close 279 * paren is not really a binary 280 * operator, and some special coding 281 * in ParseExpr() make sure we never 282 * put an actual CLOSE_PAREN node 283 * in the parse tree. The 284 * sub-expression between parens 285 * becomes the single argument of 286 * the matching OPEN_PAREN unary 287 * operator. */ 288#define END ( BINARY | 28) /* This lexeme represents the end of 289 * the string being parsed. Treating 290 * it as a binary operator follows the 291 * same logic as the CLOSE_PAREN lexeme 292 * and END pairs with START, in the 293 * same way that CLOSE_PAREN pairs with 294 * OPEN_PAREN. */ 295/* 296 * When ParseExpr() builds the parse tree it must choose which operands to 297 * connect to which operators. This is done according to operator precedence. 298 * The greater an operator's precedence the greater claim it has to link to 299 * an available operand. The Precedence enumeration lists the precedence 300 * values used by Tcl expression operators, from lowest to highest claim. 301 * Each precedence level is commented with the operators that hold that 302 * precedence. 303 */ 304 305enum Precedence { 306 PREC_END = 1, /* END */ 307 PREC_START, /* START */ 308 PREC_CLOSE_PAREN, /* ")" */ 309 PREC_OPEN_PAREN, /* "(" */ 310 PREC_COMMA, /* "," */ 311 PREC_CONDITIONAL, /* "?", ":" */ 312 PREC_OR, /* "||" */ 313 PREC_AND, /* "&&" */ 314 PREC_BIT_OR, /* "|" */ 315 PREC_BIT_XOR, /* "^" */ 316 PREC_BIT_AND, /* "&" */ 317 PREC_EQUAL, /* "==", "!=", "eq", "ne", "in", "ni" */ 318 PREC_COMPARE, /* "<", ">", "<=", ">=" */ 319 PREC_SHIFT, /* "<<", ">>" */ 320 PREC_ADD, /* "+", "-" */ 321 PREC_MULT, /* "*", "/", "%" */ 322 PREC_EXPON, /* "**" */ 323 PREC_UNARY /* "+", "-", FUNCTION, "!", "~" */ 324}; 325 326/* 327 * Here the same information contained in the comments above is stored 328 * in inverted form, so that given a lexeme, one can quickly look up 329 * its precedence value. 330 */ 331 332static const unsigned char prec[] = { 333 /* Non-operator lexemes */ 334 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 335 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 336 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 337 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 338 0, 339 /* Binary operator lexemes */ 340 PREC_ADD, /* BINARY_PLUS */ 341 PREC_ADD, /* BINARY_MINUS */ 342 PREC_COMMA, /* COMMA */ 343 PREC_MULT, /* MULT */ 344 PREC_MULT, /* DIVIDE */ 345 PREC_MULT, /* MOD */ 346 PREC_COMPARE, /* LESS */ 347 PREC_COMPARE, /* GREATER */ 348 PREC_BIT_AND, /* BIT_AND */ 349 PREC_BIT_XOR, /* BIT_XOR */ 350 PREC_BIT_OR, /* BIT_OR */ 351 PREC_CONDITIONAL, /* QUESTION */ 352 PREC_CONDITIONAL, /* COLON */ 353 PREC_SHIFT, /* LEFT_SHIFT */ 354 PREC_SHIFT, /* RIGHT_SHIFT */ 355 PREC_COMPARE, /* LEQ */ 356 PREC_COMPARE, /* GEQ */ 357 PREC_EQUAL, /* EQUAL */ 358 PREC_EQUAL, /* NEQ */ 359 PREC_AND, /* AND */ 360 PREC_OR, /* OR */ 361 PREC_EQUAL, /* STREQ */ 362 PREC_EQUAL, /* STRNEQ */ 363 PREC_EXPON, /* EXPON */ 364 PREC_EQUAL, /* IN_LIST */ 365 PREC_EQUAL, /* NOT_IN_LIST */ 366 PREC_CLOSE_PAREN, /* CLOSE_PAREN */ 367 PREC_END, /* END */ 368 /* Expansion room for more binary operators */ 369 0, 0, 0, 370 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 371 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 372 0, 373 /* Unary operator lexemes */ 374 PREC_UNARY, /* UNARY_PLUS */ 375 PREC_UNARY, /* UNARY_MINUS */ 376 PREC_UNARY, /* FUNCTION */ 377 PREC_START, /* START */ 378 PREC_OPEN_PAREN, /* OPEN_PAREN */ 379 PREC_UNARY, /* NOT*/ 380 PREC_UNARY, /* BIT_NOT*/ 381}; 382 383/* 384 * A table mapping lexemes to bytecode instructions, used by CompileExprTree(). 385 */ 386 387static const unsigned char instruction[] = { 388 /* Non-operator lexemes */ 389 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 390 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 391 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 392 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 393 0, 394 /* Binary operator lexemes */ 395 INST_ADD, /* BINARY_PLUS */ 396 INST_SUB, /* BINARY_MINUS */ 397 0, /* COMMA */ 398 INST_MULT, /* MULT */ 399 INST_DIV, /* DIVIDE */ 400 INST_MOD, /* MOD */ 401 INST_LT, /* LESS */ 402 INST_GT, /* GREATER */ 403 INST_BITAND, /* BIT_AND */ 404 INST_BITXOR, /* BIT_XOR */ 405 INST_BITOR, /* BIT_OR */ 406 0, /* QUESTION */ 407 0, /* COLON */ 408 INST_LSHIFT, /* LEFT_SHIFT */ 409 INST_RSHIFT, /* RIGHT_SHIFT */ 410 INST_LE, /* LEQ */ 411 INST_GE, /* GEQ */ 412 INST_EQ, /* EQUAL */ 413 INST_NEQ, /* NEQ */ 414 0, /* AND */ 415 0, /* OR */ 416 INST_STR_EQ, /* STREQ */ 417 INST_STR_NEQ, /* STRNEQ */ 418 INST_EXPON, /* EXPON */ 419 INST_LIST_IN, /* IN_LIST */ 420 INST_LIST_NOT_IN, /* NOT_IN_LIST */ 421 0, /* CLOSE_PAREN */ 422 0, /* END */ 423 /* Expansion room for more binary operators */ 424 0, 0, 0, 425 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 426 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 427 0, 428 /* Unary operator lexemes */ 429 INST_UPLUS, /* UNARY_PLUS */ 430 INST_UMINUS, /* UNARY_MINUS */ 431 0, /* FUNCTION */ 432 0, /* START */ 433 0, /* OPEN_PAREN */ 434 INST_LNOT, /* NOT*/ 435 INST_BITNOT, /* BIT_NOT*/ 436}; 437 438/* 439 * A table mapping a byte value to the corresponding lexeme for use by 440 * ParseLexeme(). 441 */ 442 443static unsigned char Lexeme[] = { 444 INVALID /* NUL */, INVALID /* SOH */, 445 INVALID /* STX */, INVALID /* ETX */, 446 INVALID /* EOT */, INVALID /* ENQ */, 447 INVALID /* ACK */, INVALID /* BEL */, 448 INVALID /* BS */, INVALID /* HT */, 449 INVALID /* LF */, INVALID /* VT */, 450 INVALID /* FF */, INVALID /* CR */, 451 INVALID /* SO */, INVALID /* SI */, 452 INVALID /* DLE */, INVALID /* DC1 */, 453 INVALID /* DC2 */, INVALID /* DC3 */, 454 INVALID /* DC4 */, INVALID /* NAK */, 455 INVALID /* SYN */, INVALID /* ETB */, 456 INVALID /* CAN */, INVALID /* EM */, 457 INVALID /* SUB */, INVALID /* ESC */, 458 INVALID /* FS */, INVALID /* GS */, 459 INVALID /* RS */, INVALID /* US */, 460 INVALID /* SPACE */, 0 /* ! or != */, 461 QUOTED /* " */, INVALID /* # */, 462 VARIABLE /* $ */, MOD /* % */, 463 0 /* & or && */, INVALID /* ' */, 464 OPEN_PAREN /* ( */, CLOSE_PAREN /* ) */, 465 0 /* * or ** */, PLUS /* + */, 466 COMMA /* , */, MINUS /* - */, 467 0 /* . */, DIVIDE /* / */, 468 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 0-9 */ 469 COLON /* : */, INVALID /* ; */, 470 0 /* < or << or <= */, 471 0 /* == or INVALID */, 472 0 /* > or >> or >= */, 473 QUESTION /* ? */, INVALID /* @ */, 474 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* A-M */ 475 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* N-Z */ 476 SCRIPT /* [ */, INVALID /* \ */, 477 INVALID /* ] */, BIT_XOR /* ^ */, 478 INVALID /* _ */, INVALID /* ` */, 479 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* a-m */ 480 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* n-z */ 481 BRACED /* { */, 0 /* | or || */, 482 INVALID /* } */, BIT_NOT /* ~ */, 483 INVALID /* DEL */ 484}; 485 486/* 487 * The JumpList struct is used to create a stack of data needed for the 488 * TclEmitForwardJump() and TclFixupForwardJump() calls that are performed 489 * when compiling the short-circuiting operators QUESTION/COLON, AND, and OR. 490 * Keeping a stack permits the CompileExprTree() routine to be non-recursive. 491 */ 492 493typedef struct JumpList { 494 JumpFixup jump; /* Pass this argument to matching calls of 495 * TclEmitForwardJump() and 496 * TclFixupForwardJump(). */ 497 int depth; /* Remember the currStackDepth of the 498 * CompileEnv here. */ 499 int offset; /* Data used to compute jump lengths to pass 500 * to TclFixupForwardJump() */ 501 int convert; /* Temporary storage used to compute whether 502 * numeric conversion will be needed following 503 * the operator we're compiling. */ 504 struct JumpList *next; /* Point to next item on the stack */ 505} JumpList; 506 507/* 508 * Declarations for local functions to this file: 509 */ 510 511static void CompileExprTree(Tcl_Interp *interp, OpNode *nodes, 512 int index, Tcl_Obj *const **litObjvPtr, 513 Tcl_Obj *const *funcObjv, Tcl_Token *tokenPtr, 514 CompileEnv *envPtr, int optimize); 515static void ConvertTreeToTokens(const char *start, int numBytes, 516 OpNode *nodes, Tcl_Token *tokenPtr, 517 Tcl_Parse *parsePtr); 518static int ExecConstantExprTree(Tcl_Interp *interp, OpNode *nodes, 519 int index, Tcl_Obj * const **litObjvPtr); 520static int ParseExpr(Tcl_Interp *interp, const char *start, 521 int numBytes, OpNode **opTreePtr, 522 Tcl_Obj *litList, Tcl_Obj *funcList, 523 Tcl_Parse *parsePtr, int parseOnly); 524static int ParseLexeme(const char *start, int numBytes, 525 unsigned char *lexemePtr, Tcl_Obj **literalPtr); 526 527 528/* 529 *---------------------------------------------------------------------- 530 * 531 * ParseExpr -- 532 * 533 * Given a string, the numBytes bytes starting at start, this function 534 * parses it as a Tcl expression and constructs a tree representing 535 * the structure of the expression. The caller must pass in empty 536 * lists as the funcList and litList arguments. The elements of the 537 * parsed expression are returned to the caller as that tree, a list of 538 * literal values, a list of function names, and in Tcl_Tokens 539 * added to a Tcl_Parse struct passed in by the caller. 540 * 541 * Results: 542 * If the string is successfully parsed as a valid Tcl expression, TCL_OK 543 * is returned, and data about the expression structure is written to 544 * the last four arguments. If the string cannot be parsed as a valid 545 * Tcl expression, TCL_ERROR is returned, and if interp is non-NULL, an 546 * error message is written to interp. 547 * 548 * Side effects: 549 * Memory will be allocated. If TCL_OK is returned, the caller must 550 * clean up the returned data structures. The (OpNode *) value written 551 * to opTreePtr should be passed to ckfree() and the parsePtr argument 552 * should be passed to Tcl_FreeParse(). The elements appended to the 553 * litList and funcList will automatically be freed whenever the 554 * refcount on those lists indicates they can be freed. 555 * 556 *---------------------------------------------------------------------- 557 */ 558 559static int 560ParseExpr( 561 Tcl_Interp *interp, /* Used for error reporting. */ 562 const char *start, /* Start of source string to parse. */ 563 int numBytes, /* Number of bytes in string. */ 564 OpNode **opTreePtr, /* Points to space where a pointer to the 565 * allocated OpNode tree should go. */ 566 Tcl_Obj *litList, /* List to append literals to. */ 567 Tcl_Obj *funcList, /* List to append function names to. */ 568 Tcl_Parse *parsePtr, /* Structure to fill with tokens representing 569 * those operands that require run time 570 * substitutions. */ 571 int parseOnly) /* A boolean indicating whether the caller's 572 * aim is just a parse, or whether it will go 573 * on to compile the expression. Different 574 * optimizations are appropriate for the 575 * two scenarios. */ 576{ 577 OpNode *nodes = NULL; /* Pointer to the OpNode storage array where 578 * we build the parse tree. */ 579 int nodesAvailable = 64; /* Initial size of the storage array. This 580 * value establishes a minimum tree memory cost 581 * of only about 1 kibyte, and is large enough 582 * for most expressions to parse with no need 583 * for array growth and reallocation. */ 584 int nodesUsed = 0; /* Number of OpNodes filled. */ 585 int scanned = 0; /* Capture number of byte scanned by 586 * parsing routines. */ 587 int lastParsed; /* Stores info about what the lexeme parsed 588 * the previous pass through the parsing loop 589 * was. If it was an operator, lastParsed is 590 * the index of the OpNode for that operator. 591 * If it was not an operator, lastParsed holds 592 * an OperandTypes value encoding what we 593 * need to know about it. */ 594 int incomplete; /* Index of the most recent incomplete tree 595 * in the OpNode array. Heads a stack of 596 * incomplete trees linked by p.prev. */ 597 int complete = OT_EMPTY; /* "Index" of the complete tree (that is, a 598 * complete subexpression) determined at the 599 * moment. OT_EMPTY is a nonsense value 600 * used only to silence compiler warnings. 601 * During a parse, complete will always hold 602 * an index or an OperandTypes value pointing 603 * to an actual leaf at the time the complete 604 * tree is needed. */ 605 606 /* These variables control generation of the error message. */ 607 Tcl_Obj *msg = NULL; /* The error message. */ 608 Tcl_Obj *post = NULL; /* In a few cases, an additional postscript 609 * for the error message, supplying more 610 * information after the error msg and 611 * location have been reported. */ 612 const char *mark = "_@_"; /* In the portion of the complete error message 613 * where the error location is reported, this 614 * "mark" substring is inserted into the 615 * string being parsed to aid in pinpointing 616 * the location of the syntax error in the 617 * expression. */ 618 int insertMark = 0; /* A boolean controlling whether the "mark" 619 * should be inserted. */ 620 const int limit = 25; /* Portions of the error message are 621 * constructed out of substrings of the 622 * original expression. In order to keep the 623 * error message readable, we impose this limit 624 * on the substring size we extract. */ 625 626 TclParseInit(interp, start, numBytes, parsePtr); 627 628 nodes = (OpNode *) attemptckalloc(nodesAvailable * sizeof(OpNode)); 629 if (nodes == NULL) { 630 TclNewLiteralStringObj(msg, "not enough memory to parse expression"); 631 goto error; 632 } 633 634 /* Initialize the parse tree with the special "START" node. */ 635 nodes->lexeme = START; 636 nodes->precedence = prec[START]; 637 nodes->mark = MARK_RIGHT; 638 nodes->constant = 1; 639 incomplete = lastParsed = nodesUsed; 640 nodesUsed++; 641 642 /* 643 * Main parsing loop parses one lexeme per iteration. We exit the 644 * loop only when there's a syntax error with a "goto error" which 645 * takes us to the error handling code following the loop, or when 646 * we've successfully completed the parse and we return to the caller. 647 */ 648 649 while (1) { 650 OpNode *nodePtr; /* Points to the OpNode we may fill this 651 * pass through the loop. */ 652 unsigned char lexeme; /* The lexeme we parse this iteration. */ 653 Tcl_Obj *literal; /* Filled by the ParseLexeme() call when 654 * a literal is parsed that has a Tcl_Obj 655 * rep worth preserving. */ 656 const char *lastStart = start - scanned; 657 /* Compute where the lexeme parsed the 658 * previous pass through the loop began. 659 * This is helpful for detecting invalid 660 * octals and providing more complete error 661 * messages. */ 662 663 /* 664 * Each pass through this loop adds up to one more OpNode. Allocate 665 * space for one if required. 666 */ 667 668 if (nodesUsed >= nodesAvailable) { 669 int size = nodesUsed * 2; 670 OpNode *newPtr; 671 672 do { 673 newPtr = (OpNode *) attemptckrealloc((char *) nodes, 674 (unsigned int) size * sizeof(OpNode)); 675 } while ((newPtr == NULL) 676 && ((size -= (size - nodesUsed) / 2) > nodesUsed)); 677 if (newPtr == NULL) { 678 TclNewLiteralStringObj(msg, 679 "not enough memory to parse expression"); 680 goto error; 681 } 682 nodesAvailable = size; 683 nodes = newPtr; 684 } 685 nodePtr = nodes + nodesUsed; 686 687 /* Skip white space between lexemes. */ 688 scanned = TclParseAllWhiteSpace(start, numBytes); 689 start += scanned; 690 numBytes -= scanned; 691 692 scanned = ParseLexeme(start, numBytes, &lexeme, &literal); 693 694 /* Use context to categorize the lexemes that are ambiguous. */ 695 if ((NODE_TYPE & lexeme) == 0) { 696 switch (lexeme) { 697 case INVALID: 698 msg = Tcl_ObjPrintf( 699 "invalid character \"%.*s\"", scanned, start); 700 goto error; 701 case INCOMPLETE: 702 msg = Tcl_ObjPrintf( 703 "incomplete operator \"%.*s\"", scanned, start); 704 goto error; 705 case BAREWORD: 706 707 /* 708 * Most barewords in an expression are a syntax error. 709 * The exceptions are that when a bareword is followed by 710 * an open paren, it might be a function call, and when the 711 * bareword is a legal literal boolean value, we accept that 712 * as well. 713 */ 714 715 if (start[scanned+TclParseAllWhiteSpace( 716 start+scanned, numBytes-scanned)] == '(') { 717 lexeme = FUNCTION; 718 719 /* 720 * When we compile the expression we'll need the function 721 * name, and there's no place in the parse tree to store 722 * it, so we keep a separate list of all the function 723 * names we've parsed in the order we found them. 724 */ 725 726 Tcl_ListObjAppendElement(NULL, funcList, literal); 727 } else { 728 int b; 729 if (Tcl_GetBooleanFromObj(NULL, literal, &b) == TCL_OK) { 730 lexeme = BOOLEAN; 731 } else { 732 Tcl_DecrRefCount(literal); 733 msg = Tcl_ObjPrintf( 734 "invalid bareword \"%.*s%s\"", 735 (scanned < limit) ? scanned : limit - 3, start, 736 (scanned < limit) ? "" : "..."); 737 post = Tcl_ObjPrintf( 738 "should be \"$%.*s%s\" or \"{%.*s%s}\"", 739 (scanned < limit) ? scanned : limit - 3, 740 start, (scanned < limit) ? "" : "...", 741 (scanned < limit) ? scanned : limit - 3, 742 start, (scanned < limit) ? "" : "..."); 743 Tcl_AppendPrintfToObj(post, 744 " or \"%.*s%s(...)\" or ...", 745 (scanned < limit) ? scanned : limit - 3, 746 start, (scanned < limit) ? "" : "..."); 747 if (NotOperator(lastParsed)) { 748 if ((lastStart[0] == '0') 749 && ((lastStart[1] == 'o') 750 || (lastStart[1] == 'O')) 751 && (lastStart[2] >= '0') 752 && (lastStart[2] <= '9')) { 753 const char *end = lastStart + 2; 754 Tcl_Obj* copy; 755 while (isdigit(UCHAR(*end))) { 756 end++; 757 } 758 copy = Tcl_NewStringObj(lastStart, 759 end - lastStart); 760 if (TclCheckBadOctal(NULL, 761 Tcl_GetString(copy))) { 762 Tcl_AppendToObj(post, 763 "(invalid octal number?)", -1); 764 } 765 Tcl_DecrRefCount(copy); 766 } 767 scanned = 0; 768 insertMark = 1; 769 parsePtr->errorType = TCL_PARSE_BAD_NUMBER; 770 } 771 goto error; 772 } 773 } 774 break; 775 case PLUS: 776 case MINUS: 777 if (IsOperator(lastParsed)) { 778 779 /* 780 * A "+" or "-" coming just after another operator 781 * must be interpreted as a unary operator. 782 */ 783 784 lexeme |= UNARY; 785 } else { 786 lexeme |= BINARY; 787 } 788 } 789 } /* Uncategorized lexemes */ 790 791 /* Handle lexeme based on its category. */ 792 switch (NODE_TYPE & lexeme) { 793 794 /* 795 * Each LEAF results in either a literal getting appended to the 796 * litList, or a sequence of Tcl_Tokens representing a Tcl word 797 * getting appended to the parsePtr->tokens. No OpNode is filled 798 * for this lexeme. 799 */ 800 801 case LEAF: { 802 Tcl_Token *tokenPtr; 803 const char *end = start; 804 int wordIndex; 805 int code = TCL_OK; 806 807 /* 808 * A leaf operand appearing just after something that's not an 809 * operator is a syntax error. 810 */ 811 812 if (NotOperator(lastParsed)) { 813 msg = Tcl_ObjPrintf("missing operator at %s", mark); 814 if (lastStart[0] == '0') { 815 Tcl_Obj *copy = Tcl_NewStringObj(lastStart, 816 start + scanned - lastStart); 817 if (TclCheckBadOctal(NULL, Tcl_GetString(copy))) { 818 TclNewLiteralStringObj(post, 819 "looks like invalid octal number"); 820 } 821 Tcl_DecrRefCount(copy); 822 } 823 scanned = 0; 824 insertMark = 1; 825 parsePtr->errorType = TCL_PARSE_BAD_NUMBER; 826 827 /* Free any literal to avoid a memleak. */ 828 if ((lexeme == NUMBER) || (lexeme == BOOLEAN)) { 829 Tcl_DecrRefCount(literal); 830 } 831 goto error; 832 } 833 834 switch (lexeme) { 835 case NUMBER: 836 case BOOLEAN: 837 /* 838 * TODO: Consider using a dict or hash to collapse all 839 * duplicate literals into a single representative value. 840 * (Like what is done with [split $s {}]). 841 * Pro: ~75% memory saving on expressions like 842 * {1+1+1+1+1+.....+1} (Convert "pointer + Tcl_Obj" cost 843 * to "pointer" cost only) 844 * Con: Cost of the dict store/retrieve on every literal 845 * in every expression when expressions like the above 846 * tend to be uncommon. 847 * The memory savings is temporary; Compiling to bytecode 848 * will collapse things as literals are registered 849 * anyway, so the savings applies only to the time 850 * between parsing and compiling. Possibly important 851 * due to high-water mark nature of memory allocation. 852 */ 853 Tcl_ListObjAppendElement(NULL, litList, literal); 854 complete = lastParsed = OT_LITERAL; 855 start += scanned; 856 numBytes -= scanned; 857 continue; 858 859 default: 860 break; 861 } 862 863 /* 864 * Remaining LEAF cases may involve filling Tcl_Tokens, so 865 * make room for at least 2 more tokens. 866 */ 867 868 TclGrowParseTokenArray(parsePtr, 2); 869 wordIndex = parsePtr->numTokens; 870 tokenPtr = parsePtr->tokenPtr + wordIndex; 871 tokenPtr->type = TCL_TOKEN_WORD; 872 tokenPtr->start = start; 873 parsePtr->numTokens++; 874 875 switch (lexeme) { 876 case QUOTED: 877 code = Tcl_ParseQuotedString(NULL, start, numBytes, 878 parsePtr, 1, &end); 879 scanned = end - start; 880 break; 881 882 case BRACED: 883 code = Tcl_ParseBraces(NULL, start, numBytes, 884 parsePtr, 1, &end); 885 scanned = end - start; 886 break; 887 888 case VARIABLE: 889 code = Tcl_ParseVarName(NULL, start, numBytes, parsePtr, 1); 890 891 /* 892 * Handle the quirk that Tcl_ParseVarName reports a successful 893 * parse even when it gets only a "$" with no variable name. 894 */ 895 896 tokenPtr = parsePtr->tokenPtr + wordIndex + 1; 897 if (code == TCL_OK && tokenPtr->type != TCL_TOKEN_VARIABLE) { 898 TclNewLiteralStringObj(msg, "invalid character \"$\""); 899 goto error; 900 } 901 scanned = tokenPtr->size; 902 break; 903 904 case SCRIPT: { 905 Tcl_Parse *nestedPtr = 906 (Tcl_Parse *) TclStackAlloc(interp, sizeof(Tcl_Parse)); 907 908 tokenPtr = parsePtr->tokenPtr + parsePtr->numTokens; 909 tokenPtr->type = TCL_TOKEN_COMMAND; 910 tokenPtr->start = start; 911 tokenPtr->numComponents = 0; 912 913 end = start + numBytes; 914 start++; 915 while (1) { 916 code = Tcl_ParseCommand(interp, start, (end - start), 1, 917 nestedPtr); 918 if (code != TCL_OK) { 919 parsePtr->term = nestedPtr->term; 920 parsePtr->errorType = nestedPtr->errorType; 921 parsePtr->incomplete = nestedPtr->incomplete; 922 break; 923 } 924 start = (nestedPtr->commandStart + nestedPtr->commandSize); 925 Tcl_FreeParse(nestedPtr); 926 if ((nestedPtr->term < end) && (*(nestedPtr->term) == ']') 927 && !(nestedPtr->incomplete)) { 928 break; 929 } 930 931 if (start == end) { 932 TclNewLiteralStringObj(msg, "missing close-bracket"); 933 parsePtr->term = tokenPtr->start; 934 parsePtr->errorType = TCL_PARSE_MISSING_BRACKET; 935 parsePtr->incomplete = 1; 936 code = TCL_ERROR; 937 break; 938 } 939 } 940 TclStackFree(interp, nestedPtr); 941 end = start; 942 start = tokenPtr->start; 943 scanned = end - start; 944 tokenPtr->size = scanned; 945 parsePtr->numTokens++; 946 break; 947 } 948 } 949 if (code != TCL_OK) { 950 951 /* 952 * Here we handle all the syntax errors generated by 953 * the Tcl_Token generating parsing routines called in the 954 * switch just above. If the value of parsePtr->incomplete 955 * is 1, then the error was an unbalanced '[', '(', '{', 956 * or '"' and parsePtr->term is pointing to that unbalanced 957 * character. If the value of parsePtr->incomplete is 0, 958 * then the error is one of lacking whitespace following a 959 * quoted word, for example: expr {[an error {foo}bar]}, 960 * and parsePtr->term points to where the whitespace is 961 * missing. We reset our values of start and scanned so that 962 * when our error message is constructed, the location of 963 * the syntax error is sure to appear in it, even if the 964 * quoted expression is truncated. 965 */ 966 967 start = parsePtr->term; 968 scanned = parsePtr->incomplete; 969 goto error; 970 } 971 972 tokenPtr = parsePtr->tokenPtr + wordIndex; 973 tokenPtr->size = scanned; 974 tokenPtr->numComponents = parsePtr->numTokens - wordIndex - 1; 975 if (!parseOnly && ((lexeme == QUOTED) || (lexeme == BRACED))) { 976 977 /* 978 * When this expression is destined to be compiled, and a 979 * braced or quoted word within an expression is known at 980 * compile time (no runtime substitutions in it), we can 981 * store it as a literal rather than in its tokenized form. 982 * This is an advantage since the compiled bytecode is going 983 * to need the argument in Tcl_Obj form eventually, so it's 984 * just as well to get there now. Another advantage is that 985 * with this conversion, larger constant expressions might 986 * be grown and optimized. 987 * 988 * On the contrary, if the end goal of this parse is to 989 * fill a Tcl_Parse for a caller of Tcl_ParseExpr(), then it's 990 * wasteful to convert to a literal only to convert back again 991 * later. 992 */ 993 994 literal = Tcl_NewObj(); 995 if (TclWordKnownAtCompileTime(tokenPtr, literal)) { 996 Tcl_ListObjAppendElement(NULL, litList, literal); 997 complete = lastParsed = OT_LITERAL; 998 parsePtr->numTokens = wordIndex; 999 break; 1000 } 1001 Tcl_DecrRefCount(literal); 1002 } 1003 complete = lastParsed = OT_TOKENS; 1004 break; 1005 } /* case LEAF */ 1006 1007 case UNARY: 1008 1009 /* 1010 * A unary operator appearing just after something that's not an 1011 * operator is a syntax error -- something trying to be the left 1012 * operand of an operator that doesn't take one. 1013 */ 1014 1015 if (NotOperator(lastParsed)) { 1016 msg = Tcl_ObjPrintf("missing operator at %s", mark); 1017 scanned = 0; 1018 insertMark = 1; 1019 goto error; 1020 } 1021 1022 /* Create an OpNode for the unary operator */ 1023 nodePtr->lexeme = lexeme; 1024 nodePtr->precedence = prec[lexeme]; 1025 nodePtr->mark = MARK_RIGHT; 1026 1027 /* 1028 * A FUNCTION cannot be a constant expression, because Tcl allows 1029 * functions to return variable results with the same arguments; 1030 * for example, rand(). Other unary operators can root a constant 1031 * expression, so long as the argument is a constant expression. 1032 */ 1033 1034 nodePtr->constant = (lexeme != FUNCTION); 1035 1036 /* 1037 * This unary operator is a new incomplete tree, so push it 1038 * onto our stack of incomplete trees. Also remember it as 1039 * the last lexeme we parsed. 1040 */ 1041 1042 nodePtr->p.prev = incomplete; 1043 incomplete = lastParsed = nodesUsed; 1044 nodesUsed++; 1045 break; 1046 1047 case BINARY: { 1048 OpNode *incompletePtr; 1049 unsigned char precedence = prec[lexeme]; 1050 1051 /* 1052 * A binary operator appearing just after another operator is a 1053 * syntax error -- one of the two operators is missing an operand. 1054 */ 1055 1056 if (IsOperator(lastParsed)) { 1057 if ((lexeme == CLOSE_PAREN) 1058 && (nodePtr[-1].lexeme == OPEN_PAREN)) { 1059 if (nodePtr[-2].lexeme == FUNCTION) { 1060 1061 /* 1062 * Normally, "()" is a syntax error, but as a special 1063 * case accept it as an argument list for a function. 1064 * Treat this as a special LEAF lexeme, and restart 1065 * the parsing loop with zero characters scanned. 1066 * We'll parse the ")" again the next time through, 1067 * but with the OT_EMPTY leaf as the subexpression 1068 * between the parens. 1069 */ 1070 1071 scanned = 0; 1072 complete = lastParsed = OT_EMPTY; 1073 break; 1074 } 1075 msg = Tcl_ObjPrintf("empty subexpression at %s", mark); 1076 scanned = 0; 1077 insertMark = 1; 1078 goto error; 1079 } 1080 1081 if (nodePtr[-1].precedence > precedence) { 1082 if (nodePtr[-1].lexeme == OPEN_PAREN) { 1083 TclNewLiteralStringObj(msg, "unbalanced open paren"); 1084 parsePtr->errorType = TCL_PARSE_MISSING_PAREN; 1085 } else if (nodePtr[-1].lexeme == COMMA) { 1086 msg = Tcl_ObjPrintf( 1087 "missing function argument at %s", mark); 1088 scanned = 0; 1089 insertMark = 1; 1090 } else if (nodePtr[-1].lexeme == START) { 1091 TclNewLiteralStringObj(msg, "empty expression"); 1092 } 1093 } else { 1094 if (lexeme == CLOSE_PAREN) { 1095 TclNewLiteralStringObj(msg, "unbalanced close paren"); 1096 } else if ((lexeme == COMMA) 1097 && (nodePtr[-1].lexeme == OPEN_PAREN) 1098 && (nodePtr[-2].lexeme == FUNCTION)) { 1099 msg = Tcl_ObjPrintf( 1100 "missing function argument at %s", mark); 1101 scanned = 0; 1102 insertMark = 1; 1103 } 1104 } 1105 if (msg == NULL) { 1106 msg = Tcl_ObjPrintf("missing operand at %s", mark); 1107 scanned = 0; 1108 insertMark = 1; 1109 } 1110 goto error; 1111 } 1112 1113 /* 1114 * Here is where the tree comes together. At this point, we 1115 * have a stack of incomplete trees corresponding to 1116 * substrings that are incomplete expressions, followed by 1117 * a complete tree corresponding to a substring that is itself 1118 * a complete expression, followed by the binary operator we have 1119 * just parsed. The incomplete trees can each be completed by 1120 * adding a right operand. 1121 * 1122 * To illustrate with an example, when we parse the expression 1123 * "1+2*3-4" and we reach this point having just parsed the "-" 1124 * operator, we have these incomplete trees: START, "1+", and 1125 * "2*". Next we have the complete subexpression "3". Last is 1126 * the "-" we've just parsed. 1127 * 1128 * The next step is to join our complete tree to an operator. 1129 * The choice is governed by the precedence and associativity 1130 * of the competing operators. If we connect it as the right 1131 * operand of our most recent incomplete tree, we get a new 1132 * complete tree, and we can repeat the process. The while 1133 * loop following repeats this until precedence indicates it 1134 * is time to join the complete tree as the left operand of 1135 * the just parsed binary operator. 1136 * 1137 * Continuing the example, the first pass through the loop 1138 * will join "3" to "2*"; the next pass will join "2*3" to 1139 * "1+". Then we'll exit the loop and join "1+2*3" to "-". 1140 * When we return to parse another lexeme, our stack of 1141 * incomplete trees is START and "1+2*3-". 1142 */ 1143 1144 while (1) { 1145 incompletePtr = nodes + incomplete; 1146 1147 if (incompletePtr->precedence < precedence) { 1148 break; 1149 } 1150 1151 if (incompletePtr->precedence == precedence) { 1152 1153 /* Right association rules for exponentiation. */ 1154 if (lexeme == EXPON) { 1155 break; 1156 } 1157 1158 /* 1159 * Special association rules for the conditional operators. 1160 * The "?" and ":" operators have equal precedence, but 1161 * must be linked up in sensible pairs. 1162 */ 1163 1164 if ((incompletePtr->lexeme == QUESTION) 1165 && (NotOperator(complete) 1166 || (nodes[complete].lexeme != COLON))) { 1167 break; 1168 } 1169 if ((incompletePtr->lexeme == COLON) 1170 && (lexeme == QUESTION)) { 1171 break; 1172 } 1173 } 1174 1175 /* Some special syntax checks... */ 1176 1177 /* Parens must balance */ 1178 if ((incompletePtr->lexeme == OPEN_PAREN) 1179 && (lexeme != CLOSE_PAREN)) { 1180 TclNewLiteralStringObj(msg, "unbalanced open paren"); 1181 parsePtr->errorType = TCL_PARSE_MISSING_PAREN; 1182 goto error; 1183 } 1184 1185 /* Right operand of "?" must be ":" */ 1186 if ((incompletePtr->lexeme == QUESTION) 1187 && (NotOperator(complete) 1188 || (nodes[complete].lexeme != COLON))) { 1189 msg = Tcl_ObjPrintf( 1190 "missing operator \":\" at %s", mark); 1191 scanned = 0; 1192 insertMark = 1; 1193 goto error; 1194 } 1195 1196 /* Operator ":" may only be right operand of "?" */ 1197 if (IsOperator(complete) 1198 && (nodes[complete].lexeme == COLON) 1199 && (incompletePtr->lexeme != QUESTION)) { 1200 TclNewLiteralStringObj(msg, 1201 "unexpected operator \":\" " 1202 "without preceding \"?\""); 1203 goto error; 1204 } 1205 1206 /* 1207 * Attach complete tree as right operand of most recent 1208 * incomplete tree. 1209 */ 1210 1211 incompletePtr->right = complete; 1212 if (IsOperator(complete)) { 1213 nodes[complete].p.parent = incomplete; 1214 incompletePtr->constant = incompletePtr->constant 1215 && nodes[complete].constant; 1216 } else { 1217 incompletePtr->constant = incompletePtr->constant 1218 && (complete == OT_LITERAL); 1219 } 1220 1221 /* 1222 * The QUESTION/COLON and FUNCTION/OPEN_PAREN combinations each 1223 * make up a single operator. Force them to agree whether they 1224 * have a constant expression. 1225 */ 1226 1227 if ((incompletePtr->lexeme == QUESTION) 1228 || (incompletePtr->lexeme == FUNCTION)) { 1229 nodes[complete].constant = incompletePtr->constant; 1230 } 1231 1232 if (incompletePtr->lexeme == START) { 1233 1234 /* 1235 * Completing the START tree indicates we're done. 1236 * Transfer the parse tree to the caller and return. 1237 */ 1238 1239 *opTreePtr = nodes; 1240 return TCL_OK; 1241 } 1242 1243 /* 1244 * With a right operand attached, last incomplete tree has 1245 * become the complete tree. Pop it from the incomplete 1246 * tree stack. 1247 */ 1248 1249 complete = incomplete; 1250 incomplete = incompletePtr->p.prev; 1251 1252 /* CLOSE_PAREN can only close one OPEN_PAREN. */ 1253 if (incompletePtr->lexeme == OPEN_PAREN) { 1254 break; 1255 } 1256 } 1257 1258 /* More syntax checks... */ 1259 1260 /* Parens must balance. */ 1261 if (lexeme == CLOSE_PAREN) { 1262 if (incompletePtr->lexeme != OPEN_PAREN) { 1263 TclNewLiteralStringObj(msg, "unbalanced close paren"); 1264 goto error; 1265 } 1266 } 1267 1268 /* Commas must appear only in function argument lists. */ 1269 if (lexeme == COMMA) { 1270 if ((incompletePtr->lexeme != OPEN_PAREN) 1271 || (incompletePtr[-1].lexeme != FUNCTION)) { 1272 TclNewLiteralStringObj(msg, 1273 "unexpected \",\" outside function argument list"); 1274 goto error; 1275 } 1276 } 1277 1278 /* Operator ":" may only be right operand of "?" */ 1279 if (IsOperator(complete) && (nodes[complete].lexeme == COLON)) { 1280 TclNewLiteralStringObj(msg, 1281 "unexpected operator \":\" without preceding \"?\""); 1282 goto error; 1283 } 1284 1285 /* Create no node for a CLOSE_PAREN lexeme. */ 1286 if (lexeme == CLOSE_PAREN) { 1287 break; 1288 } 1289 1290 /* Link complete tree as left operand of new node. */ 1291 nodePtr->lexeme = lexeme; 1292 nodePtr->precedence = precedence; 1293 nodePtr->mark = MARK_LEFT; 1294 nodePtr->left = complete; 1295 1296 /* 1297 * The COMMA operator cannot be optimized, since the function 1298 * needs all of its arguments, and optimization would reduce 1299 * the number. Other binary operators root constant expressions 1300 * when both arguments are constant expressions. 1301 */ 1302 1303 nodePtr->constant = (lexeme != COMMA); 1304 1305 if (IsOperator(complete)) { 1306 nodes[complete].p.parent = nodesUsed; 1307 nodePtr->constant = nodePtr->constant 1308 && nodes[complete].constant; 1309 } else { 1310 nodePtr->constant = nodePtr->constant 1311 && (complete == OT_LITERAL); 1312 } 1313 1314 /* 1315 * With a left operand attached and a right operand missing, 1316 * the just-parsed binary operator is root of a new incomplete 1317 * tree. Push it onto the stack of incomplete trees. 1318 */ 1319 1320 nodePtr->p.prev = incomplete; 1321 incomplete = lastParsed = nodesUsed; 1322 nodesUsed++; 1323 break; 1324 } /* case BINARY */ 1325 } /* lexeme handler */ 1326 1327 /* Advance past the just-parsed lexeme */ 1328 start += scanned; 1329 numBytes -= scanned; 1330 } /* main parsing loop */ 1331 1332 error: 1333 1334 /* 1335 * We only get here if there's been an error. 1336 * Any errors that didn't get a suitable parsePtr->errorType, 1337 * get recorded as syntax errors. 1338 */ 1339 1340 if (parsePtr->errorType == TCL_PARSE_SUCCESS) { 1341 parsePtr->errorType = TCL_PARSE_SYNTAX; 1342 } 1343 1344 /* Free any partial parse tree we've built. */ 1345 if (nodes != NULL) { 1346 ckfree((char*) nodes); 1347 } 1348 1349 if (interp == NULL) { 1350 1351 /* Nowhere to report an error message, so just free it */ 1352 if (msg) { 1353 Tcl_DecrRefCount(msg); 1354 } 1355 } else { 1356 1357 /* 1358 * Construct the complete error message. Start with the simple 1359 * error message, pulled from the interp result if necessary... 1360 */ 1361 1362 if (msg == NULL) { 1363 msg = Tcl_GetObjResult(interp); 1364 } 1365 1366 /* 1367 * Add a detailed quote from the bad expression, displaying and 1368 * sometimes marking the precise location of the syntax error. 1369 */ 1370 1371 Tcl_AppendPrintfToObj(msg, "\nin expression \"%s%.*s%.*s%s%s%.*s%s\"", 1372 ((start - limit) < parsePtr->string) ? "" : "...", 1373 ((start - limit) < parsePtr->string) 1374 ? (start - parsePtr->string) : limit - 3, 1375 ((start - limit) < parsePtr->string) 1376 ? parsePtr->string : start - limit + 3, 1377 (scanned < limit) ? scanned : limit - 3, start, 1378 (scanned < limit) ? "" : "...", insertMark ? mark : "", 1379 (start + scanned + limit > parsePtr->end) 1380 ? parsePtr->end - (start + scanned) : limit-3, 1381 start + scanned, 1382 (start + scanned + limit > parsePtr->end) ? "" : "..."); 1383 1384 /* Next, append any postscript message. */ 1385 if (post != NULL) { 1386 Tcl_AppendToObj(msg, ";\n", -1); 1387 Tcl_AppendObjToObj(msg, post); 1388 Tcl_DecrRefCount(post); 1389 } 1390 Tcl_SetObjResult(interp, msg); 1391 1392 /* Finally, place context information in the errorInfo. */ 1393 numBytes = parsePtr->end - parsePtr->string; 1394 Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( 1395 "\n (parsing expression \"%.*s%s\")", 1396 (numBytes < limit) ? numBytes : limit - 3, 1397 parsePtr->string, (numBytes < limit) ? "" : "...")); 1398 } 1399 1400 return TCL_ERROR; 1401} 1402 1403/* 1404 *---------------------------------------------------------------------- 1405 * 1406 * ConvertTreeToTokens -- 1407 * 1408 * Given a string, the numBytes bytes starting at start, and an OpNode 1409 * tree and Tcl_Token array created by passing that same string to 1410 * ParseExpr(), this function writes into *parsePtr the sequence of 1411 * Tcl_Tokens needed so to satisfy the historical interface provided 1412 * by Tcl_ParseExpr(). Note that this routine exists only for the sake 1413 * of the public Tcl_ParseExpr() routine. It is not used by Tcl itself 1414 * at all. 1415 * 1416 * Results: 1417 * None. 1418 * 1419 * Side effects: 1420 * The Tcl_Parse *parsePtr is filled with Tcl_Tokens representing the 1421 * parsed expression. 1422 * 1423 *---------------------------------------------------------------------- 1424 */ 1425 1426static void 1427ConvertTreeToTokens( 1428 const char *start, 1429 int numBytes, 1430 OpNode *nodes, 1431 Tcl_Token *tokenPtr, 1432 Tcl_Parse *parsePtr) 1433{ 1434 int subExprTokenIdx = 0; 1435 OpNode *nodePtr = nodes; 1436 int next = nodePtr->right; 1437 1438 while (1) { 1439 Tcl_Token *subExprTokenPtr; 1440 int scanned, parentIdx; 1441 unsigned char lexeme; 1442 1443 /* 1444 * Advance the mark so the next exit from this node won't retrace 1445 * steps over ground already covered. 1446 */ 1447 1448 nodePtr->mark++; 1449 1450 /* Handle next child node or leaf */ 1451 switch (next) { 1452 case OT_EMPTY: 1453 1454 /* No tokens and no characters for the OT_EMPTY leaf. */ 1455 break; 1456 1457 case OT_LITERAL: 1458 1459 /* Skip any white space that comes before the literal */ 1460 scanned = TclParseAllWhiteSpace(start, numBytes); 1461 start +=scanned; 1462 numBytes -= scanned; 1463 1464 /* Reparse the literal to get pointers into source string */ 1465 scanned = ParseLexeme(start, numBytes, &lexeme, NULL); 1466 1467 TclGrowParseTokenArray(parsePtr, 2); 1468 subExprTokenPtr = parsePtr->tokenPtr + parsePtr->numTokens; 1469 subExprTokenPtr->type = TCL_TOKEN_SUB_EXPR; 1470 subExprTokenPtr->start = start; 1471 subExprTokenPtr->size = scanned; 1472 subExprTokenPtr->numComponents = 1; 1473 subExprTokenPtr[1].type = TCL_TOKEN_TEXT; 1474 subExprTokenPtr[1].start = start; 1475 subExprTokenPtr[1].size = scanned; 1476 subExprTokenPtr[1].numComponents = 0; 1477 1478 parsePtr->numTokens += 2; 1479 start +=scanned; 1480 numBytes -= scanned; 1481 break; 1482 1483 case OT_TOKENS: { 1484 1485 /* 1486 * tokenPtr points to a token sequence that came from parsing 1487 * a Tcl word. A Tcl word is made up of a sequence of one or 1488 * more elements. When the word is only a single element, it's 1489 * been the historical practice to replace the TCL_TOKEN_WORD 1490 * token directly with a TCL_TOKEN_SUB_EXPR token. However, 1491 * when the word has multiple elements, a TCL_TOKEN_WORD token 1492 * is kept as a grouping device so that TCL_TOKEN_SUB_EXPR 1493 * always has only one element. Wise or not, these are the 1494 * rules the Tcl expr parser has followed, and for the sake 1495 * of those few callers of Tcl_ParseExpr() we do not change 1496 * them now. Internally, we can do better. 1497 */ 1498 1499 int toCopy = tokenPtr->numComponents + 1; 1500 1501 if (tokenPtr->numComponents == tokenPtr[1].numComponents + 1) { 1502 1503 /* 1504 * Single element word. Copy tokens and convert the leading 1505 * token to TCL_TOKEN_SUB_EXPR. 1506 */ 1507 1508 TclGrowParseTokenArray(parsePtr, toCopy); 1509 subExprTokenPtr = parsePtr->tokenPtr + parsePtr->numTokens; 1510 memcpy(subExprTokenPtr, tokenPtr, 1511 (size_t) toCopy * sizeof(Tcl_Token)); 1512 subExprTokenPtr->type = TCL_TOKEN_SUB_EXPR; 1513 parsePtr->numTokens += toCopy; 1514 } else { 1515 1516 /* 1517 * Multiple element word. Create a TCL_TOKEN_SUB_EXPR 1518 * token to lead, with fields initialized from the leading 1519 * token, then copy entire set of word tokens. 1520 */ 1521 1522 TclGrowParseTokenArray(parsePtr, toCopy+1); 1523 subExprTokenPtr = parsePtr->tokenPtr + parsePtr->numTokens; 1524 *subExprTokenPtr = *tokenPtr; 1525 subExprTokenPtr->type = TCL_TOKEN_SUB_EXPR; 1526 subExprTokenPtr->numComponents++; 1527 subExprTokenPtr++; 1528 memcpy(subExprTokenPtr, tokenPtr, 1529 (size_t) toCopy * sizeof(Tcl_Token)); 1530 parsePtr->numTokens += toCopy + 1; 1531 } 1532 1533 scanned = tokenPtr->start + tokenPtr->size - start; 1534 start +=scanned; 1535 numBytes -= scanned; 1536 tokenPtr += toCopy; 1537 break; 1538 } 1539 1540 default: 1541 1542 /* Advance to the child node, which is an operator. */ 1543 nodePtr = nodes + next; 1544 1545 /* Skip any white space that comes before the subexpression */ 1546 scanned = TclParseAllWhiteSpace(start, numBytes); 1547 start +=scanned; 1548 numBytes -= scanned; 1549 1550 /* Generate tokens for the operator / subexpression... */ 1551 switch (nodePtr->lexeme) { 1552 case OPEN_PAREN: 1553 case COMMA: 1554 case COLON: 1555 1556 /* 1557 * Historical practice has been to have no Tcl_Tokens for 1558 * these operators. 1559 */ 1560 1561 break; 1562 1563 default: { 1564 1565 /* 1566 * Remember the index of the last subexpression we were 1567 * working on -- that of our parent. We'll stack it later. 1568 */ 1569 1570 parentIdx = subExprTokenIdx; 1571 1572 /* 1573 * Verify space for the two leading Tcl_Tokens representing 1574 * the subexpression rooted by this operator. The first 1575 * Tcl_Token will be of type TCL_TOKEN_SUB_EXPR; the second 1576 * of type TCL_TOKEN_OPERATOR. 1577 */ 1578 1579 TclGrowParseTokenArray(parsePtr, 2); 1580 subExprTokenIdx = parsePtr->numTokens; 1581 subExprTokenPtr = parsePtr->tokenPtr + subExprTokenIdx; 1582 parsePtr->numTokens += 2; 1583 subExprTokenPtr->type = TCL_TOKEN_SUB_EXPR; 1584 subExprTokenPtr[1].type = TCL_TOKEN_OPERATOR; 1585 1586 /* 1587 * Our current position scanning the string is the starting 1588 * point for this subexpression. 1589 */ 1590 1591 subExprTokenPtr->start = start; 1592 1593 /* 1594 * Eventually, we know that the numComponents field of the 1595 * Tcl_Token of type TCL_TOKEN_OPERATOR will be 0. This means 1596 * we can make other use of this field for now to track the 1597 * stack of subexpressions we have pending. 1598 */ 1599 1600 subExprTokenPtr[1].numComponents = parentIdx; 1601 break; 1602 } 1603 } 1604 break; 1605 } 1606 1607 /* Determine which way to exit the node on this pass. */ 1608 router: 1609 switch (nodePtr->mark) { 1610 case MARK_LEFT: 1611 next = nodePtr->left; 1612 break; 1613 1614 case MARK_RIGHT: 1615 next = nodePtr->right; 1616 1617 /* Skip any white space that comes before the operator */ 1618 scanned = TclParseAllWhiteSpace(start, numBytes); 1619 start +=scanned; 1620 numBytes -= scanned; 1621 1622 /* 1623 * Here we scan from the string the operator corresponding to 1624 * nodePtr->lexeme. 1625 */ 1626 1627 scanned = ParseLexeme(start, numBytes, &lexeme, NULL); 1628 1629 switch(nodePtr->lexeme) { 1630 case OPEN_PAREN: 1631 case COMMA: 1632 case COLON: 1633 1634 /* No tokens for these lexemes -> nothing to do. */ 1635 break; 1636 1637 default: 1638 1639 /* 1640 * Record in the TCL_TOKEN_OPERATOR token the pointers into 1641 * the string marking where the operator is. 1642 */ 1643 1644 subExprTokenPtr = parsePtr->tokenPtr + subExprTokenIdx; 1645 subExprTokenPtr[1].start = start; 1646 subExprTokenPtr[1].size = scanned; 1647 break; 1648 } 1649 1650 start +=scanned; 1651 numBytes -= scanned; 1652 break; 1653 1654 case MARK_PARENT: 1655 switch (nodePtr->lexeme) { 1656 case START: 1657 1658 /* When we get back to the START node, we're done. */ 1659 return; 1660 1661 case COMMA: 1662 case COLON: 1663 1664 /* No tokens for these lexemes -> nothing to do. */ 1665 break; 1666 1667 case OPEN_PAREN: 1668 1669 /* Skip past matching close paren. */ 1670 scanned = TclParseAllWhiteSpace(start, numBytes); 1671 start +=scanned; 1672 numBytes -= scanned; 1673 scanned = ParseLexeme(start, numBytes, &lexeme, NULL); 1674 start +=scanned; 1675 numBytes -= scanned; 1676 break; 1677 1678 default: { 1679 1680 /* 1681 * Before we leave this node/operator/subexpression for the 1682 * last time, finish up its tokens.... 1683 * 1684 * Our current position scanning the string is where the 1685 * substring for the subexpression ends. 1686 */ 1687 1688 subExprTokenPtr = parsePtr->tokenPtr + subExprTokenIdx; 1689 subExprTokenPtr->size = start - subExprTokenPtr->start; 1690 1691 /* 1692 * All the Tcl_Tokens allocated and filled belong to 1693 * this subexpresion. The first token is the leading 1694 * TCL_TOKEN_SUB_EXPR token, and all the rest (one fewer) 1695 * are its components. 1696 */ 1697 1698 subExprTokenPtr->numComponents = 1699 (parsePtr->numTokens - subExprTokenIdx) - 1; 1700 1701 /* 1702 * Finally, as we return up the tree to our parent, pop the 1703 * parent subexpression off our subexpression stack, and 1704 * fill in the zero numComponents for the operator Tcl_Token. 1705 */ 1706 1707 parentIdx = subExprTokenPtr[1].numComponents; 1708 subExprTokenPtr[1].numComponents = 0; 1709 subExprTokenIdx = parentIdx; 1710 break; 1711 } 1712 } 1713 1714 /* Since we're returning to parent, skip child handling code. */ 1715 nodePtr = nodes + nodePtr->p.parent; 1716 goto router; 1717 } 1718 } 1719} 1720 1721/* 1722 *---------------------------------------------------------------------- 1723 * 1724 * Tcl_ParseExpr -- 1725 * 1726 * Given a string, the numBytes bytes starting at start, this function 1727 * parses it as a Tcl expression and stores information about the 1728 * structure of the expression in the Tcl_Parse struct indicated by the 1729 * caller. 1730 * 1731 * Results: 1732 * If the string is successfully parsed as a valid Tcl expression, TCL_OK 1733 * is returned, and data about the expression structure is written to 1734 * *parsePtr. If the string cannot be parsed as a valid Tcl expression, 1735 * TCL_ERROR is returned, and if interp is non-NULL, an error message is 1736 * written to interp. 1737 * 1738 * Side effects: 1739 * If there is insufficient space in parsePtr to hold all the information 1740 * about the expression, then additional space is malloc-ed. If the 1741 * function returns TCL_OK then the caller must eventually invoke 1742 * Tcl_FreeParse to release any additional space that was allocated. 1743 * 1744 *---------------------------------------------------------------------- 1745 */ 1746 1747int 1748Tcl_ParseExpr( 1749 Tcl_Interp *interp, /* Used for error reporting. */ 1750 const char *start, /* Start of source string to parse. */ 1751 int numBytes, /* Number of bytes in string. If < 0, the 1752 * string consists of all bytes up to the 1753 * first null character. */ 1754 Tcl_Parse *parsePtr) /* Structure to fill with information about 1755 * the parsed expression; any previous 1756 * information in the structure is ignored. */ 1757{ 1758 int code; 1759 OpNode *opTree = NULL; /* Will point to the tree of operators */ 1760 Tcl_Obj *litList = Tcl_NewObj(); /* List to hold the literals */ 1761 Tcl_Obj *funcList = Tcl_NewObj(); /* List to hold the functon names*/ 1762 Tcl_Parse *exprParsePtr = 1763 (Tcl_Parse *) TclStackAlloc(interp, sizeof(Tcl_Parse)); 1764 /* Holds the Tcl_Tokens of substitutions */ 1765 1766 if (numBytes < 0) { 1767 numBytes = (start ? strlen(start) : 0); 1768 } 1769 1770 code = ParseExpr(interp, start, numBytes, &opTree, litList, 1771 funcList, exprParsePtr, 1 /* parseOnly */); 1772 Tcl_DecrRefCount(funcList); 1773 Tcl_DecrRefCount(litList); 1774 1775 TclParseInit(interp, start, numBytes, parsePtr); 1776 if (code == TCL_OK) { 1777 ConvertTreeToTokens(start, numBytes, 1778 opTree, exprParsePtr->tokenPtr, parsePtr); 1779 } else { 1780 parsePtr->term = exprParsePtr->term; 1781 parsePtr->errorType = exprParsePtr->errorType; 1782 } 1783 1784 Tcl_FreeParse(exprParsePtr); 1785 TclStackFree(interp, exprParsePtr); 1786 ckfree((char *) opTree); 1787 return code; 1788} 1789 1790/* 1791 *---------------------------------------------------------------------- 1792 * 1793 * ParseLexeme -- 1794 * 1795 * Parse a single lexeme from the start of a string, scanning no more 1796 * than numBytes bytes. 1797 * 1798 * Results: 1799 * Returns the number of bytes scanned to produce the lexeme. 1800 * 1801 * Side effects: 1802 * Code identifying lexeme parsed is writen to *lexemePtr. 1803 * 1804 *---------------------------------------------------------------------- 1805 */ 1806 1807static int 1808ParseLexeme( 1809 const char *start, /* Start of lexeme to parse. */ 1810 int numBytes, /* Number of bytes in string. */ 1811 unsigned char *lexemePtr, /* Write code of parsed lexeme to this 1812 * storage. */ 1813 Tcl_Obj **literalPtr) /* Write corresponding literal value to this 1814 storage, if non-NULL. */ 1815{ 1816 const char *end; 1817 int scanned; 1818 Tcl_UniChar ch; 1819 Tcl_Obj *literal = NULL; 1820 unsigned char byte; 1821 1822 if (numBytes == 0) { 1823 *lexemePtr = END; 1824 return 0; 1825 } 1826 byte = (unsigned char)(*start); 1827 if (byte < sizeof(Lexeme) && Lexeme[byte] != 0) { 1828 *lexemePtr = Lexeme[byte]; 1829 return 1; 1830 } 1831 switch (byte) { 1832 case '*': 1833 if ((numBytes > 1) && (start[1] == '*')) { 1834 *lexemePtr = EXPON; 1835 return 2; 1836 } 1837 *lexemePtr = MULT; 1838 return 1; 1839 1840 case '=': 1841 if ((numBytes > 1) && (start[1] == '=')) { 1842 *lexemePtr = EQUAL; 1843 return 2; 1844 } 1845 *lexemePtr = INCOMPLETE; 1846 return 1; 1847 1848 case '!': 1849 if ((numBytes > 1) && (start[1] == '=')) { 1850 *lexemePtr = NEQ; 1851 return 2; 1852 } 1853 *lexemePtr = NOT; 1854 return 1; 1855 1856 case '&': 1857 if ((numBytes > 1) && (start[1] == '&')) { 1858 *lexemePtr = AND; 1859 return 2; 1860 } 1861 *lexemePtr = BIT_AND; 1862 return 1; 1863 1864 case '|': 1865 if ((numBytes > 1) && (start[1] == '|')) { 1866 *lexemePtr = OR; 1867 return 2; 1868 } 1869 *lexemePtr = BIT_OR; 1870 return 1; 1871 1872 case '<': 1873 if (numBytes > 1) { 1874 switch (start[1]) { 1875 case '<': 1876 *lexemePtr = LEFT_SHIFT; 1877 return 2; 1878 case '=': 1879 *lexemePtr = LEQ; 1880 return 2; 1881 } 1882 } 1883 *lexemePtr = LESS; 1884 return 1; 1885 1886 case '>': 1887 if (numBytes > 1) { 1888 switch (start[1]) { 1889 case '>': 1890 *lexemePtr = RIGHT_SHIFT; 1891 return 2; 1892 case '=': 1893 *lexemePtr = GEQ; 1894 return 2; 1895 } 1896 } 1897 *lexemePtr = GREATER; 1898 return 1; 1899 1900 case 'i': 1901 if ((numBytes > 1) && (start[1] == 'n') 1902 && ((numBytes == 2) || !isalpha(UCHAR(start[2])))) { 1903 1904 /* 1905 * Must make this check so we can tell the difference between 1906 * the "in" operator and the "int" function name and the 1907 * "infinity" numeric value. 1908 */ 1909 1910 *lexemePtr = IN_LIST; 1911 return 2; 1912 } 1913 break; 1914 1915 case 'e': 1916 if ((numBytes > 1) && (start[1] == 'q') 1917 && ((numBytes == 2) || !isalpha(UCHAR(start[2])))) { 1918 *lexemePtr = STREQ; 1919 return 2; 1920 } 1921 break; 1922 1923 case 'n': 1924 if ((numBytes > 1) && ((numBytes == 2) || !isalpha(UCHAR(start[2])))) { 1925 switch (start[1]) { 1926 case 'e': 1927 *lexemePtr = STRNEQ; 1928 return 2; 1929 case 'i': 1930 *lexemePtr = NOT_IN_LIST; 1931 return 2; 1932 } 1933 } 1934 } 1935 1936 literal = Tcl_NewObj(); 1937 if (TclParseNumber(NULL, literal, NULL, start, numBytes, &end, 1938 TCL_PARSE_NO_WHITESPACE) == TCL_OK) { 1939 TclInitStringRep(literal, start, end-start); 1940 *lexemePtr = NUMBER; 1941 if (literalPtr) { 1942 *literalPtr = literal; 1943 } else { 1944 Tcl_DecrRefCount(literal); 1945 } 1946 return (end-start); 1947 } 1948 1949 if (Tcl_UtfCharComplete(start, numBytes)) { 1950 scanned = Tcl_UtfToUniChar(start, &ch); 1951 } else { 1952 char utfBytes[TCL_UTF_MAX]; 1953 memcpy(utfBytes, start, (size_t) numBytes); 1954 utfBytes[numBytes] = '\0'; 1955 scanned = Tcl_UtfToUniChar(utfBytes, &ch); 1956 } 1957 if (!isalpha(UCHAR(ch))) { 1958 *lexemePtr = INVALID; 1959 Tcl_DecrRefCount(literal); 1960 return scanned; 1961 } 1962 end = start; 1963 while (isalnum(UCHAR(ch)) || (UCHAR(ch) == '_')) { 1964 end += scanned; 1965 numBytes -= scanned; 1966 if (Tcl_UtfCharComplete(end, numBytes)) { 1967 scanned = Tcl_UtfToUniChar(end, &ch); 1968 } else { 1969 char utfBytes[TCL_UTF_MAX]; 1970 memcpy(utfBytes, end, (size_t) numBytes); 1971 utfBytes[numBytes] = '\0'; 1972 scanned = Tcl_UtfToUniChar(utfBytes, &ch); 1973 } 1974 } 1975 *lexemePtr = BAREWORD; 1976 if (literalPtr) { 1977 Tcl_SetStringObj(literal, start, (int) (end-start)); 1978 *literalPtr = literal; 1979 } else { 1980 Tcl_DecrRefCount(literal); 1981 } 1982 return (end-start); 1983} 1984 1985/* 1986 *---------------------------------------------------------------------- 1987 * 1988 * TclCompileExpr -- 1989 * 1990 * This procedure compiles a string containing a Tcl expression into Tcl 1991 * bytecodes. 1992 * 1993 * Results: 1994 * None. 1995 * 1996 * Side effects: 1997 * Adds instructions to envPtr to evaluate the expression at runtime. 1998 * 1999 *---------------------------------------------------------------------- 2000 */ 2001 2002void 2003TclCompileExpr( 2004 Tcl_Interp *interp, /* Used for error reporting. */ 2005 const char *script, /* The source script to compile. */ 2006 int numBytes, /* Number of bytes in script. */ 2007 CompileEnv *envPtr, /* Holds resulting instructions. */ 2008 int optimize) /* 0 for one-off expressions */ 2009{ 2010 OpNode *opTree = NULL; /* Will point to the tree of operators */ 2011 Tcl_Obj *litList = Tcl_NewObj(); /* List to hold the literals */ 2012 Tcl_Obj *funcList = Tcl_NewObj(); /* List to hold the functon names*/ 2013 Tcl_Parse *parsePtr = 2014 (Tcl_Parse *) TclStackAlloc(interp, sizeof(Tcl_Parse)); 2015 /* Holds the Tcl_Tokens of substitutions */ 2016 2017 int code = ParseExpr(interp, script, numBytes, &opTree, litList, 2018 funcList, parsePtr, 0 /* parseOnly */); 2019 2020 if (code == TCL_OK) { 2021 2022 /* Valid parse; compile the tree. */ 2023 int objc; 2024 Tcl_Obj *const *litObjv; 2025 Tcl_Obj **funcObjv; 2026 2027 /* TIP #280 : Track Lines within the expression */ 2028 TclAdvanceLines(&envPtr->line, script, 2029 script + TclParseAllWhiteSpace(script, numBytes)); 2030 2031 TclListObjGetElements(NULL, litList, &objc, (Tcl_Obj ***)&litObjv); 2032 TclListObjGetElements(NULL, funcList, &objc, &funcObjv); 2033 CompileExprTree(interp, opTree, 0, &litObjv, funcObjv, 2034 parsePtr->tokenPtr, envPtr, optimize); 2035 } else { 2036 TclCompileSyntaxError(interp, envPtr); 2037 } 2038 2039 Tcl_FreeParse(parsePtr); 2040 TclStackFree(interp, parsePtr); 2041 Tcl_DecrRefCount(funcList); 2042 Tcl_DecrRefCount(litList); 2043 ckfree((char *) opTree); 2044} 2045 2046/* 2047 *---------------------------------------------------------------------- 2048 * 2049 * ExecConstantExprTree -- 2050 * Compiles and executes bytecode for the subexpression tree at index 2051 * in the nodes array. This subexpression must be constant, made up 2052 * of only constant operators (not functions) and literals. 2053 * 2054 * Results: 2055 * A standard Tcl return code and result left in interp. 2056 * 2057 * Side effects: 2058 * Consumes subtree of nodes rooted at index. Advances the pointer 2059 * *litObjvPtr. 2060 * 2061 *---------------------------------------------------------------------- 2062 */ 2063 2064static int 2065ExecConstantExprTree( 2066 Tcl_Interp *interp, 2067 OpNode *nodes, 2068 int index, 2069 Tcl_Obj *const **litObjvPtr) 2070{ 2071 CompileEnv *envPtr; 2072 ByteCode *byteCodePtr; 2073 int code; 2074 Tcl_Obj *byteCodeObj = Tcl_NewObj(); 2075 2076 /* 2077 * Note we are compiling an expression with literal arguments. This means 2078 * there can be no [info frame] calls when we execute the resulting 2079 * bytecode, so there's no need to tend to TIP 280 issues. 2080 */ 2081 2082 envPtr = (CompileEnv *) TclStackAlloc(interp, sizeof(CompileEnv)); 2083 TclInitCompileEnv(interp, envPtr, NULL, 0, NULL, 0); 2084 CompileExprTree(interp, nodes, index, litObjvPtr, NULL, NULL, envPtr, 2085 0 /* optimize */); 2086 TclEmitOpcode(INST_DONE, envPtr); 2087 Tcl_IncrRefCount(byteCodeObj); 2088 TclInitByteCodeObj(byteCodeObj, envPtr); 2089 TclFreeCompileEnv(envPtr); 2090 TclStackFree(interp, envPtr); 2091 byteCodePtr = (ByteCode *) byteCodeObj->internalRep.otherValuePtr; 2092 code = TclExecuteByteCode(interp, byteCodePtr); 2093 Tcl_DecrRefCount(byteCodeObj); 2094 return code; 2095} 2096 2097/* 2098 *---------------------------------------------------------------------- 2099 * 2100 * CompileExprTree -- 2101 * Compiles and writes to envPtr instructions for the subexpression 2102 * tree at index in the nodes array. (*litObjvPtr) must point to the 2103 * proper location in a corresponding literals list. Likewise, when 2104 * non-NULL, funcObjv and tokenPtr must point into matching arrays of 2105 * function names and Tcl_Token's derived from earlier call to 2106 * ParseExpr(). When optimize is true, any constant subexpressions 2107 * will be precomputed. 2108 * 2109 * Results: 2110 * None. 2111 * 2112 * Side effects: 2113 * Adds instructions to envPtr to evaluate the expression at runtime. 2114 * Consumes subtree of nodes rooted at index. Advances the pointer 2115 * *litObjvPtr. 2116 * 2117 *---------------------------------------------------------------------- 2118 */ 2119 2120static void 2121CompileExprTree( 2122 Tcl_Interp *interp, 2123 OpNode *nodes, 2124 int index, 2125 Tcl_Obj *const **litObjvPtr, 2126 Tcl_Obj *const *funcObjv, 2127 Tcl_Token *tokenPtr, 2128 CompileEnv *envPtr, 2129 int optimize) 2130{ 2131 OpNode *nodePtr = nodes + index; 2132 OpNode *rootPtr = nodePtr; 2133 int numWords = 0; 2134 JumpList *jumpPtr = NULL; 2135 int convert = 1; 2136 2137 while (1) { 2138 int next; 2139 JumpList *freePtr, *newJump; 2140 2141 if (nodePtr->mark == MARK_LEFT) { 2142 next = nodePtr->left; 2143 2144 switch (nodePtr->lexeme) { 2145 case QUESTION: 2146 newJump = (JumpList *) TclStackAlloc(interp, sizeof(JumpList)); 2147 newJump->next = jumpPtr; 2148 jumpPtr = newJump; 2149 newJump = (JumpList *) TclStackAlloc(interp, sizeof(JumpList)); 2150 newJump->next = jumpPtr; 2151 jumpPtr = newJump; 2152 jumpPtr->depth = envPtr->currStackDepth; 2153 convert = 1; 2154 break; 2155 case AND: 2156 case OR: 2157 newJump = (JumpList *) TclStackAlloc(interp, sizeof(JumpList)); 2158 newJump->next = jumpPtr; 2159 jumpPtr = newJump; 2160 newJump = (JumpList *) TclStackAlloc(interp, sizeof(JumpList)); 2161 newJump->next = jumpPtr; 2162 jumpPtr = newJump; 2163 newJump = (JumpList *) TclStackAlloc(interp, sizeof(JumpList)); 2164 newJump->next = jumpPtr; 2165 jumpPtr = newJump; 2166 jumpPtr->depth = envPtr->currStackDepth; 2167 break; 2168 } 2169 } else if (nodePtr->mark == MARK_RIGHT) { 2170 next = nodePtr->right; 2171 2172 switch (nodePtr->lexeme) { 2173 case FUNCTION: { 2174 Tcl_DString cmdName; 2175 const char *p; 2176 int length; 2177 2178 Tcl_DStringInit(&cmdName); 2179 Tcl_DStringAppend(&cmdName, "tcl::mathfunc::", -1); 2180 p = TclGetStringFromObj(*funcObjv, &length); 2181 funcObjv++; 2182 Tcl_DStringAppend(&cmdName, p, length); 2183 TclEmitPush(TclRegisterNewNSLiteral(envPtr, 2184 Tcl_DStringValue(&cmdName), 2185 Tcl_DStringLength(&cmdName)), envPtr); 2186 Tcl_DStringFree(&cmdName); 2187 2188 /* 2189 * Start a count of the number of words in this function 2190 * command invocation. In case there's already a count 2191 * in progress (nested functions), save it in our unused 2192 * "left" field for restoring later. 2193 */ 2194 2195 nodePtr->left = numWords; 2196 numWords = 2; /* Command plus one argument */ 2197 break; 2198 } 2199 case QUESTION: 2200 TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, &(jumpPtr->jump)); 2201 break; 2202 case COLON: 2203 TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, 2204 &(jumpPtr->next->jump)); 2205 envPtr->currStackDepth = jumpPtr->depth; 2206 jumpPtr->offset = (envPtr->codeNext - envPtr->codeStart); 2207 jumpPtr->convert = convert; 2208 convert = 1; 2209 break; 2210 case AND: 2211 TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, &(jumpPtr->jump)); 2212 break; 2213 case OR: 2214 TclEmitForwardJump(envPtr, TCL_TRUE_JUMP, &(jumpPtr->jump)); 2215 break; 2216 } 2217 } else { 2218 switch (nodePtr->lexeme) { 2219 case START: 2220 case QUESTION: 2221 if (convert && (nodePtr == rootPtr)) { 2222 TclEmitOpcode(INST_TRY_CVT_TO_NUMERIC, envPtr); 2223 } 2224 break; 2225 case OPEN_PAREN: 2226 2227 /* do nothing */ 2228 break; 2229 case FUNCTION: 2230 2231 /* 2232 * Use the numWords count we've kept to invoke the 2233 * function command with the correct number of arguments. 2234 */ 2235 2236 if (numWords < 255) { 2237 TclEmitInstInt1(INST_INVOKE_STK1, numWords, envPtr); 2238 } else { 2239 TclEmitInstInt4(INST_INVOKE_STK4, numWords, envPtr); 2240 } 2241 2242 /* Restore any saved numWords value. */ 2243 numWords = nodePtr->left; 2244 convert = 1; 2245 break; 2246 case COMMA: 2247 2248 /* Each comma implies another function argument. */ 2249 numWords++; 2250 break; 2251 case COLON: 2252 if (TclFixupForwardJump(envPtr, &(jumpPtr->next->jump), 2253 (envPtr->codeNext - envPtr->codeStart) 2254 - jumpPtr->next->jump.codeOffset, 127)) { 2255 jumpPtr->offset += 3; 2256 } 2257 TclFixupForwardJump(envPtr, &(jumpPtr->jump), 2258 jumpPtr->offset - jumpPtr->jump.codeOffset, 127); 2259 convert |= jumpPtr->convert; 2260 envPtr->currStackDepth = jumpPtr->depth + 1; 2261 freePtr = jumpPtr; 2262 jumpPtr = jumpPtr->next; 2263 TclStackFree(interp, freePtr); 2264 freePtr = jumpPtr; 2265 jumpPtr = jumpPtr->next; 2266 TclStackFree(interp, freePtr); 2267 break; 2268 case AND: 2269 case OR: 2270 TclEmitForwardJump(envPtr, (nodePtr->lexeme == AND) 2271 ? TCL_FALSE_JUMP : TCL_TRUE_JUMP, 2272 &(jumpPtr->next->jump)); 2273 TclEmitPush(TclRegisterNewLiteral(envPtr, 2274 (nodePtr->lexeme == AND) ? "1" : "0", 1), envPtr); 2275 TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, 2276 &(jumpPtr->next->next->jump)); 2277 TclFixupForwardJumpToHere(envPtr, &(jumpPtr->next->jump), 127); 2278 if (TclFixupForwardJumpToHere(envPtr, &(jumpPtr->jump), 127)) { 2279 jumpPtr->next->next->jump.codeOffset += 3; 2280 } 2281 TclEmitPush(TclRegisterNewLiteral(envPtr, 2282 (nodePtr->lexeme == AND) ? "0" : "1", 1), envPtr); 2283 TclFixupForwardJumpToHere(envPtr, &(jumpPtr->next->next->jump), 2284 127); 2285 convert = 0; 2286 envPtr->currStackDepth = jumpPtr->depth + 1; 2287 freePtr = jumpPtr; 2288 jumpPtr = jumpPtr->next; 2289 TclStackFree(interp, freePtr); 2290 freePtr = jumpPtr; 2291 jumpPtr = jumpPtr->next; 2292 TclStackFree(interp, freePtr); 2293 freePtr = jumpPtr; 2294 jumpPtr = jumpPtr->next; 2295 TclStackFree(interp, freePtr); 2296 break; 2297 default: 2298 TclEmitOpcode(instruction[nodePtr->lexeme], envPtr); 2299 convert = 0; 2300 break; 2301 } 2302 if (nodePtr == rootPtr) { 2303 2304 /* We're done */ 2305 return; 2306 } 2307 nodePtr = nodes + nodePtr->p.parent; 2308 continue; 2309 } 2310 2311 nodePtr->mark++; 2312 switch (next) { 2313 case OT_EMPTY: 2314 numWords = 1; /* No arguments, so just the command */ 2315 break; 2316 case OT_LITERAL: { 2317 Tcl_Obj *const *litObjv = *litObjvPtr; 2318 Tcl_Obj *literal = *litObjv; 2319 2320 if (optimize) { 2321 int length, index; 2322 const char *bytes = TclGetStringFromObj(literal, &length); 2323 LiteralEntry *lePtr; 2324 Tcl_Obj *objPtr; 2325 2326 index = TclRegisterNewLiteral(envPtr, bytes, length); 2327 lePtr = envPtr->literalArrayPtr + index; 2328 objPtr = lePtr->objPtr; 2329 if ((objPtr->typePtr == NULL) && (literal->typePtr != NULL)) { 2330 /* 2331 * Would like to do this: 2332 * 2333 * lePtr->objPtr = literal; 2334 * Tcl_IncrRefCount(literal); 2335 * Tcl_DecrRefCount(objPtr); 2336 * 2337 * However, the design of the "global" and "local" 2338 * LiteralTable does not permit the value of lePtr->objPtr 2339 * to change. So rather than replace lePtr->objPtr, we 2340 * do surgery to transfer our desired intrep into it. 2341 * 2342 */ 2343 objPtr->typePtr = literal->typePtr; 2344 objPtr->internalRep = literal->internalRep; 2345 literal->typePtr = NULL; 2346 } 2347 TclEmitPush(index, envPtr); 2348 } else { 2349 /* 2350 * When optimize==0, we know the expression is a one-off 2351 * and there's nothing to be gained from sharing literals 2352 * when they won't live long, and the copies we have already 2353 * have an appropriate intrep. In this case, skip literal 2354 * registration that would enable sharing, and use the routine 2355 * that preserves intreps. 2356 */ 2357 TclEmitPush(TclAddLiteralObj(envPtr, literal, NULL), envPtr); 2358 } 2359 (*litObjvPtr)++; 2360 break; 2361 } 2362 case OT_TOKENS: 2363 TclCompileTokens(interp, tokenPtr+1, tokenPtr->numComponents, 2364 envPtr); 2365 tokenPtr += tokenPtr->numComponents + 1; 2366 break; 2367 default: 2368 if (optimize && nodes[next].constant) { 2369 Tcl_InterpState save = Tcl_SaveInterpState(interp, TCL_OK); 2370 if (ExecConstantExprTree(interp, nodes, next, litObjvPtr) 2371 == TCL_OK) { 2372 TclEmitPush(TclAddLiteralObj(envPtr, 2373 Tcl_GetObjResult(interp), NULL), envPtr); 2374 } else { 2375 TclCompileSyntaxError(interp, envPtr); 2376 } 2377 Tcl_RestoreInterpState(interp, save); 2378 convert = 0; 2379 } else { 2380 nodePtr = nodes + next; 2381 } 2382 } 2383 } 2384} 2385 2386/* 2387 *---------------------------------------------------------------------- 2388 * 2389 * TclSingleOpCmd -- 2390 * Implements the commands: ~, !, <<, >>, %, !=, ne, in, ni 2391 * in the ::tcl::mathop namespace. These commands have no 2392 * extension to arbitrary arguments; they accept only exactly one 2393 * or exactly two arguments as suitable for the operator. 2394 * 2395 * Results: 2396 * A standard Tcl return code and result left in interp. 2397 * 2398 * Side effects: 2399 * None. 2400 * 2401 *---------------------------------------------------------------------- 2402 */ 2403 2404int 2405TclSingleOpCmd( 2406 ClientData clientData, 2407 Tcl_Interp *interp, 2408 int objc, 2409 Tcl_Obj *const objv[]) 2410{ 2411 TclOpCmdClientData *occdPtr = (TclOpCmdClientData *)clientData; 2412 unsigned char lexeme; 2413 OpNode nodes[2]; 2414 Tcl_Obj *const *litObjv = objv + 1; 2415 2416 if (objc != 1+occdPtr->i.numArgs) { 2417 Tcl_WrongNumArgs(interp, 1, objv, occdPtr->expected); 2418 return TCL_ERROR; 2419 } 2420 2421 ParseLexeme(occdPtr->op, strlen(occdPtr->op), &lexeme, NULL); 2422 nodes[0].lexeme = START; 2423 nodes[0].mark = MARK_RIGHT; 2424 nodes[0].right = 1; 2425 nodes[1].lexeme = lexeme; 2426 if (objc == 2) { 2427 nodes[1].mark = MARK_RIGHT; 2428 } else { 2429 nodes[1].mark = MARK_LEFT; 2430 nodes[1].left = OT_LITERAL; 2431 } 2432 nodes[1].right = OT_LITERAL; 2433 nodes[1].p.parent = 0; 2434 2435 return ExecConstantExprTree(interp, nodes, 0, &litObjv); 2436} 2437 2438/* 2439 *---------------------------------------------------------------------- 2440 * 2441 * TclSortingOpCmd -- 2442 * Implements the commands: <, <=, >, >=, ==, eq 2443 * in the ::tcl::mathop namespace. These commands are defined for 2444 * arbitrary number of arguments by computing the AND of the base 2445 * operator applied to all neighbor argument pairs. 2446 * 2447 * Results: 2448 * A standard Tcl return code and result left in interp. 2449 * 2450 * Side effects: 2451 * None. 2452 * 2453 *---------------------------------------------------------------------- 2454 */ 2455 2456int 2457TclSortingOpCmd( 2458 ClientData clientData, 2459 Tcl_Interp *interp, 2460 int objc, 2461 Tcl_Obj *const objv[]) 2462{ 2463 int code = TCL_OK; 2464 2465 if (objc < 3) { 2466 Tcl_SetObjResult(interp, Tcl_NewBooleanObj(1)); 2467 } else { 2468 TclOpCmdClientData *occdPtr = (TclOpCmdClientData *)clientData; 2469 Tcl_Obj **litObjv = (Tcl_Obj **) TclStackAlloc(interp, 2470 2*(objc-2)*sizeof(Tcl_Obj *)); 2471 OpNode *nodes = (OpNode *) TclStackAlloc(interp, 2472 2*(objc-2)*sizeof(OpNode)); 2473 unsigned char lexeme; 2474 int i, lastAnd = 1; 2475 Tcl_Obj *const *litObjPtrPtr = litObjv; 2476 2477 ParseLexeme(occdPtr->op, strlen(occdPtr->op), &lexeme, NULL); 2478 2479 litObjv[0] = objv[1]; 2480 nodes[0].lexeme = START; 2481 nodes[0].mark = MARK_RIGHT; 2482 for (i=2; i<objc-1; i++) { 2483 litObjv[2*(i-1)-1] = objv[i]; 2484 nodes[2*(i-1)-1].lexeme = lexeme; 2485 nodes[2*(i-1)-1].mark = MARK_LEFT; 2486 nodes[2*(i-1)-1].left = OT_LITERAL; 2487 nodes[2*(i-1)-1].right = OT_LITERAL; 2488 2489 litObjv[2*(i-1)] = objv[i]; 2490 nodes[2*(i-1)].lexeme = AND; 2491 nodes[2*(i-1)].mark = MARK_LEFT; 2492 nodes[2*(i-1)].left = lastAnd; 2493 nodes[lastAnd].p.parent = 2*(i-1); 2494 2495 nodes[2*(i-1)].right = 2*(i-1)+1; 2496 nodes[2*(i-1)+1].p.parent= 2*(i-1); 2497 2498 lastAnd = 2*(i-1); 2499 } 2500 litObjv[2*(objc-2)-1] = objv[objc-1]; 2501 2502 nodes[2*(objc-2)-1].lexeme = lexeme; 2503 nodes[2*(objc-2)-1].mark = MARK_LEFT; 2504 nodes[2*(objc-2)-1].left = OT_LITERAL; 2505 nodes[2*(objc-2)-1].right = OT_LITERAL; 2506 2507 nodes[0].right = lastAnd; 2508 nodes[lastAnd].p.parent = 0; 2509 2510 code = ExecConstantExprTree(interp, nodes, 0, &litObjPtrPtr); 2511 2512 TclStackFree(interp, nodes); 2513 TclStackFree(interp, litObjv); 2514 } 2515 return code; 2516} 2517 2518/* 2519 *---------------------------------------------------------------------- 2520 * 2521 * TclVariadicOpCmd -- 2522 * Implements the commands: +, *, &, |, ^, ** 2523 * in the ::tcl::mathop namespace. These commands are defined for 2524 * arbitrary number of arguments by repeatedly applying the base 2525 * operator with suitable associative rules. When fewer than two 2526 * arguments are provided, suitable identity values are returned. 2527 * 2528 * Results: 2529 * A standard Tcl return code and result left in interp. 2530 * 2531 * Side effects: 2532 * None. 2533 * 2534 *---------------------------------------------------------------------- 2535 */ 2536 2537int 2538TclVariadicOpCmd( 2539 ClientData clientData, 2540 Tcl_Interp *interp, 2541 int objc, 2542 Tcl_Obj *const objv[]) 2543{ 2544 TclOpCmdClientData *occdPtr = (TclOpCmdClientData *)clientData; 2545 unsigned char lexeme; 2546 int code; 2547 2548 if (objc < 2) { 2549 Tcl_SetObjResult(interp, Tcl_NewIntObj(occdPtr->i.identity)); 2550 return TCL_OK; 2551 } 2552 2553 ParseLexeme(occdPtr->op, strlen(occdPtr->op), &lexeme, NULL); 2554 lexeme |= BINARY; 2555 2556 if (objc == 2) { 2557 Tcl_Obj *litObjv[2]; 2558 OpNode nodes[2]; 2559 int decrMe = 0; 2560 Tcl_Obj *const *litObjPtrPtr = litObjv; 2561 2562 if (lexeme == EXPON) { 2563 litObjv[1] = Tcl_NewIntObj(occdPtr->i.identity); 2564 Tcl_IncrRefCount(litObjv[1]); 2565 decrMe = 1; 2566 litObjv[0] = objv[1]; 2567 nodes[0].lexeme = START; 2568 nodes[0].mark = MARK_RIGHT; 2569 nodes[0].right = 1; 2570 nodes[1].lexeme = lexeme; 2571 nodes[1].mark = MARK_LEFT; 2572 nodes[1].left = OT_LITERAL; 2573 nodes[1].right = OT_LITERAL; 2574 nodes[1].p.parent = 0; 2575 } else { 2576 if (lexeme == DIVIDE) { 2577 litObjv[0] = Tcl_NewDoubleObj(1.0); 2578 } else { 2579 litObjv[0] = Tcl_NewIntObj(occdPtr->i.identity); 2580 } 2581 Tcl_IncrRefCount(litObjv[0]); 2582 litObjv[1] = objv[1]; 2583 nodes[0].lexeme = START; 2584 nodes[0].mark = MARK_RIGHT; 2585 nodes[0].right = 1; 2586 nodes[1].lexeme = lexeme; 2587 nodes[1].mark = MARK_LEFT; 2588 nodes[1].left = OT_LITERAL; 2589 nodes[1].right = OT_LITERAL; 2590 nodes[1].p.parent = 0; 2591 } 2592 2593 code = ExecConstantExprTree(interp, nodes, 0, &litObjPtrPtr); 2594 2595 Tcl_DecrRefCount(litObjv[decrMe]); 2596 return code; 2597 } else { 2598 Tcl_Obj *const *litObjv = objv + 1; 2599 OpNode *nodes = (OpNode *) TclStackAlloc(interp, 2600 (objc-1)*sizeof(OpNode)); 2601 int i, lastOp = OT_LITERAL; 2602 2603 nodes[0].lexeme = START; 2604 nodes[0].mark = MARK_RIGHT; 2605 if (lexeme == EXPON) { 2606 for (i=objc-2; i>0; i-- ) { 2607 nodes[i].lexeme = lexeme; 2608 nodes[i].mark = MARK_LEFT; 2609 nodes[i].left = OT_LITERAL; 2610 nodes[i].right = lastOp; 2611 if (lastOp >= 0) { 2612 nodes[lastOp].p.parent = i; 2613 } 2614 lastOp = i; 2615 } 2616 } else { 2617 for (i=1; i<objc-1; i++ ) { 2618 nodes[i].lexeme = lexeme; 2619 nodes[i].mark = MARK_LEFT; 2620 nodes[i].left = lastOp; 2621 if (lastOp >= 0) { 2622 nodes[lastOp].p.parent = i; 2623 } 2624 nodes[i].right = OT_LITERAL; 2625 lastOp = i; 2626 } 2627 } 2628 nodes[0].right = lastOp; 2629 nodes[lastOp].p.parent = 0; 2630 2631 code = ExecConstantExprTree(interp, nodes, 0, &litObjv); 2632 2633 TclStackFree(interp, nodes); 2634 2635 return code; 2636 } 2637} 2638 2639/* 2640 *---------------------------------------------------------------------- 2641 * 2642 * TclNoIdentOpCmd -- 2643 * Implements the commands: -, / 2644 * in the ::tcl::mathop namespace. These commands are defined for 2645 * arbitrary non-zero number of arguments by repeatedly applying 2646 * the base operator with suitable associative rules. When no 2647 * arguments are provided, an error is raised. 2648 * 2649 * Results: 2650 * A standard Tcl return code and result left in interp. 2651 * 2652 * Side effects: 2653 * None. 2654 * 2655 *---------------------------------------------------------------------- 2656 */ 2657 2658int 2659TclNoIdentOpCmd( 2660 ClientData clientData, 2661 Tcl_Interp *interp, 2662 int objc, 2663 Tcl_Obj *const objv[]) 2664{ 2665 TclOpCmdClientData *occdPtr = (TclOpCmdClientData *)clientData; 2666 if (objc < 2) { 2667 Tcl_WrongNumArgs(interp, 1, objv, occdPtr->expected); 2668 return TCL_ERROR; 2669 } 2670 return TclVariadicOpCmd(clientData, interp, objc, objv); 2671} 2672/* 2673 * Local Variables: 2674 * mode: c 2675 * c-basic-offset: 4 2676 * fill-column: 78 2677 * End: 2678 */ 2679