/* $Header$ */ /* * tclCompExpr.c -- * * This file contains the code to compile Tcl expressions. * * Copyright (c) 1997 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * * RCS: @(#) $Id: tclcompexpr.c,v 1.1.1.1 2001/06/13 04:35:43 dtashley Exp $ */ #include "tclInt.h" #include "tclCompile.h" /* * The stuff below is a bit of a hack so that this file can be used in * environments that include no UNIX, i.e. no errno: just arrange to use * the errno from tclExecute.c here. */ #ifndef TCL_GENERIC_ONLY #include "tclPort.h" #else #define NO_ERRNO_H #endif #ifdef NO_ERRNO_H extern int errno; /* Use errno from tclExecute.c. */ #define ERANGE 34 #endif /* * Boolean variable that controls whether expression compilation tracing * is enabled. */ #ifdef TCL_COMPILE_DEBUG static int traceExprComp = 0; #endif /* TCL_COMPILE_DEBUG */ /* * The ExprInfo structure describes the state of compiling an expression. * A pointer to an ExprInfo record is passed among the routines in * this module. */ typedef struct ExprInfo { Tcl_Interp *interp; /* Used for error reporting. */ Tcl_Parse *parsePtr; /* Structure filled with information about * the parsed expression. */ char *expr; /* The expression that was originally passed * to TclCompileExpr. */ char *lastChar; /* Points just after last byte of expr. */ int hasOperators; /* Set 1 if the expr has operators; 0 if * expr is only a primary. If 1 after * compiling an expr, a tryCvtToNumeric * instruction is emitted to convert the * primary to a number if possible. */ int exprIsJustVarRef; /* Set 1 if the expr consists of just a * variable reference as in the expression * of "if $b then...". Otherwise 0. If 1 the * expr is compiled out-of-line in order to * implement expr's 2 level substitution * semantics properly. */ int exprIsComparison; /* Set 1 if the top-level operator in the * expr is a comparison. Otherwise 0. If 1, * because the operands might be strings, * the expr is compiled out-of-line in order * to implement expr's 2 level substitution * semantics properly. */ } ExprInfo; /* * Definitions of numeric codes representing each expression operator. * The order of these must match the entries in the operatorTable below. * Also the codes for the relational operators (OP_LESS, OP_GREATER, * OP_LE, OP_GE, OP_EQ, and OP_NE) must be consecutive and in that order. * Note that OP_PLUS and OP_MINUS represent both unary and binary operators. */ #define OP_MULT 0 #define OP_DIVIDE 1 #define OP_MOD 2 #define OP_PLUS 3 #define OP_MINUS 4 #define OP_LSHIFT 5 #define OP_RSHIFT 6 #define OP_LESS 7 #define OP_GREATER 8 #define OP_LE 9 #define OP_GE 10 #define OP_EQ 11 #define OP_NEQ 12 #define OP_BITAND 13 #define OP_BITXOR 14 #define OP_BITOR 15 #define OP_LAND 16 #define OP_LOR 17 #define OP_QUESTY 18 #define OP_LNOT 19 #define OP_BITNOT 20 /* * Table describing the expression operators. Entries in this table must * correspond to the definitions of numeric codes for operators just above. */ static int opTableInitialized = 0; /* 0 means not yet initialized. */ TCL_DECLARE_MUTEX(opMutex) typedef struct OperatorDesc { char *name; /* Name of the operator. */ int numOperands; /* Number of operands. 0 if the operator * requires special handling. */ int instruction; /* Instruction opcode for the operator. * Ignored if numOperands is 0. */ } OperatorDesc; OperatorDesc operatorTable[] = { {"*", 2, INST_MULT}, {"/", 2, INST_DIV}, {"%", 2, INST_MOD}, {"+", 0}, {"-", 0}, {"<<", 2, INST_LSHIFT}, {">>", 2, INST_RSHIFT}, {"<", 2, INST_LT}, {">", 2, INST_GT}, {"<=", 2, INST_LE}, {">=", 2, INST_GE}, {"==", 2, INST_EQ}, {"!=", 2, INST_NEQ}, {"&", 2, INST_BITAND}, {"^", 2, INST_BITXOR}, {"|", 2, INST_BITOR}, {"&&", 0}, {"||", 0}, {"?", 0}, {"!", 1, INST_LNOT}, {"~", 1, INST_BITNOT}, {NULL} }; /* * Hashtable used to map the names of expression operators to the index * of their OperatorDesc description. */ static Tcl_HashTable opHashTable; /* * Declarations for local procedures to this file: */ static int CompileCondExpr _ANSI_ARGS_(( Tcl_Token *exprTokenPtr, ExprInfo *infoPtr, CompileEnv *envPtr, Tcl_Token **endPtrPtr)); static int CompileLandOrLorExpr _ANSI_ARGS_(( Tcl_Token *exprTokenPtr, int opIndex, ExprInfo *infoPtr, CompileEnv *envPtr, Tcl_Token **endPtrPtr)); static int CompileMathFuncCall _ANSI_ARGS_(( Tcl_Token *exprTokenPtr, char *funcName, ExprInfo *infoPtr, CompileEnv *envPtr, Tcl_Token **endPtrPtr)); static int CompileSubExpr _ANSI_ARGS_(( Tcl_Token *exprTokenPtr, ExprInfo *infoPtr, CompileEnv *envPtr)); static void LogSyntaxError _ANSI_ARGS_((ExprInfo *infoPtr)); /* * Macro used to debug the execution of the expression compiler. */ #ifdef TCL_COMPILE_DEBUG #define TRACE(exprBytes, exprLength, tokenBytes, tokenLength) \ if (traceExprComp) { \ fprintf(stderr, "CompileSubExpr: \"%.*s\", token \"%.*s\"\n", \ (exprLength), (exprBytes), (tokenLength), (tokenBytes)); \ } #else #define TRACE(exprBytes, exprLength, tokenBytes, tokenLength) #endif /* TCL_COMPILE_DEBUG */ /* *---------------------------------------------------------------------- * * TclCompileExpr -- * * This procedure compiles a string containing a Tcl expression into * Tcl bytecodes. This procedure is the top-level interface to the * the expression compilation module, and is used by such public * procedures as Tcl_ExprString, Tcl_ExprStringObj, Tcl_ExprLong, * Tcl_ExprDouble, Tcl_ExprBoolean, and Tcl_ExprBooleanObj. * * Results: * The return value is TCL_OK on a successful compilation and TCL_ERROR * on failure. If TCL_ERROR is returned, then the interpreter's result * contains an error message. * * envPtr->maxStackDepth is updated with the maximum number of stack * elements needed to execute the expression. * * envPtr->exprIsJustVarRef is set 1 if the expression consisted of * a single variable reference as in the expression of "if $b then...". * Otherwise it is set 0. This is used to implement Tcl's two level * expression substitution semantics properly. * * envPtr->exprIsComparison is set 1 if the top-level operator in the * expr is a comparison. Otherwise it is set 0. If 1, because the * operands might be strings, the expr is compiled out-of-line in order * to implement expr's 2 level substitution semantics properly. * * Side effects: * Adds instructions to envPtr to evaluate the expression at runtime. * *---------------------------------------------------------------------- */ int TclCompileExpr(interp, script, numBytes, envPtr) Tcl_Interp *interp; /* Used for error reporting. */ char *script; /* The source script to compile. */ int numBytes; /* Number of bytes in script. If < 0, the * string consists of all bytes up to the * first null character. */ CompileEnv *envPtr; /* Holds resulting instructions. */ { ExprInfo info; Tcl_Parse parse; Tcl_HashEntry *hPtr; int maxDepth, new, i, code; /* * If this is the first time we've been called, initialize the table * of expression operators. */ if (numBytes < 0) { numBytes = (script? strlen(script) : 0); } if (!opTableInitialized) { Tcl_MutexLock(&opMutex); if (!opTableInitialized) { Tcl_InitHashTable(&opHashTable, TCL_STRING_KEYS); for (i = 0; operatorTable[i].name != NULL; i++) { hPtr = Tcl_CreateHashEntry(&opHashTable, operatorTable[i].name, &new); if (new) { Tcl_SetHashValue(hPtr, (ClientData) i); } } opTableInitialized = 1; } Tcl_MutexUnlock(&opMutex); } /* * Initialize the structure containing information abvout this * expression compilation. */ info.interp = interp; info.parsePtr = &parse; info.expr = script; info.lastChar = (script + numBytes); info.hasOperators = 0; info.exprIsJustVarRef = 1; /* will be set 0 if anything else is seen */ info.exprIsComparison = 0; /* * Parse the expression then compile it. */ maxDepth = 0; code = Tcl_ParseExpr(interp, script, numBytes, &parse); if (code != TCL_OK) { goto done; } code = CompileSubExpr(parse.tokenPtr, &info, envPtr); if (code != TCL_OK) { Tcl_FreeParse(&parse); goto done; } maxDepth = envPtr->maxStackDepth; if (!info.hasOperators) { /* * Attempt to convert the primary's object to an int or double. * This is done in order to support Tcl's policy of interpreting * operands if at all possible as first integers, else * floating-point numbers. */ TclEmitOpcode(INST_TRY_CVT_TO_NUMERIC, envPtr); } Tcl_FreeParse(&parse); done: envPtr->maxStackDepth = maxDepth; envPtr->exprIsJustVarRef = info.exprIsJustVarRef; envPtr->exprIsComparison = info.exprIsComparison; return code; } /* *---------------------------------------------------------------------- * * TclFinalizeCompilation -- * * Clean up the compilation environment so it can later be * properly reinitialized. This procedure is called by * TclFinalizeCompExecEnv() in tclObj.c, which in turn is called * by Tcl_Finalize(). * * Results: * None. * * Side effects: * Cleans up the compilation environment. At the moment, just the * table of expression operators is freed. * *---------------------------------------------------------------------- */ void TclFinalizeCompilation() { Tcl_MutexLock(&opMutex); if (opTableInitialized) { Tcl_DeleteHashTable(&opHashTable); opTableInitialized = 0; } Tcl_MutexUnlock(&opMutex); } /* *---------------------------------------------------------------------- * * CompileSubExpr -- * * Given a pointer to a TCL_TOKEN_SUB_EXPR token describing a * subexpression, this procedure emits instructions to evaluate the * subexpression at runtime. * * Results: * The return value is TCL_OK on a successful compilation and TCL_ERROR * on failure. If TCL_ERROR is returned, then the interpreter's result * contains an error message. * * envPtr->maxStackDepth is updated with the maximum number of stack * elements needed to execute the subexpression. * * envPtr->exprIsJustVarRef is set 1 if the subexpression consisted of * a single variable reference as in the expression of "if $b then...". * Otherwise it is set 0. This is used to implement Tcl's two level * expression substitution semantics properly. * * envPtr->exprIsComparison is set 1 if the top-level operator in the * subexpression is a comparison. Otherwise it is set 0. If 1, because * the operands might be strings, the expr is compiled out-of-line in * order to implement expr's 2 level substitution semantics properly. * * Side effects: * Adds instructions to envPtr to evaluate the subexpression. * *---------------------------------------------------------------------- */ static int CompileSubExpr(exprTokenPtr, infoPtr, envPtr) Tcl_Token *exprTokenPtr; /* Points to TCL_TOKEN_SUB_EXPR token * to compile. */ ExprInfo *infoPtr; /* Describes the compilation state for the * expression being compiled. */ CompileEnv *envPtr; /* Holds resulting instructions. */ { Tcl_Interp *interp = infoPtr->interp; Tcl_Token *tokenPtr, *endPtr, *afterSubexprPtr; OperatorDesc *opDescPtr; Tcl_HashEntry *hPtr; char *operator; char savedChar; int maxDepth, objIndex, opIndex, length, code; char buffer[TCL_UTF_MAX]; if (exprTokenPtr->type != TCL_TOKEN_SUB_EXPR) { panic("CompileSubExpr: token type %d not TCL_TOKEN_SUB_EXPR\n", exprTokenPtr->type); } maxDepth = 0; code = TCL_OK; /* * Switch on the type of the first token after the subexpression token. * After processing it, advance tokenPtr to point just after the * subexpression's last token. */ tokenPtr = exprTokenPtr+1; TRACE(exprTokenPtr->start, exprTokenPtr->size, tokenPtr->start, tokenPtr->size); switch (tokenPtr->type) { case TCL_TOKEN_WORD: code = TclCompileTokens(interp, tokenPtr+1, tokenPtr->numComponents, envPtr); if (code != TCL_OK) { goto done; } maxDepth = envPtr->maxStackDepth; tokenPtr += (tokenPtr->numComponents + 1); infoPtr->exprIsJustVarRef = 0; break; case TCL_TOKEN_TEXT: if (tokenPtr->size > 0) { objIndex = TclRegisterLiteral(envPtr, tokenPtr->start, tokenPtr->size, /*onHeap*/ 0); } else { objIndex = TclRegisterLiteral(envPtr, "", 0, /*onHeap*/ 0); } TclEmitPush(objIndex, envPtr); maxDepth = 1; tokenPtr += 1; infoPtr->exprIsJustVarRef = 0; break; case TCL_TOKEN_BS: length = Tcl_UtfBackslash(tokenPtr->start, (int *) NULL, buffer); if (length > 0) { objIndex = TclRegisterLiteral(envPtr, buffer, length, /*onHeap*/ 0); } else { objIndex = TclRegisterLiteral(envPtr, "", 0, /*onHeap*/ 0); } TclEmitPush(objIndex, envPtr); maxDepth = 1; tokenPtr += 1; infoPtr->exprIsJustVarRef = 0; break; case TCL_TOKEN_COMMAND: code = TclCompileScript(interp, tokenPtr->start+1, tokenPtr->size-2, /*nested*/ 1, envPtr); if (code != TCL_OK) { goto done; } maxDepth = envPtr->maxStackDepth; tokenPtr += 1; infoPtr->exprIsJustVarRef = 0; break; case TCL_TOKEN_VARIABLE: code = TclCompileTokens(interp, tokenPtr, 1, envPtr); if (code != TCL_OK) { goto done; } maxDepth = envPtr->maxStackDepth; tokenPtr += (tokenPtr->numComponents + 1); break; case TCL_TOKEN_SUB_EXPR: infoPtr->exprIsComparison = 0; code = CompileSubExpr(tokenPtr, infoPtr, envPtr); if (code != TCL_OK) { goto done; } maxDepth = envPtr->maxStackDepth; tokenPtr += (tokenPtr->numComponents + 1); break; case TCL_TOKEN_OPERATOR: /* * Look up the operator. Temporarily overwrite the character * just after the end of the operator with a 0 byte. If the * operator isn't found, treat it as a math function. */ /* * TODO: Note that the string is modified in place. This is unsafe * and will break if any of the routines called while the string is * modified have side effects that depend on the original string * being unmodified (e.g. adding an entry to the literal table). */ operator = tokenPtr->start; savedChar = operator[tokenPtr->size]; operator[tokenPtr->size] = 0; hPtr = Tcl_FindHashEntry(&opHashTable, operator); if (hPtr == NULL) { code = CompileMathFuncCall(exprTokenPtr, operator, infoPtr, envPtr, &endPtr); operator[tokenPtr->size] = (char) savedChar; if (code != TCL_OK) { goto done; } maxDepth = envPtr->maxStackDepth; tokenPtr = endPtr; infoPtr->exprIsJustVarRef = 0; infoPtr->exprIsComparison = 0; break; } operator[tokenPtr->size] = (char) savedChar; opIndex = (int) Tcl_GetHashValue(hPtr); opDescPtr = &(operatorTable[opIndex]); /* * If the operator is "normal", compile it using information * from the operator table. */ if (opDescPtr->numOperands > 0) { tokenPtr++; code = CompileSubExpr(tokenPtr, infoPtr, envPtr); if (code != TCL_OK) { goto done; } maxDepth = envPtr->maxStackDepth; tokenPtr += (tokenPtr->numComponents + 1); if (opDescPtr->numOperands == 2) { code = CompileSubExpr(tokenPtr, infoPtr, envPtr); if (code != TCL_OK) { goto done; } maxDepth = TclMax((envPtr->maxStackDepth + 1), maxDepth); tokenPtr += (tokenPtr->numComponents + 1); } TclEmitOpcode(opDescPtr->instruction, envPtr); infoPtr->hasOperators = 1; infoPtr->exprIsJustVarRef = 0; infoPtr->exprIsComparison = ((opIndex >= OP_LESS) && (opIndex <= OP_NEQ)); break; } /* * The operator requires special treatment, and is either * "+" or "-", or one of "&&", "||" or "?". */ switch (opIndex) { case OP_PLUS: case OP_MINUS: tokenPtr++; code = CompileSubExpr(tokenPtr, infoPtr, envPtr); if (code != TCL_OK) { goto done; } maxDepth = envPtr->maxStackDepth; tokenPtr += (tokenPtr->numComponents + 1); /* * Check whether the "+" or "-" is unary. */ afterSubexprPtr = exprTokenPtr + exprTokenPtr->numComponents+1; if (tokenPtr == afterSubexprPtr) { TclEmitOpcode(((opIndex==OP_PLUS)? INST_UPLUS : INST_UMINUS), envPtr); break; } /* * The "+" or "-" is binary. */ code = CompileSubExpr(tokenPtr, infoPtr, envPtr); if (code != TCL_OK) { goto done; } maxDepth = TclMax((envPtr->maxStackDepth + 1), maxDepth); tokenPtr += (tokenPtr->numComponents + 1); TclEmitOpcode(((opIndex==OP_PLUS)? INST_ADD : INST_SUB), envPtr); break; case OP_LAND: case OP_LOR: code = CompileLandOrLorExpr(exprTokenPtr, opIndex, infoPtr, envPtr, &endPtr); if (code != TCL_OK) { goto done; } maxDepth = envPtr->maxStackDepth; tokenPtr = endPtr; break; case OP_QUESTY: code = CompileCondExpr(exprTokenPtr, infoPtr, envPtr, &endPtr); if (code != TCL_OK) { goto done; } maxDepth = envPtr->maxStackDepth; tokenPtr = endPtr; break; default: panic("CompileSubExpr: unexpected operator %d requiring special treatment\n", opIndex); } /* end switch on operator requiring special treatment */ infoPtr->hasOperators = 1; infoPtr->exprIsJustVarRef = 0; infoPtr->exprIsComparison = 0; break; default: panic("CompileSubExpr: unexpected token type %d\n", tokenPtr->type); } /* * Verify that the subexpression token had the required number of * subtokens: that we've advanced tokenPtr just beyond the * subexpression's last token. For example, a "*" subexpression must * contain the tokens for exactly two operands. */ if (tokenPtr != (exprTokenPtr + exprTokenPtr->numComponents+1)) { LogSyntaxError(infoPtr); code = TCL_ERROR; } done: envPtr->maxStackDepth = maxDepth; return code; } /* *---------------------------------------------------------------------- * * CompileLandOrLorExpr -- * * This procedure compiles a Tcl logical and ("&&") or logical or * ("||") subexpression. * * Results: * The return value is TCL_OK on a successful compilation and TCL_ERROR * on failure. If TCL_OK is returned, a pointer to the token just after * the last one in the subexpression is stored at the address in * endPtrPtr. If TCL_ERROR is returned, then the interpreter's result * contains an error message. * * envPtr->maxStackDepth is updated with the maximum number of stack * elements needed to execute the expression. * * Side effects: * Adds instructions to envPtr to evaluate the expression at runtime. * *---------------------------------------------------------------------- */ static int CompileLandOrLorExpr(exprTokenPtr, opIndex, infoPtr, envPtr, endPtrPtr) Tcl_Token *exprTokenPtr; /* Points to TCL_TOKEN_SUB_EXPR token * containing the "&&" or "||" operator. */ int opIndex; /* A code describing the expression * operator: either OP_LAND or OP_LOR. */ ExprInfo *infoPtr; /* Describes the compilation state for the * expression being compiled. */ CompileEnv *envPtr; /* Holds resulting instructions. */ Tcl_Token **endPtrPtr; /* If successful, a pointer to the token * just after the last token in the * subexpression is stored here. */ { JumpFixup shortCircuitFixup; /* Used to fix up the short circuit jump * after the first subexpression. */ JumpFixup lhsTrueFixup, lhsEndFixup; /* Used to fix up jumps used to convert the * first operand to 0 or 1. */ Tcl_Token *tokenPtr; int dist, maxDepth, code; /* * Emit code for the first operand. */ maxDepth = 0; tokenPtr = exprTokenPtr+2; code = CompileSubExpr(tokenPtr, infoPtr, envPtr); if (code != TCL_OK) { goto done; } maxDepth = envPtr->maxStackDepth; tokenPtr += (tokenPtr->numComponents + 1); /* * Convert the first operand to the result that Tcl requires: * "0" or "1". Eventually we'll use a new instruction for this. */ TclEmitForwardJump(envPtr, TCL_TRUE_JUMP, &lhsTrueFixup); TclEmitPush(TclRegisterLiteral(envPtr, "0", 1, /*onHeap*/ 0), envPtr); TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &lhsEndFixup); dist = (envPtr->codeNext - envPtr->codeStart) - lhsTrueFixup.codeOffset; if (TclFixupForwardJump(envPtr, &lhsTrueFixup, dist, 127)) { badDist: panic("CompileLandOrLorExpr: bad jump distance %d\n", dist); } TclEmitPush(TclRegisterLiteral(envPtr, "1", 1, /*onHeap*/ 0), envPtr); dist = (envPtr->codeNext - envPtr->codeStart) - lhsEndFixup.codeOffset; if (TclFixupForwardJump(envPtr, &lhsEndFixup, dist, 127)) { goto badDist; } /* * Emit the "short circuit" jump around the rest of the expression. * Duplicate the "0" or "1" on top of the stack first to keep the * jump from consuming it. */ TclEmitOpcode(INST_DUP, envPtr); TclEmitForwardJump(envPtr, ((opIndex==OP_LAND)? TCL_FALSE_JUMP : TCL_TRUE_JUMP), &shortCircuitFixup); /* * Emit code for the second operand. */ code = CompileSubExpr(tokenPtr, infoPtr, envPtr); if (code != TCL_OK) { goto done; } maxDepth = TclMax((envPtr->maxStackDepth + 1), maxDepth); tokenPtr += (tokenPtr->numComponents + 1); /* * Emit a "logical and" or "logical or" instruction. This does not try * to "short- circuit" the evaluation of both operands, but instead * ensures that we either have a "1" or a "0" result. */ TclEmitOpcode(((opIndex==OP_LAND)? INST_LAND : INST_LOR), envPtr); /* * Now that we know the target of the forward jump, update it with the * correct distance. */ dist = (envPtr->codeNext - envPtr->codeStart) - shortCircuitFixup.codeOffset; TclFixupForwardJump(envPtr, &shortCircuitFixup, dist, 127); *endPtrPtr = tokenPtr; done: envPtr->maxStackDepth = maxDepth; return code; } /* *---------------------------------------------------------------------- * * CompileCondExpr -- * * This procedure compiles a Tcl conditional expression: * condExpr ::= lorExpr ['?' condExpr ':' condExpr] * * Results: * The return value is TCL_OK on a successful compilation and TCL_ERROR * on failure. If TCL_OK is returned, a pointer to the token just after * the last one in the subexpression is stored at the address in * endPtrPtr. If TCL_ERROR is returned, then the interpreter's result * contains an error message. * * envPtr->maxStackDepth is updated with the maximum number of stack * elements needed to execute the expression. * * Side effects: * Adds instructions to envPtr to evaluate the expression at runtime. * *---------------------------------------------------------------------- */ static int CompileCondExpr(exprTokenPtr, infoPtr, envPtr, endPtrPtr) Tcl_Token *exprTokenPtr; /* Points to TCL_TOKEN_SUB_EXPR token * containing the "?" operator. */ ExprInfo *infoPtr; /* Describes the compilation state for the * expression being compiled. */ CompileEnv *envPtr; /* Holds resulting instructions. */ Tcl_Token **endPtrPtr; /* If successful, a pointer to the token * just after the last token in the * subexpression is stored here. */ { JumpFixup jumpAroundThenFixup, jumpAroundElseFixup; /* Used to update or replace one-byte jumps * around the then and else expressions when * their target PCs are determined. */ Tcl_Token *tokenPtr; int elseCodeOffset, dist, maxDepth, code; /* * Emit code for the test. */ maxDepth = 0; tokenPtr = exprTokenPtr+2; code = CompileSubExpr(tokenPtr, infoPtr, envPtr); if (code != TCL_OK) { goto done; } maxDepth = envPtr->maxStackDepth; tokenPtr += (tokenPtr->numComponents + 1); /* * Emit the jump to the "else" expression if the test was false. */ TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, &jumpAroundThenFixup); /* * Compile the "then" expression. Note that if a subexpression is only * a primary, we need to try to convert it to numeric. We do this to * support Tcl's policy of interpreting operands if at all possible as * first integers, else floating-point numbers. */ infoPtr->hasOperators = 0; code = CompileSubExpr(tokenPtr, infoPtr, envPtr); if (code != TCL_OK) { goto done; } maxDepth = TclMax(envPtr->maxStackDepth, maxDepth); tokenPtr += (tokenPtr->numComponents + 1); if (!infoPtr->hasOperators) { TclEmitOpcode(INST_TRY_CVT_TO_NUMERIC, envPtr); } /* * Emit an unconditional jump around the "else" condExpr. */ TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &jumpAroundElseFixup); /* * Compile the "else" expression. */ elseCodeOffset = (envPtr->codeNext - envPtr->codeStart); infoPtr->hasOperators = 0; code = CompileSubExpr(tokenPtr, infoPtr, envPtr); if (code != TCL_OK) { goto done; } maxDepth = TclMax(envPtr->maxStackDepth, maxDepth); tokenPtr += (tokenPtr->numComponents + 1); if (!infoPtr->hasOperators) { TclEmitOpcode(INST_TRY_CVT_TO_NUMERIC, envPtr); } /* * Fix up the second jump around the "else" expression. */ dist = (envPtr->codeNext - envPtr->codeStart) - jumpAroundElseFixup.codeOffset; if (TclFixupForwardJump(envPtr, &jumpAroundElseFixup, dist, 127)) { /* * Update the else expression's starting code offset since it * moved down 3 bytes too. */ elseCodeOffset += 3; } /* * Fix up the first jump to the "else" expression if the test was false. */ dist = (elseCodeOffset - jumpAroundThenFixup.codeOffset); TclFixupForwardJump(envPtr, &jumpAroundThenFixup, dist, 127); *endPtrPtr = tokenPtr; done: envPtr->maxStackDepth = maxDepth; return code; } /* *---------------------------------------------------------------------- * * CompileMathFuncCall -- * * This procedure compiles a call on a math function in an expression: * mathFuncCall ::= funcName '(' [condExpr {',' condExpr}] ')' * * Results: * The return value is TCL_OK on a successful compilation and TCL_ERROR * on failure. If TCL_OK is returned, a pointer to the token just after * the last one in the subexpression is stored at the address in * endPtrPtr. If TCL_ERROR is returned, then the interpreter's result * contains an error message. * * envPtr->maxStackDepth is updated with the maximum number of stack * elements needed to execute the function. * * Side effects: * Adds instructions to envPtr to evaluate the math function at * runtime. * *---------------------------------------------------------------------- */ static int CompileMathFuncCall(exprTokenPtr, funcName, infoPtr, envPtr, endPtrPtr) Tcl_Token *exprTokenPtr; /* Points to TCL_TOKEN_SUB_EXPR token * containing the math function call. */ char *funcName; /* Name of the math function. */ ExprInfo *infoPtr; /* Describes the compilation state for the * expression being compiled. */ CompileEnv *envPtr; /* Holds resulting instructions. */ Tcl_Token **endPtrPtr; /* If successful, a pointer to the token * just after the last token in the * subexpression is stored here. */ { Tcl_Interp *interp = infoPtr->interp; Interp *iPtr = (Interp *) interp; MathFunc *mathFuncPtr; Tcl_HashEntry *hPtr; Tcl_Token *tokenPtr, *afterSubexprPtr; int maxDepth, code, i; /* * Look up the MathFunc record for the function. */ code = TCL_OK; maxDepth = 0; hPtr = Tcl_FindHashEntry(&iPtr->mathFuncTable, funcName); if (hPtr == NULL) { Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "unknown math function \"", funcName, "\"", (char *) NULL); code = TCL_ERROR; goto done; } mathFuncPtr = (MathFunc *) Tcl_GetHashValue(hPtr); /* * If not a builtin function, push an object with the function's name. */ if (mathFuncPtr->builtinFuncIndex < 0) { TclEmitPush(TclRegisterLiteral(envPtr, funcName, -1, /*onHeap*/ 0), envPtr); maxDepth = 1; } /* * Compile any arguments for the function. */ tokenPtr = exprTokenPtr+2; afterSubexprPtr = exprTokenPtr + (exprTokenPtr->numComponents + 1); if (mathFuncPtr->numArgs > 0) { for (i = 0; i < mathFuncPtr->numArgs; i++) { if (tokenPtr == afterSubexprPtr) { Tcl_ResetResult(interp); Tcl_AppendToObj(Tcl_GetObjResult(interp), "too few arguments for math function", -1); code = TCL_ERROR; goto done; } infoPtr->exprIsComparison = 0; code = CompileSubExpr(tokenPtr, infoPtr, envPtr); if (code != TCL_OK) { goto done; } tokenPtr += (tokenPtr->numComponents + 1); maxDepth++; } if (tokenPtr != afterSubexprPtr) { Tcl_ResetResult(interp); Tcl_AppendToObj(Tcl_GetObjResult(interp), "too many arguments for math function", -1); code = TCL_ERROR; goto done; } } else if (tokenPtr != afterSubexprPtr) { Tcl_ResetResult(interp); Tcl_AppendToObj(Tcl_GetObjResult(interp), "too many arguments for math function", -1); code = TCL_ERROR; goto done; } /* * Compile the call on the math function. Note that the "objc" argument * count for non-builtin functions is incremented by 1 to include the * function name itself. */ if (mathFuncPtr->builtinFuncIndex >= 0) { /* a builtin function */ TclEmitInstInt1(INST_CALL_BUILTIN_FUNC1, mathFuncPtr->builtinFuncIndex, envPtr); } else { TclEmitInstInt1(INST_CALL_FUNC1, (mathFuncPtr->numArgs+1), envPtr); } *endPtrPtr = afterSubexprPtr; done: envPtr->maxStackDepth = maxDepth; return code; } /* *---------------------------------------------------------------------- * * LogSyntaxError -- * * This procedure is invoked after an error occurs when compiling an * expression. It sets the interpreter result to an error message * describing the error. * * Results: * None. * * Side effects: * Sets the interpreter result to an error message describing the * expression that was being compiled when the error occurred. * *---------------------------------------------------------------------- */ static void LogSyntaxError(infoPtr) ExprInfo *infoPtr; /* Describes the compilation state for the * expression being compiled. */ { int numBytes = (infoPtr->lastChar - infoPtr->expr); char buffer[100]; sprintf(buffer, "syntax error in expression \"%.*s\"", ((numBytes > 60)? 60 : numBytes), infoPtr->expr); Tcl_AppendStringsToObj(Tcl_GetObjResult(infoPtr->interp), buffer, (char *) NULL); } /* $History: tclcompexpr.c $ * * ***************** Version 1 ***************** * User: Dtashley Date: 1/02/01 Time: 1:27a * Created in $/IjuScripter, IjuConsole/Source/Tcl Base * Initial check-in. */ /* End of TCLCOMPEXPR.C */