#include "tclInt.h"
#ifdef NO_FLOAT_H
# include "../compat/float.h"
#else
# include <float.h>
#endif
#ifndef TCL_NO_MATH
#include <math.h>
#endif
#ifndef TCL_GENERIC_ONLY
#include "tclPort.h"
#else
#define NO_ERRNO_H
#endif
#ifdef NO_ERRNO_H
int errno;
#define EDOM 33
#define ERANGE 34
#endif
#define STATIC_STRING_SPACE 150
typedef struct {
long intValue;
double doubleValue;
ParseValue pv;
char staticSpace[STATIC_STRING_SPACE];
int type;
} Value;
#define TYPE_INT 0
#define TYPE_DOUBLE 1
#define TYPE_STRING 2
typedef struct {
char *originalExpr;
char *expr;
int token;
} ExprInfo;
#define VALUE 0
#define OPEN_PAREN 1
#define CLOSE_PAREN 2
#define COMMA 3
#define END 4
#define UNKNOWN 5
#define MULT 8
#define DIVIDE 9
#define MOD 10
#define PLUS 11
#define MINUS 12
#define LEFT_SHIFT 13
#define RIGHT_SHIFT 14
#define LESS 15
#define GREATER 16
#define LEQ 17
#define GEQ 18
#define EQUAL 19
#define NEQ 20
#define BIT_AND 21
#define BIT_XOR 22
#define BIT_OR 23
#define AND 24
#define OR 25
#define QUESTY 26
#define COLON 27
#define UNARY_MINUS 28
#define UNARY_PLUS 29
#define NOT 30
#define BIT_NOT 31
static int precTable[] = {
0, 0, 0, 0, 0, 0, 0, 0,
12, 12, 12,
11, 11,
10, 10,
9, 9, 9, 9,
8, 8,
7,
6,
5,
4,
3,
2,
1,
13, 13, 13, 13
};
static char *operatorStrings[] = {
"VALUE", "(", ")", ",", "END", "UNKNOWN", "6", "7",
"*", "/", "%", "+", "-", "<<", ">>", "<", ">", "<=",
">=", "==", "!=", "&", "^", "|", "&&", "||", "?", ":",
"-", "+", "!", "~"
};
#ifdef sprite
#undef DBL_MAX
#define DBL_MAX 1.797693134862316e+307
#endif
#define IS_NAN(v) ((v) != (v))
#ifdef DBL_MAX
# define IS_INF(v) (((v) > DBL_MAX) || ((v) < -DBL_MAX))
#else
# define IS_INF(v) 0
#endif
int tcl_MathInProgress = 0;
#ifdef NEED_MATHERR
extern int matherr();
int (*tclMatherrPtr)() = matherr;
#endif
static int ExprAbsFunc _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, Tcl_Value *args,
Tcl_Value *resultPtr));
static int ExprBinaryFunc _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, Tcl_Value *args,
Tcl_Value *resultPtr));
static int ExprDoubleFunc _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, Tcl_Value *args,
Tcl_Value *resultPtr));
static int ExprGetValue _ANSI_ARGS_((Tcl_Interp *interp,
ExprInfo *infoPtr, int prec, Value *valuePtr));
static int ExprIntFunc _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, Tcl_Value *args,
Tcl_Value *resultPtr));
static int ExprLex _ANSI_ARGS_((Tcl_Interp *interp,
ExprInfo *infoPtr, Value *valuePtr));
static int ExprLooksLikeInt _ANSI_ARGS_((char *p));
static void ExprMakeString _ANSI_ARGS_((Tcl_Interp *interp,
Value *valuePtr));
static int ExprMathFunc _ANSI_ARGS_((Tcl_Interp *interp,
ExprInfo *infoPtr, Value *valuePtr));
static int ExprParseString _ANSI_ARGS_((Tcl_Interp *interp,
char *string, Value *valuePtr));
static int ExprRoundFunc _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, Tcl_Value *args,
Tcl_Value *resultPtr));
static int ExprTopLevel _ANSI_ARGS_((Tcl_Interp *interp,
char *string, Value *valuePtr));
static int ExprUnaryFunc _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, Tcl_Value *args,
Tcl_Value *resultPtr));
typedef struct {
char *name;
int numArgs;
Tcl_ValueType argTypes[MAX_MATH_ARGS];
Tcl_MathProc *proc;
ClientData clientData;
} BuiltinFunc;
static BuiltinFunc funcTable[] = {
#ifndef TCL_NO_MATH
{"acos", 1, {TCL_DOUBLE}, ExprUnaryFunc, (ClientData) acos},
{"asin", 1, {TCL_DOUBLE}, ExprUnaryFunc, (ClientData) asin},
{"atan", 1, {TCL_DOUBLE}, ExprUnaryFunc, (ClientData) atan},
{"atan2", 2, {TCL_DOUBLE, TCL_DOUBLE}, ExprBinaryFunc, (ClientData) atan2},
{"ceil", 1, {TCL_DOUBLE}, ExprUnaryFunc, (ClientData) ceil},
{"cos", 1, {TCL_DOUBLE}, ExprUnaryFunc, (ClientData) cos},
{"cosh", 1, {TCL_DOUBLE}, ExprUnaryFunc, (ClientData) cosh},
{"exp", 1, {TCL_DOUBLE}, ExprUnaryFunc, (ClientData) exp},
{"floor", 1, {TCL_DOUBLE}, ExprUnaryFunc, (ClientData) floor},
{"fmod", 2, {TCL_DOUBLE, TCL_DOUBLE}, ExprBinaryFunc, (ClientData) fmod},
{"hypot", 2, {TCL_DOUBLE, TCL_DOUBLE}, ExprBinaryFunc, (ClientData) hypot},
{"log", 1, {TCL_DOUBLE}, ExprUnaryFunc, (ClientData) log},
{"log10", 1, {TCL_DOUBLE}, ExprUnaryFunc, (ClientData) log10},
{"pow", 2, {TCL_DOUBLE, TCL_DOUBLE}, ExprBinaryFunc, (ClientData) pow},
{"sin", 1, {TCL_DOUBLE}, ExprUnaryFunc, (ClientData) sin},
{"sinh", 1, {TCL_DOUBLE}, ExprUnaryFunc, (ClientData) sinh},
{"sqrt", 1, {TCL_DOUBLE}, ExprUnaryFunc, (ClientData) sqrt},
{"tan", 1, {TCL_DOUBLE}, ExprUnaryFunc, (ClientData) tan},
{"tanh", 1, {TCL_DOUBLE}, ExprUnaryFunc, (ClientData) tanh},
#endif
{"abs", 1, {TCL_EITHER}, ExprAbsFunc, 0},
{"double", 1, {TCL_EITHER}, ExprDoubleFunc, 0},
{"int", 1, {TCL_EITHER}, ExprIntFunc, 0},
{"round", 1, {TCL_EITHER}, ExprRoundFunc, 0},
{0},
};
static int
ExprParseString(interp, string, valuePtr)
Tcl_Interp *interp;
char *string;
Value *valuePtr;
{
char *term, *p, *start;
if (*string != 0) {
if (ExprLooksLikeInt(string)) {
valuePtr->type = TYPE_INT;
errno = 0;
for (p = string; isspace(UCHAR(*p)); p++) {
}
if (*p == '-') {
start = p+1;
valuePtr->intValue = -((int)strtoul(start, &term, 0));
} else if (*p == '+') {
start = p+1;
valuePtr->intValue = strtoul(start, &term, 0);
} else {
start = p;
valuePtr->intValue = strtoul(start, &term, 0);
}
if (*term == 0) {
if (errno == ERANGE) {
Tcl_ResetResult(interp);
interp->result = "integer value too large to represent";
Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW",
interp->result, (char *) NULL);
return TCL_ERROR;
} else {
return TCL_OK;
}
}
} else {
errno = 0;
valuePtr->doubleValue = strtod(string, &term);
if ((term != string) && (*term == 0)) {
if (errno != 0) {
Tcl_ResetResult(interp);
TclExprFloatError(interp, valuePtr->doubleValue);
return TCL_ERROR;
}
valuePtr->type = TYPE_DOUBLE;
return TCL_OK;
}
}
}
valuePtr->type = TYPE_STRING;
if (string != valuePtr->pv.buffer) {
int length, shortfall;
length = strlen(string);
valuePtr->pv.next = valuePtr->pv.buffer;
shortfall = length - (valuePtr->pv.end - valuePtr->pv.buffer);
if (shortfall > 0) {
(*valuePtr->pv.expandProc)(&valuePtr->pv, shortfall);
}
strcpy(valuePtr->pv.buffer, string);
}
return TCL_OK;
}
static int
ExprLex(interp, infoPtr, valuePtr)
Tcl_Interp *interp;
register ExprInfo *infoPtr;
register Value *valuePtr;
{
register char *p;
char *var, *term;
int result;
p = infoPtr->expr;
while (isspace(UCHAR(*p))) {
p++;
}
if (*p == 0) {
infoPtr->token = END;
infoPtr->expr = p;
return TCL_OK;
}
if ((*p != '+') && (*p != '-')) {
if (ExprLooksLikeInt(p)) {
errno = 0;
valuePtr->intValue = strtoul(p, &term, 0);
if (errno == ERANGE) {
interp->result = "integer value too large to represent";
Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW",
interp->result, (char *) NULL);
return TCL_ERROR;
}
infoPtr->token = VALUE;
infoPtr->expr = term;
valuePtr->type = TYPE_INT;
return TCL_OK;
} else {
errno = 0;
valuePtr->doubleValue = strtod(p, &term);
if (term != p) {
if (errno != 0) {
TclExprFloatError(interp, valuePtr->doubleValue);
return TCL_ERROR;
}
infoPtr->token = VALUE;
infoPtr->expr = term;
valuePtr->type = TYPE_DOUBLE;
return TCL_OK;
}
}
}
infoPtr->expr = p+1;
switch (*p) {
case '$':
infoPtr->token = VALUE;
var = Tcl_ParseVar(interp, p, &infoPtr->expr);
if (var == NULL) {
return TCL_ERROR;
}
Tcl_ResetResult(interp);
if (((Interp *) interp)->noEval) {
valuePtr->type = TYPE_INT;
valuePtr->intValue = 0;
return TCL_OK;
}
return ExprParseString(interp, var, valuePtr);
case '[':
infoPtr->token = VALUE;
((Interp *) interp)->evalFlags = TCL_BRACKET_TERM;
result = Tcl_Eval(interp, p+1);
infoPtr->expr = ((Interp *) interp)->termPtr;
if (result != TCL_OK) {
return result;
}
infoPtr->expr++;
if (((Interp *) interp)->noEval) {
valuePtr->type = TYPE_INT;
valuePtr->intValue = 0;
Tcl_ResetResult(interp);
return TCL_OK;
}
result = ExprParseString(interp, interp->result, valuePtr);
if (result != TCL_OK) {
return result;
}
Tcl_ResetResult(interp);
return TCL_OK;
case '"':
infoPtr->token = VALUE;
result = TclParseQuotes(interp, infoPtr->expr, '"', 0,
&infoPtr->expr, &valuePtr->pv);
if (result != TCL_OK) {
return result;
}
Tcl_ResetResult(interp);
return ExprParseString(interp, valuePtr->pv.buffer, valuePtr);
case '{':
infoPtr->token = VALUE;
result = TclParseBraces(interp, infoPtr->expr, &infoPtr->expr,
&valuePtr->pv);
if (result != TCL_OK) {
return result;
}
Tcl_ResetResult(interp);
return ExprParseString(interp, valuePtr->pv.buffer, valuePtr);
case '(':
infoPtr->token = OPEN_PAREN;
return TCL_OK;
case ')':
infoPtr->token = CLOSE_PAREN;
return TCL_OK;
case ',':
infoPtr->token = COMMA;
return TCL_OK;
case '*':
infoPtr->token = MULT;
return TCL_OK;
case '/':
infoPtr->token = DIVIDE;
return TCL_OK;
case '%':
infoPtr->token = MOD;
return TCL_OK;
case '+':
infoPtr->token = PLUS;
return TCL_OK;
case '-':
infoPtr->token = MINUS;
return TCL_OK;
case '?':
infoPtr->token = QUESTY;
return TCL_OK;
case ':':
infoPtr->token = COLON;
return TCL_OK;
case '<':
switch (p[1]) {
case '<':
infoPtr->expr = p+2;
infoPtr->token = LEFT_SHIFT;
break;
case '=':
infoPtr->expr = p+2;
infoPtr->token = LEQ;
break;
default:
infoPtr->token = LESS;
break;
}
return TCL_OK;
case '>':
switch (p[1]) {
case '>':
infoPtr->expr = p+2;
infoPtr->token = RIGHT_SHIFT;
break;
case '=':
infoPtr->expr = p+2;
infoPtr->token = GEQ;
break;
default:
infoPtr->token = GREATER;
break;
}
return TCL_OK;
case '=':
if (p[1] == '=') {
infoPtr->expr = p+2;
infoPtr->token = EQUAL;
} else {
infoPtr->token = UNKNOWN;
}
return TCL_OK;
case '!':
if (p[1] == '=') {
infoPtr->expr = p+2;
infoPtr->token = NEQ;
} else {
infoPtr->token = NOT;
}
return TCL_OK;
case '&':
if (p[1] == '&') {
infoPtr->expr = p+2;
infoPtr->token = AND;
} else {
infoPtr->token = BIT_AND;
}
return TCL_OK;
case '^':
infoPtr->token = BIT_XOR;
return TCL_OK;
case '|':
if (p[1] == '|') {
infoPtr->expr = p+2;
infoPtr->token = OR;
} else {
infoPtr->token = BIT_OR;
}
return TCL_OK;
case '~':
infoPtr->token = BIT_NOT;
return TCL_OK;
default:
if (isalpha(UCHAR(*p))) {
infoPtr->expr = p;
return ExprMathFunc(interp, infoPtr, valuePtr);
}
infoPtr->expr = p+1;
infoPtr->token = UNKNOWN;
return TCL_OK;
}
}
static int
ExprGetValue(interp, infoPtr, prec, valuePtr)
Tcl_Interp *interp;
register ExprInfo *infoPtr;
int prec;
Value *valuePtr;
{
Interp *iPtr = (Interp *) interp;
Value value2;
int operator;
int badType;
int gotOp;
int result;
gotOp = 0;
value2.pv.buffer = value2.pv.next = value2.staticSpace;
value2.pv.end = value2.pv.buffer + STATIC_STRING_SPACE - 1;
value2.pv.expandProc = TclExpandParseValue;
value2.pv.clientData = (ClientData) NULL;
result = ExprLex(interp, infoPtr, valuePtr);
if (result != TCL_OK) {
goto done;
}
if (infoPtr->token == OPEN_PAREN) {
result = ExprGetValue(interp, infoPtr, -1, valuePtr);
if (result != TCL_OK) {
goto done;
}
if (infoPtr->token != CLOSE_PAREN) {
Tcl_AppendResult(interp, "unmatched parentheses in expression \"",
infoPtr->originalExpr, "\"", (char *) NULL);
result = TCL_ERROR;
goto done;
}
} else {
if (infoPtr->token == MINUS) {
infoPtr->token = UNARY_MINUS;
}
if (infoPtr->token == PLUS) {
infoPtr->token = UNARY_PLUS;
}
if (infoPtr->token >= UNARY_MINUS) {
operator = infoPtr->token;
result = ExprGetValue(interp, infoPtr, precTable[infoPtr->token],
valuePtr);
if (result != TCL_OK) {
goto done;
}
if (!iPtr->noEval) {
switch (operator) {
case UNARY_MINUS:
if (valuePtr->type == TYPE_INT) {
valuePtr->intValue = -valuePtr->intValue;
} else if (valuePtr->type == TYPE_DOUBLE){
valuePtr->doubleValue = -valuePtr->doubleValue;
} else {
badType = valuePtr->type;
goto illegalType;
}
break;
case UNARY_PLUS:
if ((valuePtr->type != TYPE_INT)
&& (valuePtr->type != TYPE_DOUBLE)) {
badType = valuePtr->type;
goto illegalType;
}
break;
case NOT:
if (valuePtr->type == TYPE_INT) {
valuePtr->intValue = !valuePtr->intValue;
} else if (valuePtr->type == TYPE_DOUBLE) {
if (valuePtr->doubleValue == 0.0) {
valuePtr->intValue = 1;
} else {
valuePtr->intValue = 0;
}
valuePtr->type = TYPE_INT;
} else {
badType = valuePtr->type;
goto illegalType;
}
break;
case BIT_NOT:
if (valuePtr->type == TYPE_INT) {
valuePtr->intValue = ~valuePtr->intValue;
} else {
badType = valuePtr->type;
goto illegalType;
}
break;
}
}
gotOp = 1;
} else if (infoPtr->token != VALUE) {
goto syntaxError;
}
}
if (!gotOp) {
result = ExprLex(interp, infoPtr, &value2);
if (result != TCL_OK) {
goto done;
}
}
while (1) {
operator = infoPtr->token;
value2.pv.next = value2.pv.buffer;
if ((operator < MULT) || (operator >= UNARY_MINUS)) {
if ((operator == END) || (operator == CLOSE_PAREN)
|| (operator == COMMA)) {
result = TCL_OK;
goto done;
} else {
goto syntaxError;
}
}
if (precTable[operator] <= prec) {
result = TCL_OK;
goto done;
}
if ((operator == AND) || (operator == OR) || (operator == QUESTY)) {
if (valuePtr->type == TYPE_DOUBLE) {
valuePtr->intValue = valuePtr->doubleValue != 0;
valuePtr->type = TYPE_INT;
} else if (valuePtr->type == TYPE_STRING) {
if (!iPtr->noEval) {
badType = TYPE_STRING;
goto illegalType;
}
valuePtr->intValue = 0;
}
if (((operator == AND) && !valuePtr->intValue)
|| ((operator == OR) && valuePtr->intValue)) {
iPtr->noEval++;
result = ExprGetValue(interp, infoPtr, precTable[operator],
&value2);
iPtr->noEval--;
if (result != TCL_OK) {
goto done;
}
if (operator == OR) {
valuePtr->intValue = 1;
}
continue;
} else if (operator == QUESTY) {
if (valuePtr->intValue != 0) {
valuePtr->pv.next = valuePtr->pv.buffer;
result = ExprGetValue(interp, infoPtr,
precTable[QUESTY] - 1, valuePtr);
if (result != TCL_OK) {
goto done;
}
if (infoPtr->token != COLON) {
goto syntaxError;
}
value2.pv.next = value2.pv.buffer;
iPtr->noEval++;
result = ExprGetValue(interp, infoPtr,
precTable[QUESTY] - 1, &value2);
iPtr->noEval--;
} else {
iPtr->noEval++;
result = ExprGetValue(interp, infoPtr,
precTable[QUESTY] - 1, &value2);
iPtr->noEval--;
if (result != TCL_OK) {
goto done;
}
if (infoPtr->token != COLON) {
goto syntaxError;
}
valuePtr->pv.next = valuePtr->pv.buffer;
result = ExprGetValue(interp, infoPtr,
precTable[QUESTY] - 1, valuePtr);
if (result != TCL_OK) {
goto done;
}
}
continue;
} else {
result = ExprGetValue(interp, infoPtr, precTable[operator],
&value2);
}
} else {
result = ExprGetValue(interp, infoPtr, precTable[operator],
&value2);
}
if (result != TCL_OK) {
goto done;
}
if ((infoPtr->token < MULT) && (infoPtr->token != VALUE)
&& (infoPtr->token != END) && (infoPtr->token != COMMA)
&& (infoPtr->token != CLOSE_PAREN)) {
goto syntaxError;
}
if (iPtr->noEval) {
continue;
}
switch (operator) {
case MULT: case DIVIDE: case PLUS: case MINUS:
if ((valuePtr->type == TYPE_STRING)
|| (value2.type == TYPE_STRING)) {
badType = TYPE_STRING;
goto illegalType;
}
if (valuePtr->type == TYPE_DOUBLE) {
if (value2.type == TYPE_INT) {
value2.doubleValue = value2.intValue;
value2.type = TYPE_DOUBLE;
}
} else if (value2.type == TYPE_DOUBLE) {
if (valuePtr->type == TYPE_INT) {
valuePtr->doubleValue = valuePtr->intValue;
valuePtr->type = TYPE_DOUBLE;
}
}
break;
case MOD: case LEFT_SHIFT: case RIGHT_SHIFT:
case BIT_AND: case BIT_XOR: case BIT_OR:
if (valuePtr->type != TYPE_INT) {
badType = valuePtr->type;
goto illegalType;
} else if (value2.type != TYPE_INT) {
badType = value2.type;
goto illegalType;
}
break;
case LESS: case GREATER: case LEQ: case GEQ:
case EQUAL: case NEQ:
if (valuePtr->type == TYPE_STRING) {
if (value2.type != TYPE_STRING) {
ExprMakeString(interp, &value2);
}
} else if (value2.type == TYPE_STRING) {
if (valuePtr->type != TYPE_STRING) {
ExprMakeString(interp, valuePtr);
}
} else if (valuePtr->type == TYPE_DOUBLE) {
if (value2.type == TYPE_INT) {
value2.doubleValue = value2.intValue;
value2.type = TYPE_DOUBLE;
}
} else if (value2.type == TYPE_DOUBLE) {
if (valuePtr->type == TYPE_INT) {
valuePtr->doubleValue = valuePtr->intValue;
valuePtr->type = TYPE_DOUBLE;
}
}
break;
case AND: case OR:
if (valuePtr->type == TYPE_STRING) {
badType = valuePtr->type;
goto illegalType;
}
if (value2.type == TYPE_STRING) {
badType = value2.type;
goto illegalType;
}
break;
case QUESTY: case COLON:
break;
default:
interp->result = "unknown operator in expression";
result = TCL_ERROR;
goto done;
}
switch (operator) {
case MULT:
if (valuePtr->type == TYPE_INT) {
valuePtr->intValue = valuePtr->intValue * value2.intValue;
} else {
valuePtr->doubleValue *= value2.doubleValue;
}
break;
case DIVIDE:
case MOD:
if (valuePtr->type == TYPE_INT) {
long divisor, quot, rem;
int negative;
if (value2.intValue == 0) {
divideByZero:
interp->result = "divide by zero";
Tcl_SetErrorCode(interp, "ARITH", "DIVZERO",
interp->result, (char *) NULL);
result = TCL_ERROR;
goto done;
}
divisor = value2.intValue;
negative = 0;
if (divisor < 0) {
divisor = -divisor;
valuePtr->intValue = -valuePtr->intValue;
negative = 1;
}
quot = valuePtr->intValue / divisor;
rem = valuePtr->intValue % divisor;
if (rem < 0) {
rem += divisor;
quot -= 1;
}
if (negative) {
rem = -rem;
}
valuePtr->intValue = (operator == DIVIDE) ? quot : rem;
} else {
if (value2.doubleValue == 0.0) {
goto divideByZero;
}
valuePtr->doubleValue /= value2.doubleValue;
}
break;
case PLUS:
if (valuePtr->type == TYPE_INT) {
valuePtr->intValue = valuePtr->intValue + value2.intValue;
} else {
valuePtr->doubleValue += value2.doubleValue;
}
break;
case MINUS:
if (valuePtr->type == TYPE_INT) {
valuePtr->intValue = valuePtr->intValue - value2.intValue;
} else {
valuePtr->doubleValue -= value2.doubleValue;
}
break;
case LEFT_SHIFT:
valuePtr->intValue <<= value2.intValue;
break;
case RIGHT_SHIFT:
if (valuePtr->intValue < 0) {
valuePtr->intValue =
~((~valuePtr->intValue) >> value2.intValue);
} else {
valuePtr->intValue >>= value2.intValue;
}
break;
case LESS:
if (valuePtr->type == TYPE_INT) {
valuePtr->intValue =
valuePtr->intValue < value2.intValue;
} else if (valuePtr->type == TYPE_DOUBLE) {
valuePtr->intValue =
valuePtr->doubleValue < value2.doubleValue;
} else {
valuePtr->intValue =
strcmp(valuePtr->pv.buffer, value2.pv.buffer) < 0;
}
valuePtr->type = TYPE_INT;
break;
case GREATER:
if (valuePtr->type == TYPE_INT) {
valuePtr->intValue =
valuePtr->intValue > value2.intValue;
} else if (valuePtr->type == TYPE_DOUBLE) {
valuePtr->intValue =
valuePtr->doubleValue > value2.doubleValue;
} else {
valuePtr->intValue =
strcmp(valuePtr->pv.buffer, value2.pv.buffer) > 0;
}
valuePtr->type = TYPE_INT;
break;
case LEQ:
if (valuePtr->type == TYPE_INT) {
valuePtr->intValue =
valuePtr->intValue <= value2.intValue;
} else if (valuePtr->type == TYPE_DOUBLE) {
valuePtr->intValue =
valuePtr->doubleValue <= value2.doubleValue;
} else {
valuePtr->intValue =
strcmp(valuePtr->pv.buffer, value2.pv.buffer) <= 0;
}
valuePtr->type = TYPE_INT;
break;
case GEQ:
if (valuePtr->type == TYPE_INT) {
valuePtr->intValue =
valuePtr->intValue >= value2.intValue;
} else if (valuePtr->type == TYPE_DOUBLE) {
valuePtr->intValue =
valuePtr->doubleValue >= value2.doubleValue;
} else {
valuePtr->intValue =
strcmp(valuePtr->pv.buffer, value2.pv.buffer) >= 0;
}
valuePtr->type = TYPE_INT;
break;
case EQUAL:
if (valuePtr->type == TYPE_INT) {
valuePtr->intValue =
valuePtr->intValue == value2.intValue;
} else if (valuePtr->type == TYPE_DOUBLE) {
valuePtr->intValue =
valuePtr->doubleValue == value2.doubleValue;
} else {
valuePtr->intValue =
strcmp(valuePtr->pv.buffer, value2.pv.buffer) == 0;
}
valuePtr->type = TYPE_INT;
break;
case NEQ:
if (valuePtr->type == TYPE_INT) {
valuePtr->intValue =
valuePtr->intValue != value2.intValue;
} else if (valuePtr->type == TYPE_DOUBLE) {
valuePtr->intValue =
valuePtr->doubleValue != value2.doubleValue;
} else {
valuePtr->intValue =
strcmp(valuePtr->pv.buffer, value2.pv.buffer) != 0;
}
valuePtr->type = TYPE_INT;
break;
case BIT_AND:
valuePtr->intValue &= value2.intValue;
break;
case BIT_XOR:
valuePtr->intValue ^= value2.intValue;
break;
case BIT_OR:
valuePtr->intValue |= value2.intValue;
break;
case AND:
if (value2.type == TYPE_DOUBLE) {
value2.intValue = value2.doubleValue != 0;
value2.type = TYPE_INT;
}
valuePtr->intValue = valuePtr->intValue && value2.intValue;
break;
case OR:
if (value2.type == TYPE_DOUBLE) {
value2.intValue = value2.doubleValue != 0;
value2.type = TYPE_INT;
}
valuePtr->intValue = valuePtr->intValue || value2.intValue;
break;
case COLON:
interp->result = "can't have : operator without ? first";
result = TCL_ERROR;
goto done;
}
}
done:
if (value2.pv.buffer != value2.staticSpace) {
ckfree(value2.pv.buffer);
}
return result;
syntaxError:
Tcl_AppendResult(interp, "syntax error in expression \"",
infoPtr->originalExpr, "\"", (char *) NULL);
result = TCL_ERROR;
goto done;
illegalType:
Tcl_AppendResult(interp, "can't use ", (badType == TYPE_DOUBLE) ?
"floating-point value" : "non-numeric string",
" as operand of \"", operatorStrings[operator], "\"",
(char *) NULL);
result = TCL_ERROR;
goto done;
}
static void
ExprMakeString(interp, valuePtr)
Tcl_Interp *interp;
register Value *valuePtr;
{
int shortfall;
shortfall = 150 - (valuePtr->pv.end - valuePtr->pv.buffer);
if (shortfall > 0) {
(*valuePtr->pv.expandProc)(&valuePtr->pv, shortfall);
}
if (valuePtr->type == TYPE_INT) {
sprintf(valuePtr->pv.buffer, "%ld", valuePtr->intValue);
} else if (valuePtr->type == TYPE_DOUBLE) {
Tcl_PrintDouble(interp, valuePtr->doubleValue, valuePtr->pv.buffer);
}
valuePtr->type = TYPE_STRING;
}
static int
ExprTopLevel(interp, string, valuePtr)
Tcl_Interp *interp;
char *string;
Value *valuePtr;
{
ExprInfo info;
int result;
if (!(((Interp *) interp)->flags & EXPR_INITIALIZED)) {
BuiltinFunc *funcPtr;
((Interp *) interp)->flags |= EXPR_INITIALIZED;
for (funcPtr = funcTable; funcPtr->name != NULL;
funcPtr++) {
Tcl_CreateMathFunc(interp, funcPtr->name, funcPtr->numArgs,
funcPtr->argTypes, funcPtr->proc, funcPtr->clientData);
}
}
info.originalExpr = string;
info.expr = string;
valuePtr->pv.buffer = valuePtr->pv.next = valuePtr->staticSpace;
valuePtr->pv.end = valuePtr->pv.buffer + STATIC_STRING_SPACE - 1;
valuePtr->pv.expandProc = TclExpandParseValue;
valuePtr->pv.clientData = (ClientData) NULL;
result = ExprGetValue(interp, &info, -1, valuePtr);
if (result != TCL_OK) {
return result;
}
if (info.token != END) {
Tcl_AppendResult(interp, "syntax error in expression \"",
string, "\"", (char *) NULL);
return TCL_ERROR;
}
if ((valuePtr->type == TYPE_DOUBLE) && (IS_NAN(valuePtr->doubleValue)
|| IS_INF(valuePtr->doubleValue))) {
TclExprFloatError(interp, valuePtr->doubleValue);
return TCL_ERROR;
}
return TCL_OK;
}
int
Tcl_ExprLong(interp, string, ptr)
Tcl_Interp *interp;
char *string;
long *ptr;
{
Value value;
int result;
result = ExprTopLevel(interp, string, &value);
if (result == TCL_OK) {
if (value.type == TYPE_INT) {
*ptr = value.intValue;
} else if (value.type == TYPE_DOUBLE) {
*ptr = (long) value.doubleValue;
} else {
interp->result = "expression didn't have numeric value";
result = TCL_ERROR;
}
}
if (value.pv.buffer != value.staticSpace) {
ckfree(value.pv.buffer);
}
return result;
}
int
Tcl_ExprDouble(interp, string, ptr)
Tcl_Interp *interp;
char *string;
double *ptr;
{
Value value;
int result;
result = ExprTopLevel(interp, string, &value);
if (result == TCL_OK) {
if (value.type == TYPE_INT) {
*ptr = value.intValue;
} else if (value.type == TYPE_DOUBLE) {
*ptr = value.doubleValue;
} else {
interp->result = "expression didn't have numeric value";
result = TCL_ERROR;
}
}
if (value.pv.buffer != value.staticSpace) {
ckfree(value.pv.buffer);
}
return result;
}
int
Tcl_ExprBoolean(interp, string, ptr)
Tcl_Interp *interp;
char *string;
int *ptr;
{
Value value;
int result;
result = ExprTopLevel(interp, string, &value);
if (result == TCL_OK) {
if (value.type == TYPE_INT) {
*ptr = value.intValue != 0;
} else if (value.type == TYPE_DOUBLE) {
*ptr = value.doubleValue != 0.0;
} else {
result = Tcl_GetBoolean(interp, value.pv.buffer, ptr);
}
}
if (value.pv.buffer != value.staticSpace) {
ckfree(value.pv.buffer);
}
return result;
}
int
Tcl_ExprString(interp, string)
Tcl_Interp *interp;
char *string;
{
Value value;
int result;
result = ExprTopLevel(interp, string, &value);
if (result == TCL_OK) {
if (value.type == TYPE_INT) {
sprintf(interp->result, "%ld", value.intValue);
} else if (value.type == TYPE_DOUBLE) {
Tcl_PrintDouble(interp, value.doubleValue, interp->result);
} else {
if (value.pv.buffer != value.staticSpace) {
interp->result = value.pv.buffer;
interp->freeProc = TCL_DYNAMIC;
value.pv.buffer = value.staticSpace;
} else {
Tcl_SetResult(interp, value.pv.buffer, TCL_VOLATILE);
}
}
}
if (value.pv.buffer != value.staticSpace) {
ckfree(value.pv.buffer);
}
return result;
}
void
Tcl_CreateMathFunc(interp, name, numArgs, argTypes, proc, clientData)
Tcl_Interp *interp;
char *name;
int numArgs;
Tcl_ValueType *argTypes;
Tcl_MathProc *proc;
ClientData clientData;
{
Interp *iPtr = (Interp *) interp;
Tcl_HashEntry *hPtr;
MathFunc *mathFuncPtr;
int new, i;
hPtr = Tcl_CreateHashEntry(&iPtr->mathFuncTable, name, &new);
if (new) {
Tcl_SetHashValue(hPtr, ckalloc(sizeof(MathFunc)));
}
mathFuncPtr = (MathFunc *) Tcl_GetHashValue(hPtr);
if (numArgs > MAX_MATH_ARGS) {
numArgs = MAX_MATH_ARGS;
}
mathFuncPtr->numArgs = numArgs;
for (i = 0; i < numArgs; i++) {
mathFuncPtr->argTypes[i] = argTypes[i];
}
mathFuncPtr->proc = proc;
mathFuncPtr->clientData = clientData;
}
static int
ExprMathFunc(interp, infoPtr, valuePtr)
Tcl_Interp *interp;
register ExprInfo *infoPtr;
register Value *valuePtr;
{
Interp *iPtr = (Interp *) interp;
MathFunc *mathFuncPtr;
Tcl_Value args[MAX_MATH_ARGS];
Tcl_Value funcResult;
Tcl_HashEntry *hPtr;
char *p, *funcName, savedChar;
int i, result;
p = funcName = infoPtr->expr;
while (isalnum(UCHAR(*p)) || (*p == '_')) {
p++;
}
infoPtr->expr = p;
result = ExprLex(interp, infoPtr, valuePtr);
if (result != TCL_OK) {
return TCL_ERROR;
}
if (infoPtr->token != OPEN_PAREN) {
goto syntaxError;
}
savedChar = *p;
*p = 0;
hPtr = Tcl_FindHashEntry(&iPtr->mathFuncTable, funcName);
if (hPtr == NULL) {
Tcl_AppendResult(interp, "unknown math function \"", funcName,
"\"", (char *) NULL);
*p = savedChar;
return TCL_ERROR;
}
*p = savedChar;
mathFuncPtr = (MathFunc *) Tcl_GetHashValue(hPtr);
if (mathFuncPtr->numArgs == 0) {
result = ExprLex(interp, infoPtr, valuePtr);
if ((result != TCL_OK) || (infoPtr->token != CLOSE_PAREN)) {
goto syntaxError;
}
} else {
for (i = 0; ; i++) {
valuePtr->pv.next = valuePtr->pv.buffer;
result = ExprGetValue(interp, infoPtr, -1, valuePtr);
if (result != TCL_OK) {
return result;
}
if (valuePtr->type == TYPE_STRING) {
interp->result =
"argument to math function didn't have numeric value";
return TCL_ERROR;
}
if (valuePtr->type == TYPE_INT) {
if (mathFuncPtr->argTypes[i] == TCL_DOUBLE) {
args[i].type = TCL_DOUBLE;
args[i].doubleValue = valuePtr->intValue;
} else {
args[i].type = TCL_INT;
args[i].intValue = valuePtr->intValue;
}
} else {
if (mathFuncPtr->argTypes[i] == TCL_INT) {
args[i].type = TCL_INT;
args[i].intValue = (long) valuePtr->doubleValue;
} else {
args[i].type = TCL_DOUBLE;
args[i].doubleValue = valuePtr->doubleValue;
}
}
if (i == (mathFuncPtr->numArgs-1)) {
if (infoPtr->token == CLOSE_PAREN) {
break;
}
if (infoPtr->token == COMMA) {
interp->result = "too many arguments for math function";
return TCL_ERROR;
} else {
goto syntaxError;
}
}
if (infoPtr->token != COMMA) {
if (infoPtr->token == CLOSE_PAREN) {
interp->result = "too few arguments for math function";
return TCL_ERROR;
} else {
goto syntaxError;
}
}
}
}
if (iPtr->noEval) {
valuePtr->type = TYPE_INT;
valuePtr->intValue = 0;
infoPtr->token = VALUE;
return TCL_OK;
}
tcl_MathInProgress++;
result = (*mathFuncPtr->proc)(mathFuncPtr->clientData, interp, args,
&funcResult);
tcl_MathInProgress--;
if (result != TCL_OK) {
return result;
}
if (funcResult.type == TCL_INT) {
valuePtr->type = TYPE_INT;
valuePtr->intValue = funcResult.intValue;
} else {
valuePtr->type = TYPE_DOUBLE;
valuePtr->doubleValue = funcResult.doubleValue;
}
infoPtr->token = VALUE;
return TCL_OK;
syntaxError:
Tcl_AppendResult(interp, "syntax error in expression \"",
infoPtr->originalExpr, "\"", (char *) NULL);
return TCL_ERROR;
}
void
TclExprFloatError(interp, value)
Tcl_Interp *interp;
double value;
{
char buf[20];
if ((errno == EDOM) || (value != value)) {
interp->result = "domain error: argument not in valid range";
Tcl_SetErrorCode(interp, "ARITH", "DOMAIN", interp->result,
(char *) NULL);
} else if ((errno == ERANGE) || IS_INF(value)) {
if (value == 0.0) {
interp->result = "floating-point value too small to represent";
Tcl_SetErrorCode(interp, "ARITH", "UNDERFLOW", interp->result,
(char *) NULL);
} else {
interp->result = "floating-point value too large to represent";
Tcl_SetErrorCode(interp, "ARITH", "OVERFLOW", interp->result,
(char *) NULL);
}
} else {
sprintf(buf, "%d", errno);
Tcl_AppendResult(interp, "unknown floating-point error, ",
"errno = ", buf, (char *) NULL);
Tcl_SetErrorCode(interp, "ARITH", "UNKNOWN", interp->result,
(char *) NULL);
}
}
static int
ExprUnaryFunc(clientData, interp, args, resultPtr)
ClientData clientData;
Tcl_Interp *interp;
Tcl_Value *args;
Tcl_Value *resultPtr;
{
double (*func) _ANSI_ARGS_((double)) = (double (*)_ANSI_ARGS_((double))) clientData;
errno = 0;
resultPtr->type = TCL_DOUBLE;
resultPtr->doubleValue = (*func)(args[0].doubleValue);
if (errno != 0) {
TclExprFloatError(interp, resultPtr->doubleValue);
return TCL_ERROR;
}
return TCL_OK;
}
static int
ExprBinaryFunc(clientData, interp, args, resultPtr)
ClientData clientData;
Tcl_Interp *interp;
Tcl_Value *args;
Tcl_Value *resultPtr;
{
double (*func) _ANSI_ARGS_((double, double))
= (double (*)_ANSI_ARGS_((double, double))) clientData;
errno = 0;
resultPtr->type = TCL_DOUBLE;
resultPtr->doubleValue = (*func)(args[0].doubleValue, args[1].doubleValue);
if (errno != 0) {
TclExprFloatError(interp, resultPtr->doubleValue);
return TCL_ERROR;
}
return TCL_OK;
}
static int
ExprAbsFunc(clientData, interp, args, resultPtr)
ClientData clientData;
Tcl_Interp *interp;
Tcl_Value *args;
Tcl_Value *resultPtr;
{
resultPtr->type = TCL_DOUBLE;
if (args[0].type == TCL_DOUBLE) {
resultPtr->type = TCL_DOUBLE;
if (args[0].doubleValue < 0) {
resultPtr->doubleValue = -args[0].doubleValue;
} else {
resultPtr->doubleValue = args[0].doubleValue;
}
} else {
resultPtr->type = TCL_INT;
if (args[0].intValue < 0) {
resultPtr->intValue = -args[0].intValue;
if (resultPtr->intValue < 0) {
interp->result = "integer value too large to represent";
Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW", interp->result,
(char *) NULL);
return TCL_ERROR;
}
} else {
resultPtr->intValue = args[0].intValue;
}
}
return TCL_OK;
}
static int
ExprDoubleFunc(clientData, interp, args, resultPtr)
ClientData clientData;
Tcl_Interp *interp;
Tcl_Value *args;
Tcl_Value *resultPtr;
{
resultPtr->type = TCL_DOUBLE;
if (args[0].type == TCL_DOUBLE) {
resultPtr->doubleValue = args[0].doubleValue;
} else {
resultPtr->doubleValue = args[0].intValue;
}
return TCL_OK;
}
static int
ExprIntFunc(clientData, interp, args, resultPtr)
ClientData clientData;
Tcl_Interp *interp;
Tcl_Value *args;
Tcl_Value *resultPtr;
{
resultPtr->type = TCL_INT;
if (args[0].type == TCL_INT) {
resultPtr->intValue = args[0].intValue;
} else {
if (args[0].doubleValue < 0) {
if (args[0].doubleValue < (double) (long) LONG_MIN) {
tooLarge:
interp->result = "integer value too large to represent";
Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW",
interp->result, (char *) NULL);
return TCL_ERROR;
}
} else {
if (args[0].doubleValue > (double) LONG_MAX) {
goto tooLarge;
}
}
resultPtr->intValue = (long) args[0].doubleValue;
}
return TCL_OK;
}
static int
ExprRoundFunc(clientData, interp, args, resultPtr)
ClientData clientData;
Tcl_Interp *interp;
Tcl_Value *args;
Tcl_Value *resultPtr;
{
resultPtr->type = TCL_INT;
if (args[0].type == TCL_INT) {
resultPtr->intValue = args[0].intValue;
} else {
if (args[0].doubleValue < 0) {
if (args[0].doubleValue <= (((double) (long) LONG_MIN) - 0.5)) {
tooLarge:
interp->result = "integer value too large to represent";
Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW",
interp->result, (char *) NULL);
return TCL_ERROR;
}
resultPtr->intValue = (long) (args[0].doubleValue - 0.5);
} else {
if (args[0].doubleValue >= (((double) LONG_MAX + 0.5))) {
goto tooLarge;
}
resultPtr->intValue = (long) (args[0].doubleValue + 0.5);
}
}
return TCL_OK;
}
static int
ExprLooksLikeInt(p)
char *p;
{
while (isspace(UCHAR(*p))) {
p++;
}
if ((*p == '+') || (*p == '-')) {
p++;
}
if (!isdigit(UCHAR(*p))) {
return 0;
}
p++;
while (isdigit(UCHAR(*p))) {
p++;
}
if ((*p != '.') && (*p != 'e') && (*p != 'E')) {
return 1;
}
return 0;
}