diff options
author | Keith Seitz <keiths@redhat.com> | 2002-09-24 19:55:43 +0000 |
---|---|---|
committer | Keith Seitz <keiths@redhat.com> | 2002-09-24 19:55:43 +0000 |
commit | 0e8f9dd357b81ada6f8f4a215b928d63ca983f97 (patch) | |
tree | 7474a17bfcb82d128f44269ac686c462e2fc191e /tcl/generic/tclCompExpr.c | |
parent | e18731d328254b7e926369741b282fbffc840ea5 (diff) | |
download | gdb-0e8f9dd357b81ada6f8f4a215b928d63ca983f97.tar.gz |
import tcl 8.4.0
Diffstat (limited to 'tcl/generic/tclCompExpr.c')
-rw-r--r-- | tcl/generic/tclCompExpr.c | 185 |
1 files changed, 55 insertions, 130 deletions
diff --git a/tcl/generic/tclCompExpr.c b/tcl/generic/tclCompExpr.c index ff368e20004..d1f25b5e157 100644 --- a/tcl/generic/tclCompExpr.c +++ b/tcl/generic/tclCompExpr.c @@ -4,6 +4,7 @@ * This file contains the code to compile Tcl expressions. * * 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. @@ -50,26 +51,14 @@ 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 + CONST char *expr; /* The expression that was originally passed * to TclCompileExpr. */ - char *lastChar; /* Points just after last byte of expr. */ + 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 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; /* @@ -101,6 +90,8 @@ typedef struct ExprInfo { #define OP_QUESTY 18 #define OP_LNOT 19 #define OP_BITNOT 20 +#define OP_STREQ 21 +#define OP_STRNEQ 22 /* * Table describing the expression operators. Entries in this table must @@ -119,7 +110,7 @@ typedef struct OperatorDesc { * Ignored if numOperands is 0. */ } OperatorDesc; -OperatorDesc operatorTable[] = { +static OperatorDesc operatorTable[] = { {"*", 2, INST_MULT}, {"/", 2, INST_DIV}, {"%", 2, INST_MOD}, @@ -141,6 +132,8 @@ OperatorDesc operatorTable[] = { {"?", 0}, {"!", 1, INST_LNOT}, {"~", 1, INST_BITNOT}, + {"eq", 2, INST_STR_EQ}, + {"ne", 2, INST_STR_NEQ}, {NULL} }; @@ -163,7 +156,7 @@ static int CompileLandOrLorExpr _ANSI_ARGS_(( ExprInfo *infoPtr, CompileEnv *envPtr, Tcl_Token **endPtrPtr)); static int CompileMathFuncCall _ANSI_ARGS_(( - Tcl_Token *exprTokenPtr, char *funcName, + Tcl_Token *exprTokenPtr, CONST char *funcName, ExprInfo *infoPtr, CompileEnv *envPtr, Tcl_Token **endPtrPtr)); static int CompileSubExpr _ANSI_ARGS_(( @@ -201,19 +194,6 @@ static void LogSyntaxError _ANSI_ARGS_((ExprInfo *infoPtr)); * 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. * @@ -223,7 +203,7 @@ static void LogSyntaxError _ANSI_ARGS_((ExprInfo *infoPtr)); int TclCompileExpr(interp, script, numBytes, envPtr) Tcl_Interp *interp; /* Used for error reporting. */ - char *script; /* The source script to compile. */ + CONST 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. */ @@ -232,7 +212,7 @@ TclCompileExpr(interp, script, numBytes, envPtr) ExprInfo info; Tcl_Parse parse; Tcl_HashEntry *hPtr; - int maxDepth, new, i, code; + int new, i, code; /* * If this is the first time we've been called, initialize the table @@ -268,14 +248,11 @@ TclCompileExpr(interp, script, numBytes, envPtr) 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; @@ -286,7 +263,6 @@ TclCompileExpr(interp, script, numBytes, envPtr) Tcl_FreeParse(&parse); goto done; } - maxDepth = envPtr->maxStackDepth; if (!info.hasOperators) { /* @@ -301,9 +277,6 @@ TclCompileExpr(interp, script, numBytes, envPtr) Tcl_FreeParse(&parse); done: - envPtr->maxStackDepth = maxDepth; - envPtr->exprIsJustVarRef = info.exprIsJustVarRef; - envPtr->exprIsComparison = info.exprIsComparison; return code; } @@ -352,19 +325,6 @@ TclFinalizeCompilation() * 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. * @@ -383,15 +343,15 @@ CompileSubExpr(exprTokenPtr, infoPtr, envPtr) Tcl_Token *tokenPtr, *endPtr, *afterSubexprPtr; OperatorDesc *opDescPtr; Tcl_HashEntry *hPtr; - char *operator; - int maxDepth, objIndex, opIndex, length, code; + CONST char *operator; + Tcl_DString opBuf; + int 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; /* @@ -410,37 +370,30 @@ CompileSubExpr(exprTokenPtr, infoPtr, 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); + objIndex = TclRegisterNewLiteral(envPtr, tokenPtr->start, + tokenPtr->size); } else { - objIndex = TclRegisterLiteral(envPtr, "", 0, /*onHeap*/ 0); + objIndex = TclRegisterNewLiteral(envPtr, "", 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); + objIndex = TclRegisterNewLiteral(envPtr, buffer, length); } else { - objIndex = TclRegisterLiteral(envPtr, "", 0, /*onHeap*/ 0); + objIndex = TclRegisterNewLiteral(envPtr, "", 0); } TclEmitPush(objIndex, envPtr); - maxDepth = 1; tokenPtr += 1; - infoPtr->exprIsJustVarRef = 0; break; case TCL_TOKEN_COMMAND: @@ -449,9 +402,7 @@ CompileSubExpr(exprTokenPtr, infoPtr, envPtr) if (code != TCL_OK) { goto done; } - maxDepth = envPtr->maxStackDepth; tokenPtr += 1; - infoPtr->exprIsJustVarRef = 0; break; case TCL_TOKEN_VARIABLE: @@ -459,42 +410,37 @@ CompileSubExpr(exprTokenPtr, infoPtr, 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: { - Tcl_DString operatorDString; - - Tcl_DStringInit(&operatorDString); - Tcl_DStringAppend(&operatorDString, tokenPtr->start, - tokenPtr->size); - operator = Tcl_DStringValue(&operatorDString); + 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(&operatorDString); + Tcl_DStringFree(&opBuf); if (code != TCL_OK) { goto done; } - maxDepth = envPtr->maxStackDepth; tokenPtr = endPtr; - infoPtr->exprIsJustVarRef = 0; - infoPtr->exprIsComparison = 0; break; } - Tcl_DStringFree(&operatorDString); + Tcl_DStringFree(&opBuf); opIndex = (int) Tcl_GetHashValue(hPtr); opDescPtr = &(operatorTable[opIndex]); @@ -509,7 +455,6 @@ CompileSubExpr(exprTokenPtr, infoPtr, envPtr) if (code != TCL_OK) { goto done; } - maxDepth = envPtr->maxStackDepth; tokenPtr += (tokenPtr->numComponents + 1); if (opDescPtr->numOperands == 2) { @@ -517,15 +462,10 @@ CompileSubExpr(exprTokenPtr, 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; } @@ -542,7 +482,6 @@ CompileSubExpr(exprTokenPtr, infoPtr, envPtr) if (code != TCL_OK) { goto done; } - maxDepth = envPtr->maxStackDepth; tokenPtr += (tokenPtr->numComponents + 1); /* @@ -566,8 +505,6 @@ CompileSubExpr(exprTokenPtr, 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); @@ -580,7 +517,6 @@ CompileSubExpr(exprTokenPtr, infoPtr, envPtr) if (code != TCL_OK) { goto done; } - maxDepth = envPtr->maxStackDepth; tokenPtr = endPtr; break; @@ -590,7 +526,6 @@ CompileSubExpr(exprTokenPtr, infoPtr, envPtr) if (code != TCL_OK) { goto done; } - maxDepth = envPtr->maxStackDepth; tokenPtr = endPtr; break; @@ -599,10 +534,7 @@ CompileSubExpr(exprTokenPtr, infoPtr, envPtr) 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", @@ -622,7 +554,6 @@ CompileSubExpr(exprTokenPtr, infoPtr, envPtr) } done: - envPtr->maxStackDepth = maxDepth; return code; } @@ -641,9 +572,6 @@ CompileSubExpr(exprTokenPtr, infoPtr, envPtr) * 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. * @@ -669,19 +597,18 @@ CompileLandOrLorExpr(exprTokenPtr, opIndex, infoPtr, envPtr, endPtrPtr) /* Used to fix up jumps used to convert the * first operand to 0 or 1. */ Tcl_Token *tokenPtr; - int dist, maxDepth, code; + int dist, code; + int savedStackDepth = envPtr->currStackDepth; /* * 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); /* @@ -690,14 +617,15 @@ CompileLandOrLorExpr(exprTokenPtr, opIndex, infoPtr, envPtr, endPtrPtr) */ TclEmitForwardJump(envPtr, TCL_TRUE_JUMP, &lhsTrueFixup); - TclEmitPush(TclRegisterLiteral(envPtr, "0", 1, /*onHeap*/ 0), envPtr); + TclEmitPush(TclRegisterNewLiteral(envPtr, "0", 1), 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); + envPtr->currStackDepth = savedStackDepth; + TclEmitPush(TclRegisterNewLiteral(envPtr, "1", 1), envPtr); dist = (envPtr->codeNext - envPtr->codeStart) - lhsEndFixup.codeOffset; if (TclFixupForwardJump(envPtr, &lhsEndFixup, dist, 127)) { goto badDist; @@ -722,7 +650,6 @@ CompileLandOrLorExpr(exprTokenPtr, opIndex, infoPtr, envPtr, endPtrPtr) if (code != TCL_OK) { goto done; } - maxDepth = TclMax((envPtr->maxStackDepth + 1), maxDepth); tokenPtr += (tokenPtr->numComponents + 1); /* @@ -744,7 +671,7 @@ CompileLandOrLorExpr(exprTokenPtr, opIndex, infoPtr, envPtr, endPtrPtr) *endPtrPtr = tokenPtr; done: - envPtr->maxStackDepth = maxDepth; + envPtr->currStackDepth = savedStackDepth + 1; return code; } @@ -763,9 +690,6 @@ CompileLandOrLorExpr(exprTokenPtr, opIndex, infoPtr, envPtr, endPtrPtr) * 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. * @@ -788,19 +712,18 @@ CompileCondExpr(exprTokenPtr, infoPtr, envPtr, endPtrPtr) * around the then and else expressions when * their target PCs are determined. */ Tcl_Token *tokenPtr; - int elseCodeOffset, dist, maxDepth, code; + int elseCodeOffset, dist, code; + int savedStackDepth = envPtr->currStackDepth; /* * 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); /* @@ -821,7 +744,6 @@ CompileCondExpr(exprTokenPtr, infoPtr, envPtr, endPtrPtr) 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); @@ -838,13 +760,13 @@ CompileCondExpr(exprTokenPtr, infoPtr, envPtr, endPtrPtr) * Compile the "else" expression. */ + envPtr->currStackDepth = savedStackDepth; 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); @@ -874,7 +796,7 @@ CompileCondExpr(exprTokenPtr, infoPtr, envPtr, endPtrPtr) *endPtrPtr = tokenPtr; done: - envPtr->maxStackDepth = maxDepth; + envPtr->currStackDepth = savedStackDepth + 1; return code; } @@ -893,9 +815,6 @@ CompileCondExpr(exprTokenPtr, infoPtr, envPtr, endPtrPtr) * 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. @@ -907,7 +826,7 @@ 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. */ + CONST char *funcName; /* Name of the math function. */ ExprInfo *infoPtr; /* Describes the compilation state for the * expression being compiled. */ CompileEnv *envPtr; /* Holds resulting instructions. */ @@ -920,14 +839,13 @@ CompileMathFuncCall(exprTokenPtr, funcName, infoPtr, envPtr, endPtrPtr) MathFunc *mathFuncPtr; Tcl_HashEntry *hPtr; Tcl_Token *tokenPtr, *afterSubexprPtr; - int maxDepth, code, i; + int 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), @@ -942,9 +860,7 @@ CompileMathFuncCall(exprTokenPtr, funcName, infoPtr, envPtr, endPtrPtr) */ if (mathFuncPtr->builtinFuncIndex < 0) { - TclEmitPush(TclRegisterLiteral(envPtr, funcName, -1, /*onHeap*/ 0), - envPtr); - maxDepth = 1; + TclEmitPush(TclRegisterNewLiteral(envPtr, funcName, -1), envPtr); } /* @@ -962,13 +878,11 @@ CompileMathFuncCall(exprTokenPtr, funcName, infoPtr, envPtr, endPtrPtr) 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); @@ -992,15 +906,25 @@ CompileMathFuncCall(exprTokenPtr, funcName, infoPtr, envPtr, endPtrPtr) */ if (mathFuncPtr->builtinFuncIndex >= 0) { /* a builtin function */ - TclEmitInstInt1(INST_CALL_BUILTIN_FUNC1, + /* + * Adjust the current stack depth by the number of arguments + * of the builtin function. This cannot be handled by the + * TclEmitInstInt1 macro as the number of arguments is not + * passed as an operand. + */ + + if (envPtr->maxStackDepth < envPtr->currStackDepth) { + envPtr->maxStackDepth = envPtr->currStackDepth; + } + TclEmitInstInt1(INST_CALL_BUILTIN_FUNC1, mathFuncPtr->builtinFuncIndex, envPtr); + envPtr->currStackDepth -= mathFuncPtr->numArgs; } else { TclEmitInstInt1(INST_CALL_FUNC1, (mathFuncPtr->numArgs+1), envPtr); } *endPtrPtr = afterSubexprPtr; done: - envPtr->maxStackDepth = maxDepth; return code; } @@ -1033,6 +957,7 @@ LogSyntaxError(infoPtr) sprintf(buffer, "syntax error in expression \"%.*s\"", ((numBytes > 60)? 60 : numBytes), infoPtr->expr); + Tcl_ResetResult(infoPtr->interp); Tcl_AppendStringsToObj(Tcl_GetObjResult(infoPtr->interp), buffer, (char *) NULL); } |