1/* 2 * tclCompExpr.c -- 3 * 4 * This file contains the code to compile Tcl expressions. 5 * 6 * Copyright (c) 1997 Sun Microsystems, Inc. 7 * Copyright (c) 1998-2000 by Scriptics Corporation. 8 * 9 * See the file "license.terms" for information on usage and redistribution 10 * of this file, and for a DISCLAIMER OF ALL WARRANTIES. 11 * 12 * RCS: @(#) $Id: tclCompExpr.c,v 1.13.2.5 2008/04/17 19:47:34 dgp Exp $ 13 */ 14 15#include "tclInt.h" 16#include "tclCompile.h" 17 18/* 19 * The stuff below is a bit of a hack so that this file can be used in 20 * environments that include no UNIX, i.e. no errno: just arrange to use 21 * the errno from tclExecute.c here. 22 */ 23 24#ifndef TCL_GENERIC_ONLY 25#include "tclPort.h" 26#else 27#define NO_ERRNO_H 28#endif 29 30#ifdef NO_ERRNO_H 31extern int errno; /* Use errno from tclExecute.c. */ 32#define ERANGE 34 33#endif 34 35/* 36 * Boolean variable that controls whether expression compilation tracing 37 * is enabled. 38 */ 39 40#ifdef TCL_COMPILE_DEBUG 41static int traceExprComp = 0; 42#endif /* TCL_COMPILE_DEBUG */ 43 44/* 45 * The ExprInfo structure describes the state of compiling an expression. 46 * A pointer to an ExprInfo record is passed among the routines in 47 * this module. 48 */ 49 50typedef struct ExprInfo { 51 Tcl_Interp *interp; /* Used for error reporting. */ 52 Tcl_Parse *parsePtr; /* Structure filled with information about 53 * the parsed expression. */ 54 CONST char *expr; /* The expression that was originally passed 55 * to TclCompileExpr. */ 56 CONST char *lastChar; /* Points just after last byte of expr. */ 57 int hasOperators; /* Set 1 if the expr has operators; 0 if 58 * expr is only a primary. If 1 after 59 * compiling an expr, a tryCvtToNumeric 60 * instruction is emitted to convert the 61 * primary to a number if possible. */ 62} ExprInfo; 63 64/* 65 * Definitions of numeric codes representing each expression operator. 66 * The order of these must match the entries in the operatorTable below. 67 * Also the codes for the relational operators (OP_LESS, OP_GREATER, 68 * OP_LE, OP_GE, OP_EQ, and OP_NE) must be consecutive and in that order. 69 * Note that OP_PLUS and OP_MINUS represent both unary and binary operators. 70 */ 71 72#define OP_MULT 0 73#define OP_DIVIDE 1 74#define OP_MOD 2 75#define OP_PLUS 3 76#define OP_MINUS 4 77#define OP_LSHIFT 5 78#define OP_RSHIFT 6 79#define OP_LESS 7 80#define OP_GREATER 8 81#define OP_LE 9 82#define OP_GE 10 83#define OP_EQ 11 84#define OP_NEQ 12 85#define OP_BITAND 13 86#define OP_BITXOR 14 87#define OP_BITOR 15 88#define OP_LAND 16 89#define OP_LOR 17 90#define OP_QUESTY 18 91#define OP_LNOT 19 92#define OP_BITNOT 20 93#define OP_STREQ 21 94#define OP_STRNEQ 22 95 96/* 97 * Table describing the expression operators. Entries in this table must 98 * correspond to the definitions of numeric codes for operators just above. 99 */ 100 101static int opTableInitialized = 0; /* 0 means not yet initialized. */ 102 103TCL_DECLARE_MUTEX(opMutex) 104 105typedef struct OperatorDesc { 106 char *name; /* Name of the operator. */ 107 int numOperands; /* Number of operands. 0 if the operator 108 * requires special handling. */ 109 int instruction; /* Instruction opcode for the operator. 110 * Ignored if numOperands is 0. */ 111} OperatorDesc; 112 113static OperatorDesc operatorTable[] = { 114 {"*", 2, INST_MULT}, 115 {"/", 2, INST_DIV}, 116 {"%", 2, INST_MOD}, 117 {"+", 0}, 118 {"-", 0}, 119 {"<<", 2, INST_LSHIFT}, 120 {">>", 2, INST_RSHIFT}, 121 {"<", 2, INST_LT}, 122 {">", 2, INST_GT}, 123 {"<=", 2, INST_LE}, 124 {">=", 2, INST_GE}, 125 {"==", 2, INST_EQ}, 126 {"!=", 2, INST_NEQ}, 127 {"&", 2, INST_BITAND}, 128 {"^", 2, INST_BITXOR}, 129 {"|", 2, INST_BITOR}, 130 {"&&", 0}, 131 {"||", 0}, 132 {"?", 0}, 133 {"!", 1, INST_LNOT}, 134 {"~", 1, INST_BITNOT}, 135 {"eq", 2, INST_STR_EQ}, 136 {"ne", 2, INST_STR_NEQ}, 137 {NULL} 138}; 139 140/* 141 * Hashtable used to map the names of expression operators to the index 142 * of their OperatorDesc description. 143 */ 144 145static Tcl_HashTable opHashTable; 146 147/* 148 * Declarations for local procedures to this file: 149 */ 150 151static int CompileCondExpr _ANSI_ARGS_(( 152 Tcl_Token *exprTokenPtr, ExprInfo *infoPtr, 153 CompileEnv *envPtr, Tcl_Token **endPtrPtr)); 154static int CompileLandOrLorExpr _ANSI_ARGS_(( 155 Tcl_Token *exprTokenPtr, int opIndex, 156 ExprInfo *infoPtr, CompileEnv *envPtr, 157 Tcl_Token **endPtrPtr)); 158static int CompileMathFuncCall _ANSI_ARGS_(( 159 Tcl_Token *exprTokenPtr, CONST char *funcName, 160 ExprInfo *infoPtr, CompileEnv *envPtr, 161 Tcl_Token **endPtrPtr)); 162static int CompileSubExpr _ANSI_ARGS_(( 163 Tcl_Token *exprTokenPtr, ExprInfo *infoPtr, 164 CompileEnv *envPtr)); 165static void LogSyntaxError _ANSI_ARGS_((ExprInfo *infoPtr)); 166 167/* 168 * Macro used to debug the execution of the expression compiler. 169 */ 170 171#ifdef TCL_COMPILE_DEBUG 172#define TRACE(exprBytes, exprLength, tokenBytes, tokenLength) \ 173 if (traceExprComp) { \ 174 fprintf(stderr, "CompileSubExpr: \"%.*s\", token \"%.*s\"\n", \ 175 (exprLength), (exprBytes), (tokenLength), (tokenBytes)); \ 176 } 177#else 178#define TRACE(exprBytes, exprLength, tokenBytes, tokenLength) 179#endif /* TCL_COMPILE_DEBUG */ 180 181/* 182 *---------------------------------------------------------------------- 183 * 184 * TclCompileExpr -- 185 * 186 * This procedure compiles a string containing a Tcl expression into 187 * Tcl bytecodes. This procedure is the top-level interface to the 188 * the expression compilation module, and is used by such public 189 * procedures as Tcl_ExprString, Tcl_ExprStringObj, Tcl_ExprLong, 190 * Tcl_ExprDouble, Tcl_ExprBoolean, and Tcl_ExprBooleanObj. 191 * 192 * Results: 193 * The return value is TCL_OK on a successful compilation and TCL_ERROR 194 * on failure. If TCL_ERROR is returned, then the interpreter's result 195 * contains an error message. 196 * 197 * Side effects: 198 * Adds instructions to envPtr to evaluate the expression at runtime. 199 * 200 *---------------------------------------------------------------------- 201 */ 202 203int 204TclCompileExpr(interp, script, numBytes, envPtr) 205 Tcl_Interp *interp; /* Used for error reporting. */ 206 CONST char *script; /* The source script to compile. */ 207 int numBytes; /* Number of bytes in script. If < 0, the 208 * string consists of all bytes up to the 209 * first null character. */ 210 CompileEnv *envPtr; /* Holds resulting instructions. */ 211{ 212 ExprInfo info; 213 Tcl_Parse parse; 214 Tcl_HashEntry *hPtr; 215 int new, i, code; 216 217 /* 218 * If this is the first time we've been called, initialize the table 219 * of expression operators. 220 */ 221 222 if (numBytes < 0) { 223 numBytes = (script? strlen(script) : 0); 224 } 225 if (!opTableInitialized) { 226 Tcl_MutexLock(&opMutex); 227 if (!opTableInitialized) { 228 Tcl_InitHashTable(&opHashTable, TCL_STRING_KEYS); 229 for (i = 0; operatorTable[i].name != NULL; i++) { 230 hPtr = Tcl_CreateHashEntry(&opHashTable, 231 operatorTable[i].name, &new); 232 if (new) { 233 Tcl_SetHashValue(hPtr, (ClientData) i); 234 } 235 } 236 opTableInitialized = 1; 237 } 238 Tcl_MutexUnlock(&opMutex); 239 } 240 241 /* 242 * Initialize the structure containing information abvout this 243 * expression compilation. 244 */ 245 246 info.interp = interp; 247 info.parsePtr = &parse; 248 info.expr = script; 249 info.lastChar = (script + numBytes); 250 info.hasOperators = 0; 251 252 /* 253 * Parse the expression then compile it. 254 */ 255 256 code = Tcl_ParseExpr(interp, script, numBytes, &parse); 257 if (code != TCL_OK) { 258 goto done; 259 } 260 261#ifdef TCL_TIP280 262 /* TIP #280 : Track Lines within the expression */ 263 TclAdvanceLines (&envPtr->line, script, parse.tokenPtr->start); 264#endif 265 266 code = CompileSubExpr(parse.tokenPtr, &info, envPtr); 267 if (code != TCL_OK) { 268 Tcl_FreeParse(&parse); 269 goto done; 270 } 271 272 if (!info.hasOperators) { 273 /* 274 * Attempt to convert the primary's object to an int or double. 275 * This is done in order to support Tcl's policy of interpreting 276 * operands if at all possible as first integers, else 277 * floating-point numbers. 278 */ 279 280 TclEmitOpcode(INST_TRY_CVT_TO_NUMERIC, envPtr); 281 } 282 Tcl_FreeParse(&parse); 283 284 done: 285 return code; 286} 287 288/* 289 *---------------------------------------------------------------------- 290 * 291 * TclFinalizeCompilation -- 292 * 293 * Clean up the compilation environment so it can later be 294 * properly reinitialized. This procedure is called by Tcl_Finalize(). 295 * 296 * Results: 297 * None. 298 * 299 * Side effects: 300 * Cleans up the compilation environment. At the moment, just the 301 * table of expression operators is freed. 302 * 303 *---------------------------------------------------------------------- 304 */ 305 306void 307TclFinalizeCompilation() 308{ 309 Tcl_MutexLock(&opMutex); 310 if (opTableInitialized) { 311 Tcl_DeleteHashTable(&opHashTable); 312 opTableInitialized = 0; 313 } 314 Tcl_MutexUnlock(&opMutex); 315} 316 317/* 318 *---------------------------------------------------------------------- 319 * 320 * CompileSubExpr -- 321 * 322 * Given a pointer to a TCL_TOKEN_SUB_EXPR token describing a 323 * subexpression, this procedure emits instructions to evaluate the 324 * subexpression at runtime. 325 * 326 * Results: 327 * The return value is TCL_OK on a successful compilation and TCL_ERROR 328 * on failure. If TCL_ERROR is returned, then the interpreter's result 329 * contains an error message. 330 * 331 * Side effects: 332 * Adds instructions to envPtr to evaluate the subexpression. 333 * 334 *---------------------------------------------------------------------- 335 */ 336 337static int 338CompileSubExpr(exprTokenPtr, infoPtr, envPtr) 339 Tcl_Token *exprTokenPtr; /* Points to TCL_TOKEN_SUB_EXPR token 340 * to compile. */ 341 ExprInfo *infoPtr; /* Describes the compilation state for the 342 * expression being compiled. */ 343 CompileEnv *envPtr; /* Holds resulting instructions. */ 344{ 345 Tcl_Interp *interp = infoPtr->interp; 346 Tcl_Token *tokenPtr, *endPtr = NULL; /* silence gcc 4 warning */ 347 Tcl_Token *afterSubexprPtr; 348 OperatorDesc *opDescPtr; 349 Tcl_HashEntry *hPtr; 350 CONST char *operator; 351 Tcl_DString opBuf; 352 int objIndex, opIndex, length, code; 353 char buffer[TCL_UTF_MAX]; 354 355 if (exprTokenPtr->type != TCL_TOKEN_SUB_EXPR) { 356 panic("CompileSubExpr: token type %d not TCL_TOKEN_SUB_EXPR\n", 357 exprTokenPtr->type); 358 } 359 code = TCL_OK; 360 361 /* 362 * Switch on the type of the first token after the subexpression token. 363 * After processing it, advance tokenPtr to point just after the 364 * subexpression's last token. 365 */ 366 367 tokenPtr = exprTokenPtr+1; 368 TRACE(exprTokenPtr->start, exprTokenPtr->size, 369 tokenPtr->start, tokenPtr->size); 370 switch (tokenPtr->type) { 371 case TCL_TOKEN_WORD: 372 code = TclCompileTokens(interp, tokenPtr+1, 373 tokenPtr->numComponents, envPtr); 374 if (code != TCL_OK) { 375 goto done; 376 } 377 tokenPtr += (tokenPtr->numComponents + 1); 378 break; 379 380 case TCL_TOKEN_TEXT: 381 if (tokenPtr->size > 0) { 382 objIndex = TclRegisterNewLiteral(envPtr, tokenPtr->start, 383 tokenPtr->size); 384 } else { 385 objIndex = TclRegisterNewLiteral(envPtr, "", 0); 386 } 387 TclEmitPush(objIndex, envPtr); 388 tokenPtr += 1; 389 break; 390 391 case TCL_TOKEN_BS: 392 length = Tcl_UtfBackslash(tokenPtr->start, (int *) NULL, 393 buffer); 394 if (length > 0) { 395 objIndex = TclRegisterNewLiteral(envPtr, buffer, length); 396 } else { 397 objIndex = TclRegisterNewLiteral(envPtr, "", 0); 398 } 399 TclEmitPush(objIndex, envPtr); 400 tokenPtr += 1; 401 break; 402 403 case TCL_TOKEN_COMMAND: 404 code = TclCompileScript(interp, tokenPtr->start+1, 405 tokenPtr->size-2, /*nested*/ 0, envPtr); 406 if (code != TCL_OK) { 407 goto done; 408 } 409 tokenPtr += 1; 410 break; 411 412 case TCL_TOKEN_VARIABLE: 413 code = TclCompileTokens(interp, tokenPtr, 1, envPtr); 414 if (code != TCL_OK) { 415 goto done; 416 } 417 tokenPtr += (tokenPtr->numComponents + 1); 418 break; 419 420 case TCL_TOKEN_SUB_EXPR: 421 code = CompileSubExpr(tokenPtr, infoPtr, envPtr); 422 if (code != TCL_OK) { 423 goto done; 424 } 425 tokenPtr += (tokenPtr->numComponents + 1); 426 break; 427 428 case TCL_TOKEN_OPERATOR: 429 /* 430 * Look up the operator. If the operator isn't found, treat it 431 * as a math function. 432 */ 433 Tcl_DStringInit(&opBuf); 434 operator = Tcl_DStringAppend(&opBuf, 435 tokenPtr->start, tokenPtr->size); 436 hPtr = Tcl_FindHashEntry(&opHashTable, operator); 437 if (hPtr == NULL) { 438 code = CompileMathFuncCall(exprTokenPtr, operator, infoPtr, 439 envPtr, &endPtr); 440 Tcl_DStringFree(&opBuf); 441 if (code != TCL_OK) { 442 goto done; 443 } 444 tokenPtr = endPtr; 445 break; 446 } 447 Tcl_DStringFree(&opBuf); 448 opIndex = (int) Tcl_GetHashValue(hPtr); 449 opDescPtr = &(operatorTable[opIndex]); 450 451 /* 452 * If the operator is "normal", compile it using information 453 * from the operator table. 454 */ 455 456 if (opDescPtr->numOperands > 0) { 457 tokenPtr++; 458 code = CompileSubExpr(tokenPtr, infoPtr, envPtr); 459 if (code != TCL_OK) { 460 goto done; 461 } 462 tokenPtr += (tokenPtr->numComponents + 1); 463 464 if (opDescPtr->numOperands == 2) { 465 code = CompileSubExpr(tokenPtr, infoPtr, envPtr); 466 if (code != TCL_OK) { 467 goto done; 468 } 469 tokenPtr += (tokenPtr->numComponents + 1); 470 } 471 TclEmitOpcode(opDescPtr->instruction, envPtr); 472 infoPtr->hasOperators = 1; 473 break; 474 } 475 476 /* 477 * The operator requires special treatment, and is either 478 * "+" or "-", or one of "&&", "||" or "?". 479 */ 480 481 switch (opIndex) { 482 case OP_PLUS: 483 case OP_MINUS: 484 tokenPtr++; 485 code = CompileSubExpr(tokenPtr, infoPtr, envPtr); 486 if (code != TCL_OK) { 487 goto done; 488 } 489 tokenPtr += (tokenPtr->numComponents + 1); 490 491 /* 492 * Check whether the "+" or "-" is unary. 493 */ 494 495 afterSubexprPtr = exprTokenPtr 496 + exprTokenPtr->numComponents+1; 497 if (tokenPtr == afterSubexprPtr) { 498 TclEmitOpcode(((opIndex==OP_PLUS)? 499 INST_UPLUS : INST_UMINUS), 500 envPtr); 501 break; 502 } 503 504 /* 505 * The "+" or "-" is binary. 506 */ 507 508 code = CompileSubExpr(tokenPtr, infoPtr, envPtr); 509 if (code != TCL_OK) { 510 goto done; 511 } 512 tokenPtr += (tokenPtr->numComponents + 1); 513 TclEmitOpcode(((opIndex==OP_PLUS)? INST_ADD : INST_SUB), 514 envPtr); 515 break; 516 517 case OP_LAND: 518 case OP_LOR: 519 code = CompileLandOrLorExpr(exprTokenPtr, opIndex, 520 infoPtr, envPtr, &endPtr); 521 if (code != TCL_OK) { 522 goto done; 523 } 524 tokenPtr = endPtr; 525 break; 526 527 case OP_QUESTY: 528 code = CompileCondExpr(exprTokenPtr, infoPtr, 529 envPtr, &endPtr); 530 if (code != TCL_OK) { 531 goto done; 532 } 533 tokenPtr = endPtr; 534 break; 535 536 default: 537 panic("CompileSubExpr: unexpected operator %d requiring special treatment\n", 538 opIndex); 539 } /* end switch on operator requiring special treatment */ 540 infoPtr->hasOperators = 1; 541 break; 542 543 default: 544 panic("CompileSubExpr: unexpected token type %d\n", 545 tokenPtr->type); 546 } 547 548 /* 549 * Verify that the subexpression token had the required number of 550 * subtokens: that we've advanced tokenPtr just beyond the 551 * subexpression's last token. For example, a "*" subexpression must 552 * contain the tokens for exactly two operands. 553 */ 554 555 if (tokenPtr != (exprTokenPtr + exprTokenPtr->numComponents+1)) { 556 LogSyntaxError(infoPtr); 557 code = TCL_ERROR; 558 } 559 560 done: 561 return code; 562} 563 564/* 565 *---------------------------------------------------------------------- 566 * 567 * CompileLandOrLorExpr -- 568 * 569 * This procedure compiles a Tcl logical and ("&&") or logical or 570 * ("||") subexpression. 571 * 572 * Results: 573 * The return value is TCL_OK on a successful compilation and TCL_ERROR 574 * on failure. If TCL_OK is returned, a pointer to the token just after 575 * the last one in the subexpression is stored at the address in 576 * endPtrPtr. If TCL_ERROR is returned, then the interpreter's result 577 * contains an error message. 578 * 579 * Side effects: 580 * Adds instructions to envPtr to evaluate the expression at runtime. 581 * 582 *---------------------------------------------------------------------- 583 */ 584 585static int 586CompileLandOrLorExpr(exprTokenPtr, opIndex, infoPtr, envPtr, endPtrPtr) 587 Tcl_Token *exprTokenPtr; /* Points to TCL_TOKEN_SUB_EXPR token 588 * containing the "&&" or "||" operator. */ 589 int opIndex; /* A code describing the expression 590 * operator: either OP_LAND or OP_LOR. */ 591 ExprInfo *infoPtr; /* Describes the compilation state for the 592 * expression being compiled. */ 593 CompileEnv *envPtr; /* Holds resulting instructions. */ 594 Tcl_Token **endPtrPtr; /* If successful, a pointer to the token 595 * just after the last token in the 596 * subexpression is stored here. */ 597{ 598 JumpFixup shortCircuitFixup; /* Used to fix up the short circuit jump 599 * after the first subexpression. */ 600 JumpFixup lhsTrueFixup, lhsEndFixup; 601 /* Used to fix up jumps used to convert the 602 * first operand to 0 or 1. */ 603 Tcl_Token *tokenPtr; 604 int dist, code; 605 int savedStackDepth = envPtr->currStackDepth; 606 607 /* 608 * Emit code for the first operand. 609 */ 610 611 tokenPtr = exprTokenPtr+2; 612 code = CompileSubExpr(tokenPtr, infoPtr, envPtr); 613 if (code != TCL_OK) { 614 goto done; 615 } 616 tokenPtr += (tokenPtr->numComponents + 1); 617 618 /* 619 * Convert the first operand to the result that Tcl requires: 620 * "0" or "1". Eventually we'll use a new instruction for this. 621 */ 622 623 TclEmitForwardJump(envPtr, TCL_TRUE_JUMP, &lhsTrueFixup); 624 TclEmitPush(TclRegisterNewLiteral(envPtr, "0", 1), envPtr); 625 TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &lhsEndFixup); 626 dist = (envPtr->codeNext - envPtr->codeStart) - lhsTrueFixup.codeOffset; 627 if (TclFixupForwardJump(envPtr, &lhsTrueFixup, dist, 127)) { 628 badDist: 629 panic("CompileLandOrLorExpr: bad jump distance %d\n", dist); 630 } 631 envPtr->currStackDepth = savedStackDepth; 632 TclEmitPush(TclRegisterNewLiteral(envPtr, "1", 1), envPtr); 633 dist = (envPtr->codeNext - envPtr->codeStart) - lhsEndFixup.codeOffset; 634 if (TclFixupForwardJump(envPtr, &lhsEndFixup, dist, 127)) { 635 goto badDist; 636 } 637 638 /* 639 * Emit the "short circuit" jump around the rest of the expression. 640 * Duplicate the "0" or "1" on top of the stack first to keep the 641 * jump from consuming it. 642 */ 643 644 TclEmitOpcode(INST_DUP, envPtr); 645 TclEmitForwardJump(envPtr, 646 ((opIndex==OP_LAND)? TCL_FALSE_JUMP : TCL_TRUE_JUMP), 647 &shortCircuitFixup); 648 649 /* 650 * Emit code for the second operand. 651 */ 652 653 code = CompileSubExpr(tokenPtr, infoPtr, envPtr); 654 if (code != TCL_OK) { 655 goto done; 656 } 657 tokenPtr += (tokenPtr->numComponents + 1); 658 659 /* 660 * Emit a "logical and" or "logical or" instruction. This does not try 661 * to "short- circuit" the evaluation of both operands, but instead 662 * ensures that we either have a "1" or a "0" result. 663 */ 664 665 TclEmitOpcode(((opIndex==OP_LAND)? INST_LAND : INST_LOR), envPtr); 666 667 /* 668 * Now that we know the target of the forward jump, update it with the 669 * correct distance. 670 */ 671 672 dist = (envPtr->codeNext - envPtr->codeStart) 673 - shortCircuitFixup.codeOffset; 674 TclFixupForwardJump(envPtr, &shortCircuitFixup, dist, 127); 675 *endPtrPtr = tokenPtr; 676 677 done: 678 envPtr->currStackDepth = savedStackDepth + 1; 679 return code; 680} 681 682/* 683 *---------------------------------------------------------------------- 684 * 685 * CompileCondExpr -- 686 * 687 * This procedure compiles a Tcl conditional expression: 688 * condExpr ::= lorExpr ['?' condExpr ':' condExpr] 689 * 690 * Results: 691 * The return value is TCL_OK on a successful compilation and TCL_ERROR 692 * on failure. If TCL_OK is returned, a pointer to the token just after 693 * the last one in the subexpression is stored at the address in 694 * endPtrPtr. If TCL_ERROR is returned, then the interpreter's result 695 * contains an error message. 696 * 697 * Side effects: 698 * Adds instructions to envPtr to evaluate the expression at runtime. 699 * 700 *---------------------------------------------------------------------- 701 */ 702 703static int 704CompileCondExpr(exprTokenPtr, infoPtr, envPtr, endPtrPtr) 705 Tcl_Token *exprTokenPtr; /* Points to TCL_TOKEN_SUB_EXPR token 706 * containing the "?" operator. */ 707 ExprInfo *infoPtr; /* Describes the compilation state for the 708 * expression being compiled. */ 709 CompileEnv *envPtr; /* Holds resulting instructions. */ 710 Tcl_Token **endPtrPtr; /* If successful, a pointer to the token 711 * just after the last token in the 712 * subexpression is stored here. */ 713{ 714 JumpFixup jumpAroundThenFixup, jumpAroundElseFixup; 715 /* Used to update or replace one-byte jumps 716 * around the then and else expressions when 717 * their target PCs are determined. */ 718 Tcl_Token *tokenPtr; 719 int elseCodeOffset, dist, code; 720 int savedStackDepth = envPtr->currStackDepth; 721 722 /* 723 * Emit code for the test. 724 */ 725 726 tokenPtr = exprTokenPtr+2; 727 code = CompileSubExpr(tokenPtr, infoPtr, envPtr); 728 if (code != TCL_OK) { 729 goto done; 730 } 731 tokenPtr += (tokenPtr->numComponents + 1); 732 733 /* 734 * Emit the jump to the "else" expression if the test was false. 735 */ 736 737 TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, &jumpAroundThenFixup); 738 739 /* 740 * Compile the "then" expression. Note that if a subexpression is only 741 * a primary, we need to try to convert it to numeric. We do this to 742 * support Tcl's policy of interpreting operands if at all possible as 743 * first integers, else floating-point numbers. 744 */ 745 746 infoPtr->hasOperators = 0; 747 code = CompileSubExpr(tokenPtr, infoPtr, envPtr); 748 if (code != TCL_OK) { 749 goto done; 750 } 751 tokenPtr += (tokenPtr->numComponents + 1); 752 if (!infoPtr->hasOperators) { 753 TclEmitOpcode(INST_TRY_CVT_TO_NUMERIC, envPtr); 754 } 755 756 /* 757 * Emit an unconditional jump around the "else" condExpr. 758 */ 759 760 TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, 761 &jumpAroundElseFixup); 762 763 /* 764 * Compile the "else" expression. 765 */ 766 767 envPtr->currStackDepth = savedStackDepth; 768 elseCodeOffset = (envPtr->codeNext - envPtr->codeStart); 769 infoPtr->hasOperators = 0; 770 code = CompileSubExpr(tokenPtr, infoPtr, envPtr); 771 if (code != TCL_OK) { 772 goto done; 773 } 774 tokenPtr += (tokenPtr->numComponents + 1); 775 if (!infoPtr->hasOperators) { 776 TclEmitOpcode(INST_TRY_CVT_TO_NUMERIC, envPtr); 777 } 778 779 /* 780 * Fix up the second jump around the "else" expression. 781 */ 782 783 dist = (envPtr->codeNext - envPtr->codeStart) 784 - jumpAroundElseFixup.codeOffset; 785 if (TclFixupForwardJump(envPtr, &jumpAroundElseFixup, dist, 127)) { 786 /* 787 * Update the else expression's starting code offset since it 788 * moved down 3 bytes too. 789 */ 790 791 elseCodeOffset += 3; 792 } 793 794 /* 795 * Fix up the first jump to the "else" expression if the test was false. 796 */ 797 798 dist = (elseCodeOffset - jumpAroundThenFixup.codeOffset); 799 TclFixupForwardJump(envPtr, &jumpAroundThenFixup, dist, 127); 800 *endPtrPtr = tokenPtr; 801 802 done: 803 envPtr->currStackDepth = savedStackDepth + 1; 804 return code; 805} 806 807/* 808 *---------------------------------------------------------------------- 809 * 810 * CompileMathFuncCall -- 811 * 812 * This procedure compiles a call on a math function in an expression: 813 * mathFuncCall ::= funcName '(' [condExpr {',' condExpr}] ')' 814 * 815 * Results: 816 * The return value is TCL_OK on a successful compilation and TCL_ERROR 817 * on failure. If TCL_OK is returned, a pointer to the token just after 818 * the last one in the subexpression is stored at the address in 819 * endPtrPtr. If TCL_ERROR is returned, then the interpreter's result 820 * contains an error message. 821 * 822 * Side effects: 823 * Adds instructions to envPtr to evaluate the math function at 824 * runtime. 825 * 826 *---------------------------------------------------------------------- 827 */ 828 829static int 830CompileMathFuncCall(exprTokenPtr, funcName, infoPtr, envPtr, endPtrPtr) 831 Tcl_Token *exprTokenPtr; /* Points to TCL_TOKEN_SUB_EXPR token 832 * containing the math function call. */ 833 CONST char *funcName; /* Name of the math function. */ 834 ExprInfo *infoPtr; /* Describes the compilation state for the 835 * expression being compiled. */ 836 CompileEnv *envPtr; /* Holds resulting instructions. */ 837 Tcl_Token **endPtrPtr; /* If successful, a pointer to the token 838 * just after the last token in the 839 * subexpression is stored here. */ 840{ 841 Tcl_Interp *interp = infoPtr->interp; 842 Interp *iPtr = (Interp *) interp; 843 MathFunc *mathFuncPtr; 844 Tcl_HashEntry *hPtr; 845 Tcl_Token *tokenPtr, *afterSubexprPtr; 846 int code, i; 847 848 /* 849 * Look up the MathFunc record for the function. 850 */ 851 852 code = TCL_OK; 853 hPtr = Tcl_FindHashEntry(&iPtr->mathFuncTable, funcName); 854 if (hPtr == NULL) { 855 Tcl_ResetResult(interp); 856 Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), 857 "unknown math function \"", funcName, "\"", (char *) NULL); 858 code = TCL_ERROR; 859 goto done; 860 } 861 mathFuncPtr = (MathFunc *) Tcl_GetHashValue(hPtr); 862 863 /* 864 * If not a builtin function, push an object with the function's name. 865 */ 866 867 if (mathFuncPtr->builtinFuncIndex < 0) { 868 TclEmitPush(TclRegisterNewLiteral(envPtr, funcName, -1), envPtr); 869 } 870 871 /* 872 * Compile any arguments for the function. 873 */ 874 875 tokenPtr = exprTokenPtr+2; 876 afterSubexprPtr = exprTokenPtr + (exprTokenPtr->numComponents + 1); 877 if (mathFuncPtr->numArgs > 0) { 878 for (i = 0; i < mathFuncPtr->numArgs; i++) { 879 if (tokenPtr == afterSubexprPtr) { 880 Tcl_ResetResult(interp); 881 Tcl_AppendToObj(Tcl_GetObjResult(interp), 882 "too few arguments for math function", -1); 883 code = TCL_ERROR; 884 goto done; 885 } 886 code = CompileSubExpr(tokenPtr, infoPtr, envPtr); 887 if (code != TCL_OK) { 888 goto done; 889 } 890 tokenPtr += (tokenPtr->numComponents + 1); 891 } 892 if (tokenPtr != afterSubexprPtr) { 893 Tcl_ResetResult(interp); 894 Tcl_AppendToObj(Tcl_GetObjResult(interp), 895 "too many arguments for math function", -1); 896 code = TCL_ERROR; 897 goto done; 898 } 899 } else if (tokenPtr != afterSubexprPtr) { 900 Tcl_ResetResult(interp); 901 Tcl_AppendToObj(Tcl_GetObjResult(interp), 902 "too many arguments for math function", -1); 903 code = TCL_ERROR; 904 goto done; 905 } 906 907 /* 908 * Compile the call on the math function. Note that the "objc" argument 909 * count for non-builtin functions is incremented by 1 to include the 910 * function name itself. 911 */ 912 913 if (mathFuncPtr->builtinFuncIndex >= 0) { /* a builtin function */ 914 /* 915 * Adjust the current stack depth by the number of arguments 916 * of the builtin function. This cannot be handled by the 917 * TclEmitInstInt1 macro as the number of arguments is not 918 * passed as an operand. 919 */ 920 921 if (envPtr->maxStackDepth < envPtr->currStackDepth) { 922 envPtr->maxStackDepth = envPtr->currStackDepth; 923 } 924 TclEmitInstInt1(INST_CALL_BUILTIN_FUNC1, 925 mathFuncPtr->builtinFuncIndex, envPtr); 926 envPtr->currStackDepth -= mathFuncPtr->numArgs; 927 } else { 928 TclEmitInstInt1(INST_CALL_FUNC1, (mathFuncPtr->numArgs+1), envPtr); 929 } 930 *endPtrPtr = afterSubexprPtr; 931 932 done: 933 return code; 934} 935 936/* 937 *---------------------------------------------------------------------- 938 * 939 * LogSyntaxError -- 940 * 941 * This procedure is invoked after an error occurs when compiling an 942 * expression. It sets the interpreter result to an error message 943 * describing the error. 944 * 945 * Results: 946 * None. 947 * 948 * Side effects: 949 * Sets the interpreter result to an error message describing the 950 * expression that was being compiled when the error occurred. 951 * 952 *---------------------------------------------------------------------- 953 */ 954 955static void 956LogSyntaxError(infoPtr) 957 ExprInfo *infoPtr; /* Describes the compilation state for the 958 * expression being compiled. */ 959{ 960 int numBytes = (infoPtr->lastChar - infoPtr->expr); 961 char buffer[100]; 962 963 sprintf(buffer, "syntax error in expression \"%.*s\"", 964 ((numBytes > 60)? 60 : numBytes), infoPtr->expr); 965 Tcl_ResetResult(infoPtr->interp); 966 Tcl_AppendStringsToObj(Tcl_GetObjResult(infoPtr->interp), 967 buffer, (char *) NULL); 968} 969