summaryrefslogtreecommitdiff
path: root/tcl/generic/tclCompExpr.c
diff options
context:
space:
mode:
Diffstat (limited to 'tcl/generic/tclCompExpr.c')
-rw-r--r--tcl/generic/tclCompExpr.c185
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);
}
View Lorry Controller Status