4 * This file contains the code to evaluate expressions for
7 * This implementation of floating-point support was modelled
8 * after an initial implementation by Bill Carpenter.
10 * Copyright 1987-1991 Regents of the University of California
11 * Permission to use, copy, modify, and distribute this
12 * software and its documentation for any purpose and without
13 * fee is hereby granted, provided that the above copyright
14 * notice appear in all copies. The University of California
15 * makes no representations about the suitability of this
16 * software for any purpose. It is provided "as is" without
17 * express or implied warranty.
21 static char rcsid
[] = "$Header: /user6/ouster/tcl/RCS/tclExpr.c,v 1.35 92/03/23 09:53:46 ouster Exp $ SPRITE (Berkeley)";
27 * The stuff below is a bit of a workaround so that this file can be used
28 * in environments that include no UNIX, i.e. no errno. Just define
32 #ifndef TCL_GENERIC_ONLY
40 * The data structure below is used to describe an expression value,
41 * which can be either an integer (the usual case), a double-precision
42 * floating-point value, or a string. A given number has only one
46 #define STATIC_STRING_SPACE 150
49 long intValue
; /* Integer value, if any. */
50 double doubleValue
; /* Floating-point value, if any. */
51 ParseValue pv
; /* Used to hold a string value, if any. */
52 char staticSpace
[STATIC_STRING_SPACE
];
53 /* Storage for small strings; large ones
55 int type
; /* Type of value: TYPE_INT, TYPE_DOUBLE,
60 * Valid values for type:
69 * The data structure below describes the state of parsing an expression.
70 * It's passed among the routines in this module.
74 char *originalExpr
; /* The entire expression, as originally
75 * passed to Tcl_Expr. */
76 char *expr
; /* Position to the next character to be
77 * scanned from the expression string. */
78 int token
; /* Type of the last token to be parsed from
79 * expr. See below for definitions.
80 * Corresponds to the characters just
85 * The token types are defined below. In addition, there is a table
86 * associating a precedence with each operator. The order of types
87 * is important. Consult the code before changing it.
105 #define LEFT_SHIFT 13
106 #define RIGHT_SHIFT 14
125 #define UNARY_MINUS 28
130 * Precedence table. The values for non-operator token types are ignored.
134 0, 0, 0, 0, 0, 0, 0, 0,
135 11, 11, 11, /* MULT, DIVIDE, MOD */
136 10, 10, /* PLUS, MINUS */
137 9, 9, /* LEFT_SHIFT, RIGHT_SHIFT */
138 8, 8, 8, 8, /* LESS, GREATER, LEQ, GEQ */
139 7, 7, /* EQUAL, NEQ */
145 1, 1, /* QUESTY, COLON */
146 12, 12, 12 /* UNARY_MINUS, NOT, BIT_NOT */
150 * Mapping from operator numbers to strings; used for error messages.
153 char *operatorStrings
[] = {
154 "VALUE", "(", ")", "END", "UNKNOWN", "5", "6", "7",
155 "*", "/", "%", "+", "-", "<<", ">>", "<", ">", "<=",
156 ">=", "==", "!=", "&", "^", "|", "&&", "||", "?", ":",
161 * Declarations for local procedures to this file:
164 static int ExprGetValue
_ANSI_ARGS_((Tcl_Interp
*interp
,
165 ExprInfo
*infoPtr
, int prec
, Value
*valuePtr
));
166 static int ExprLex
_ANSI_ARGS_((Tcl_Interp
*interp
,
167 ExprInfo
*infoPtr
, Value
*valuePtr
));
168 static void ExprMakeString
_ANSI_ARGS_((Value
*valuePtr
));
169 static int ExprParseString
_ANSI_ARGS_((Tcl_Interp
*interp
,
170 char *string
, Value
*valuePtr
));
171 static int ExprTopLevel
_ANSI_ARGS_((Tcl_Interp
*interp
,
172 char *string
, Value
*valuePtr
));
175 *--------------------------------------------------------------
179 * Given a string (such as one coming from command or variable
180 * substitution), make a Value based on the string. The value
181 * will be a floating-point or integer, if possible, or else it
182 * will just be a copy of the string.
185 * TCL_OK is returned under normal circumstances, and TCL_ERROR
186 * is returned if a floating-point overflow or underflow occurred
187 * while reading in a number. The value at *valuePtr is modified
188 * to hold a number, if possible.
193 *--------------------------------------------------------------
197 ExprParseString(interp
, string
, valuePtr
)
198 Tcl_Interp
*interp
; /* Where to store error message. */
199 char *string
; /* String to turn into value. */
200 Value
*valuePtr
; /* Where to store value information.
201 * Caller must have initialized pv field. */
206 * Try to convert the string to a number.
210 if (((c
>= '0') && (c
<= '9')) || (c
== '-') || (c
== '.')) {
213 valuePtr
->type
= TYPE_INT
;
215 valuePtr
->intValue
= strtol(string
, &term
, 0);
217 if ((c
== '\0') && (errno
!= ERANGE
)) {
220 if ((c
== '.') || (c
== 'e') || (c
== 'E') || (errno
== ERANGE
)) {
222 valuePtr
->doubleValue
= strtod(string
, &term
);
223 if (errno
== ERANGE
) {
224 Tcl_ResetResult(interp
);
225 if (valuePtr
->doubleValue
== 0.0) {
226 Tcl_AppendResult(interp
, "floating-point value \"",
227 string
, "\" too small to represent",
230 Tcl_AppendResult(interp
, "floating-point value \"",
231 string
, "\" too large to represent",
237 valuePtr
->type
= TYPE_DOUBLE
;
244 * Not a valid number. Save a string value (but don't do anything
245 * if it's already the value).
248 valuePtr
->type
= TYPE_STRING
;
249 if (string
!= valuePtr
->pv
.buffer
) {
250 int length
, shortfall
;
252 length
= strlen(string
);
253 valuePtr
->pv
.next
= valuePtr
->pv
.buffer
;
254 shortfall
= length
- (valuePtr
->pv
.end
- valuePtr
->pv
.buffer
);
256 (*valuePtr
->pv
.expandProc
)(&valuePtr
->pv
, shortfall
);
258 strcpy(valuePtr
->pv
.buffer
, string
);
264 *----------------------------------------------------------------------
268 * Lexical analyzer for expression parser: parses a single value,
269 * operator, or other syntactic element from an expression string.
272 * TCL_OK is returned unless an error occurred while doing lexical
273 * analysis or executing an embedded command. In that case a
274 * standard Tcl error is returned, using interp->result to hold
275 * an error message. In the event of a successful return, the token
276 * and field in infoPtr is updated to refer to the next symbol in
277 * the expression string, and the expr field is advanced past that
278 * token; if the token is a value, then the value is stored at
284 *----------------------------------------------------------------------
288 ExprLex(interp
, infoPtr
, valuePtr
)
289 Tcl_Interp
*interp
; /* Interpreter to use for error
291 register ExprInfo
*infoPtr
; /* Describes the state of the parse. */
292 register Value
*valuePtr
; /* Where to store value, if that is
293 * what's parsed from string. Caller
294 * must have initialized pv field
322 * Number. First read an integer. Then if it looks like
323 * there's a floating-point number (or if it's too big a
324 * number to fit in an integer), parse it as a floating-point
328 infoPtr
->token
= VALUE
;
329 valuePtr
->type
= TYPE_INT
;
331 valuePtr
->intValue
= strtoul(p
, &term
, 0);
333 if ((c
== '.') || (c
== 'e') || (c
== 'E') || (errno
== ERANGE
)) {
337 valuePtr
->doubleValue
= strtod(p
, &term2
);
338 if (errno
== ERANGE
) {
339 Tcl_ResetResult(interp
);
340 if (valuePtr
->doubleValue
== 0.0) {
342 "floating-point value too small to represent";
345 "floating-point value too large to represent";
349 if (term2
== infoPtr
->expr
) {
350 interp
->result
= "poorly-formed floating-point value";
353 valuePtr
->type
= TYPE_DOUBLE
;
354 infoPtr
->expr
= term2
;
356 infoPtr
->expr
= term
;
363 * Variable. Fetch its value, then see if it makes sense
364 * as an integer or floating-point number.
367 infoPtr
->token
= VALUE
;
368 var
= Tcl_ParseVar(interp
, p
, &infoPtr
->expr
);
372 if (((Interp
*) interp
)->noEval
) {
373 valuePtr
->type
= TYPE_INT
;
374 valuePtr
->intValue
= 0;
377 return ExprParseString(interp
, var
, valuePtr
);
380 infoPtr
->token
= VALUE
;
381 result
= Tcl_Eval(interp
, p
+1, TCL_BRACKET_TERM
,
383 if (result
!= TCL_OK
) {
387 if (((Interp
*) interp
)->noEval
) {
388 valuePtr
->type
= TYPE_INT
;
389 valuePtr
->intValue
= 0;
390 Tcl_ResetResult(interp
);
393 result
= ExprParseString(interp
, interp
->result
, valuePtr
);
394 if (result
!= TCL_OK
) {
397 Tcl_ResetResult(interp
);
401 infoPtr
->token
= VALUE
;
402 result
= TclParseQuotes(interp
, infoPtr
->expr
, '"', 0,
403 &infoPtr
->expr
, &valuePtr
->pv
);
404 if (result
!= TCL_OK
) {
407 return ExprParseString(interp
, valuePtr
->pv
.buffer
, valuePtr
);
410 infoPtr
->token
= VALUE
;
411 result
= TclParseBraces(interp
, infoPtr
->expr
, &infoPtr
->expr
,
413 if (result
!= TCL_OK
) {
416 return ExprParseString(interp
, valuePtr
->pv
.buffer
, valuePtr
);
419 infoPtr
->token
= OPEN_PAREN
;
423 infoPtr
->token
= CLOSE_PAREN
;
427 infoPtr
->token
= MULT
;
431 infoPtr
->token
= DIVIDE
;
435 infoPtr
->token
= MOD
;
439 infoPtr
->token
= PLUS
;
443 infoPtr
->token
= MINUS
;
447 infoPtr
->token
= QUESTY
;
451 infoPtr
->token
= COLON
;
458 infoPtr
->token
= LEFT_SHIFT
;
462 infoPtr
->token
= LEQ
;
465 infoPtr
->token
= LESS
;
474 infoPtr
->token
= RIGHT_SHIFT
;
478 infoPtr
->token
= GEQ
;
481 infoPtr
->token
= GREATER
;
489 infoPtr
->token
= EQUAL
;
491 infoPtr
->token
= UNKNOWN
;
498 infoPtr
->token
= NEQ
;
500 infoPtr
->token
= NOT
;
507 infoPtr
->token
= AND
;
509 infoPtr
->token
= BIT_AND
;
514 infoPtr
->token
= BIT_XOR
;
522 infoPtr
->token
= BIT_OR
;
527 infoPtr
->token
= BIT_NOT
;
531 infoPtr
->token
= END
;
537 infoPtr
->token
= UNKNOWN
;
543 *----------------------------------------------------------------------
547 * Parse a "value" from the remainder of the expression in infoPtr.
550 * Normally TCL_OK is returned. The value of the expression is
551 * returned in *valuePtr. If an error occurred, then interp->result
552 * contains an error message and TCL_ERROR is returned.
553 * InfoPtr->token will be left pointing to the token AFTER the
554 * expression, and infoPtr->expr will point to the character just
555 * after the terminating token.
560 *----------------------------------------------------------------------
564 ExprGetValue(interp
, infoPtr
, prec
, valuePtr
)
565 Tcl_Interp
*interp
; /* Interpreter to use for error
567 register ExprInfo
*infoPtr
; /* Describes the state of the parse
568 * just before the value (i.e. ExprLex
569 * will be called to get first token
571 int prec
; /* Treat any un-parenthesized operator
572 * with precedence <= this as the end
573 * of the expression. */
574 Value
*valuePtr
; /* Where to store the value of the
575 * expression. Caller must have
576 * initialized pv field. */
578 Interp
*iPtr
= (Interp
*) interp
;
579 Value value2
; /* Second operand for current
581 int operator; /* Current operator (either unary
583 int badType
; /* Type of offending argument; used
584 * for error messages. */
585 int gotOp
; /* Non-zero means already lexed the
586 * operator (while picking up value
587 * for unary operator). Don't lex
592 * There are two phases to this procedure. First, pick off an initial
593 * value. Then, parse (binary operator, value) pairs until done.
597 value2
.pv
.buffer
= value2
.pv
.next
= value2
.staticSpace
;
598 value2
.pv
.end
= value2
.pv
.buffer
+ STATIC_STRING_SPACE
- 1;
599 value2
.pv
.expandProc
= TclExpandParseValue
;
600 value2
.pv
.clientData
= (ClientData
) NULL
;
601 result
= ExprLex(interp
, infoPtr
, valuePtr
);
602 if (result
!= TCL_OK
) {
605 if (infoPtr
->token
== OPEN_PAREN
) {
608 * Parenthesized sub-expression.
611 result
= ExprGetValue(interp
, infoPtr
, -1, valuePtr
);
612 if (result
!= TCL_OK
) {
615 if (infoPtr
->token
!= CLOSE_PAREN
) {
616 Tcl_ResetResult(interp
);
617 sprintf(interp
->result
,
618 "unmatched parentheses in expression \"%.50s\"",
619 infoPtr
->originalExpr
);
624 if (infoPtr
->token
== MINUS
) {
625 infoPtr
->token
= UNARY_MINUS
;
627 if (infoPtr
->token
>= UNARY_MINUS
) {
630 * Process unary operators.
633 operator = infoPtr
->token
;
634 result
= ExprGetValue(interp
, infoPtr
, precTable
[infoPtr
->token
],
636 if (result
!= TCL_OK
) {
641 if (valuePtr
->type
== TYPE_INT
) {
642 valuePtr
->intValue
= -valuePtr
->intValue
;
643 } else if (valuePtr
->type
== TYPE_DOUBLE
){
644 valuePtr
->doubleValue
= -valuePtr
->doubleValue
;
646 badType
= valuePtr
->type
;
651 if (valuePtr
->type
== TYPE_INT
) {
652 valuePtr
->intValue
= !valuePtr
->intValue
;
653 } else if (valuePtr
->type
== TYPE_DOUBLE
) {
655 * Theoretically, should be able to use
656 * "!valuePtr->intValue", but apparently some
657 * compilers can't handle it.
659 if (valuePtr
->doubleValue
== 0.0) {
660 valuePtr
->intValue
= 1;
662 valuePtr
->intValue
= 0;
664 valuePtr
->type
= TYPE_INT
;
666 badType
= valuePtr
->type
;
671 if (valuePtr
->type
== TYPE_INT
) {
672 valuePtr
->intValue
= ~valuePtr
->intValue
;
674 badType
= valuePtr
->type
;
680 } else if (infoPtr
->token
!= VALUE
) {
686 * Got the first operand. Now fetch (operator, operand) pairs.
690 result
= ExprLex(interp
, infoPtr
, &value2
);
691 if (result
!= TCL_OK
) {
696 operator = infoPtr
->token
;
697 value2
.pv
.next
= value2
.pv
.buffer
;
698 if ((operator < MULT
) || (operator >= UNARY_MINUS
)) {
699 if ((operator == END
) || (operator == CLOSE_PAREN
)) {
706 if (precTable
[operator] <= prec
) {
712 * If we're doing an AND or OR and the first operand already
713 * determines the result, don't execute anything in the
714 * second operand: just parse. Same style for ?: pairs.
717 if ((operator == AND
) || (operator == OR
) || (operator == QUESTY
)) {
718 if (valuePtr
->type
== TYPE_DOUBLE
) {
719 valuePtr
->intValue
= valuePtr
->doubleValue
!= 0;
720 valuePtr
->type
= TYPE_INT
;
721 } else if (valuePtr
->type
== TYPE_STRING
) {
722 badType
= TYPE_STRING
;
725 if (((operator == AND
) && !valuePtr
->intValue
)
726 || ((operator == OR
) && valuePtr
->intValue
)) {
728 result
= ExprGetValue(interp
, infoPtr
, precTable
[operator],
731 } else if (operator == QUESTY
) {
732 if (valuePtr
->intValue
!= 0) {
733 valuePtr
->pv
.next
= valuePtr
->pv
.buffer
;
734 result
= ExprGetValue(interp
, infoPtr
, precTable
[operator],
736 if (result
!= TCL_OK
) {
739 if (infoPtr
->token
!= COLON
) {
742 value2
.pv
.next
= value2
.pv
.buffer
;
744 result
= ExprGetValue(interp
, infoPtr
, precTable
[operator],
749 result
= ExprGetValue(interp
, infoPtr
, precTable
[operator],
752 if (result
!= TCL_OK
) {
755 if (infoPtr
->token
!= COLON
) {
758 valuePtr
->pv
.next
= valuePtr
->pv
.buffer
;
759 result
= ExprGetValue(interp
, infoPtr
, precTable
[operator],
763 result
= ExprGetValue(interp
, infoPtr
, precTable
[operator],
767 result
= ExprGetValue(interp
, infoPtr
, precTable
[operator],
770 if (result
!= TCL_OK
) {
773 if ((infoPtr
->token
< MULT
) && (infoPtr
->token
!= VALUE
)
774 && (infoPtr
->token
!= END
)
775 && (infoPtr
->token
!= CLOSE_PAREN
)) {
780 * At this point we've got two values and an operator. Check
781 * to make sure that the particular data types are appropriate
782 * for the particular operator, and perform type conversion
789 * For the operators below, no strings are allowed and
790 * ints get converted to floats if necessary.
793 case MULT
: case DIVIDE
: case PLUS
: case MINUS
:
794 if ((valuePtr
->type
== TYPE_STRING
)
795 || (value2
.type
== TYPE_STRING
)) {
796 badType
= TYPE_STRING
;
799 if (valuePtr
->type
== TYPE_DOUBLE
) {
800 if (value2
.type
== TYPE_INT
) {
801 value2
.doubleValue
= value2
.intValue
;
802 value2
.type
= TYPE_DOUBLE
;
804 } else if (value2
.type
== TYPE_DOUBLE
) {
805 if (valuePtr
->type
== TYPE_INT
) {
806 valuePtr
->doubleValue
= valuePtr
->intValue
;
807 valuePtr
->type
= TYPE_DOUBLE
;
813 * For the operators below, only integers are allowed.
816 case MOD
: case LEFT_SHIFT
: case RIGHT_SHIFT
:
817 case BIT_AND
: case BIT_XOR
: case BIT_OR
:
818 if (valuePtr
->type
!= TYPE_INT
) {
819 badType
= valuePtr
->type
;
821 } else if (value2
.type
!= TYPE_INT
) {
822 badType
= value2
.type
;
828 * For the operators below, any type is allowed but the
829 * two operands must have the same type. Convert integers
830 * to floats and either to strings, if necessary.
833 case LESS
: case GREATER
: case LEQ
: case GEQ
:
834 case EQUAL
: case NEQ
:
835 if (valuePtr
->type
== TYPE_STRING
) {
836 if (value2
.type
!= TYPE_STRING
) {
837 ExprMakeString(&value2
);
839 } else if (value2
.type
== TYPE_STRING
) {
840 if (valuePtr
->type
!= TYPE_STRING
) {
841 ExprMakeString(valuePtr
);
843 } else if (valuePtr
->type
== TYPE_DOUBLE
) {
844 if (value2
.type
== TYPE_INT
) {
845 value2
.doubleValue
= value2
.intValue
;
846 value2
.type
= TYPE_DOUBLE
;
848 } else if (value2
.type
== TYPE_DOUBLE
) {
849 if (valuePtr
->type
== TYPE_INT
) {
850 valuePtr
->doubleValue
= valuePtr
->intValue
;
851 valuePtr
->type
= TYPE_DOUBLE
;
857 * For the operators below, no strings are allowed, but
858 * no int->double conversions are performed.
862 if (valuePtr
->type
== TYPE_STRING
) {
863 badType
= valuePtr
->type
;
866 if (value2
.type
== TYPE_STRING
) {
867 badType
= value2
.type
;
873 * For the operators below, type and conversions are
874 * irrelevant: they're handled elsewhere.
877 case QUESTY
: case COLON
:
881 * Any other operator is an error.
885 interp
->result
= "unknown operator in expression";
891 * If necessary, convert one of the operands to the type
892 * of the other. If the operands are incompatible with
893 * the operator (e.g. "+" on strings) then return an
899 if (valuePtr
->type
== TYPE_INT
) {
900 valuePtr
->intValue
*= value2
.intValue
;
902 valuePtr
->doubleValue
*= value2
.doubleValue
;
906 if (valuePtr
->type
== TYPE_INT
) {
907 if (value2
.intValue
== 0) {
909 interp
->result
= "divide by zero";
913 valuePtr
->intValue
/= value2
.intValue
;
915 if (value2
.doubleValue
== 0.0) {
918 valuePtr
->doubleValue
/= value2
.doubleValue
;
922 if (value2
.intValue
== 0) {
925 valuePtr
->intValue
%= value2
.intValue
;
928 if (valuePtr
->type
== TYPE_INT
) {
929 valuePtr
->intValue
+= value2
.intValue
;
931 valuePtr
->doubleValue
+= value2
.doubleValue
;
935 if (valuePtr
->type
== TYPE_INT
) {
936 valuePtr
->intValue
-= value2
.intValue
;
938 valuePtr
->doubleValue
-= value2
.doubleValue
;
942 valuePtr
->intValue
<<= value2
.intValue
;
946 * The following code is a bit tricky: it ensures that
947 * right shifts propagate the sign bit even on machines
948 * where ">>" won't do it by default.
951 if (valuePtr
->intValue
< 0) {
953 ~((~valuePtr
->intValue
) >> value2
.intValue
);
955 valuePtr
->intValue
>>= value2
.intValue
;
959 if (valuePtr
->type
== TYPE_INT
) {
961 valuePtr
->intValue
< value2
.intValue
;
962 } else if (valuePtr
->type
== TYPE_DOUBLE
) {
964 valuePtr
->doubleValue
< value2
.doubleValue
;
967 strcmp(valuePtr
->pv
.buffer
, value2
.pv
.buffer
) < 0;
969 valuePtr
->type
= TYPE_INT
;
972 if (valuePtr
->type
== TYPE_INT
) {
974 valuePtr
->intValue
> value2
.intValue
;
975 } else if (valuePtr
->type
== TYPE_DOUBLE
) {
977 valuePtr
->doubleValue
> value2
.doubleValue
;
980 strcmp(valuePtr
->pv
.buffer
, value2
.pv
.buffer
) > 0;
982 valuePtr
->type
= TYPE_INT
;
985 if (valuePtr
->type
== TYPE_INT
) {
987 valuePtr
->intValue
<= value2
.intValue
;
988 } else if (valuePtr
->type
== TYPE_DOUBLE
) {
990 valuePtr
->doubleValue
<= value2
.doubleValue
;
993 strcmp(valuePtr
->pv
.buffer
, value2
.pv
.buffer
) <= 0;
995 valuePtr
->type
= TYPE_INT
;
998 if (valuePtr
->type
== TYPE_INT
) {
1000 valuePtr
->intValue
>= value2
.intValue
;
1001 } else if (valuePtr
->type
== TYPE_DOUBLE
) {
1002 valuePtr
->intValue
=
1003 valuePtr
->doubleValue
>= value2
.doubleValue
;
1005 valuePtr
->intValue
=
1006 strcmp(valuePtr
->pv
.buffer
, value2
.pv
.buffer
) >= 0;
1008 valuePtr
->type
= TYPE_INT
;
1011 if (valuePtr
->type
== TYPE_INT
) {
1012 valuePtr
->intValue
=
1013 valuePtr
->intValue
== value2
.intValue
;
1014 } else if (valuePtr
->type
== TYPE_DOUBLE
) {
1015 valuePtr
->intValue
=
1016 valuePtr
->doubleValue
== value2
.doubleValue
;
1018 valuePtr
->intValue
=
1019 strcmp(valuePtr
->pv
.buffer
, value2
.pv
.buffer
) == 0;
1021 valuePtr
->type
= TYPE_INT
;
1024 if (valuePtr
->type
== TYPE_INT
) {
1025 valuePtr
->intValue
=
1026 valuePtr
->intValue
!= value2
.intValue
;
1027 } else if (valuePtr
->type
== TYPE_DOUBLE
) {
1028 valuePtr
->intValue
=
1029 valuePtr
->doubleValue
!= value2
.doubleValue
;
1031 valuePtr
->intValue
=
1032 strcmp(valuePtr
->pv
.buffer
, value2
.pv
.buffer
) != 0;
1034 valuePtr
->type
= TYPE_INT
;
1037 valuePtr
->intValue
&= value2
.intValue
;
1040 valuePtr
->intValue
^= value2
.intValue
;
1043 valuePtr
->intValue
|= value2
.intValue
;
1047 * For AND and OR, we know that the first value has already
1048 * been converted to an integer. Thus we need only consider
1049 * the possibility of int vs. double for the second value.
1053 if (value2
.type
== TYPE_DOUBLE
) {
1054 value2
.intValue
= value2
.doubleValue
!= 0;
1055 value2
.type
= TYPE_INT
;
1057 valuePtr
->intValue
= valuePtr
->intValue
&& value2
.intValue
;
1060 if (value2
.type
== TYPE_DOUBLE
) {
1061 value2
.intValue
= value2
.doubleValue
!= 0;
1062 value2
.type
= TYPE_INT
;
1064 valuePtr
->intValue
= valuePtr
->intValue
|| value2
.intValue
;
1068 interp
->result
= "can't have : operator without ? first";
1075 if (value2
.pv
.buffer
!= value2
.staticSpace
) {
1076 ckfree(value2
.pv
.buffer
);
1081 Tcl_ResetResult(interp
);
1082 Tcl_AppendResult(interp
, "syntax error in expression \"",
1083 infoPtr
->originalExpr
, "\"", (char *) NULL
);
1088 Tcl_AppendResult(interp
, "can't use ", (badType
== TYPE_DOUBLE
) ?
1089 "floating-point value" : "non-numeric string",
1090 " as operand of \"", operatorStrings
[operator], "\"",
1097 *--------------------------------------------------------------
1101 * Convert a value from int or double representation to
1105 * The information at *valuePtr gets converted to string
1106 * format, if it wasn't that way already.
1111 *--------------------------------------------------------------
1115 ExprMakeString(valuePtr
)
1116 register Value
*valuePtr
; /* Value to be converted. */
1120 shortfall
= 150 - (valuePtr
->pv
.end
- valuePtr
->pv
.buffer
);
1121 if (shortfall
> 0) {
1122 (*valuePtr
->pv
.expandProc
)(&valuePtr
->pv
, shortfall
);
1124 if (valuePtr
->type
== TYPE_INT
) {
1125 sprintf(valuePtr
->pv
.buffer
, "%ld", valuePtr
->intValue
);
1126 } else if (valuePtr
->type
== TYPE_DOUBLE
) {
1127 sprintf(valuePtr
->pv
.buffer
, "%g", valuePtr
->doubleValue
);
1129 valuePtr
->type
= TYPE_STRING
;
1133 *--------------------------------------------------------------
1137 * This procedure provides top-level functionality shared by
1138 * procedures like Tcl_ExprInt, Tcl_ExprDouble, etc.
1141 * The result is a standard Tcl return value. If an error
1142 * occurs then an error message is left in interp->result.
1143 * The value of the expression is returned in *valuePtr, in
1144 * whatever form it ends up in (could be string or integer
1145 * or double). Caller may need to convert result. Caller
1146 * is also responsible for freeing string memory in *valuePtr,
1147 * if any was allocated.
1152 *--------------------------------------------------------------
1156 ExprTopLevel(interp
, string
, valuePtr
)
1157 Tcl_Interp
*interp
; /* Context in which to evaluate the
1159 char *string
; /* Expression to evaluate. */
1160 Value
*valuePtr
; /* Where to store result. Should
1161 * not be initialized by caller. */
1166 info
.originalExpr
= string
;
1168 valuePtr
->pv
.buffer
= valuePtr
->pv
.next
= valuePtr
->staticSpace
;
1169 valuePtr
->pv
.end
= valuePtr
->pv
.buffer
+ STATIC_STRING_SPACE
- 1;
1170 valuePtr
->pv
.expandProc
= TclExpandParseValue
;
1171 valuePtr
->pv
.clientData
= (ClientData
) NULL
;
1173 result
= ExprGetValue(interp
, &info
, -1, valuePtr
);
1174 if (result
!= TCL_OK
) {
1177 if (info
.token
!= END
) {
1178 Tcl_AppendResult(interp
, "syntax error in expression \"",
1179 string
, "\"", (char *) NULL
);
1186 *--------------------------------------------------------------
1188 * Tcl_ExprLong, Tcl_ExprDouble, Tcl_ExprBoolean --
1190 * Procedures to evaluate an expression and return its value
1191 * in a particular form.
1194 * Each of the procedures below returns a standard Tcl result.
1195 * If an error occurs then an error message is left in
1196 * interp->result. Otherwise the value of the expression,
1197 * in the appropriate form, is stored at *resultPtr. If
1198 * the expression had a result that was incompatible with the
1199 * desired form then an error is returned.
1204 *--------------------------------------------------------------
1208 Tcl_ExprLong(interp
, string
, ptr
)
1209 Tcl_Interp
*interp
; /* Context in which to evaluate the
1211 char *string
; /* Expression to evaluate. */
1212 long *ptr
; /* Where to store result. */
1217 result
= ExprTopLevel(interp
, string
, &value
);
1218 if (result
== TCL_OK
) {
1219 if (value
.type
== TYPE_INT
) {
1220 *ptr
= value
.intValue
;
1221 } else if (value
.type
== TYPE_DOUBLE
) {
1222 *ptr
= value
.doubleValue
;
1224 interp
->result
= "expression didn't have numeric value";
1228 if (value
.pv
.buffer
!= value
.staticSpace
) {
1229 ckfree(value
.pv
.buffer
);
1235 Tcl_ExprDouble(interp
, string
, ptr
)
1236 Tcl_Interp
*interp
; /* Context in which to evaluate the
1238 char *string
; /* Expression to evaluate. */
1239 double *ptr
; /* Where to store result. */
1244 result
= ExprTopLevel(interp
, string
, &value
);
1245 if (result
== TCL_OK
) {
1246 if (value
.type
== TYPE_INT
) {
1247 *ptr
= value
.intValue
;
1248 } else if (value
.type
== TYPE_DOUBLE
) {
1249 *ptr
= value
.doubleValue
;
1251 interp
->result
= "expression didn't have numeric value";
1255 if (value
.pv
.buffer
!= value
.staticSpace
) {
1256 ckfree(value
.pv
.buffer
);
1262 Tcl_ExprBoolean(interp
, string
, ptr
)
1263 Tcl_Interp
*interp
; /* Context in which to evaluate the
1265 char *string
; /* Expression to evaluate. */
1266 int *ptr
; /* Where to store 0/1 result. */
1271 result
= ExprTopLevel(interp
, string
, &value
);
1272 if (result
== TCL_OK
) {
1273 if (value
.type
== TYPE_INT
) {
1274 *ptr
= value
.intValue
!= 0;
1275 } else if (value
.type
== TYPE_DOUBLE
) {
1276 *ptr
= value
.doubleValue
!= 0.0;
1278 interp
->result
= "expression didn't have numeric value";
1282 if (value
.pv
.buffer
!= value
.staticSpace
) {
1283 ckfree(value
.pv
.buffer
);
1289 *--------------------------------------------------------------
1293 * Evaluate an expression and return its value in string form.
1296 * A standard Tcl result. If the result is TCL_OK, then the
1297 * interpreter's result is set to the string value of the
1298 * expression. If the result is TCL_OK, then interp->result
1299 * contains an error message.
1304 *--------------------------------------------------------------
1308 Tcl_ExprString(interp
, string
)
1309 Tcl_Interp
*interp
; /* Context in which to evaluate the
1311 char *string
; /* Expression to evaluate. */
1316 result
= ExprTopLevel(interp
, string
, &value
);
1317 if (result
== TCL_OK
) {
1318 if (value
.type
== TYPE_INT
) {
1319 sprintf(interp
->result
, "%ld", value
.intValue
);
1320 } else if (value
.type
== TYPE_DOUBLE
) {
1321 sprintf(interp
->result
, "%g", value
.doubleValue
);
1323 if (value
.pv
.buffer
!= value
.staticSpace
) {
1324 interp
->result
= value
.pv
.buffer
;
1325 interp
->freeProc
= (Tcl_FreeProc
*) free
;
1326 value
.pv
.buffer
= value
.staticSpace
;
1328 Tcl_SetResult(interp
, value
.pv
.buffer
, TCL_VOLATILE
);
1332 if (value
.pv
.buffer
!= value
.staticSpace
) {
1333 ckfree(value
.pv
.buffer
);