/*
* tclExpr.c --
*
* This file contains the code to evaluate expressions for
* Tcl.
*
* This implementation of floating-point support was modelled
* after an initial implementation by Bill Carpenter.
*
* Copyright (c) 1987-1994 The Regents of the University of California.
* Copyright (c) 1994 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
* SCCS: @(#) tclExpr.c 1.92 96/09/06 13:22:44
*/
#include "tclInt.h"
#ifdef NO_FLOAT_H
#else
# include <float.h>
#endif
#ifndef TCL_NO_MATH
#include <math.h>
#endif
/*
* 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 define
* errno here.
*/
#ifndef TCL_GENERIC_ONLY
#include "tclPort.h"
#else
#define NO_ERRNO_H
#endif
#ifdef NO_ERRNO_H
int errno;
#endif
/*
* The data structure below is used to describe an expression value,
* which can be either an integer (the usual case), a double-precision
* floating-point value, or a string. A given number has only one
* value at a time.
*/
typedef struct {
/* Storage for small strings; large ones
* are malloc-ed. */
* or TYPE_STRING. */
} Value;
/*
* Valid values for type:
*/
#define TYPE_INT 0
/*
* The data structure below describes the state of parsing an expression.
* It's passed among the routines in this module.
*/
typedef struct {
* passed to Tcl_ExprString et al. */
* scanned from the expression string. */
* expr. See below for definitions.
* Corresponds to the characters just
* before expr. */
} ExprInfo;
/*
* The token types are defined below. In addition, there is a table
* associating a precedence with each operator. The order of types
* is important. Consult the code before changing it.
*/
#define VALUE 0
/*
* Binary operators:
*/
/*
* Unary operators:
*/
/*
* Precedence table. The values for non-operator token types are ignored.
*/
static int precTable[] = {
0, 0, 0, 0, 0, 0, 0, 0,
12, 12, 12, /* MULT, DIVIDE, MOD */
11, 11, /* PLUS, MINUS */
10, 10, /* LEFT_SHIFT, RIGHT_SHIFT */
9, 9, 9, 9, /* LESS, GREATER, LEQ, GEQ */
8, 8, /* EQUAL, NEQ */
7, /* BIT_AND */
6, /* BIT_XOR */
5, /* BIT_OR */
4, /* AND */
3, /* OR */
2, /* QUESTY */
1, /* COLON */
13, 13, 13, 13 /* UNARY_MINUS, UNARY_PLUS, NOT,
* BIT_NOT */
};
/*
* Mapping from operator numbers to strings; used for error messages.
*/
static char *operatorStrings[] = {
"VALUE", "(", ")", ",", "END", "UNKNOWN", "6", "7",
"*", "/", "%", "+", "-", "<<", ">>", "<", ">", "<=",
">=", "==", "!=", "&", "^", "|", "&&", "||", "?", ":",
"-", "+", "!", "~"
};
/*
* The following slight modification to DBL_MAX is needed because of
* a compiler bug on Sprite (4/15/93).
*/
#ifdef sprite
#endif
/*
* Macros for testing floating-point values for certain special
* cases. Test for not-a-number by comparing a value against
* itself; test for infinity by comparing against the largest
* floating-point value.
*/
#define IS_NAN(v) ((v) != (v))
#ifdef DBL_MAX
#else
# define IS_INF(v) 0
#endif
/*
* The following global variable is use to signal matherr that Tcl
* is responsible for the arithmetic, so errors can be handled in a
* fashion appropriate for Tcl. Zero means no Tcl math is in
* progress; non-zero means Tcl is doing math.
*/
int tcl_MathInProgress = 0;
/*
* The variable below serves no useful purpose except to generate
* a reference to matherr, so that the Tcl version of matherr is
* linked in rather than the system version. Without this reference
* the need for matherr won't be discovered during linking until after
* libtcl.a has been processed, so Tcl's version won't be used.
*/
#ifdef NEED_MATHERR
extern int matherr();
#endif
/*
* Declarations for local procedures to this file:
*/
static int ExprLooksLikeInt _ANSI_ARGS_((char *p));
#ifndef TCL_NO_MATH
#if _WIN32
#endif
#endif
/*
* Built-in math functions:
*/
typedef struct {
/* Acceptable types for each argument. */
* when invoking it. */
} BuiltinFunc;
#ifndef TCL_NO_MATH
#endif
{0},
};
/*
*--------------------------------------------------------------
*
* ExprParseString --
*
* Given a string (such as one coming from command or variable
* substitution), make a Value based on the string. The value
* will be a floating-point or integer, if possible, or else it
* will just be a copy of the string.
*
* Results:
* TCL_OK is returned under normal circumstances, and TCL_ERROR
* is returned if a floating-point overflow or underflow occurred
* while reading in a number. The value at *valuePtr is modified
* to hold a number, if possible.
*
* Side effects:
* None.
*
*--------------------------------------------------------------
*/
static int
char *string; /* String to turn into value. */
* Caller must have initialized pv field. */
{
if (*string != 0) {
if (ExprLooksLikeInt(string)) {
errno = 0;
/*
* Note: use strtoul instead of strtol for integer conversions
* to allow full-size unsigned numbers, but don't depend on
* strtoul to handle sign characters; it won't in some
* implementations.
*/
/* Empty loop body. */
}
if (*p == '-') {
start = p+1;
} else if (*p == '+') {
start = p+1;
} else {
start = p;
}
if (*term == 0) {
/*
* This procedure is sometimes called with string in
* interp->result, so we have to clear the result before
* logging an error message.
*/
return TCL_ERROR;
} else {
return TCL_OK;
}
}
} else {
errno = 0;
if (errno != 0) {
return TCL_ERROR;
}
return TCL_OK;
}
}
}
/*
* Not a valid number. Save a string value (but don't do anything
* if it's already the value).
*/
if (shortfall > 0) {
}
}
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* ExprLex --
*
* Lexical analyzer for expression parser: parses a single value,
* operator, or other syntactic element from an expression string.
*
* Results:
* TCL_OK is returned unless an error occurred while doing lexical
* analysis or executing an embedded command. In that case a
* standard Tcl error is returned, using interp->result to hold
* an error message. In the event of a successful return, the token
* and field in infoPtr is updated to refer to the next symbol in
* the expression string, and the expr field is advanced past that
* token; if the token is a value, then the value is stored at
* valuePtr.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
static int
* reporting. */
* what's parsed from string. Caller
* must have initialized pv field
* correctly. */
{
register char *p;
int result;
p++;
}
if (*p == 0) {
return TCL_OK;
}
/*
* First try to parse the token as an integer or floating-point number.
* Don't want to check for a number if the first character is "+"
* or "-". If we do, we might treat a binary operator as unary by
* mistake, which will eventually cause a syntax error.
*/
if ((*p != '+') && (*p != '-')) {
if (ExprLooksLikeInt(p)) {
errno = 0;
return TCL_ERROR;
}
return TCL_OK;
} else {
errno = 0;
if (term != p) {
if (errno != 0) {
return TCL_ERROR;
}
return TCL_OK;
}
}
}
switch (*p) {
case '$':
/*
* Variable. Fetch its value, then see if it makes sense
* as an integer or floating-point number.
*/
return TCL_ERROR;
}
return TCL_OK;
}
case '[':
return result;
}
return TCL_OK;
}
return result;
}
return TCL_OK;
case '"':
return result;
}
case '{':
return result;
}
case '(':
return TCL_OK;
case ')':
return TCL_OK;
case ',':
return TCL_OK;
case '*':
return TCL_OK;
case '/':
return TCL_OK;
case '%':
return TCL_OK;
case '+':
return TCL_OK;
case '-':
return TCL_OK;
case '?':
return TCL_OK;
case ':':
return TCL_OK;
case '<':
switch (p[1]) {
case '<':
break;
case '=':
break;
default:
break;
}
return TCL_OK;
case '>':
switch (p[1]) {
case '>':
break;
case '=':
break;
default:
break;
}
return TCL_OK;
case '=':
if (p[1] == '=') {
} else {
}
return TCL_OK;
case '!':
if (p[1] == '=') {
} else {
}
return TCL_OK;
case '&':
if (p[1] == '&') {
} else {
}
return TCL_OK;
case '^':
return TCL_OK;
case '|':
if (p[1] == '|') {
} else {
}
return TCL_OK;
case '~':
return TCL_OK;
default:
}
return TCL_OK;
}
}
/*
*----------------------------------------------------------------------
*
* ExprGetValue --
*
* Parse a "value" from the remainder of the expression in infoPtr.
*
* Results:
* Normally TCL_OK is returned. The value of the expression is
* returned in *valuePtr. If an error occurred, then interp->result
* contains an error message and TCL_ERROR is returned.
* InfoPtr->token will be left pointing to the token AFTER the
* expression, and infoPtr->expr will point to the character just
* after the terminating token.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
static int
* reporting. */
* just before the value (i.e. ExprLex
* will be called to get first token
* of value). */
int prec; /* Treat any un-parenthesized operator
* with precedence <= this as the end
* of the expression. */
* expression. Caller must have
* initialized pv field. */
{
* operator. */
* or binary). */
* for error messages. */
* operator (while picking up value
* for unary operator). Don't lex
* again. */
int result;
/*
* There are two phases to this procedure. First, pick off an initial
* value. Then, parse (binary operator, value) pairs until done.
*/
gotOp = 0;
goto done;
}
/*
* Parenthesized sub-expression.
*/
goto done;
}
goto done;
}
} else {
}
}
/*
* Process unary operators.
*/
valuePtr);
goto done;
}
switch (operator) {
case UNARY_MINUS:
} else {
goto illegalType;
}
break;
case UNARY_PLUS:
goto illegalType;
}
break;
case NOT:
/*
* Theoretically, should be able to use
* "!valuePtr->intValue", but apparently some
* compilers can't handle it.
*/
} else {
}
} else {
goto illegalType;
}
break;
case BIT_NOT:
} else {
goto illegalType;
}
break;
}
}
gotOp = 1;
goto syntaxError;
}
}
/*
* Got the first operand. Now fetch (operator, operand) pairs.
*/
if (!gotOp) {
goto done;
}
}
while (1) {
goto done;
} else {
goto syntaxError;
}
}
goto done;
}
/*
* If we're doing an AND or OR and the first operand already
* determines the result, don't execute anything in the
* second operand: just parse. Same style for ?: pairs.
*/
goto illegalType;
}
/*
* Must set valuePtr->intValue to avoid referencing
* uninitialized memory in the "if" below; the actual
* value doesn't matter, since it will be ignored.
*/
}
&value2);
goto done;
}
}
continue;
/*
* Special note: ?: operators must associate right to
* left. To make this happen, use a precedence one lower
* than QUESTY when calling ExprGetValue recursively.
*/
goto done;
}
goto syntaxError;
}
} else {
goto done;
}
goto syntaxError;
}
goto done;
}
}
continue;
} else {
&value2);
}
} else {
&value2);
}
goto done;
}
goto syntaxError;
}
continue;
}
/*
* At this point we've got two values and an operator. Check
* to make sure that the particular data types are appropriate
* for the particular operator, and perform type conversion
* if necessary.
*/
switch (operator) {
/*
* For the operators below, no strings are allowed and
* ints get converted to floats if necessary.
*/
goto illegalType;
}
}
}
}
break;
/*
* For the operators below, only integers are allowed.
*/
goto illegalType;
goto illegalType;
}
break;
/*
* For the operators below, any type is allowed but the
* two operands must have the same type. Convert integers
* to floats and either to strings, if necessary.
*/
}
}
}
}
}
break;
/*
* For the operators below, no strings are allowed, but
* no int->double conversions are performed.
*/
goto illegalType;
}
goto illegalType;
}
break;
/*
* For the operators below, type and conversions are
* irrelevant: they're handled elsewhere.
*/
break;
/*
* Any other operator is an error.
*/
default:
goto done;
}
/*
* Carry out the function of the specified operator.
*/
switch (operator) {
case MULT:
} else {
}
break;
case DIVIDE:
case MOD:
int negative;
goto done;
}
/*
* The code below is tricky because C doesn't guarantee
* much about the properties of the quotient or
* remainder, but Tcl does: the remainder always has
* the same sign as the divisor and a smaller absolute
* value.
*/
negative = 0;
if (divisor < 0) {
negative = 1;
}
if (rem < 0) {
quot -= 1;
}
if (negative) {
}
} else {
goto divideByZero;
}
}
break;
case PLUS:
} else {
}
break;
case MINUS:
} else {
}
break;
case LEFT_SHIFT:
break;
case RIGHT_SHIFT:
/*
* The following code is a bit tricky: it ensures that
* right shifts propagate the sign bit even on machines
* where ">>" won't do it by default.
*/
} else {
}
break;
case LESS:
} else {
}
break;
case GREATER:
} else {
}
break;
case LEQ:
} else {
}
break;
case GEQ:
} else {
}
break;
case EQUAL:
} else {
}
break;
case NEQ:
} else {
}
break;
case BIT_AND:
break;
case BIT_XOR:
break;
case BIT_OR:
break;
/*
* For AND and OR, we know that the first value has already
* been converted to an integer. Thus we need only consider
* the possibility of int vs. double for the second value.
*/
case AND:
}
break;
case OR:
}
break;
case COLON:
goto done;
}
}
done:
}
return result;
goto done;
"floating-point value" : "non-numeric string",
(char *) NULL);
goto done;
}
/*
*--------------------------------------------------------------
*
* ExprMakeString --
*
* Convert a value from int or double representation to
* a string.
*
* Results:
* The information at *valuePtr gets converted to string
* format, if it wasn't that way already.
*
* Side effects:
* None.
*
*--------------------------------------------------------------
*/
static void
* information. */
{
int shortfall;
if (shortfall > 0) {
}
}
}
/*
*--------------------------------------------------------------
*
* ExprTopLevel --
*
* This procedure provides top-level functionality shared by
* procedures like Tcl_ExprInt, Tcl_ExprDouble, etc.
*
* Results:
* The result is a standard Tcl return value. If an error
* occurs then an error message is left in interp->result.
* The value of the expression is returned in *valuePtr, in
* whatever form it ends up in (could be string or integer
* or double). Caller may need to convert result. Caller
* is also responsible for freeing string memory in *valuePtr,
* if any was allocated.
*
* Side effects:
* None.
*
*--------------------------------------------------------------
*/
static int
* expression. */
char *string; /* Expression to evaluate. */
* not be initialized by caller. */
{
int result;
/*
* Create the math functions the first time an expression is
* evaluated.
*/
funcPtr++) {
}
}
return result;
}
return TCL_ERROR;
}
/*
* IEEE floating-point error.
*/
return TCL_ERROR;
}
return TCL_OK;
}
/*
*--------------------------------------------------------------
*
* Tcl_ExprLong, Tcl_ExprDouble, Tcl_ExprBoolean --
*
* Procedures to evaluate an expression and return its value
* in a particular form.
*
* Results:
* Each of the procedures below returns a standard Tcl result.
* If an error occurs then an error message is left in
* interp->result. Otherwise the value of the expression,
* in the appropriate form, is stored at *resultPtr. If
* the expression had a result that was incompatible with the
* desired form then an error is returned.
*
* Side effects:
* None.
*
*--------------------------------------------------------------
*/
int
* expression. */
char *string; /* Expression to evaluate. */
long *ptr; /* Where to store result. */
{
int result;
} else {
}
}
}
return result;
}
int
* expression. */
char *string; /* Expression to evaluate. */
double *ptr; /* Where to store result. */
{
int result;
} else {
}
}
}
return result;
}
int
* expression. */
char *string; /* Expression to evaluate. */
int *ptr; /* Where to store 0/1 result. */
{
int result;
} else {
}
}
}
return result;
}
/*
*--------------------------------------------------------------
*
* Tcl_ExprString --
*
* Evaluate an expression and return its value in string form.
*
* Results:
* A standard Tcl result. If the result is TCL_OK, then the
* interpreter's result is set to the string value of the
* expression. If the result is TCL_OK, then interp->result
* contains an error message.
*
* Side effects:
* None.
*
*--------------------------------------------------------------
*/
int
* expression. */
char *string; /* Expression to evaluate. */
{
int result;
} else {
} else {
}
}
}
}
return result;
}
/*
*----------------------------------------------------------------------
*
* Tcl_CreateMathFunc --
*
* Creates a new math function for expressions in a given
* interpreter.
*
* Results:
* None.
*
* Side effects:
* The function defined by "name" is created; if such a function
* already existed then its definition is overriden.
*
*----------------------------------------------------------------------
*/
void
* to be available. */
char *name; /* Name of function (e.g. "sin"). */
int numArgs; /* Nnumber of arguments required by
* function. */
* each argument. */
* math function. */
* function. */
{
int new, i;
if (new) {
}
if (numArgs > MAX_MATH_ARGS) {
}
for (i = 0; i < numArgs; i++) {
}
}
/*
*----------------------------------------------------------------------
*
* ExprMathFunc --
*
* This procedure is invoked to parse a math function from an
* expression string, carry out the function, and return the
* value computed.
*
* Results:
* TCL_OK is returned if all went well and the function's value
* was computed successfully. If an error occurred, TCL_ERROR
* is returned and an error message is left in interp->result.
* After a successful return infoPtr has been updated to refer
* to the character just after the function call, the token is
* set to VALUE, and the value is stored in valuePtr.
*
* Side effects:
* Embedded commands could have arbitrary side-effects.
*
*----------------------------------------------------------------------
*/
static int
* reporting. */
* infoPtr->expr must point to the
* first character of the function's
* name. */
* what's parsed from string. Caller
* must have initialized pv field
* correctly. */
{
int i, result;
/*
* Find the end of the math function's name and lookup the MathFunc
* record for the function.
*/
p++;
}
return TCL_ERROR;
}
goto syntaxError;
}
savedChar = *p;
*p = 0;
"\"", (char *) NULL);
*p = savedChar;
return TCL_ERROR;
}
*p = savedChar;
/*
* Scan off the arguments for the function, if there are any.
*/
if (mathFuncPtr->numArgs == 0) {
goto syntaxError;
}
} else {
for (i = 0; ; i++) {
return result;
}
"argument to math function didn't have numeric value";
return TCL_ERROR;
}
/*
* Copy the value to the argument record, converting it if
* necessary.
*/
} else {
}
} else {
} else {
}
}
/*
* Check for a comma separator between arguments or a close-paren
* to end the argument list.
*/
break;
}
return TCL_ERROR;
} else {
goto syntaxError;
}
}
return TCL_ERROR;
} else {
goto syntaxError;
}
}
}
}
return TCL_OK;
}
/*
* Invoke the function and copy its result back into valuePtr.
*/
&funcResult);
return result;
}
} else {
}
return TCL_OK;
return TCL_ERROR;
}
/*
*----------------------------------------------------------------------
*
* TclExprFloatError --
*
* This procedure is called when an error occurs during a
* floating-point operation. It reads errno and sets
* interp->result accordingly.
*
* Results:
* Interp->result is set to hold an error message.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
void
double value; /* Value returned after error; used to
* distinguish underflows from overflows. */
{
(char *) NULL);
if (value == 0.0) {
(char *) NULL);
} else {
(char *) NULL);
}
} else {
(char *) NULL);
}
}
/*
*----------------------------------------------------------------------
*
* Math Functions --
*
* This page contains the procedures that implement all of the
* built-in math functions for expressions.
*
* Results:
* Each procedure returns TCL_OK if it succeeds and places result
* information at *resultPtr. If it fails it returns TCL_ERROR
* and leaves an error message in interp->result.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
static int
* takes one double argument and
* returns a double result. */
{
errno = 0;
if (errno != 0) {
return TCL_ERROR;
}
return TCL_OK;
}
static int
* takes two double arguments and
* returns a double result. */
{
double (*func) _ANSI_ARGS_((double, double))
= (double (*)_ANSI_ARGS_((double, double))) clientData;
errno = 0;
if (errno != 0) {
return TCL_ERROR;
}
return TCL_OK;
}
/* ARGSUSED */
static int
{
if (args[0].doubleValue < 0) {
} else {
}
} else {
(char *) NULL);
return TCL_ERROR;
}
} else {
}
}
return TCL_OK;
}
/* ARGSUSED */
static int
{
} else {
}
return TCL_OK;
}
/* ARGSUSED */
static int
{
} else {
if (args[0].doubleValue < 0) {
return TCL_ERROR;
}
} else {
goto tooLarge;
}
}
}
return TCL_OK;
}
/* ARGSUSED */
static int
{
} else {
if (args[0].doubleValue < 0) {
return TCL_ERROR;
}
} else {
goto tooLarge;
}
}
}
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* ExprLooksLikeInt --
*
* This procedure decides whether the leading characters of a
* string look like an integer or something else (such as a
* floating-point number or string).
*
* Results:
* The return value is 1 if the leading characters of p look
* like a valid Tcl integer. If they look like a floating-point
* number (e.g. "e01" or "2.4"), or if they don't look like a
* number at all, then 0 is returned.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
static int
char *p; /* Pointer to string. */
{
p++;
}
if ((*p == '+') || (*p == '-')) {
p++;
}
return 0;
}
p++;
p++;
}
if ((*p != '.') && (*p != 'e') && (*p != 'E')) {
return 1;
}
return 0;
}