![[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 [Research Unix] / researchv10dc / cmd / worm / scsi / tcl|
Return to tclExpr.c CVS log | Up to [Research Unix] / researchv10dc / cmd / worm / scsi / tcl |
1.1 root 1: /*
2: * tclExpr.c --
3: *
4: * This file contains the code to evaluate expressions for
5: * Tcl.
6: *
7: * Copyright 1987 Regents of the University of California
8: * Permission to use, copy, modify, and distribute this
9: * software and its documentation for any purpose and without
10: * fee is hereby granted, provided that the above copyright
11: * notice appear in all copies. The University of California
12: * makes no representations about the suitability of this
13: * software for any purpose. It is provided "as is" without
14: * express or implied warranty.
15: */
16:
17: #ifndef lint
18: static char rcsid[] = "$Header: /sprite/src/lib/tcl/RCS/tclExpr.c,v 1.13 90/03/22 15:24:59 ouster Exp $ SPRITE (Berkeley)";
19: #pragma ref rcsid
20: #endif not lint
21:
22: #define _POSIX_SOURCE
23:
24: #include <stdio.h>
25: #include <ctype.h>
26: #include "tcl.h"
27: #include "tclInt.h"
28:
29: /*
30: * The data structure below describes the state of parsing an expression.
31: * It's passed among the routines in this module.
32: */
33:
34: typedef struct {
35: Tcl_Interp *interp; /* Intepreter to use for command execution
36: * and variable lookup. */
37: char *originalExpr; /* The entire expression, as originally
38: * passed to Tcl_Expr. */
39: char *expr; /* Position to the next character to be
40: * scanned from the expression string. */
41: int token; /* Type of the last token to be parsed from
42: * expr. See below for definitions.
43: * Corresponds to the characters just
44: * before expr. */
45: int number; /* If token is NUMBER, gives value of
46: * the number. */
47: } ExprInfo;
48:
49: /*
50: * The token types are defined below. In addition, there is a table
51: * associating a precedence with each operator. The order of types
52: * is important. Consult the code before changing it.
53: */
54:
55: #define NUMBER 0
56: #define OPEN_PAREN 1
57: #define CLOSE_PAREN 2
58: #define END 3
59: #define UNKNOWN 4
60:
61: /*
62: * Binary operators:
63: */
64:
65: #define MULT 8
66: #define DIVIDE 9
67: #define MOD 10
68: #define PLUS 11
69: #define MINUS 12
70: #define LEFT_SHIFT 13
71: #define RIGHT_SHIFT 14
72: #define LESS 15
73: #define GREATER 16
74: #define LEQ 17
75: #define GEQ 18
76: #define EQUAL 19
77: #define NEQ 20
78: #define BIT_AND 21
79: #define BIT_XOR 22
80: #define BIT_OR 23
81: #define AND 24
82: #define OR 25
83: #define QUESTY 26
84: #define COLON 27
85:
86: /*
87: * Unary operators:
88: */
89:
90: #define UNARY_MINUS 28
91: #define NOT 29
92: #define BIT_NOT 30
93:
94: /*
95: * Precedence table. The values for non-operator token types are ignored.
96: */
97:
98: int precTable[] = {
99: 0, 0, 0, 0, 0, 0, 0, 0,
100: 11, 11, 11, /* MULT, DIVIDE, MOD */
101: 10, 10, /* PLUS, MINUS */
102: 9, 9, /* LEFT_SHIFT, RIGHT_SHIFT */
103: 8, 8, 8, 8, /* LESS, GREATER, LEQ, GEQ */
104: 7, 7, /* EQUAL, NEQ */
105: 6, /* BIT_AND */
106: 5, /* BIT_XOR */
107: 4, /* BIT_OR */
108: 3, /* AND */
109: 2, /* OR */
110: 1, 1, /* QUESTY, COLON */
111: 12, 12, 12 /* UNARY_MINUS, NOT, BIT_NOT */
112: };
113:
114: /*
115: *----------------------------------------------------------------------
116: *
117: * ExprGetNum --
118: *
119: * Parse off a number from a string.
120: *
121: * Results:
122: * The return value is the integer value corresponding to the
123: * leading digits of string. If termPtr isn't NULL, *termPtr
124: * is filled in with the address of the character after the
125: * last one that is part of the number.
126: *
127: * Side effects:
128: * None.
129: *
130: *----------------------------------------------------------------------
131: */
132:
133: int
134: ExprGetNum(string, termPtr)
135: register char *string; /* ASCII representation of number.
136: * If leading digit is "0" then read
137: * in base 8; if "0x", then read in
138: * base 16. */
139: register char **termPtr; /* If non-NULL, fill in with address
140: * of terminating character. */
141: {
142: int result, sign;
143: register char c;
144:
145: c = *string;
146: result = 0;
147: if (c == '-') {
148: sign = -1;
149: string++; c = *string;
150: } else {
151: sign = 1;
152: }
153: if (c == '0') {
154: string++; c = *string;
155: if (c == 'x') {
156: while (1) {
157: string++; c = *string;
158: if ((c >= '0') && (c <= '9')) {
159: result = (result << 4) + (c - '0');
160: } else if ((c >= 'a') && (c <= 'f')) {
161: result = (result << 4) + 10 + (c - 'a');
162: } else if ((c >= 'A') && (c <= 'F')) {
163: result = (result << 4) + 10 + (c - 'A');
164: } else {
165: break;
166: }
167: }
168: } else {
169: while ((c >= '0') && (c <= '7')) {
170: result = (result << 3) + (c - '0');
171: string++; c = *string;
172: }
173: }
174: } else {
175: while ((c >= '0') && (c <= '9')) {
176: result = (result*10) + (c - '0');
177: string++; c = *string;
178: }
179: }
180: if (termPtr != NULL) {
181: *termPtr = string;
182: }
183: return result*sign;
184: }
185:
186: /*
187: *----------------------------------------------------------------------
188: *
189: * ExprLex --
190: *
191: * Lexical analyzer for expression parser.
192: *
193: * Results:
194: * TCL_OK is returned unless an error occurred while doing lexical
195: * analysis or executing an embedded command. In that case a
196: * standard Tcl error is returned, using interp->result to hold
197: * an error message. In the event of a successful return, the token
198: * and (possibly) number fields in infoPtr are updated to refer to
199: * the next symbol in the expression string, and the expr field is
200: * advanced.
201: *
202: * Side effects:
203: * None.
204: *
205: *----------------------------------------------------------------------
206: */
207:
208: int
209: ExprLex(interp, infoPtr)
210: Tcl_Interp *interp; /* Interpreter to use for error
211: * reporting. */
212: register ExprInfo *infoPtr; /* Describes the state of the parse. */
213: {
214: register char *p, c;
215: char *var, *term;
216: int result;
217:
218: /*
219: * The next token is either:
220: * (a) a variable name (indicated by a $ sign plus a variable
221: * name in the standard Tcl fashion); lookup the value
222: * of the variable and return its numeric equivalent as a
223: * number.
224: * (b) an embedded command (anything between '[' and ']').
225: * Execute the command and convert its result to a number.
226: * (c) a series of decimal digits. Convert it to a number.
227: * (d) space: skip it.
228: * (d) an operator. See what kind it is.
229: */
230:
231: p = infoPtr->expr;
232: c = *p;
233: while (isspace(c)) {
234: p++; c = *p;
235: }
236: infoPtr->expr = p+1;
237: switch (c) {
238: case '0':
239: case '1':
240: case '2':
241: case '3':
242: case '4':
243: case '5':
244: case '6':
245: case '7':
246: case '8':
247: case '9':
248: infoPtr->token = NUMBER;
249: infoPtr->number = ExprGetNum(p, &infoPtr->expr);
250: return TCL_OK;
251:
252: case '$':
253: infoPtr->token = NUMBER;
254: var = Tcl_ParseVar(infoPtr->interp, p, &infoPtr->expr);
255: if (var == NULL) {
256: return TCL_ERROR;
257: }
258: if (((Interp *) infoPtr->interp)->noEval) {
259: infoPtr->number = 0;
260: return TCL_OK;
261: }
262: infoPtr->number = ExprGetNum(var, &term);
263: if ((term == var) || (*term != 0)) {
264: c = *infoPtr->expr;
265: *infoPtr->expr = 0;
266: Tcl_Return(interp, (char *) NULL, TCL_STATIC);
267: sprintf(interp->result,
268: "variable \"%.50s\" contained non-numeric value \"%.50s\"",
269: p, var);
270: *infoPtr->expr = c;
271: return TCL_ERROR;
272: }
273: return TCL_OK;
274:
275: case '[':
276: infoPtr->token = NUMBER;
277: result = Tcl_Eval(infoPtr->interp, p+1, TCL_BRACKET_TERM,
278: &infoPtr->expr);
279: if (result != TCL_OK) {
280: return result;
281: }
282: infoPtr->expr++;
283: if (((Interp *) infoPtr->interp)->noEval) {
284: infoPtr->number = 0;
285: Tcl_Return(interp, (char *) NULL, TCL_STATIC);
286: return TCL_OK;
287: }
288: infoPtr->number = ExprGetNum(interp->result, &term);
289: if ((term == interp->result) || (*term != 0)) {
290: char string[200];
291: infoPtr->expr[-1];
292: infoPtr->expr[-1] = 0;
293: sprintf(string, "command \"%.50s\" returned non-numeric result \"%.50s\"",
294: p+1, interp->result);
295: infoPtr->expr[-1] = c;
296: Tcl_Return(interp, string, TCL_VOLATILE);
297: return TCL_ERROR;
298: }
299: Tcl_Return(interp, (char *) NULL, TCL_STATIC);
300: return TCL_OK;
301:
302: case '(':
303: infoPtr->token = OPEN_PAREN;
304: return TCL_OK;
305:
306: case ')':
307: infoPtr->token = CLOSE_PAREN;
308: return TCL_OK;
309:
310: case '*':
311: infoPtr->token = MULT;
312: return TCL_OK;
313:
314: case '/':
315: infoPtr->token = DIVIDE;
316: return TCL_OK;
317:
318: case '%':
319: infoPtr->token = MOD;
320: return TCL_OK;
321:
322: case '+':
323: infoPtr->token = PLUS;
324: return TCL_OK;
325:
326: case '-':
327: infoPtr->token = MINUS;
328: return TCL_OK;
329:
330: case '?':
331: infoPtr->token = QUESTY;
332: return TCL_OK;
333:
334: case ':':
335: infoPtr->token = COLON;
336: return TCL_OK;
337:
338: case '<':
339: switch (p[1]) {
340: case '<':
341: infoPtr->expr = p+2;
342: infoPtr->token = LEFT_SHIFT;
343: break;
344: case '=':
345: infoPtr->expr = p+2;
346: infoPtr->token = LEQ;
347: break;
348: default:
349: infoPtr->token = LESS;
350: break;
351: }
352: return TCL_OK;
353:
354: case '>':
355: switch (p[1]) {
356: case '>':
357: infoPtr->expr = p+2;
358: infoPtr->token = RIGHT_SHIFT;
359: break;
360: case '=':
361: infoPtr->expr = p+2;
362: infoPtr->token = GEQ;
363: break;
364: default:
365: infoPtr->token = GREATER;
366: break;
367: }
368: return TCL_OK;
369:
370: case '=':
371: if (p[1] == '=') {
372: infoPtr->expr = p+2;
373: infoPtr->token = EQUAL;
374: } else {
375: infoPtr->token = UNKNOWN;
376: }
377: return TCL_OK;
378:
379: case '!':
380: if (p[1] == '=') {
381: infoPtr->expr = p+2;
382: infoPtr->token = NEQ;
383: } else {
384: infoPtr->token = NOT;
385: }
386: return TCL_OK;
387:
388: case '&':
389: if (p[1] == '&') {
390: infoPtr->expr = p+2;
391: infoPtr->token = AND;
392: } else {
393: infoPtr->token = BIT_AND;
394: }
395: return TCL_OK;
396:
397: case '^':
398: infoPtr->token = BIT_XOR;
399: return TCL_OK;
400:
401: case '|':
402: if (p[1] == '|') {
403: infoPtr->expr = p+2;
404: infoPtr->token = OR;
405: } else {
406: infoPtr->token = BIT_OR;
407: }
408: return TCL_OK;
409:
410: case '~':
411: infoPtr->token = BIT_NOT;
412: return TCL_OK;
413:
414: case 0:
415: infoPtr->token = END;
416: infoPtr->expr = p;
417: return TCL_OK;
418:
419: default:
420: infoPtr->expr = p+1;
421: infoPtr->token = UNKNOWN;
422: return TCL_OK;
423: }
424: }
425:
426: /*
427: *----------------------------------------------------------------------
428: *
429: * ExprGetValue --
430: *
431: * Parse a "value" from the remainder of the expression in infoPtr.
432: *
433: * Results:
434: * Normally TCL_OK is returned. The value of the parsed number is
435: * returned in infoPtr->number. If an error occurred, then
436: * interp->result contains an error message and TCL_ERROR is returned.
437: *
438: * Side effects:
439: * Information gets parsed from the remaining expression, and the
440: * expr and token fields in infoPtr get updated. Information is
441: * parsed until either the end of the expression is reached (null
442: * character or close paren), an error occurs, or a binary operator
443: * is encountered with precedence <= prec. In any of these cases,
444: * infoPtr->token will be left pointing to the token AFTER the
445: * expression.
446: *
447: *----------------------------------------------------------------------
448: */
449:
450: int
451: ExprGetValue(interp, infoPtr, prec)
452: Tcl_Interp *interp; /* Interpreter to use for error
453: * reporting. */
454: register ExprInfo *infoPtr; /* Describes the state of the parse
455: * just before the value (i.e. ExprLex
456: * will be called to get first token
457: * of value). */
458: int prec; /* Treat any un-parenthesized operator
459: * with precedence <= this as the end
460: * of the expression. */
461: {
462: Interp *iPtr = (Interp *) interp;
463: int result, operator, operand;
464: int gotOp; /* Non-zero means already lexed the
465: * operator (while picking up value
466: * for unary operator). Don't lex
467: * again. */
468:
469: /*
470: * There are two phases to this procedure. First, pick off an initial
471: * value. Then, parse (binary operator, value) pairs until done.
472: */
473:
474: gotOp = 0;
475: result = ExprLex(interp, infoPtr);
476: if (result != TCL_OK) {
477: return result;
478: }
479: if (infoPtr->token == OPEN_PAREN) {
480:
481: /*
482: * Parenthesized sub-expression.
483: */
484:
485: result = ExprGetValue(interp, infoPtr, -1);
486: if (result != TCL_OK) {
487: return result;
488: }
489: if (infoPtr->token != CLOSE_PAREN) {
490: Tcl_Return(interp, (char *) NULL, TCL_STATIC);
491: sprintf(interp->result,
492: "unmatched parentheses in expression \"%.50s\"",
493: infoPtr->originalExpr);
494: return TCL_ERROR;
495: }
496: } else {
497: if (infoPtr->token == MINUS) {
498: infoPtr->token = UNARY_MINUS;
499: }
500: if (infoPtr->token >= UNARY_MINUS) {
501:
502: /*
503: * Process unary operators.
504: */
505:
506: operator = infoPtr->token;
507: result = ExprGetValue(interp, infoPtr, precTable[infoPtr->token]);
508: if (result != TCL_OK) {
509: return result;
510: }
511: switch (operator) {
512: case UNARY_MINUS:
513: infoPtr->number = -infoPtr->number;
514: break;
515: case NOT:
516: infoPtr->number = !infoPtr->number;
517: break;
518: case BIT_NOT:
519: infoPtr->number = ~infoPtr->number;
520: break;
521: }
522: gotOp = 1;
523: } else if (infoPtr->token != NUMBER) {
524: goto syntaxError;
525: }
526: }
527:
528: /*
529: * Got the first operand. Now fetch (operator, operand) pairs.
530: */
531:
532: if (!gotOp) {
533: result = ExprLex(interp, infoPtr);
534: if (result != TCL_OK) {
535: return result;
536: }
537: }
538: while (1) {
539: operand = infoPtr->number;
540: operator = infoPtr->token;
541: if ((operator < MULT) || (operator >= UNARY_MINUS)) {
542: if ((operator == END) || (operator == CLOSE_PAREN)) {
543: return TCL_OK;
544: } else {
545: goto syntaxError;
546: }
547: }
548: if (precTable[operator] <= prec) {
549: return TCL_OK;
550: }
551:
552: /*
553: * If we're doing an AND or OR and the first operand already
554: * determines the result, don't execute anything in the
555: * second operand: just parse. Same style for ?: pairs.
556: */
557:
558: if (((operator == AND) && !operand)
559: || ((operator == OR) && operand)) {
560: iPtr->noEval++;
561: result = ExprGetValue(interp, infoPtr, precTable[operator]);
562: iPtr->noEval--;
563: } else if (operator == QUESTY) {
564: if (operand != 0) {
565: result = ExprGetValue(interp, infoPtr, precTable[operator]);
566: operand = infoPtr->number;
567: if (result != TCL_OK)
568: return result;
569: if (infoPtr->token != COLON)
570: goto syntaxError;
571: iPtr->noEval++;
572: result = ExprGetValue(interp, infoPtr, precTable[operator]);
573: iPtr->noEval--;
574: } else {
575: iPtr->noEval++;
576: result = ExprGetValue(interp, infoPtr, precTable[operator]);
577: iPtr->noEval--;
578: if (result != TCL_OK)
579: return result;
580: if (infoPtr->token != COLON)
581: goto syntaxError;
582: result = ExprGetValue(interp, infoPtr, precTable[operator]);
583: operand = infoPtr->number;
584: }
585: infoPtr->number = operand;
586: } else {
587: result = ExprGetValue(interp, infoPtr, precTable[operator]);
588: }
589: if (result != TCL_OK) {
590: return result;
591: }
592: if ((infoPtr->token < MULT) && (infoPtr->token != NUMBER)
593: && (infoPtr->token != END)
594: && (infoPtr->token != CLOSE_PAREN)) {
595: goto syntaxError;
596: }
597: switch (operator) {
598: case MULT:
599: infoPtr->number = operand * infoPtr->number;
600: break;
601: case DIVIDE:
602: if (infoPtr->number == 0) {
603: Tcl_Return(interp, "divide by zero", TCL_STATIC);
604: return TCL_ERROR;
605: }
606: infoPtr->number = operand / infoPtr->number;
607: break;
608: case MOD:
609: if (infoPtr->number == 0) {
610: Tcl_Return(interp, "divide by zero", TCL_STATIC);
611: return TCL_ERROR;
612: }
613: infoPtr->number = operand % infoPtr->number;
614: break;
615: case PLUS:
616: infoPtr->number = operand + infoPtr->number;
617: break;
618: case MINUS:
619: infoPtr->number = operand - infoPtr->number;
620: break;
621: case LEFT_SHIFT:
622: infoPtr->number = operand << infoPtr->number;
623: break;
624: case RIGHT_SHIFT:
625: infoPtr->number = operand >> infoPtr->number;
626: break;
627: case LESS:
628: infoPtr->number = operand < infoPtr->number;
629: break;
630: case GREATER:
631: infoPtr->number = operand > infoPtr->number;
632: break;
633: case LEQ:
634: infoPtr->number = operand <= infoPtr->number;
635: break;
636: case GEQ:
637: infoPtr->number = operand >= infoPtr->number;
638: break;
639: case EQUAL:
640: infoPtr->number = operand == infoPtr->number;
641: break;
642: case NEQ:
643: infoPtr->number = operand != infoPtr->number;
644: break;
645: case BIT_AND:
646: infoPtr->number = operand & infoPtr->number;
647: break;
648: case BIT_XOR:
649: infoPtr->number = operand ^ infoPtr->number;
650: break;
651: case BIT_OR:
652: infoPtr->number = operand | infoPtr->number;
653: break;
654: case AND:
655: infoPtr->number = operand && infoPtr->number;
656: break;
657: case OR:
658: infoPtr->number = operand || infoPtr->number;
659: break;
660: }
661: }
662:
663: syntaxError:
664: Tcl_Return(interp, (char *) NULL, TCL_STATIC);
665: sprintf(interp->result, "syntax error in expression \"%.50s\"",
666: infoPtr->originalExpr);
667: return TCL_ERROR;
668: }
669:
670: /*
671: *----------------------------------------------------------------------
672: *
673: * Tcl_Expr --
674: *
675: * Parse and evaluate an expression.
676: *
677: * Results:
678: * The return value is TCL_OK if the expression was correctly parsed;
679: * if there was a syntax error or some other error during parsing,
680: * then another Tcl return value is returned and Tcl_Result points
681: * to an error message. If all went well, *valuePtr is filled in
682: * with the result corresponding to the expression string.
683: *
684: * Side effects:
685: * None.
686: *
687: *----------------------------------------------------------------------
688: */
689:
690: int
691: Tcl_Expr(interp, string, valuePtr)
692: Tcl_Interp *interp; /* Intepreter to use for variables etc. */
693: char *string; /* Expression to evaluate. */
694: int *valuePtr; /* Where to store result of evaluation. */
695: {
696: ExprInfo info;
697: int result;
698:
699: info.interp = interp;
700: info.originalExpr = string;
701: info.expr = string;
702: result = ExprGetValue(interp, &info, -1);
703: if (result != TCL_OK) {
704: return result;
705: }
706: if (info.token != END) {
707: Tcl_Return(interp, (char *) NULL, TCL_STATIC);
708: sprintf(interp->result, "syntax error in expression \"%.50s\"", string);
709: return TCL_ERROR;
710: }
711: *valuePtr = info.number;
712: return TCL_OK;
713: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.