diff options
Diffstat (limited to 'generic/tclCompExpr.c')
| -rw-r--r-- | generic/tclCompExpr.c | 538 |
1 files changed, 267 insertions, 271 deletions
diff --git a/generic/tclCompExpr.c b/generic/tclCompExpr.c index e378ef6..9ca9f73 100644 --- a/generic/tclCompExpr.c +++ b/generic/tclCompExpr.c @@ -1,4 +1,4 @@ -/* +/* * tclCompExpr.c -- * * This file contains the code to compile Tcl expressions. @@ -6,10 +6,10 @@ * Copyright (c) 1997 Sun Microsystems, Inc. * Copyright (c) 1998-2000 by Scriptics Corporation. * - * See the file "license.terms" for information on usage and redistribution - * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + * 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.26 2005/05/10 18:34:11 kennykb Exp $ + * RCS: @(#) $Id: tclCompExpr.c,v 1.27 2005/07/17 21:17:40 dkf Exp $ */ #include "tclInt.h" @@ -17,8 +17,8 @@ /* * 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. + * environments that include no UNIX, i.e. no errno: just arrange to use the + * errno from tclExecute.c here. */ #ifdef TCL_GENERIC_ONLY @@ -31,8 +31,8 @@ extern int errno; /* Use errno from tclExecute.c. */ #endif /* - * Boolean variable that controls whether expression compilation tracing - * is enabled. + * Boolean variable that controls whether expression compilation tracing is + * enabled. */ #ifdef TCL_COMPILE_DEBUG @@ -40,31 +40,30 @@ 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. + * 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. */ + Tcl_Parse *parsePtr; /* Structure filled with information about the + * parsed expression. */ CONST char *expr; /* The expression that was originally passed * to TclCompileExpr. */ CONST 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 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. */ } 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. + * 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 @@ -115,7 +114,7 @@ static OperatorDesc operatorTable[] = { {"*", 2, INST_MULT}, {"/", 2, INST_DIV}, {"%", 2, INST_MOD}, - {"+", 0}, + {"+", 0}, {"-", 0}, {"<<", 2, INST_LSHIFT}, {">>", 2, INST_RSHIFT}, @@ -142,8 +141,8 @@ static OperatorDesc operatorTable[] = { }; /* - * Hashtable used to map the names of expression operators to the index - * of their OperatorDesc description. + * Hashtable used to map the names of expression operators to the index of + * their OperatorDesc description. */ static Tcl_HashTable opHashTable; @@ -176,7 +175,7 @@ static void LogSyntaxError _ANSI_ARGS_((ExprInfo *infoPtr)); #define TRACE(exprBytes, exprLength, tokenBytes, tokenLength) \ if (traceExprComp) { \ fprintf(stderr, "CompileSubExpr: \"%.*s\", token \"%.*s\"\n", \ - (exprLength), (exprBytes), (tokenLength), (tokenBytes)); \ + (exprLength), (exprBytes), (tokenLength), (tokenBytes)); \ } #else #define TRACE(exprBytes, exprLength, tokenBytes, tokenLength) @@ -187,11 +186,11 @@ static void LogSyntaxError _ANSI_ARGS_((ExprInfo *infoPtr)); * * 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. + * 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 @@ -219,8 +218,8 @@ TclCompileExpr(interp, script, numBytes, envPtr) int new, i, code; /* - * If this is the first time we've been called, initialize the table - * of expression operators. + * If this is the first time we've been called, initialize the table of + * expression operators. */ if (numBytes < 0) { @@ -243,14 +242,14 @@ TclCompileExpr(interp, script, numBytes, envPtr) } /* - * Initialize the structure containing information abvout this - * expression compilation. + * Initialize the structure containing information abvout this expression + * compilation. */ info.interp = interp; info.parsePtr = &parse; info.expr = script; - info.lastChar = (script + numBytes); + info.lastChar = (script + numBytes); info.hasOperators = 0; /* @@ -267,20 +266,19 @@ TclCompileExpr(interp, script, numBytes, envPtr) Tcl_FreeParse(&parse); goto done; } - + 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. + * 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: + done: return code; } @@ -289,17 +287,16 @@ TclCompileExpr(interp, script, numBytes, envPtr) * * 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(). + * 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. + * Cleans up the compilation environment. At the moment, just the table + * of expression operators is freed. * *---------------------------------------------------------------------- */ @@ -309,8 +306,8 @@ TclFinalizeCompilation() { Tcl_MutexLock(&opMutex); if (opTableInitialized) { - Tcl_DeleteHashTable(&opHashTable); - opTableInitialized = 0; + Tcl_DeleteHashTable(&opHashTable); + opTableInitialized = 0; } Tcl_MutexUnlock(&opMutex); } @@ -337,8 +334,8 @@ TclFinalizeCompilation() static int CompileSubExpr(exprTokenPtr, infoPtr, envPtr) - Tcl_Token *exprTokenPtr; /* Points to TCL_TOKEN_SUB_EXPR token - * to compile. */ + 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. */ @@ -354,7 +351,7 @@ CompileSubExpr(exprTokenPtr, infoPtr, envPtr) if (exprTokenPtr->type != TCL_TOKEN_SUB_EXPR) { Tcl_Panic("CompileSubExpr: token type %d not TCL_TOKEN_SUB_EXPR\n", - exprTokenPtr->type); + exprTokenPtr->type); } code = TCL_OK; @@ -363,192 +360,184 @@ CompileSubExpr(exprTokenPtr, infoPtr, envPtr) * 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: - TclCompileTokens(interp, tokenPtr+1, - tokenPtr->numComponents, envPtr); - tokenPtr += (tokenPtr->numComponents + 1); - break; - - case TCL_TOKEN_TEXT: - if (tokenPtr->size > 0) { - objIndex = TclRegisterNewLiteral(envPtr, tokenPtr->start, - tokenPtr->size); - } else { - objIndex = TclRegisterNewLiteral(envPtr, "", 0); + case TCL_TOKEN_WORD: + TclCompileTokens(interp, tokenPtr+1, tokenPtr->numComponents, envPtr); + tokenPtr += (tokenPtr->numComponents + 1); + break; + + case TCL_TOKEN_TEXT: + if (tokenPtr->size > 0) { + objIndex = TclRegisterNewLiteral(envPtr, tokenPtr->start, + tokenPtr->size); + } else { + objIndex = TclRegisterNewLiteral(envPtr, "", 0); + } + TclEmitPush(objIndex, envPtr); + tokenPtr += 1; + break; + + case TCL_TOKEN_BS: + length = Tcl_UtfBackslash(tokenPtr->start, (int *) NULL, buffer); + if (length > 0) { + objIndex = TclRegisterNewLiteral(envPtr, buffer, length); + } else { + objIndex = TclRegisterNewLiteral(envPtr, "", 0); + } + TclEmitPush(objIndex, envPtr); + tokenPtr += 1; + break; + + case TCL_TOKEN_COMMAND: + TclCompileScript(interp, tokenPtr->start+1, tokenPtr->size-2, envPtr); + tokenPtr += 1; + break; + + case TCL_TOKEN_VARIABLE: + TclCompileTokens(interp, tokenPtr, 1, envPtr); + tokenPtr += (tokenPtr->numComponents + 1); + break; + + case TCL_TOKEN_SUB_EXPR: + code = CompileSubExpr(tokenPtr, infoPtr, envPtr); + if (code != TCL_OK) { + goto done; + } + tokenPtr += (tokenPtr->numComponents + 1); + break; + + case TCL_TOKEN_OPERATOR: + /* + * Look up the operator. If the operator isn't found, treat it as a + * math function. + */ + Tcl_DStringInit(&opBuf); + operator = Tcl_DStringAppend(&opBuf, tokenPtr->start, tokenPtr->size); + hPtr = Tcl_FindHashEntry(&opHashTable, operator); + if (hPtr == NULL) { + code = CompileMathFuncCall(exprTokenPtr, operator, infoPtr, envPtr, + &endPtr); + Tcl_DStringFree(&opBuf); + if (code != TCL_OK) { + goto done; } - TclEmitPush(objIndex, envPtr); - tokenPtr += 1; + tokenPtr = endPtr; break; - - case TCL_TOKEN_BS: - length = Tcl_UtfBackslash(tokenPtr->start, (int *) NULL, - buffer); - if (length > 0) { - objIndex = TclRegisterNewLiteral(envPtr, buffer, length); - } else { - objIndex = TclRegisterNewLiteral(envPtr, "", 0); + } + Tcl_DStringFree(&opBuf); + 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; } - TclEmitPush(objIndex, envPtr); - tokenPtr += 1; - break; - - case TCL_TOKEN_COMMAND: - TclCompileScript(interp, tokenPtr->start+1, - tokenPtr->size-2, envPtr); - tokenPtr += 1; - break; - - case TCL_TOKEN_VARIABLE: - TclCompileTokens(interp, tokenPtr, 1, envPtr); tokenPtr += (tokenPtr->numComponents + 1); + + if (opDescPtr->numOperands == 2) { + code = CompileSubExpr(tokenPtr, infoPtr, envPtr); + if (code != TCL_OK) { + goto done; + } + tokenPtr += (tokenPtr->numComponents + 1); + } + TclEmitOpcode(opDescPtr->instruction, envPtr); + infoPtr->hasOperators = 1; break; - - case TCL_TOKEN_SUB_EXPR: + } + + /* + * 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; } tokenPtr += (tokenPtr->numComponents + 1); - break; - - case TCL_TOKEN_OPERATOR: + /* - * Look up the operator. If the operator isn't found, treat it - * as a math function. + * Check whether the "+" or "-" is unary. */ - Tcl_DStringInit(&opBuf); - operator = Tcl_DStringAppend(&opBuf, - tokenPtr->start, tokenPtr->size); - hPtr = Tcl_FindHashEntry(&opHashTable, operator); - if (hPtr == NULL) { - code = CompileMathFuncCall(exprTokenPtr, operator, infoPtr, - envPtr, &endPtr); - Tcl_DStringFree(&opBuf); - if (code != TCL_OK) { - goto done; - } - tokenPtr = endPtr; + + afterSubexprPtr = exprTokenPtr + exprTokenPtr->numComponents+1; + if (tokenPtr == afterSubexprPtr) { + TclEmitOpcode(((opIndex==OP_PLUS)? INST_UPLUS : INST_UMINUS), + envPtr); break; } - Tcl_DStringFree(&opBuf); - opIndex = (int) Tcl_GetHashValue(hPtr); - opDescPtr = &(operatorTable[opIndex]); /* - * If the operator is "normal", compile it using information - * from the operator table. + * The "+" or "-" is binary. */ - if (opDescPtr->numOperands > 0) { - tokenPtr++; - code = CompileSubExpr(tokenPtr, infoPtr, envPtr); - if (code != TCL_OK) { - goto done; - } - tokenPtr += (tokenPtr->numComponents + 1); + code = CompileSubExpr(tokenPtr, infoPtr, envPtr); + if (code != TCL_OK) { + goto done; + } + tokenPtr += (tokenPtr->numComponents + 1); + TclEmitOpcode(((opIndex==OP_PLUS)? INST_ADD : INST_SUB), envPtr); + break; - if (opDescPtr->numOperands == 2) { - code = CompileSubExpr(tokenPtr, infoPtr, envPtr); - if (code != TCL_OK) { - goto done; - } - tokenPtr += (tokenPtr->numComponents + 1); - } - TclEmitOpcode(opDescPtr->instruction, envPtr); - infoPtr->hasOperators = 1; - break; + case OP_LAND: + case OP_LOR: + code = CompileLandOrLorExpr(exprTokenPtr, opIndex, infoPtr, envPtr, + &endPtr); + if (code != TCL_OK) { + goto done; } - - /* - * 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; - } - 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; - } - 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; - } - tokenPtr = endPtr; - break; - - case OP_QUESTY: - code = CompileCondExpr(exprTokenPtr, infoPtr, - envPtr, &endPtr); - if (code != TCL_OK) { - goto done; - } - tokenPtr = endPtr; - break; - - default: - Tcl_Panic("CompileSubExpr: unexpected operator %d requiring special treatment\n", - opIndex); - } /* end switch on operator requiring special treatment */ - infoPtr->hasOperators = 1; + tokenPtr = endPtr; + break; + + case OP_QUESTY: + code = CompileCondExpr(exprTokenPtr, infoPtr, envPtr, &endPtr); + if (code != TCL_OK) { + goto done; + } + tokenPtr = endPtr; break; - default: - Tcl_Panic("CompileSubExpr: unexpected token type %d\n", - tokenPtr->type); + default: + Tcl_Panic("CompileSubExpr: unexpected operator %d requiring special treatment\n", + opIndex); + } /* end switch on operator requiring special treatment */ + infoPtr->hasOperators = 1; + break; + + default: + Tcl_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. + * 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: + + done: return code; } @@ -557,8 +546,8 @@ CompileSubExpr(exprTokenPtr, infoPtr, envPtr) * * CompileLandOrLorExpr -- * - * This procedure compiles a Tcl logical and ("&&") or logical or - * ("||") subexpression. + * 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 @@ -575,22 +564,23 @@ CompileSubExpr(exprTokenPtr, infoPtr, envPtr) 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. */ + 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 shortCircuitFixup2;/* Used to fix up the second jump to the - * short-circuit target. */ - JumpFixup endFixup; /* Used to fix up jump to the end. */ + JumpFixup shortCircuitFixup;/* Used to fix up the short circuit jump after + * the first subexpression. */ + JumpFixup shortCircuitFixup2; + /* Used to fix up the second jump to the + * short-circuit target. */ + JumpFixup endFixup; /* Used to fix up jump to the end. */ Tcl_Token *tokenPtr; int code; int savedStackDepth = envPtr->currStackDepth; @@ -623,11 +613,11 @@ CompileLandOrLorExpr(exprTokenPtr, opIndex, infoPtr, envPtr, endPtrPtr) goto done; } tokenPtr += (tokenPtr->numComponents + 1); - + /* - * The result is the boolean value of the second operand. We - * code this in a somewhat contorted manner to be able to reuse - * the shortCircuit value and save one INST_JUMP. + * The result is the boolean value of the second operand. We code this in + * a somewhat contorted manner to be able to reuse the shortCircuit value + * and save one INST_JUMP. */ TclEmitForwardJump(envPtr, @@ -642,8 +632,8 @@ CompileLandOrLorExpr(exprTokenPtr, opIndex, infoPtr, envPtr, endPtrPtr) TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &endFixup); /* - * Fixup the short-circuit jumps and push the shortCircuit value. - * Note that shortCircuitFixup2 is always a short jump. + * Fixup the short-circuit jumps and push the shortCircuit value. Note + * that shortCircuitFixup2 is always a short jump. */ TclFixupForwardJumpToHere(envPtr, &shortCircuitFixup2, 127); @@ -651,7 +641,7 @@ CompileLandOrLorExpr(exprTokenPtr, opIndex, infoPtr, envPtr, endPtrPtr) /* * shortCircuit jump grown by 3 bytes: update endFixup. */ - + endFixup.codeOffset += 3; } @@ -664,7 +654,7 @@ CompileLandOrLorExpr(exprTokenPtr, opIndex, infoPtr, envPtr, endPtrPtr) TclFixupForwardJumpToHere(envPtr, &endFixup, 127); *endPtrPtr = tokenPtr; - done: + done: envPtr->currStackDepth = savedStackDepth + 1; return code; } @@ -697,9 +687,9 @@ CompileCondExpr(exprTokenPtr, infoPtr, envPtr, endPtrPtr) 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_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 @@ -719,18 +709,18 @@ CompileCondExpr(exprTokenPtr, infoPtr, envPtr, endPtrPtr) goto done; } 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. + * 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; @@ -746,9 +736,8 @@ CompileCondExpr(exprTokenPtr, infoPtr, envPtr, endPtrPtr) /* * Emit an unconditional jump around the "else" condExpr. */ - - TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, - &jumpAroundElseFixup); + + TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &jumpAroundElseFixup); /* * Compile the "else" expression. @@ -774,22 +763,22 @@ CompileCondExpr(exprTokenPtr, infoPtr, envPtr, endPtrPtr) - jumpAroundElseFixup.codeOffset; if (TclFixupForwardJump(envPtr, &jumpAroundElseFixup, dist, 127)) { /* - * Update the else expression's starting code offset since it - * moved down 3 bytes too. + * 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: + done: envPtr->currStackDepth = savedStackDepth + 1; return code; } @@ -824,31 +813,30 @@ CompileMathFuncCall(exprTokenPtr, funcName, infoPtr, envPtr, endPtrPtr) 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_Token **endPtrPtr; /* If successful, a pointer to the token just + * after the last token in the subexpression + * is stored here. */ { Tcl_DString cmdName; int objIndex; Tcl_Token *tokenPtr, *afterSubexprPtr; int argCount; int code = TCL_OK; - + /* - * Prepend "tcl::mathfunc::" to the function name, to produce the - * name of a command that evaluates the function. Push that - * command name on the stack, in a literal registered to the - * namespace so that resolution can be cached. + * Prepend "tcl::mathfunc::" to the function name, to produce the name of + * a command that evaluates the function. Push that command name on the + * stack, in a literal registered to the namespace so that resolution can + * be cached. */ - Tcl_DStringInit( &cmdName ); - Tcl_DStringAppend( &cmdName, "tcl::mathfunc::", -1 ); - Tcl_DStringAppend( &cmdName, funcName, -1 ); - objIndex = TclRegisterNewNSLiteral( envPtr, - Tcl_DStringValue( &cmdName ), - Tcl_DStringLength( &cmdName ) ); - TclEmitPush( objIndex, envPtr ); - Tcl_DStringFree( &cmdName ); + Tcl_DStringInit(&cmdName); + Tcl_DStringAppend(&cmdName, "tcl::mathfunc::", -1); + Tcl_DStringAppend(&cmdName, funcName, -1); + objIndex = TclRegisterNewNSLiteral(envPtr, Tcl_DStringValue(&cmdName), + Tcl_DStringLength(&cmdName)); + TclEmitPush(objIndex, envPtr); + Tcl_DStringFree(&cmdName); /* * Compile any arguments for the function. @@ -865,13 +853,13 @@ CompileMathFuncCall(exprTokenPtr, funcName, infoPtr, envPtr, endPtrPtr) } tokenPtr += (tokenPtr->numComponents + 1); } - + /* Invoke the function */ - if ( argCount < 255 ) { - TclEmitInstInt1( INST_INVOKE_STK1, argCount, envPtr ); + if (argCount < 255) { + TclEmitInstInt1(INST_INVOKE_STK1, argCount, envPtr); } else { - TclEmitInstInt4( INST_INVOKE_STK4, argCount, envPtr ); + TclEmitInstInt4(INST_INVOKE_STK4, argCount, envPtr); } *endPtrPtr = afterSubexprPtr; @@ -903,9 +891,17 @@ LogSyntaxError(infoPtr) * expression being compiled. */ { Tcl_Obj *result = - Tcl_NewStringObj("syntax error in expression \"", -1); + Tcl_NewStringObj("syntax error in expression \"", -1); TclAppendLimitedToObj(result, infoPtr->expr, - (int)(infoPtr->lastChar - infoPtr->expr), 60, ""); + (int)(infoPtr->lastChar - infoPtr->expr), 60, ""); Tcl_AppendToObj(result, "\"", -1); Tcl_SetObjResult(infoPtr->interp, result); } + +/* + * Local Variables: + * mode: c + * c-basic-offset: 4 + * fill-column: 78 + * End: + */ |