![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to tclexpr.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Micropolis - Activity] / micropolis / src / tcl|
Return to tclexpr.c CVS log | Up to [Micropolis - Activity] / micropolis / src / tcl |
1.1 root 1: /*
2: * tclExpr.c --
3: *
4: * This file contains the code to evaluate expressions for
5: * Tcl.
6: *
7: * This implementation of floating-point support was modelled
8: * after an initial implementation by Bill Carpenter.
9: *
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.
18: */
19:
20: #ifndef lint
21: static char rcsid[] = "$Header: /user6/ouster/tcl/RCS/tclExpr.c,v 1.35 92/03/23 09:53:46 ouster Exp $ SPRITE (Berkeley)";
22: #endif
23:
24: #include "tclint.h"
25:
26: /*
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
29: * errno here.
30: */
31:
32: #ifndef TCL_GENERIC_ONLY
33: #include "tclunix.h"
34: #else
35: int errno;
36: #define ERANGE 34
37: #endif
38:
39: /*
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
43: * value at a time.
44: */
45:
46: #define STATIC_STRING_SPACE 150
47:
48: typedef struct {
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
54: * are malloc-ed. */
55: int type; /* Type of value: TYPE_INT, TYPE_DOUBLE,
56: * or TYPE_STRING. */
57: } Value;
58:
59: /*
60: * Valid values for type:
61: */
62:
63: #define TYPE_INT 0
64: #define TYPE_DOUBLE 1
65: #define TYPE_STRING 2
66:
67:
68: /*
69: * The data structure below describes the state of parsing an expression.
70: * It's passed among the routines in this module.
71: */
72:
73: typedef struct {
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
81: * before expr. */
82: } ExprInfo;
83:
84: /*
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.
88: */
89:
90: #define VALUE 0
91: #define OPEN_PAREN 1
92: #define CLOSE_PAREN 2
93: #define END 3
94: #define UNKNOWN 4
95:
96: /*
97: * Binary operators:
98: */
99:
100: #define MULT 8
101: #define DIVIDE 9
102: #define MOD 10
103: #define PLUS 11
104: #define MINUS 12
105: #define LEFT_SHIFT 13
106: #define RIGHT_SHIFT 14
107: #define LESS 15
108: #define GREATER 16
109: #define LEQ 17
110: #define GEQ 18
111: #define EQUAL 19
112: #define NEQ 20
113: #define BIT_AND 21
114: #define BIT_XOR 22
115: #define BIT_OR 23
116: #define AND 24
117: #define OR 25
118: #define QUESTY 26
119: #define COLON 27
120:
121: /*
122: * Unary operators:
123: */
124:
125: #define UNARY_MINUS 28
126: #define NOT 29
127: #define BIT_NOT 30
128:
129: /*
130: * Precedence table. The values for non-operator token types are ignored.
131: */
132:
133: int precTable[] = {
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 */
140: 6, /* BIT_AND */
141: 5, /* BIT_XOR */
142: 4, /* BIT_OR */
143: 3, /* AND */
144: 2, /* OR */
145: 1, 1, /* QUESTY, COLON */
146: 12, 12, 12 /* UNARY_MINUS, NOT, BIT_NOT */
147: };
148:
149: /*
150: * Mapping from operator numbers to strings; used for error messages.
151: */
152:
153: char *operatorStrings[] = {
154: "VALUE", "(", ")", "END", "UNKNOWN", "5", "6", "7",
155: "*", "/", "%", "+", "-", "<<", ">>", "<", ">", "<=",
156: ">=", "==", "!=", "&", "^", "|", "&&", "||", "?", ":",
157: "-", "!", "~"
158: };
159:
160: /*
161: * Declarations for local procedures to this file:
162: */
163:
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));
173:
174: /*
175: *--------------------------------------------------------------
176: *
177: * ExprParseString --
178: *
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.
183: *
184: * Results:
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.
189: *
190: * Side effects:
191: * None.
192: *
193: *--------------------------------------------------------------
194: */
195:
196: static int
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. */
202: {
203: register char c;
204:
205: /*
206: * Try to convert the string to a number.
207: */
208:
209: c = *string;
210: if (((c >= '0') && (c <= '9')) || (c == '-') || (c == '.')) {
211: char *term;
212:
213: valuePtr->type = TYPE_INT;
214: errno = 0;
215: valuePtr->intValue = strtol(string, &term, 0);
216: c = *term;
217: if ((c == '\0') && (errno != ERANGE)) {
218: return TCL_OK;
219: }
220: if ((c == '.') || (c == 'e') || (c == 'E') || (errno == ERANGE)) {
221: errno = 0;
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",
228: (char *) NULL);
229: } else {
230: Tcl_AppendResult(interp, "floating-point value \"",
231: string, "\" too large to represent",
232: (char *) NULL);
233: }
234: return TCL_ERROR;
235: }
236: if (*term == '\0') {
237: valuePtr->type = TYPE_DOUBLE;
238: return TCL_OK;
239: }
240: }
241: }
242:
243: /*
244: * Not a valid number. Save a string value (but don't do anything
245: * if it's already the value).
246: */
247:
248: valuePtr->type = TYPE_STRING;
249: if (string != valuePtr->pv.buffer) {
250: int length, shortfall;
251:
252: length = strlen(string);
253: valuePtr->pv.next = valuePtr->pv.buffer;
254: shortfall = length - (valuePtr->pv.end - valuePtr->pv.buffer);
255: if (shortfall > 0) {
256: (*valuePtr->pv.expandProc)(&valuePtr->pv, shortfall);
257: }
258: strcpy(valuePtr->pv.buffer, string);
259: }
260: return TCL_OK;
261: }
262:
263: /*
264: *----------------------------------------------------------------------
265: *
266: * ExprLex --
267: *
268: * Lexical analyzer for expression parser: parses a single value,
269: * operator, or other syntactic element from an expression string.
270: *
271: * Results:
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
279: * valuePtr.
280: *
281: * Side effects:
282: * None.
283: *
284: *----------------------------------------------------------------------
285: */
286:
287: static int
288: ExprLex(interp, infoPtr, valuePtr)
289: Tcl_Interp *interp; /* Interpreter to use for error
290: * reporting. */
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
295: * correctly. */
296: {
297: register char *p, c;
298: char *var, *term;
299: int result;
300:
301: p = infoPtr->expr;
302: c = *p;
303: while (isspace(c)) {
304: p++;
305: c = *p;
306: }
307: infoPtr->expr = p+1;
308: switch (c) {
309: case '0':
310: case '1':
311: case '2':
312: case '3':
313: case '4':
314: case '5':
315: case '6':
316: case '7':
317: case '8':
318: case '9':
319: case '.':
320:
321: /*
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
325: * number.
326: */
327:
328: infoPtr->token = VALUE;
329: valuePtr->type = TYPE_INT;
330: errno = 0;
331: valuePtr->intValue = strtoul(p, &term, 0);
332: c = *term;
333: if ((c == '.') || (c == 'e') || (c == 'E') || (errno == ERANGE)) {
334: char *term2;
335:
336: errno = 0;
337: valuePtr->doubleValue = strtod(p, &term2);
338: if (errno == ERANGE) {
339: Tcl_ResetResult(interp);
340: if (valuePtr->doubleValue == 0.0) {
341: interp->result =
342: "floating-point value too small to represent";
343: } else {
344: interp->result =
345: "floating-point value too large to represent";
346: }
347: return TCL_ERROR;
348: }
349: if (term2 == infoPtr->expr) {
350: interp->result = "poorly-formed floating-point value";
351: return TCL_ERROR;
352: }
353: valuePtr->type = TYPE_DOUBLE;
354: infoPtr->expr = term2;
355: } else {
356: infoPtr->expr = term;
357: }
358: return TCL_OK;
359:
360: case '$':
361:
362: /*
363: * Variable. Fetch its value, then see if it makes sense
364: * as an integer or floating-point number.
365: */
366:
367: infoPtr->token = VALUE;
368: var = Tcl_ParseVar(interp, p, &infoPtr->expr);
369: if (var == NULL) {
370: return TCL_ERROR;
371: }
372: if (((Interp *) interp)->noEval) {
373: valuePtr->type = TYPE_INT;
374: valuePtr->intValue = 0;
375: return TCL_OK;
376: }
377: return ExprParseString(interp, var, valuePtr);
378:
379: case '[':
380: infoPtr->token = VALUE;
381: result = Tcl_Eval(interp, p+1, TCL_BRACKET_TERM,
382: &infoPtr->expr);
383: if (result != TCL_OK) {
384: return result;
385: }
386: infoPtr->expr++;
387: if (((Interp *) interp)->noEval) {
388: valuePtr->type = TYPE_INT;
389: valuePtr->intValue = 0;
390: Tcl_ResetResult(interp);
391: return TCL_OK;
392: }
393: result = ExprParseString(interp, interp->result, valuePtr);
394: if (result != TCL_OK) {
395: return result;
396: }
397: Tcl_ResetResult(interp);
398: return TCL_OK;
399:
400: case '"':
401: infoPtr->token = VALUE;
402: result = TclParseQuotes(interp, infoPtr->expr, '"', 0,
403: &infoPtr->expr, &valuePtr->pv);
404: if (result != TCL_OK) {
405: return result;
406: }
407: return ExprParseString(interp, valuePtr->pv.buffer, valuePtr);
408:
409: case '{':
410: infoPtr->token = VALUE;
411: result = TclParseBraces(interp, infoPtr->expr, &infoPtr->expr,
412: &valuePtr->pv);
413: if (result != TCL_OK) {
414: return result;
415: }
416: return ExprParseString(interp, valuePtr->pv.buffer, valuePtr);
417:
418: case '(':
419: infoPtr->token = OPEN_PAREN;
420: return TCL_OK;
421:
422: case ')':
423: infoPtr->token = CLOSE_PAREN;
424: return TCL_OK;
425:
426: case '*':
427: infoPtr->token = MULT;
428: return TCL_OK;
429:
430: case '/':
431: infoPtr->token = DIVIDE;
432: return TCL_OK;
433:
434: case '%':
435: infoPtr->token = MOD;
436: return TCL_OK;
437:
438: case '+':
439: infoPtr->token = PLUS;
440: return TCL_OK;
441:
442: case '-':
443: infoPtr->token = MINUS;
444: return TCL_OK;
445:
446: case '?':
447: infoPtr->token = QUESTY;
448: return TCL_OK;
449:
450: case ':':
451: infoPtr->token = COLON;
452: return TCL_OK;
453:
454: case '<':
455: switch (p[1]) {
456: case '<':
457: infoPtr->expr = p+2;
458: infoPtr->token = LEFT_SHIFT;
459: break;
460: case '=':
461: infoPtr->expr = p+2;
462: infoPtr->token = LEQ;
463: break;
464: default:
465: infoPtr->token = LESS;
466: break;
467: }
468: return TCL_OK;
469:
470: case '>':
471: switch (p[1]) {
472: case '>':
473: infoPtr->expr = p+2;
474: infoPtr->token = RIGHT_SHIFT;
475: break;
476: case '=':
477: infoPtr->expr = p+2;
478: infoPtr->token = GEQ;
479: break;
480: default:
481: infoPtr->token = GREATER;
482: break;
483: }
484: return TCL_OK;
485:
486: case '=':
487: if (p[1] == '=') {
488: infoPtr->expr = p+2;
489: infoPtr->token = EQUAL;
490: } else {
491: infoPtr->token = UNKNOWN;
492: }
493: return TCL_OK;
494:
495: case '!':
496: if (p[1] == '=') {
497: infoPtr->expr = p+2;
498: infoPtr->token = NEQ;
499: } else {
500: infoPtr->token = NOT;
501: }
502: return TCL_OK;
503:
504: case '&':
505: if (p[1] == '&') {
506: infoPtr->expr = p+2;
507: infoPtr->token = AND;
508: } else {
509: infoPtr->token = BIT_AND;
510: }
511: return TCL_OK;
512:
513: case '^':
514: infoPtr->token = BIT_XOR;
515: return TCL_OK;
516:
517: case '|':
518: if (p[1] == '|') {
519: infoPtr->expr = p+2;
520: infoPtr->token = OR;
521: } else {
522: infoPtr->token = BIT_OR;
523: }
524: return TCL_OK;
525:
526: case '~':
527: infoPtr->token = BIT_NOT;
528: return TCL_OK;
529:
530: case 0:
531: infoPtr->token = END;
532: infoPtr->expr = p;
533: return TCL_OK;
534:
535: default:
536: infoPtr->expr = p+1;
537: infoPtr->token = UNKNOWN;
538: return TCL_OK;
539: }
540: }
541:
542: /*
543: *----------------------------------------------------------------------
544: *
545: * ExprGetValue --
546: *
547: * Parse a "value" from the remainder of the expression in infoPtr.
548: *
549: * Results:
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.
556: *
557: * Side effects:
558: * None.
559: *
560: *----------------------------------------------------------------------
561: */
562:
563: static int
564: ExprGetValue(interp, infoPtr, prec, valuePtr)
565: Tcl_Interp *interp; /* Interpreter to use for error
566: * reporting. */
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
570: * of value). */
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. */
577: {
578: Interp *iPtr = (Interp *) interp;
579: Value value2; /* Second operand for current
580: * operator. */
581: int operator; /* Current operator (either unary
582: * or binary). */
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
588: * again. */
589: int result;
590:
591: /*
592: * There are two phases to this procedure. First, pick off an initial
593: * value. Then, parse (binary operator, value) pairs until done.
594: */
595:
596: gotOp = 0;
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) {
603: goto done;
604: }
605: if (infoPtr->token == OPEN_PAREN) {
606:
607: /*
608: * Parenthesized sub-expression.
609: */
610:
611: result = ExprGetValue(interp, infoPtr, -1, valuePtr);
612: if (result != TCL_OK) {
613: goto done;
614: }
615: if (infoPtr->token != CLOSE_PAREN) {
616: Tcl_ResetResult(interp);
617: sprintf(interp->result,
618: "unmatched parentheses in expression \"%.50s\"",
619: infoPtr->originalExpr);
620: result = TCL_ERROR;
621: goto done;
622: }
623: } else {
624: if (infoPtr->token == MINUS) {
625: infoPtr->token = UNARY_MINUS;
626: }
627: if (infoPtr->token >= UNARY_MINUS) {
628:
629: /*
630: * Process unary operators.
631: */
632:
633: operator = infoPtr->token;
634: result = ExprGetValue(interp, infoPtr, precTable[infoPtr->token],
635: valuePtr);
636: if (result != TCL_OK) {
637: goto done;
638: }
639: switch (operator) {
640: case UNARY_MINUS:
641: if (valuePtr->type == TYPE_INT) {
642: valuePtr->intValue = -valuePtr->intValue;
643: } else if (valuePtr->type == TYPE_DOUBLE){
644: valuePtr->doubleValue = -valuePtr->doubleValue;
645: } else {
646: badType = valuePtr->type;
647: goto illegalType;
648: }
649: break;
650: case NOT:
651: if (valuePtr->type == TYPE_INT) {
652: valuePtr->intValue = !valuePtr->intValue;
653: } else if (valuePtr->type == TYPE_DOUBLE) {
654: /*
655: * Theoretically, should be able to use
656: * "!valuePtr->intValue", but apparently some
657: * compilers can't handle it.
658: */
659: if (valuePtr->doubleValue == 0.0) {
660: valuePtr->intValue = 1;
661: } else {
662: valuePtr->intValue = 0;
663: }
664: valuePtr->type = TYPE_INT;
665: } else {
666: badType = valuePtr->type;
667: goto illegalType;
668: }
669: break;
670: case BIT_NOT:
671: if (valuePtr->type == TYPE_INT) {
672: valuePtr->intValue = ~valuePtr->intValue;
673: } else {
674: badType = valuePtr->type;
675: goto illegalType;
676: }
677: break;
678: }
679: gotOp = 1;
680: } else if (infoPtr->token != VALUE) {
681: goto syntaxError;
682: }
683: }
684:
685: /*
686: * Got the first operand. Now fetch (operator, operand) pairs.
687: */
688:
689: if (!gotOp) {
690: result = ExprLex(interp, infoPtr, &value2);
691: if (result != TCL_OK) {
692: goto done;
693: }
694: }
695: while (1) {
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)) {
700: result = TCL_OK;
701: goto done;
702: } else {
703: goto syntaxError;
704: }
705: }
706: if (precTable[operator] <= prec) {
707: result = TCL_OK;
708: goto done;
709: }
710:
711: /*
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.
715: */
716:
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;
723: goto illegalType;
724: }
725: if (((operator == AND) && !valuePtr->intValue)
726: || ((operator == OR) && valuePtr->intValue)) {
727: iPtr->noEval++;
728: result = ExprGetValue(interp, infoPtr, precTable[operator],
729: &value2);
730: iPtr->noEval--;
731: } else if (operator == QUESTY) {
732: if (valuePtr->intValue != 0) {
733: valuePtr->pv.next = valuePtr->pv.buffer;
734: result = ExprGetValue(interp, infoPtr, precTable[operator],
735: valuePtr);
736: if (result != TCL_OK) {
737: goto done;
738: }
739: if (infoPtr->token != COLON) {
740: goto syntaxError;
741: }
742: value2.pv.next = value2.pv.buffer;
743: iPtr->noEval++;
744: result = ExprGetValue(interp, infoPtr, precTable[operator],
745: &value2);
746: iPtr->noEval--;
747: } else {
748: iPtr->noEval++;
749: result = ExprGetValue(interp, infoPtr, precTable[operator],
750: &value2);
751: iPtr->noEval--;
752: if (result != TCL_OK) {
753: goto done;
754: }
755: if (infoPtr->token != COLON) {
756: goto syntaxError;
757: }
758: valuePtr->pv.next = valuePtr->pv.buffer;
759: result = ExprGetValue(interp, infoPtr, precTable[operator],
760: valuePtr);
761: }
762: } else {
763: result = ExprGetValue(interp, infoPtr, precTable[operator],
764: &value2);
765: }
766: } else {
767: result = ExprGetValue(interp, infoPtr, precTable[operator],
768: &value2);
769: }
770: if (result != TCL_OK) {
771: goto done;
772: }
773: if ((infoPtr->token < MULT) && (infoPtr->token != VALUE)
774: && (infoPtr->token != END)
775: && (infoPtr->token != CLOSE_PAREN)) {
776: goto syntaxError;
777: }
778:
779: /*
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
783: * if necessary.
784: */
785:
786: switch (operator) {
787:
788: /*
789: * For the operators below, no strings are allowed and
790: * ints get converted to floats if necessary.
791: */
792:
793: case MULT: case DIVIDE: case PLUS: case MINUS:
794: if ((valuePtr->type == TYPE_STRING)
795: || (value2.type == TYPE_STRING)) {
796: badType = TYPE_STRING;
797: goto illegalType;
798: }
799: if (valuePtr->type == TYPE_DOUBLE) {
800: if (value2.type == TYPE_INT) {
801: value2.doubleValue = value2.intValue;
802: value2.type = TYPE_DOUBLE;
803: }
804: } else if (value2.type == TYPE_DOUBLE) {
805: if (valuePtr->type == TYPE_INT) {
806: valuePtr->doubleValue = valuePtr->intValue;
807: valuePtr->type = TYPE_DOUBLE;
808: }
809: }
810: break;
811:
812: /*
813: * For the operators below, only integers are allowed.
814: */
815:
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;
820: goto illegalType;
821: } else if (value2.type != TYPE_INT) {
822: badType = value2.type;
823: goto illegalType;
824: }
825: break;
826:
827: /*
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.
831: */
832:
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);
838: }
839: } else if (value2.type == TYPE_STRING) {
840: if (valuePtr->type != TYPE_STRING) {
841: ExprMakeString(valuePtr);
842: }
843: } else if (valuePtr->type == TYPE_DOUBLE) {
844: if (value2.type == TYPE_INT) {
845: value2.doubleValue = value2.intValue;
846: value2.type = TYPE_DOUBLE;
847: }
848: } else if (value2.type == TYPE_DOUBLE) {
849: if (valuePtr->type == TYPE_INT) {
850: valuePtr->doubleValue = valuePtr->intValue;
851: valuePtr->type = TYPE_DOUBLE;
852: }
853: }
854: break;
855:
856: /*
857: * For the operators below, no strings are allowed, but
858: * no int->double conversions are performed.
859: */
860:
861: case AND: case OR:
862: if (valuePtr->type == TYPE_STRING) {
863: badType = valuePtr->type;
864: goto illegalType;
865: }
866: if (value2.type == TYPE_STRING) {
867: badType = value2.type;
868: goto illegalType;
869: }
870: break;
871:
872: /*
873: * For the operators below, type and conversions are
874: * irrelevant: they're handled elsewhere.
875: */
876:
877: case QUESTY: case COLON:
878: break;
879:
880: /*
881: * Any other operator is an error.
882: */
883:
884: default:
885: interp->result = "unknown operator in expression";
886: result = TCL_ERROR;
887: goto done;
888: }
889:
890: /*
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
894: * error.
895: */
896:
897: switch (operator) {
898: case MULT:
899: if (valuePtr->type == TYPE_INT) {
900: valuePtr->intValue *= value2.intValue;
901: } else {
902: valuePtr->doubleValue *= value2.doubleValue;
903: }
904: break;
905: case DIVIDE:
906: if (valuePtr->type == TYPE_INT) {
907: if (value2.intValue == 0) {
908: divideByZero:
909: interp->result = "divide by zero";
910: result = TCL_ERROR;
911: goto done;
912: }
913: valuePtr->intValue /= value2.intValue;
914: } else {
915: if (value2.doubleValue == 0.0) {
916: goto divideByZero;
917: }
918: valuePtr->doubleValue /= value2.doubleValue;
919: }
920: break;
921: case MOD:
922: if (value2.intValue == 0) {
923: goto divideByZero;
924: }
925: valuePtr->intValue %= value2.intValue;
926: break;
927: case PLUS:
928: if (valuePtr->type == TYPE_INT) {
929: valuePtr->intValue += value2.intValue;
930: } else {
931: valuePtr->doubleValue += value2.doubleValue;
932: }
933: break;
934: case MINUS:
935: if (valuePtr->type == TYPE_INT) {
936: valuePtr->intValue -= value2.intValue;
937: } else {
938: valuePtr->doubleValue -= value2.doubleValue;
939: }
940: break;
941: case LEFT_SHIFT:
942: valuePtr->intValue <<= value2.intValue;
943: break;
944: case RIGHT_SHIFT:
945: /*
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.
949: */
950:
951: if (valuePtr->intValue < 0) {
952: valuePtr->intValue =
953: ~((~valuePtr->intValue) >> value2.intValue);
954: } else {
955: valuePtr->intValue >>= value2.intValue;
956: }
957: break;
958: case LESS:
959: if (valuePtr->type == TYPE_INT) {
960: valuePtr->intValue =
961: valuePtr->intValue < value2.intValue;
962: } else if (valuePtr->type == TYPE_DOUBLE) {
963: valuePtr->intValue =
964: valuePtr->doubleValue < value2.doubleValue;
965: } else {
966: valuePtr->intValue =
967: strcmp(valuePtr->pv.buffer, value2.pv.buffer) < 0;
968: }
969: valuePtr->type = TYPE_INT;
970: break;
971: case GREATER:
972: if (valuePtr->type == TYPE_INT) {
973: valuePtr->intValue =
974: valuePtr->intValue > value2.intValue;
975: } else if (valuePtr->type == TYPE_DOUBLE) {
976: valuePtr->intValue =
977: valuePtr->doubleValue > value2.doubleValue;
978: } else {
979: valuePtr->intValue =
980: strcmp(valuePtr->pv.buffer, value2.pv.buffer) > 0;
981: }
982: valuePtr->type = TYPE_INT;
983: break;
984: case LEQ:
985: if (valuePtr->type == TYPE_INT) {
986: valuePtr->intValue =
987: valuePtr->intValue <= value2.intValue;
988: } else if (valuePtr->type == TYPE_DOUBLE) {
989: valuePtr->intValue =
990: valuePtr->doubleValue <= value2.doubleValue;
991: } else {
992: valuePtr->intValue =
993: strcmp(valuePtr->pv.buffer, value2.pv.buffer) <= 0;
994: }
995: valuePtr->type = TYPE_INT;
996: break;
997: case GEQ:
998: if (valuePtr->type == TYPE_INT) {
999: valuePtr->intValue =
1000: valuePtr->intValue >= value2.intValue;
1001: } else if (valuePtr->type == TYPE_DOUBLE) {
1002: valuePtr->intValue =
1003: valuePtr->doubleValue >= value2.doubleValue;
1004: } else {
1005: valuePtr->intValue =
1006: strcmp(valuePtr->pv.buffer, value2.pv.buffer) >= 0;
1007: }
1008: valuePtr->type = TYPE_INT;
1009: break;
1010: case EQUAL:
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;
1017: } else {
1018: valuePtr->intValue =
1019: strcmp(valuePtr->pv.buffer, value2.pv.buffer) == 0;
1020: }
1021: valuePtr->type = TYPE_INT;
1022: break;
1023: case NEQ:
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;
1030: } else {
1031: valuePtr->intValue =
1032: strcmp(valuePtr->pv.buffer, value2.pv.buffer) != 0;
1033: }
1034: valuePtr->type = TYPE_INT;
1035: break;
1036: case BIT_AND:
1037: valuePtr->intValue &= value2.intValue;
1038: break;
1039: case BIT_XOR:
1040: valuePtr->intValue ^= value2.intValue;
1041: break;
1042: case BIT_OR:
1043: valuePtr->intValue |= value2.intValue;
1044: break;
1045:
1046: /*
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.
1050: */
1051:
1052: case AND:
1053: if (value2.type == TYPE_DOUBLE) {
1054: value2.intValue = value2.doubleValue != 0;
1055: value2.type = TYPE_INT;
1056: }
1057: valuePtr->intValue = valuePtr->intValue && value2.intValue;
1058: break;
1059: case OR:
1060: if (value2.type == TYPE_DOUBLE) {
1061: value2.intValue = value2.doubleValue != 0;
1062: value2.type = TYPE_INT;
1063: }
1064: valuePtr->intValue = valuePtr->intValue || value2.intValue;
1065: break;
1066:
1067: case COLON:
1068: interp->result = "can't have : operator without ? first";
1069: result = TCL_ERROR;
1070: goto done;
1071: }
1072: }
1073:
1074: done:
1075: if (value2.pv.buffer != value2.staticSpace) {
1076: ckfree(value2.pv.buffer);
1077: }
1078: return result;
1079:
1080: syntaxError:
1081: Tcl_ResetResult(interp);
1082: Tcl_AppendResult(interp, "syntax error in expression \"",
1083: infoPtr->originalExpr, "\"", (char *) NULL);
1084: result = TCL_ERROR;
1085: goto done;
1086:
1087: illegalType:
1088: Tcl_AppendResult(interp, "can't use ", (badType == TYPE_DOUBLE) ?
1089: "floating-point value" : "non-numeric string",
1090: " as operand of \"", operatorStrings[operator], "\"",
1091: (char *) NULL);
1092: result = TCL_ERROR;
1093: goto done;
1094: }
1095:
1096: /*
1097: *--------------------------------------------------------------
1098: *
1099: * ExprMakeString --
1100: *
1101: * Convert a value from int or double representation to
1102: * a string.
1103: *
1104: * Results:
1105: * The information at *valuePtr gets converted to string
1106: * format, if it wasn't that way already.
1107: *
1108: * Side effects:
1109: * None.
1110: *
1111: *--------------------------------------------------------------
1112: */
1113:
1114: static void
1115: ExprMakeString(valuePtr)
1116: register Value *valuePtr; /* Value to be converted. */
1117: {
1118: int shortfall;
1119:
1120: shortfall = 150 - (valuePtr->pv.end - valuePtr->pv.buffer);
1121: if (shortfall > 0) {
1122: (*valuePtr->pv.expandProc)(&valuePtr->pv, shortfall);
1123: }
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);
1128: }
1129: valuePtr->type = TYPE_STRING;
1130: }
1131:
1132: /*
1133: *--------------------------------------------------------------
1134: *
1135: * ExprTopLevel --
1136: *
1137: * This procedure provides top-level functionality shared by
1138: * procedures like Tcl_ExprInt, Tcl_ExprDouble, etc.
1139: *
1140: * Results:
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.
1148: *
1149: * Side effects:
1150: * None.
1151: *
1152: *--------------------------------------------------------------
1153: */
1154:
1155: static int
1156: ExprTopLevel(interp, string, valuePtr)
1157: Tcl_Interp *interp; /* Context in which to evaluate the
1158: * expression. */
1159: char *string; /* Expression to evaluate. */
1160: Value *valuePtr; /* Where to store result. Should
1161: * not be initialized by caller. */
1162: {
1163: ExprInfo info;
1164: int result;
1165:
1166: info.originalExpr = string;
1167: info.expr = 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;
1172:
1173: result = ExprGetValue(interp, &info, -1, valuePtr);
1174: if (result != TCL_OK) {
1175: return result;
1176: }
1177: if (info.token != END) {
1178: Tcl_AppendResult(interp, "syntax error in expression \"",
1179: string, "\"", (char *) NULL);
1180: return TCL_ERROR;
1181: }
1182: return TCL_OK;
1183: }
1184:
1185: /*
1186: *--------------------------------------------------------------
1187: *
1188: * Tcl_ExprLong, Tcl_ExprDouble, Tcl_ExprBoolean --
1189: *
1190: * Procedures to evaluate an expression and return its value
1191: * in a particular form.
1192: *
1193: * Results:
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.
1200: *
1201: * Side effects:
1202: * None.
1203: *
1204: *--------------------------------------------------------------
1205: */
1206:
1207: int
1208: Tcl_ExprLong(interp, string, ptr)
1209: Tcl_Interp *interp; /* Context in which to evaluate the
1210: * expression. */
1211: char *string; /* Expression to evaluate. */
1212: long *ptr; /* Where to store result. */
1213: {
1214: Value value;
1215: int result;
1216:
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;
1223: } else {
1224: interp->result = "expression didn't have numeric value";
1225: result = TCL_ERROR;
1226: }
1227: }
1228: if (value.pv.buffer != value.staticSpace) {
1229: ckfree(value.pv.buffer);
1230: }
1231: return result;
1232: }
1233:
1234: int
1235: Tcl_ExprDouble(interp, string, ptr)
1236: Tcl_Interp *interp; /* Context in which to evaluate the
1237: * expression. */
1238: char *string; /* Expression to evaluate. */
1239: double *ptr; /* Where to store result. */
1240: {
1241: Value value;
1242: int result;
1243:
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;
1250: } else {
1251: interp->result = "expression didn't have numeric value";
1252: result = TCL_ERROR;
1253: }
1254: }
1255: if (value.pv.buffer != value.staticSpace) {
1256: ckfree(value.pv.buffer);
1257: }
1258: return result;
1259: }
1260:
1261: int
1262: Tcl_ExprBoolean(interp, string, ptr)
1263: Tcl_Interp *interp; /* Context in which to evaluate the
1264: * expression. */
1265: char *string; /* Expression to evaluate. */
1266: int *ptr; /* Where to store 0/1 result. */
1267: {
1268: Value value;
1269: int result;
1270:
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;
1277: } else {
1278: interp->result = "expression didn't have numeric value";
1279: result = TCL_ERROR;
1280: }
1281: }
1282: if (value.pv.buffer != value.staticSpace) {
1283: ckfree(value.pv.buffer);
1284: }
1285: return result;
1286: }
1287:
1288: /*
1289: *--------------------------------------------------------------
1290: *
1291: * Tcl_ExprString --
1292: *
1293: * Evaluate an expression and return its value in string form.
1294: *
1295: * Results:
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.
1300: *
1301: * Side effects:
1302: * None.
1303: *
1304: *--------------------------------------------------------------
1305: */
1306:
1307: int
1308: Tcl_ExprString(interp, string)
1309: Tcl_Interp *interp; /* Context in which to evaluate the
1310: * expression. */
1311: char *string; /* Expression to evaluate. */
1312: {
1313: Value value;
1314: int result;
1315:
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);
1322: } else {
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;
1327: } else {
1328: Tcl_SetResult(interp, value.pv.buffer, TCL_VOLATILE);
1329: }
1330: }
1331: }
1332: if (value.pv.buffer != value.staticSpace) {
1333: ckfree(value.pv.buffer);
1334: }
1335: return result;
1336: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.