This is tclExpr.c in view mode; [Download] [Up]
/*
* 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 1987-1991 Regents of the University of California
* Permission to use, copy, modify, and distribute this
* software and its documentation for any purpose and without
* fee is hereby granted, provided that the above copyright
* notice appear in all copies. The University of California
* makes no representations about the suitability of this
* software for any purpose. It is provided "as is" without
* express or implied warranty.
*/
#ifndef lint
static char rcsid[] = "$Header: /user6/ouster/tcl/RCS/tclExpr.c,v 1.36 92/08/16 13:25:34 ouster Exp $ SPRITE (Berkeley)";
#endif
#include "tclInt.h"
/*
* 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 "tclUnix.h"
#else
int errno;
#define ERANGE 34
#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.
*/
#define STATIC_STRING_SPACE 150
typedef struct {
long intValue; /* Integer value, if any. */
double doubleValue; /* Floating-point value, if any. */
ParseValue pv; /* Used to hold a string value, if any. */
char staticSpace[STATIC_STRING_SPACE];
/* Storage for small strings; large ones
* are malloc-ed. */
int type; /* Type of value: TYPE_INT, TYPE_DOUBLE,
* or TYPE_STRING. */
} Value;
/*
* Valid values for type:
*/
#define TYPE_INT 0
#define TYPE_DOUBLE 1
#define TYPE_STRING 2
/*
* The data structure below describes the state of parsing an expression.
* It's passed among the routines in this module.
*/
typedef struct {
char *originalExpr; /* The entire expression, as originally
* passed to Tcl_Expr. */
char *expr; /* Position to the next character to be
* scanned from the expression string. */
int token; /* Type of the last token to be parsed from
* 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
#define OPEN_PAREN 1
#define CLOSE_PAREN 2
#define END 3
#define UNKNOWN 4
/*
* Binary operators:
*/
#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
/*
* Unary operators:
*/
#define UNARY_MINUS 28
#define NOT 29
#define BIT_NOT 30
/*
* Precedence table. The values for non-operator token types are ignored.
*/
int precTable[] = {
0, 0, 0, 0, 0, 0, 0, 0,
11, 11, 11, /* MULT, DIVIDE, MOD */
10, 10, /* PLUS, MINUS */
9, 9, /* LEFT_SHIFT, RIGHT_SHIFT */
8, 8, 8, 8, /* LESS, GREATER, LEQ, GEQ */
7, 7, /* EQUAL, NEQ */
6, /* BIT_AND */
5, /* BIT_XOR */
4, /* BIT_OR */
3, /* AND */
2, /* OR */
1, 1, /* QUESTY, COLON */
12, 12, 12 /* UNARY_MINUS, NOT, BIT_NOT */
};
/*
* Mapping from operator numbers to strings; used for error messages.
*/
char *operatorStrings[] = {
"VALUE", "(", ")", "END", "UNKNOWN", "5", "6", "7",
"*", "/", "%", "+", "-", "<<", ">>", "<", ">", "<=",
">=", "==", "!=", "&", "^", "|", "&&", "||", "?", ":",
"-", "!", "~"
};
/*
* Declarations for local procedures to this file:
*/
static int ExprGetValue _ANSI_ARGS_((Tcl_Interp *interp,
ExprInfo *infoPtr, int prec, Value *valuePtr));
static int ExprLex _ANSI_ARGS_((Tcl_Interp *interp,
ExprInfo *infoPtr, Value *valuePtr));
static void ExprMakeString _ANSI_ARGS_((Value *valuePtr));
static int ExprParseString _ANSI_ARGS_((Tcl_Interp *interp,
char *string, Value *valuePtr));
static int ExprTopLevel _ANSI_ARGS_((Tcl_Interp *interp,
char *string, Value *valuePtr));
/*
*--------------------------------------------------------------
*
* 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
ExprParseString(interp, string, valuePtr)
Tcl_Interp *interp; /* Where to store error message. */
char *string; /* String to turn into value. */
Value *valuePtr; /* Where to store value information.
* Caller must have initialized pv field. */
{
register char c;
/*
* Try to convert the string to a number.
*/
c = *string;
if (((c >= '0') && (c <= '9')) || (c == '-') || (c == '.')) {
char *term;
valuePtr->type = TYPE_INT;
errno = 0;
valuePtr->intValue = strtol(string, &term, 0);
c = *term;
if ((c == '\0') && (errno != ERANGE)) {
return TCL_OK;
}
if ((c == '.') || (c == 'e') || (c == 'E') || (errno == ERANGE)) {
errno = 0;
valuePtr->doubleValue = strtod(string, &term);
if (errno == ERANGE) {
Tcl_ResetResult(interp);
if (valuePtr->doubleValue == 0.0) {
Tcl_AppendResult(interp, "floating-point value \"",
string, "\" too small to represent",
(char *) NULL);
} else {
Tcl_AppendResult(interp, "floating-point value \"",
string, "\" too large to represent",
(char *) NULL);
}
return TCL_ERROR;
}
if (*term == '\0') {
valuePtr->type = TYPE_DOUBLE;
return TCL_OK;
}
}
}
/*
* Not a valid number. Save a string value (but don't do anything
* if it's already the value).
*/
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;
}
/*
*----------------------------------------------------------------------
*
* 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
ExprLex(interp, infoPtr, valuePtr)
Tcl_Interp *interp; /* Interpreter to use for error
* reporting. */
register ExprInfo *infoPtr; /* Describes the state of the parse. */
register Value *valuePtr; /* Where to store value, if that is
* what's parsed from string. Caller
* must have initialized pv field
* correctly. */
{
register char *p, c;
char *var, *term;
int result;
p = infoPtr->expr;
c = *p;
while (isspace(c)) {
p++;
c = *p;
}
infoPtr->expr = p+1;
switch (c) {
case '0':
case '1':
case '2':
case '3':
case '4':
case '5':
case '6':
case '7':
case '8':
case '9':
case '.':
/*
* Number. First read an integer. Then if it looks like
* there's a floating-point number (or if it's too big a
* number to fit in an integer), parse it as a floating-point
* number.
*/
infoPtr->token = VALUE;
valuePtr->type = TYPE_INT;
errno = 0;
valuePtr->intValue = strtoul(p, &term, 0);
c = *term;
if ((c == '.') || (c == 'e') || (c == 'E') || (errno == ERANGE)) {
char *term2;
errno = 0;
valuePtr->doubleValue = strtod(p, &term2);
if (errno == ERANGE) {
Tcl_ResetResult(interp);
if (valuePtr->doubleValue == 0.0) {
interp->result =
"floating-point value too small to represent";
} else {
interp->result =
"floating-point value too large to represent";
}
return TCL_ERROR;
}
if (term2 == infoPtr->expr) {
interp->result = "poorly-formed floating-point value";
return TCL_ERROR;
}
valuePtr->type = TYPE_DOUBLE;
infoPtr->expr = term2;
} else {
infoPtr->expr = term;
}
return TCL_OK;
case '$':
/*
* Variable. Fetch its value, then see if it makes sense
* as an integer or floating-point number.
*/
infoPtr->token = VALUE;
var = Tcl_ParseVar(interp, p, &infoPtr->expr);
if (var == NULL) {
return TCL_ERROR;
}
if (((Interp *) interp)->noEval) {
valuePtr->type = TYPE_INT;
valuePtr->intValue = 0;
return TCL_OK;
}
return ExprParseString(interp, var, valuePtr);
case '[':
infoPtr->token = VALUE;
result = Tcl_Eval(interp, p+1, TCL_BRACKET_TERM,
&infoPtr->expr);
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;
}
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;
}
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 = 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;
case 0:
infoPtr->token = END;
infoPtr->expr = p;
return TCL_OK;
default:
infoPtr->expr = p+1;
infoPtr->token = UNKNOWN;
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
ExprGetValue(interp, infoPtr, prec, valuePtr)
Tcl_Interp *interp; /* Interpreter to use for error
* reporting. */
register ExprInfo *infoPtr; /* Describes the state of the parse
* 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. */
Value *valuePtr; /* Where to store the value of the
* expression. Caller must have
* initialized pv field. */
{
Interp *iPtr = (Interp *) interp;
Value value2; /* Second operand for current
* operator. */
int operator; /* Current operator (either unary
* or binary). */
int badType; /* Type of offending argument; used
* for error messages. */
int gotOp; /* Non-zero means already lexed the
* 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;
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) {
/*
* Parenthesized sub-expression.
*/
result = ExprGetValue(interp, infoPtr, -1, valuePtr);
if (result != TCL_OK) {
goto done;
}
if (infoPtr->token != CLOSE_PAREN) {
Tcl_ResetResult(interp);
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 >= UNARY_MINUS) {
/*
* Process unary operators.
*/
operator = infoPtr->token;
result = ExprGetValue(interp, infoPtr, precTable[infoPtr->token],
valuePtr);
if (result != TCL_OK) {
goto done;
}
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 NOT:
if (valuePtr->type == TYPE_INT) {
valuePtr->intValue = !valuePtr->intValue;
} else if (valuePtr->type == TYPE_DOUBLE) {
/*
* Theoretically, should be able to use
* "!valuePtr->intValue", but apparently some
* compilers can't handle it.
*/
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;
}
}
/*
* Got the first operand. Now fetch (operator, operand) pairs.
*/
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)) {
result = TCL_OK;
goto done;
} else {
goto syntaxError;
}
}
if (precTable[operator] <= prec) {
result = TCL_OK;
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.
*/
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) {
badType = TYPE_STRING;
goto illegalType;
}
if (((operator == AND) && !valuePtr->intValue)
|| ((operator == OR) && valuePtr->intValue)) {
iPtr->noEval++;
result = ExprGetValue(interp, infoPtr, precTable[operator],
&value2);
iPtr->noEval--;
} else if (operator == QUESTY) {
if (valuePtr->intValue != 0) {
valuePtr->pv.next = valuePtr->pv.buffer;
result = ExprGetValue(interp, infoPtr, precTable[operator],
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[operator],
&value2);
iPtr->noEval--;
} else {
iPtr->noEval++;
result = ExprGetValue(interp, infoPtr, precTable[operator],
&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[operator],
valuePtr);
}
} 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 != CLOSE_PAREN)) {
goto syntaxError;
}
/*
* 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.
*/
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;
/*
* For the operators below, only integers are allowed.
*/
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;
/*
* 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.
*/
case LESS: case GREATER: case LEQ: case GEQ:
case EQUAL: case NEQ:
if (valuePtr->type == TYPE_STRING) {
if (value2.type != TYPE_STRING) {
ExprMakeString(&value2);
}
} else if (value2.type == TYPE_STRING) {
if (valuePtr->type != TYPE_STRING) {
ExprMakeString(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;
/*
* For the operators below, no strings are allowed, but
* no int->double conversions are performed.
*/
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;
/*
* For the operators below, type and conversions are
* irrelevant: they're handled elsewhere.
*/
case QUESTY: case COLON:
break;
/*
* Any other operator is an error.
*/
default:
interp->result = "unknown operator in expression";
result = TCL_ERROR;
goto done;
}
/*
* If necessary, convert one of the operands to the type
* of the other. If the operands are incompatible with
* the operator (e.g. "+" on strings) then return an
* error.
*/
switch (operator) {
case MULT:
if (valuePtr->type == TYPE_INT) {
valuePtr->intValue *= value2.intValue;
} else {
valuePtr->doubleValue *= value2.doubleValue;
}
break;
case DIVIDE:
if (valuePtr->type == TYPE_INT) {
if (value2.intValue == 0) {
divideByZero:
interp->result = "divide by zero";
result = TCL_ERROR;
goto done;
}
valuePtr->intValue /= value2.intValue;
} else {
if (value2.doubleValue == 0.0) {
goto divideByZero;
}
valuePtr->doubleValue /= value2.doubleValue;
}
break;
case MOD:
if (value2.intValue == 0) {
goto divideByZero;
}
valuePtr->intValue %= value2.intValue;
break;
case PLUS:
if (valuePtr->type == TYPE_INT) {
valuePtr->intValue += value2.intValue;
} else {
valuePtr->doubleValue += value2.doubleValue;
}
break;
case MINUS:
if (valuePtr->type == TYPE_INT) {
valuePtr->intValue -= value2.intValue;
} else {
valuePtr->doubleValue -= value2.doubleValue;
}
break;
case LEFT_SHIFT:
valuePtr->intValue <<= value2.intValue;
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.
*/
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;
/*
* 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:
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_ResetResult(interp);
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;
}
/*
*--------------------------------------------------------------
*
* 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
ExprMakeString(valuePtr)
register Value *valuePtr; /* Value to be converted. */
{
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) {
sprintf(valuePtr->pv.buffer, "%g", valuePtr->doubleValue);
}
valuePtr->type = TYPE_STRING;
}
/*
*--------------------------------------------------------------
*
* 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
ExprTopLevel(interp, string, valuePtr)
Tcl_Interp *interp; /* Context in which to evaluate the
* expression. */
char *string; /* Expression to evaluate. */
Value *valuePtr; /* Where to store result. Should
* not be initialized by caller. */
{
ExprInfo info;
int result;
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;
}
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
Tcl_ExprLong(interp, string, ptr)
Tcl_Interp *interp; /* Context in which to evaluate the
* expression. */
char *string; /* Expression to evaluate. */
long *ptr; /* Where to store result. */
{
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_ExprDouble(interp, string, ptr)
Tcl_Interp *interp; /* Context in which to evaluate the
* expression. */
char *string; /* Expression to evaluate. */
double *ptr; /* Where to store result. */
{
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; /* Context in which to evaluate the
* expression. */
char *string; /* Expression to evaluate. */
int *ptr; /* Where to store 0/1 result. */
{
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 {
interp->result = "expression didn't have numeric value";
result = TCL_ERROR;
}
}
if (value.pv.buffer != value.staticSpace) {
ckfree(value.pv.buffer);
}
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
Tcl_ExprString(interp, string)
Tcl_Interp *interp; /* Context in which to evaluate the
* expression. */
char *string; /* Expression to evaluate. */
{
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) {
sprintf(interp->result, "%g", value.doubleValue);
} else {
if (value.pv.buffer != value.staticSpace) {
interp->result = value.pv.buffer;
interp->freeProc = (Tcl_FreeProc *) free;
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;
}
These are the contents of the former NiCE NeXT User Group NeXTSTEP/OpenStep software archive, currently hosted by Netfuture.ch.