/[dtapublic]/projs/trunk/shared_source/c_tcl_base_7_5_w_mods/tclparseexpr.c
ViewVC logotype

Contents of /projs/trunk/shared_source/c_tcl_base_7_5_w_mods/tclparseexpr.c

Parent Directory Parent Directory | Revision Log Revision Log


Revision 64 - (show annotations) (download)
Sun Oct 30 04:21:11 2016 UTC (7 years, 8 months ago) by dashley
File MIME type: text/plain
File size: 51236 byte(s)
Adjust line endings to Windows style.
Set properties to expand the "Header" keyword.
Change header and footer.
1 /*$Header$ */
2 /*
3 * tclParseExpr.c --
4 *
5 * This file contains procedures that parse Tcl expressions. They
6 * do so in a general-purpose fashion that can be used for many
7 * different purposes, including compilation, direct execution,
8 * code analysis, etc.
9 *
10 * Copyright (c) 1997 Sun Microsystems, Inc.
11 *
12 * See the file "license.terms" for information on usage and redistribution
13 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
14 *
15 * RCS: @(#) $Id: tclparseexpr.c,v 1.1.1.1 2001/06/13 04:44:43 dtashley Exp $
16 */
17
18 #include "tclInt.h"
19 #include "tclCompile.h"
20
21 /*
22 * The stuff below is a bit of a hack so that this file can be used in
23 * environments that include no UNIX, i.e. no errno: just arrange to use
24 * the errno from tclExecute.c here.
25 */
26
27 #ifndef TCL_GENERIC_ONLY
28 #include "tclPort.h"
29 #else
30 #define NO_ERRNO_H
31 #endif
32
33 #ifdef NO_ERRNO_H
34 extern int errno; /* Use errno from tclExecute.c. */
35 #define ERANGE 34
36 #endif
37
38 /*
39 * Boolean variable that controls whether expression parse tracing
40 * is enabled.
41 */
42
43 #ifdef TCL_COMPILE_DEBUG
44 static int traceParseExpr = 0;
45 #endif /* TCL_COMPILE_DEBUG */
46
47 /*
48 * The ParseInfo structure holds state while parsing an expression.
49 * A pointer to an ParseInfo record is passed among the routines in
50 * this module.
51 */
52
53 typedef struct ParseInfo {
54 Tcl_Parse *parsePtr; /* Points to structure to fill in with
55 * information about the expression. */
56 int lexeme; /* Type of last lexeme scanned in expr.
57 * See below for definitions. Corresponds to
58 * size characters beginning at start. */
59 char *start; /* First character in lexeme. */
60 int size; /* Number of bytes in lexeme. */
61 char *next; /* Position of the next character to be
62 * scanned in the expression string. */
63 char *prevEnd; /* Points to the character just after the
64 * last one in the previous lexeme. Used to
65 * compute size of subexpression tokens. */
66 char *originalExpr; /* Points to the start of the expression
67 * originally passed to Tcl_ParseExpr. */
68 char *lastChar; /* Points just after last byte of expr. */
69 } ParseInfo;
70
71 /*
72 * Definitions of the different lexemes that appear in expressions. The
73 * order of these must match the corresponding entries in the
74 * operatorStrings array below.
75 */
76
77 #define LITERAL 0
78 #define FUNC_NAME 1
79 #define OPEN_BRACKET 2
80 #define OPEN_BRACE 3
81 #define OPEN_PAREN 4
82 #define CLOSE_PAREN 5
83 #define DOLLAR 6
84 #define QUOTE 7
85 #define COMMA 8
86 #define END 9
87 #define UNKNOWN 10
88
89 /*
90 * Binary operators:
91 */
92
93 #define MULT 11
94 #define DIVIDE 12
95 #define MOD 13
96 #define PLUS 14
97 #define MINUS 15
98 #define LEFT_SHIFT 16
99 #define RIGHT_SHIFT 17
100 #define LESS 18
101 #define GREATER 19
102 #define LEQ 20
103 #define GEQ 21
104 #define EQUAL 22
105 #define NEQ 23
106 #define BIT_AND 24
107 #define BIT_XOR 25
108 #define BIT_OR 26
109 #define AND 27
110 #define OR 28
111 #define QUESTY 29
112 #define COLON 30
113
114 /*
115 * Unary operators. Unary minus and plus are represented by the (binary)
116 * lexemes MINUS and PLUS.
117 */
118
119 #define NOT 31
120 #define BIT_NOT 32
121
122 /*
123 * Mapping from lexemes to strings; used for debugging messages. These
124 * entries must match the order and number of the lexeme definitions above.
125 */
126
127 #ifdef TCL_COMPILE_DEBUG
128 static char *lexemeStrings[] = {
129 "LITERAL", "FUNCNAME",
130 "[", "{", "(", ")", "$", "\"", ",", "END", "UNKNOWN",
131 "*", "/", "%", "+", "-",
132 "<<", ">>", "<", ">", "<=", ">=", "==", "!=",
133 "&", "^", "|", "&&", "||", "?", ":",
134 "!", "~"
135 };
136 #endif /* TCL_COMPILE_DEBUG */
137
138 /*
139 * Declarations for local procedures to this file:
140 */
141
142 static int GetLexeme _ANSI_ARGS_((ParseInfo *infoPtr));
143 static void LogSyntaxError _ANSI_ARGS_((ParseInfo *infoPtr));
144 static int ParseAddExpr _ANSI_ARGS_((ParseInfo *infoPtr));
145 static int ParseBitAndExpr _ANSI_ARGS_((ParseInfo *infoPtr));
146 static int ParseBitOrExpr _ANSI_ARGS_((ParseInfo *infoPtr));
147 static int ParseBitXorExpr _ANSI_ARGS_((ParseInfo *infoPtr));
148 static int ParseCondExpr _ANSI_ARGS_((ParseInfo *infoPtr));
149 static int ParseEqualityExpr _ANSI_ARGS_((ParseInfo *infoPtr));
150 static int ParseLandExpr _ANSI_ARGS_((ParseInfo *infoPtr));
151 static int ParseLorExpr _ANSI_ARGS_((ParseInfo *infoPtr));
152 static int ParseMultiplyExpr _ANSI_ARGS_((ParseInfo *infoPtr));
153 static int ParsePrimaryExpr _ANSI_ARGS_((ParseInfo *infoPtr));
154 static int ParseRelationalExpr _ANSI_ARGS_((ParseInfo *infoPtr));
155 static int ParseShiftExpr _ANSI_ARGS_((ParseInfo *infoPtr));
156 static int ParseUnaryExpr _ANSI_ARGS_((ParseInfo *infoPtr));
157 static void PrependSubExprTokens _ANSI_ARGS_((char *op,
158 int opBytes, char *src, int srcBytes,
159 int firstIndex, ParseInfo *infoPtr));
160
161 /*
162 * Macro used to debug the execution of the recursive descent parser used
163 * to parse expressions.
164 */
165
166 #ifdef TCL_COMPILE_DEBUG
167 #define HERE(production, level) \
168 if (traceParseExpr) { \
169 fprintf(stderr, "%*s%s: lexeme=%s, next=\"%.20s\"\n", \
170 (level), " ", (production), \
171 lexemeStrings[infoPtr->lexeme], infoPtr->next); \
172 }
173 #else
174 #define HERE(production, level)
175 #endif /* TCL_COMPILE_DEBUG */
176
177 /*
178 *----------------------------------------------------------------------
179 *
180 * Tcl_ParseExpr --
181 *
182 * Given a string, this procedure parses the first Tcl expression
183 * in the string and returns information about the structure of
184 * the expression. This procedure is the top-level interface to the
185 * the expression parsing module.
186 *
187 * Results:
188 * The return value is TCL_OK if the command was parsed successfully
189 * and TCL_ERROR otherwise. If an error occurs and interp isn't NULL
190 * then an error message is left in its result. On a successful return,
191 * parsePtr is filled in with information about the expression that
192 * was parsed.
193 *
194 * Side effects:
195 * If there is insufficient space in parsePtr to hold all the
196 * information about the expression, then additional space is
197 * malloc-ed. If the procedure returns TCL_OK then the caller must
198 * eventually invoke Tcl_FreeParse to release any additional space
199 * that was allocated.
200 *
201 *----------------------------------------------------------------------
202 */
203
204 int
205 Tcl_ParseExpr(interp, string, numBytes, parsePtr)
206 Tcl_Interp *interp; /* Used for error reporting. */
207 char *string; /* The source string to parse. */
208 int numBytes; /* Number of bytes in string. If < 0, the
209 * string consists of all bytes up to the
210 * first null character. */
211 Tcl_Parse *parsePtr; /* Structure to fill with information about
212 * the parsed expression; any previous
213 * information in the structure is
214 * ignored. */
215 {
216 ParseInfo info;
217 int code;
218 char savedChar;
219
220 if (numBytes < 0) {
221 numBytes = (string? strlen(string) : 0);
222 }
223 #ifdef TCL_COMPILE_DEBUG
224 if (traceParseExpr) {
225 fprintf(stderr, "Tcl_ParseExpr: string=\"%.*s\"\n",
226 numBytes, string);
227 }
228 #endif /* TCL_COMPILE_DEBUG */
229
230 parsePtr->commentStart = NULL;
231 parsePtr->commentSize = 0;
232 parsePtr->commandStart = NULL;
233 parsePtr->commandSize = 0;
234 parsePtr->numWords = 0;
235 parsePtr->tokenPtr = parsePtr->staticTokens;
236 parsePtr->numTokens = 0;
237 parsePtr->tokensAvailable = NUM_STATIC_TOKENS;
238 parsePtr->string = string;
239 parsePtr->end = (string + numBytes);
240 parsePtr->interp = interp;
241 parsePtr->term = string;
242 parsePtr->incomplete = 0;
243
244 /*
245 * Temporarily overwrite the character just after the end of the
246 * string with a 0 byte. This acts as a sentinel and reduces the
247 * number of places where we have to check for the end of the
248 * input string. The original value of the byte is restored at
249 * the end of the parse.
250 */
251
252 savedChar = string[numBytes];
253 string[numBytes] = 0;
254
255 /*
256 * Initialize the ParseInfo structure that holds state while parsing
257 * the expression.
258 */
259
260 info.parsePtr = parsePtr;
261 info.lexeme = UNKNOWN;
262 info.start = NULL;
263 info.size = 0;
264 info.next = string;
265 info.prevEnd = string;
266 info.originalExpr = string;
267 info.lastChar = (string + numBytes); /* just after last char of expr */
268
269 /*
270 * Get the first lexeme then parse the expression.
271 */
272
273 code = GetLexeme(&info);
274 if (code != TCL_OK) {
275 goto error;
276 }
277 code = ParseCondExpr(&info);
278 if (code != TCL_OK) {
279 goto error;
280 }
281 if (info.lexeme != END) {
282 LogSyntaxError(&info);
283 goto error;
284 }
285 string[numBytes] = (char) savedChar;
286 return TCL_OK;
287
288 error:
289 string[numBytes] = (char) savedChar;
290 if (parsePtr->tokenPtr != parsePtr->staticTokens) {
291 ckfree((char *) parsePtr->tokenPtr);
292 }
293 return TCL_ERROR;
294 }
295
296 /*
297 *----------------------------------------------------------------------
298 *
299 * ParseCondExpr --
300 *
301 * This procedure parses a Tcl conditional expression:
302 * condExpr ::= lorExpr ['?' condExpr ':' condExpr]
303 *
304 * Note that this is the topmost recursive-descent parsing routine used
305 * by TclParseExpr to parse expressions. This avoids an extra procedure
306 * call since such a procedure would only return the result of calling
307 * ParseCondExpr. Other recursive-descent procedures that need to parse
308 * complete expressions also call ParseCondExpr.
309 *
310 * Results:
311 * The return value is TCL_OK on a successful parse and TCL_ERROR
312 * on failure. If TCL_ERROR is returned, then the interpreter's result
313 * contains an error message.
314 *
315 * Side effects:
316 * If there is insufficient space in parsePtr to hold all the
317 * information about the subexpression, then additional space is
318 * malloc-ed.
319 *
320 *----------------------------------------------------------------------
321 */
322
323 static int
324 ParseCondExpr(infoPtr)
325 ParseInfo *infoPtr; /* Holds the parse state for the
326 * expression being parsed. */
327 {
328 Tcl_Parse *parsePtr = infoPtr->parsePtr;
329 Tcl_Token *tokenPtr, *firstTokenPtr, *condTokenPtr;
330 int firstIndex, numToMove, code;
331 char *srcStart;
332
333 HERE("condExpr", 1);
334 srcStart = infoPtr->start;
335 firstIndex = parsePtr->numTokens;
336
337 code = ParseLorExpr(infoPtr);
338 if (code != TCL_OK) {
339 return code;
340 }
341
342 if (infoPtr->lexeme == QUESTY) {
343 /*
344 * Emit two tokens: one TCL_TOKEN_SUB_EXPR token for the entire
345 * conditional expression, and a TCL_TOKEN_OPERATOR token for
346 * the "?" operator. Note that these two tokens must be inserted
347 * before the LOR operand tokens generated above.
348 */
349
350 if ((parsePtr->numTokens + 1) >= parsePtr->tokensAvailable) {
351 TclExpandTokenArray(parsePtr);
352 }
353 firstTokenPtr = &parsePtr->tokenPtr[firstIndex];
354 tokenPtr = (firstTokenPtr + 2);
355 numToMove = (parsePtr->numTokens - firstIndex);
356 memmove((VOID *) tokenPtr, (VOID *) firstTokenPtr,
357 (size_t) (numToMove * sizeof(Tcl_Token)));
358 parsePtr->numTokens += 2;
359
360 tokenPtr = firstTokenPtr;
361 tokenPtr->type = TCL_TOKEN_SUB_EXPR;
362 tokenPtr->start = srcStart;
363
364 tokenPtr++;
365 tokenPtr->type = TCL_TOKEN_OPERATOR;
366 tokenPtr->start = infoPtr->start;
367 tokenPtr->size = 1;
368 tokenPtr->numComponents = 0;
369
370 /*
371 * Skip over the '?'.
372 */
373
374 code = GetLexeme(infoPtr);
375 if (code != TCL_OK) {
376 return code;
377 }
378
379 /*
380 * Parse the "then" expression.
381 */
382
383 code = ParseCondExpr(infoPtr);
384 if (code != TCL_OK) {
385 return code;
386 }
387 if (infoPtr->lexeme != COLON) {
388 LogSyntaxError(infoPtr);
389 return TCL_ERROR;
390 }
391 code = GetLexeme(infoPtr); /* skip over the ':' */
392 if (code != TCL_OK) {
393 return code;
394 }
395
396 /*
397 * Parse the "else" expression.
398 */
399
400 code = ParseCondExpr(infoPtr);
401 if (code != TCL_OK) {
402 return code;
403 }
404
405 /*
406 * Now set the size-related fields in the '?' subexpression token.
407 */
408
409 condTokenPtr = &parsePtr->tokenPtr[firstIndex];
410 condTokenPtr->size = (infoPtr->prevEnd - srcStart);
411 condTokenPtr->numComponents = parsePtr->numTokens - (firstIndex+1);
412 }
413 return TCL_OK;
414 }
415
416 /*
417 *----------------------------------------------------------------------
418 *
419 * ParseLorExpr --
420 *
421 * This procedure parses a Tcl logical or expression:
422 * lorExpr ::= landExpr {'||' landExpr}
423 *
424 * Results:
425 * The return value is TCL_OK on a successful parse and TCL_ERROR
426 * on failure. If TCL_ERROR is returned, then the interpreter's result
427 * contains an error message.
428 *
429 * Side effects:
430 * If there is insufficient space in parsePtr to hold all the
431 * information about the subexpression, then additional space is
432 * malloc-ed.
433 *
434 *----------------------------------------------------------------------
435 */
436
437 static int
438 ParseLorExpr(infoPtr)
439 ParseInfo *infoPtr; /* Holds the parse state for the
440 * expression being parsed. */
441 {
442 Tcl_Parse *parsePtr = infoPtr->parsePtr;
443 int firstIndex, code;
444 char *srcStart, *operator;
445
446 HERE("lorExpr", 2);
447 srcStart = infoPtr->start;
448 firstIndex = parsePtr->numTokens;
449
450 code = ParseLandExpr(infoPtr);
451 if (code != TCL_OK) {
452 return code;
453 }
454
455 while (infoPtr->lexeme == OR) {
456 operator = infoPtr->start;
457 code = GetLexeme(infoPtr); /* skip over the '||' */
458 if (code != TCL_OK) {
459 return code;
460 }
461 code = ParseLandExpr(infoPtr);
462 if (code != TCL_OK) {
463 return code;
464 }
465
466 /*
467 * Generate tokens for the LOR subexpression and the '||' operator.
468 */
469
470 PrependSubExprTokens(operator, 2, srcStart,
471 (infoPtr->prevEnd - srcStart), firstIndex, infoPtr);
472 }
473 return TCL_OK;
474 }
475
476 /*
477 *----------------------------------------------------------------------
478 *
479 * ParseLandExpr --
480 *
481 * This procedure parses a Tcl logical and expression:
482 * landExpr ::= bitOrExpr {'&&' bitOrExpr}
483 *
484 * Results:
485 * The return value is TCL_OK on a successful parse and TCL_ERROR
486 * on failure. If TCL_ERROR is returned, then the interpreter's result
487 * contains an error message.
488 *
489 * Side effects:
490 * If there is insufficient space in parsePtr to hold all the
491 * information about the subexpression, then additional space is
492 * malloc-ed.
493 *
494 *----------------------------------------------------------------------
495 */
496
497 static int
498 ParseLandExpr(infoPtr)
499 ParseInfo *infoPtr; /* Holds the parse state for the
500 * expression being parsed. */
501 {
502 Tcl_Parse *parsePtr = infoPtr->parsePtr;
503 int firstIndex, code;
504 char *srcStart, *operator;
505
506 HERE("landExpr", 3);
507 srcStart = infoPtr->start;
508 firstIndex = parsePtr->numTokens;
509
510 code = ParseBitOrExpr(infoPtr);
511 if (code != TCL_OK) {
512 return code;
513 }
514
515 while (infoPtr->lexeme == AND) {
516 operator = infoPtr->start;
517 code = GetLexeme(infoPtr); /* skip over the '&&' */
518 if (code != TCL_OK) {
519 return code;
520 }
521 code = ParseBitOrExpr(infoPtr);
522 if (code != TCL_OK) {
523 return code;
524 }
525
526 /*
527 * Generate tokens for the LAND subexpression and the '&&' operator.
528 */
529
530 PrependSubExprTokens(operator, 2, srcStart,
531 (infoPtr->prevEnd - srcStart), firstIndex, infoPtr);
532 }
533 return TCL_OK;
534 }
535
536 /*
537 *----------------------------------------------------------------------
538 *
539 * ParseBitOrExpr --
540 *
541 * This procedure parses a Tcl bitwise or expression:
542 * bitOrExpr ::= bitXorExpr {'|' bitXorExpr}
543 *
544 * Results:
545 * The return value is TCL_OK on a successful parse and TCL_ERROR
546 * on failure. If TCL_ERROR is returned, then the interpreter's result
547 * contains an error message.
548 *
549 * Side effects:
550 * If there is insufficient space in parsePtr to hold all the
551 * information about the subexpression, then additional space is
552 * malloc-ed.
553 *
554 *----------------------------------------------------------------------
555 */
556
557 static int
558 ParseBitOrExpr(infoPtr)
559 ParseInfo *infoPtr; /* Holds the parse state for the
560 * expression being parsed. */
561 {
562 Tcl_Parse *parsePtr = infoPtr->parsePtr;
563 int firstIndex, code;
564 char *srcStart, *operator;
565
566 HERE("bitOrExpr", 4);
567 srcStart = infoPtr->start;
568 firstIndex = parsePtr->numTokens;
569
570 code = ParseBitXorExpr(infoPtr);
571 if (code != TCL_OK) {
572 return code;
573 }
574
575 while (infoPtr->lexeme == BIT_OR) {
576 operator = infoPtr->start;
577 code = GetLexeme(infoPtr); /* skip over the '|' */
578 if (code != TCL_OK) {
579 return code;
580 }
581
582 code = ParseBitXorExpr(infoPtr);
583 if (code != TCL_OK) {
584 return code;
585 }
586
587 /*
588 * Generate tokens for the BITOR subexpression and the '|' operator.
589 */
590
591 PrependSubExprTokens(operator, 1, srcStart,
592 (infoPtr->prevEnd - srcStart), firstIndex, infoPtr);
593 }
594 return TCL_OK;
595 }
596
597 /*
598 *----------------------------------------------------------------------
599 *
600 * ParseBitXorExpr --
601 *
602 * This procedure parses a Tcl bitwise exclusive or expression:
603 * bitXorExpr ::= bitAndExpr {'^' bitAndExpr}
604 *
605 * Results:
606 * The return value is TCL_OK on a successful parse and TCL_ERROR
607 * on failure. If TCL_ERROR is returned, then the interpreter's result
608 * contains an error message.
609 *
610 * Side effects:
611 * If there is insufficient space in parsePtr to hold all the
612 * information about the subexpression, then additional space is
613 * malloc-ed.
614 *
615 *----------------------------------------------------------------------
616 */
617
618 static int
619 ParseBitXorExpr(infoPtr)
620 ParseInfo *infoPtr; /* Holds the parse state for the
621 * expression being parsed. */
622 {
623 Tcl_Parse *parsePtr = infoPtr->parsePtr;
624 int firstIndex, code;
625 char *srcStart, *operator;
626
627 HERE("bitXorExpr", 5);
628 srcStart = infoPtr->start;
629 firstIndex = parsePtr->numTokens;
630
631 code = ParseBitAndExpr(infoPtr);
632 if (code != TCL_OK) {
633 return code;
634 }
635
636 while (infoPtr->lexeme == BIT_XOR) {
637 operator = infoPtr->start;
638 code = GetLexeme(infoPtr); /* skip over the '^' */
639 if (code != TCL_OK) {
640 return code;
641 }
642
643 code = ParseBitAndExpr(infoPtr);
644 if (code != TCL_OK) {
645 return code;
646 }
647
648 /*
649 * Generate tokens for the XOR subexpression and the '^' operator.
650 */
651
652 PrependSubExprTokens(operator, 1, srcStart,
653 (infoPtr->prevEnd - srcStart), firstIndex, infoPtr);
654 }
655 return TCL_OK;
656 }
657
658 /*
659 *----------------------------------------------------------------------
660 *
661 * ParseBitAndExpr --
662 *
663 * This procedure parses a Tcl bitwise and expression:
664 * bitAndExpr ::= equalityExpr {'&' equalityExpr}
665 *
666 * Results:
667 * The return value is TCL_OK on a successful parse and TCL_ERROR
668 * on failure. If TCL_ERROR is returned, then the interpreter's result
669 * contains an error message.
670 *
671 * Side effects:
672 * If there is insufficient space in parsePtr to hold all the
673 * information about the subexpression, then additional space is
674 * malloc-ed.
675 *
676 *----------------------------------------------------------------------
677 */
678
679 static int
680 ParseBitAndExpr(infoPtr)
681 ParseInfo *infoPtr; /* Holds the parse state for the
682 * expression being parsed. */
683 {
684 Tcl_Parse *parsePtr = infoPtr->parsePtr;
685 int firstIndex, code;
686 char *srcStart, *operator;
687
688 HERE("bitAndExpr", 6);
689 srcStart = infoPtr->start;
690 firstIndex = parsePtr->numTokens;
691
692 code = ParseEqualityExpr(infoPtr);
693 if (code != TCL_OK) {
694 return code;
695 }
696
697 while (infoPtr->lexeme == BIT_AND) {
698 operator = infoPtr->start;
699 code = GetLexeme(infoPtr); /* skip over the '&' */
700 if (code != TCL_OK) {
701 return code;
702 }
703 code = ParseEqualityExpr(infoPtr);
704 if (code != TCL_OK) {
705 return code;
706 }
707
708 /*
709 * Generate tokens for the BITAND subexpression and '&' operator.
710 */
711
712 PrependSubExprTokens(operator, 1, srcStart,
713 (infoPtr->prevEnd - srcStart), firstIndex, infoPtr);
714 }
715 return TCL_OK;
716 }
717
718 /*
719 *----------------------------------------------------------------------
720 *
721 * ParseEqualityExpr --
722 *
723 * This procedure parses a Tcl equality (inequality) expression:
724 * equalityExpr ::= relationalExpr {('==' | '!=') relationalExpr}
725 *
726 * Results:
727 * The return value is TCL_OK on a successful parse and TCL_ERROR
728 * on failure. If TCL_ERROR is returned, then the interpreter's result
729 * contains an error message.
730 *
731 * Side effects:
732 * If there is insufficient space in parsePtr to hold all the
733 * information about the subexpression, then additional space is
734 * malloc-ed.
735 *
736 *----------------------------------------------------------------------
737 */
738
739 static int
740 ParseEqualityExpr(infoPtr)
741 ParseInfo *infoPtr; /* Holds the parse state for the
742 * expression being parsed. */
743 {
744 Tcl_Parse *parsePtr = infoPtr->parsePtr;
745 int firstIndex, lexeme, code;
746 char *srcStart, *operator;
747
748 HERE("equalityExpr", 7);
749 srcStart = infoPtr->start;
750 firstIndex = parsePtr->numTokens;
751
752 code = ParseRelationalExpr(infoPtr);
753 if (code != TCL_OK) {
754 return code;
755 }
756
757 lexeme = infoPtr->lexeme;
758 while ((lexeme == EQUAL) || (lexeme == NEQ)) {
759 operator = infoPtr->start;
760 code = GetLexeme(infoPtr); /* skip over == or != */
761 if (code != TCL_OK) {
762 return code;
763 }
764 code = ParseRelationalExpr(infoPtr);
765 if (code != TCL_OK) {
766 return code;
767 }
768
769 /*
770 * Generate tokens for the subexpression and '==' or '!=' operator.
771 */
772
773 PrependSubExprTokens(operator, 2, srcStart,
774 (infoPtr->prevEnd - srcStart), firstIndex, infoPtr);
775 lexeme = infoPtr->lexeme;
776 }
777 return TCL_OK;
778 }
779
780 /*
781 *----------------------------------------------------------------------
782 *
783 * ParseRelationalExpr --
784 *
785 * This procedure parses a Tcl relational expression:
786 * relationalExpr ::= shiftExpr {('<' | '>' | '<=' | '>=') shiftExpr}
787 *
788 * Results:
789 * The return value is TCL_OK on a successful parse and TCL_ERROR
790 * on failure. If TCL_ERROR is returned, then the interpreter's result
791 * contains an error message.
792 *
793 * Side effects:
794 * If there is insufficient space in parsePtr to hold all the
795 * information about the subexpression, then additional space is
796 * malloc-ed.
797 *
798 *----------------------------------------------------------------------
799 */
800
801 static int
802 ParseRelationalExpr(infoPtr)
803 ParseInfo *infoPtr; /* Holds the parse state for the
804 * expression being parsed. */
805 {
806 Tcl_Parse *parsePtr = infoPtr->parsePtr;
807 int firstIndex, lexeme, operatorSize, code;
808 char *srcStart, *operator;
809
810 HERE("relationalExpr", 8);
811 srcStart = infoPtr->start;
812 firstIndex = parsePtr->numTokens;
813
814 code = ParseShiftExpr(infoPtr);
815 if (code != TCL_OK) {
816 return code;
817 }
818
819 lexeme = infoPtr->lexeme;
820 while ((lexeme == LESS) || (lexeme == GREATER) || (lexeme == LEQ)
821 || (lexeme == GEQ)) {
822 operator = infoPtr->start;
823 if ((lexeme == LEQ) || (lexeme == GEQ)) {
824 operatorSize = 2;
825 } else {
826 operatorSize = 1;
827 }
828 code = GetLexeme(infoPtr); /* skip over the operator */
829 if (code != TCL_OK) {
830 return code;
831 }
832 code = ParseShiftExpr(infoPtr);
833 if (code != TCL_OK) {
834 return code;
835 }
836
837 /*
838 * Generate tokens for the subexpression and the operator.
839 */
840
841 PrependSubExprTokens(operator, operatorSize, srcStart,
842 (infoPtr->prevEnd - srcStart), firstIndex, infoPtr);
843 lexeme = infoPtr->lexeme;
844 }
845 return TCL_OK;
846 }
847
848 /*
849 *----------------------------------------------------------------------
850 *
851 * ParseShiftExpr --
852 *
853 * This procedure parses a Tcl shift expression:
854 * shiftExpr ::= addExpr {('<<' | '>>') addExpr}
855 *
856 * Results:
857 * The return value is TCL_OK on a successful parse and TCL_ERROR
858 * on failure. If TCL_ERROR is returned, then the interpreter's result
859 * contains an error message.
860 *
861 * Side effects:
862 * If there is insufficient space in parsePtr to hold all the
863 * information about the subexpression, then additional space is
864 * malloc-ed.
865 *
866 *----------------------------------------------------------------------
867 */
868
869 static int
870 ParseShiftExpr(infoPtr)
871 ParseInfo *infoPtr; /* Holds the parse state for the
872 * expression being parsed. */
873 {
874 Tcl_Parse *parsePtr = infoPtr->parsePtr;
875 int firstIndex, lexeme, code;
876 char *srcStart, *operator;
877
878 HERE("shiftExpr", 9);
879 srcStart = infoPtr->start;
880 firstIndex = parsePtr->numTokens;
881
882 code = ParseAddExpr(infoPtr);
883 if (code != TCL_OK) {
884 return code;
885 }
886
887 lexeme = infoPtr->lexeme;
888 while ((lexeme == LEFT_SHIFT) || (lexeme == RIGHT_SHIFT)) {
889 operator = infoPtr->start;
890 code = GetLexeme(infoPtr); /* skip over << or >> */
891 if (code != TCL_OK) {
892 return code;
893 }
894 code = ParseAddExpr(infoPtr);
895 if (code != TCL_OK) {
896 return code;
897 }
898
899 /*
900 * Generate tokens for the subexpression and '<<' or '>>' operator.
901 */
902
903 PrependSubExprTokens(operator, 2, srcStart,
904 (infoPtr->prevEnd - srcStart), firstIndex, infoPtr);
905 lexeme = infoPtr->lexeme;
906 }
907 return TCL_OK;
908 }
909
910 /*
911 *----------------------------------------------------------------------
912 *
913 * ParseAddExpr --
914 *
915 * This procedure parses a Tcl addition expression:
916 * addExpr ::= multiplyExpr {('+' | '-') multiplyExpr}
917 *
918 * Results:
919 * The return value is TCL_OK on a successful parse and TCL_ERROR
920 * on failure. If TCL_ERROR is returned, then the interpreter's result
921 * contains an error message.
922 *
923 * Side effects:
924 * If there is insufficient space in parsePtr to hold all the
925 * information about the subexpression, then additional space is
926 * malloc-ed.
927 *
928 *----------------------------------------------------------------------
929 */
930
931 static int
932 ParseAddExpr(infoPtr)
933 ParseInfo *infoPtr; /* Holds the parse state for the
934 * expression being parsed. */
935 {
936 Tcl_Parse *parsePtr = infoPtr->parsePtr;
937 int firstIndex, lexeme, code;
938 char *srcStart, *operator;
939
940 HERE("addExpr", 10);
941 srcStart = infoPtr->start;
942 firstIndex = parsePtr->numTokens;
943
944 code = ParseMultiplyExpr(infoPtr);
945 if (code != TCL_OK) {
946 return code;
947 }
948
949 lexeme = infoPtr->lexeme;
950 while ((lexeme == PLUS) || (lexeme == MINUS)) {
951 operator = infoPtr->start;
952 code = GetLexeme(infoPtr); /* skip over + or - */
953 if (code != TCL_OK) {
954 return code;
955 }
956 code = ParseMultiplyExpr(infoPtr);
957 if (code != TCL_OK) {
958 return code;
959 }
960
961 /*
962 * Generate tokens for the subexpression and '+' or '-' operator.
963 */
964
965 PrependSubExprTokens(operator, 1, srcStart,
966 (infoPtr->prevEnd - srcStart), firstIndex, infoPtr);
967 lexeme = infoPtr->lexeme;
968 }
969 return TCL_OK;
970 }
971
972 /*
973 *----------------------------------------------------------------------
974 *
975 * ParseMultiplyExpr --
976 *
977 * This procedure parses a Tcl multiply expression:
978 * multiplyExpr ::= unaryExpr {('*' | '/' | '%') unaryExpr}
979 *
980 * Results:
981 * The return value is TCL_OK on a successful parse and TCL_ERROR
982 * on failure. If TCL_ERROR is returned, then the interpreter's result
983 * contains an error message.
984 *
985 * Side effects:
986 * If there is insufficient space in parsePtr to hold all the
987 * information about the subexpression, then additional space is
988 * malloc-ed.
989 *
990 *----------------------------------------------------------------------
991 */
992
993 static int
994 ParseMultiplyExpr(infoPtr)
995 ParseInfo *infoPtr; /* Holds the parse state for the
996 * expression being parsed. */
997 {
998 Tcl_Parse *parsePtr = infoPtr->parsePtr;
999 int firstIndex, lexeme, code;
1000 char *srcStart, *operator;
1001
1002 HERE("multiplyExpr", 11);
1003 srcStart = infoPtr->start;
1004 firstIndex = parsePtr->numTokens;
1005
1006 code = ParseUnaryExpr(infoPtr);
1007 if (code != TCL_OK) {
1008 return code;
1009 }
1010
1011 lexeme = infoPtr->lexeme;
1012 while ((lexeme == MULT) || (lexeme == DIVIDE) || (lexeme == MOD)) {
1013 operator = infoPtr->start;
1014 code = GetLexeme(infoPtr); /* skip over * or / or % */
1015 if (code != TCL_OK) {
1016 return code;
1017 }
1018 code = ParseUnaryExpr(infoPtr);
1019 if (code != TCL_OK) {
1020 return code;
1021 }
1022
1023 /*
1024 * Generate tokens for the subexpression and * or / or % operator.
1025 */
1026
1027 PrependSubExprTokens(operator, 1, srcStart,
1028 (infoPtr->prevEnd - srcStart), firstIndex, infoPtr);
1029 lexeme = infoPtr->lexeme;
1030 }
1031 return TCL_OK;
1032 }
1033
1034 /*
1035 *----------------------------------------------------------------------
1036 *
1037 * ParseUnaryExpr --
1038 *
1039 * This procedure parses a Tcl unary expression:
1040 * unaryExpr ::= ('+' | '-' | '~' | '!') unaryExpr | primaryExpr
1041 *
1042 * Results:
1043 * The return value is TCL_OK on a successful parse and TCL_ERROR
1044 * on failure. If TCL_ERROR is returned, then the interpreter's result
1045 * contains an error message.
1046 *
1047 * Side effects:
1048 * If there is insufficient space in parsePtr to hold all the
1049 * information about the subexpression, then additional space is
1050 * malloc-ed.
1051 *
1052 *----------------------------------------------------------------------
1053 */
1054
1055 static int
1056 ParseUnaryExpr(infoPtr)
1057 ParseInfo *infoPtr; /* Holds the parse state for the
1058 * expression being parsed. */
1059 {
1060 Tcl_Parse *parsePtr = infoPtr->parsePtr;
1061 int firstIndex, lexeme, code;
1062 char *srcStart, *operator;
1063
1064 HERE("unaryExpr", 12);
1065 srcStart = infoPtr->start;
1066 firstIndex = parsePtr->numTokens;
1067
1068 lexeme = infoPtr->lexeme;
1069 if ((lexeme == PLUS) || (lexeme == MINUS) || (lexeme == BIT_NOT)
1070 || (lexeme == NOT)) {
1071 operator = infoPtr->start;
1072 code = GetLexeme(infoPtr); /* skip over the unary operator */
1073 if (code != TCL_OK) {
1074 return code;
1075 }
1076 code = ParseUnaryExpr(infoPtr);
1077 if (code != TCL_OK) {
1078 return code;
1079 }
1080
1081 /*
1082 * Generate tokens for the subexpression and the operator.
1083 */
1084
1085 PrependSubExprTokens(operator, 1, srcStart,
1086 (infoPtr->prevEnd - srcStart), firstIndex, infoPtr);
1087 } else { /* must be a primaryExpr */
1088 code = ParsePrimaryExpr(infoPtr);
1089 if (code != TCL_OK) {
1090 return code;
1091 }
1092 }
1093 return TCL_OK;
1094 }
1095
1096 /*
1097 *----------------------------------------------------------------------
1098 *
1099 * ParsePrimaryExpr --
1100 *
1101 * This procedure parses a Tcl primary expression:
1102 * primaryExpr ::= literal | varReference | quotedString |
1103 * '[' command ']' | mathFuncCall | '(' condExpr ')'
1104 *
1105 * Results:
1106 * The return value is TCL_OK on a successful parse and TCL_ERROR
1107 * on failure. If TCL_ERROR is returned, then the interpreter's result
1108 * contains an error message.
1109 *
1110 * Side effects:
1111 * If there is insufficient space in parsePtr to hold all the
1112 * information about the subexpression, then additional space is
1113 * malloc-ed.
1114 *
1115 *----------------------------------------------------------------------
1116 */
1117
1118 static int
1119 ParsePrimaryExpr(infoPtr)
1120 ParseInfo *infoPtr; /* Holds the parse state for the
1121 * expression being parsed. */
1122 {
1123 Tcl_Parse *parsePtr = infoPtr->parsePtr;
1124 Tcl_Interp *interp = parsePtr->interp;
1125 Tcl_Token *tokenPtr, *exprTokenPtr;
1126 Tcl_Parse nested;
1127 char *dollarPtr, *stringStart, *termPtr, *src;
1128 int lexeme, exprIndex, firstIndex, numToMove, code;
1129
1130 /*
1131 * We simply recurse on parenthesized subexpressions.
1132 */
1133
1134 HERE("primaryExpr", 13);
1135 lexeme = infoPtr->lexeme;
1136 if (lexeme == OPEN_PAREN) {
1137 code = GetLexeme(infoPtr); /* skip over the '(' */
1138 if (code != TCL_OK) {
1139 return code;
1140 }
1141 code = ParseCondExpr(infoPtr);
1142 if (code != TCL_OK) {
1143 return code;
1144 }
1145 if (infoPtr->lexeme != CLOSE_PAREN) {
1146 goto syntaxError;
1147 }
1148 code = GetLexeme(infoPtr); /* skip over the ')' */
1149 if (code != TCL_OK) {
1150 return code;
1151 }
1152 return TCL_OK;
1153 }
1154
1155 /*
1156 * Start a TCL_TOKEN_SUB_EXPR token for the primary.
1157 */
1158
1159 if (parsePtr->numTokens == parsePtr->tokensAvailable) {
1160 TclExpandTokenArray(parsePtr);
1161 }
1162 exprIndex = parsePtr->numTokens;
1163 exprTokenPtr = &parsePtr->tokenPtr[exprIndex];
1164 exprTokenPtr->type = TCL_TOKEN_SUB_EXPR;
1165 exprTokenPtr->start = infoPtr->start;
1166 parsePtr->numTokens++;
1167
1168 /*
1169 * Process the primary then finish setting the fields of the
1170 * TCL_TOKEN_SUB_EXPR token. Note that we can't use the pointer now
1171 * stored in "exprTokenPtr" in the code below since the token array
1172 * might be reallocated.
1173 */
1174
1175 firstIndex = parsePtr->numTokens;
1176 switch (lexeme) {
1177 case LITERAL:
1178 /*
1179 * Int or double number.
1180 */
1181
1182 if (parsePtr->numTokens == parsePtr->tokensAvailable) {
1183 TclExpandTokenArray(parsePtr);
1184 }
1185 tokenPtr = &parsePtr->tokenPtr[parsePtr->numTokens];
1186 tokenPtr->type = TCL_TOKEN_TEXT;
1187 tokenPtr->start = infoPtr->start;
1188 tokenPtr->size = infoPtr->size;
1189 tokenPtr->numComponents = 0;
1190 parsePtr->numTokens++;
1191
1192 exprTokenPtr = &parsePtr->tokenPtr[exprIndex];
1193 exprTokenPtr->size = infoPtr->size;
1194 exprTokenPtr->numComponents = 1;
1195 break;
1196
1197 case DOLLAR:
1198 /*
1199 * $var variable reference.
1200 */
1201
1202 dollarPtr = (infoPtr->next - 1);
1203 code = Tcl_ParseVarName(interp, dollarPtr,
1204 (infoPtr->lastChar - dollarPtr), parsePtr, 1);
1205 if (code != TCL_OK) {
1206 return code;
1207 }
1208 infoPtr->next = dollarPtr + parsePtr->tokenPtr[firstIndex].size;
1209
1210 exprTokenPtr = &parsePtr->tokenPtr[exprIndex];
1211 exprTokenPtr->size = parsePtr->tokenPtr[firstIndex].size;
1212 exprTokenPtr->numComponents =
1213 (parsePtr->tokenPtr[firstIndex].numComponents + 1);
1214 break;
1215
1216 case QUOTE:
1217 /*
1218 * '"' string '"'
1219 */
1220
1221 stringStart = infoPtr->next;
1222 code = Tcl_ParseQuotedString(interp, infoPtr->start,
1223 (infoPtr->lastChar - stringStart), parsePtr, 1, &termPtr);
1224 if (code != TCL_OK) {
1225 return code;
1226 }
1227 infoPtr->next = termPtr;
1228
1229 exprTokenPtr = &parsePtr->tokenPtr[exprIndex];
1230 exprTokenPtr->size = (termPtr - exprTokenPtr->start);
1231 exprTokenPtr->numComponents = parsePtr->numTokens - firstIndex;
1232
1233 /*
1234 * If parsing the quoted string resulted in more than one token,
1235 * insert a TCL_TOKEN_WORD token before them. This indicates that
1236 * the quoted string represents a concatenation of multiple tokens.
1237 */
1238
1239 if (exprTokenPtr->numComponents > 1) {
1240 if (parsePtr->numTokens >= parsePtr->tokensAvailable) {
1241 TclExpandTokenArray(parsePtr);
1242 }
1243 tokenPtr = &parsePtr->tokenPtr[firstIndex];
1244 numToMove = (parsePtr->numTokens - firstIndex);
1245 memmove((VOID *) (tokenPtr + 1), (VOID *) tokenPtr,
1246 (size_t) (numToMove * sizeof(Tcl_Token)));
1247 parsePtr->numTokens++;
1248
1249 exprTokenPtr = &parsePtr->tokenPtr[exprIndex];
1250 exprTokenPtr->numComponents++;
1251
1252 tokenPtr->type = TCL_TOKEN_WORD;
1253 tokenPtr->start = exprTokenPtr->start;
1254 tokenPtr->size = exprTokenPtr->size;
1255 tokenPtr->numComponents = (exprTokenPtr->numComponents - 1);
1256 }
1257 break;
1258
1259 case OPEN_BRACKET:
1260 /*
1261 * '[' command {command} ']'
1262 */
1263
1264 if (parsePtr->numTokens == parsePtr->tokensAvailable) {
1265 TclExpandTokenArray(parsePtr);
1266 }
1267 tokenPtr = &parsePtr->tokenPtr[parsePtr->numTokens];
1268 tokenPtr->type = TCL_TOKEN_COMMAND;
1269 tokenPtr->start = infoPtr->start;
1270 tokenPtr->numComponents = 0;
1271 parsePtr->numTokens++;
1272
1273 /*
1274 * Call Tcl_ParseCommand repeatedly to parse the nested command(s)
1275 * to find their end, then throw away that parse information.
1276 */
1277
1278 src = infoPtr->next;
1279 while (1) {
1280 if (Tcl_ParseCommand(interp, src, (parsePtr->end - src), 1,
1281 &nested) != TCL_OK) {
1282 parsePtr->term = nested.term;
1283 parsePtr->errorType = nested.errorType;
1284 parsePtr->incomplete = nested.incomplete;
1285 return TCL_ERROR;
1286 }
1287 src = (nested.commandStart + nested.commandSize);
1288 if (nested.tokenPtr != nested.staticTokens) {
1289 ckfree((char *) nested.tokenPtr);
1290 }
1291 if ((src[-1] == ']') && !nested.incomplete) {
1292 break;
1293 }
1294 if (src == parsePtr->end) {
1295 if (parsePtr->interp != NULL) {
1296 Tcl_SetResult(interp, "missing close-bracket",
1297 TCL_STATIC);
1298 }
1299 parsePtr->term = tokenPtr->start;
1300 parsePtr->errorType = TCL_PARSE_MISSING_BRACKET;
1301 parsePtr->incomplete = 1;
1302 return TCL_ERROR;
1303 }
1304 }
1305 tokenPtr->size = (src - tokenPtr->start);
1306 infoPtr->next = src;
1307
1308 exprTokenPtr = &parsePtr->tokenPtr[exprIndex];
1309 exprTokenPtr->size = (src - tokenPtr->start);
1310 exprTokenPtr->numComponents = 1;
1311 break;
1312
1313 case OPEN_BRACE:
1314 /*
1315 * '{' string '}'
1316 */
1317
1318 code = Tcl_ParseBraces(interp, infoPtr->start,
1319 (infoPtr->lastChar - infoPtr->start), parsePtr, 1,
1320 &termPtr);
1321 if (code != TCL_OK) {
1322 return code;
1323 }
1324 infoPtr->next = termPtr;
1325
1326 exprTokenPtr = &parsePtr->tokenPtr[exprIndex];
1327 exprTokenPtr->size = (termPtr - infoPtr->start);
1328 exprTokenPtr->numComponents = parsePtr->numTokens - firstIndex;
1329
1330 /*
1331 * If parsing the braced string resulted in more than one token,
1332 * insert a TCL_TOKEN_WORD token before them. This indicates that
1333 * the braced string represents a concatenation of multiple tokens.
1334 */
1335
1336 if (exprTokenPtr->numComponents > 1) {
1337 if (parsePtr->numTokens >= parsePtr->tokensAvailable) {
1338 TclExpandTokenArray(parsePtr);
1339 }
1340 tokenPtr = &parsePtr->tokenPtr[firstIndex];
1341 numToMove = (parsePtr->numTokens - firstIndex);
1342 memmove((VOID *) (tokenPtr + 1), (VOID *) tokenPtr,
1343 (size_t) (numToMove * sizeof(Tcl_Token)));
1344 parsePtr->numTokens++;
1345
1346 exprTokenPtr = &parsePtr->tokenPtr[exprIndex];
1347 exprTokenPtr->numComponents++;
1348
1349 tokenPtr->type = TCL_TOKEN_WORD;
1350 tokenPtr->start = exprTokenPtr->start;
1351 tokenPtr->size = exprTokenPtr->size;
1352 tokenPtr->numComponents = exprTokenPtr->numComponents-1;
1353 }
1354 break;
1355
1356 case FUNC_NAME:
1357 /*
1358 * math_func '(' expr {',' expr} ')'
1359 */
1360
1361 if (parsePtr->numTokens == parsePtr->tokensAvailable) {
1362 TclExpandTokenArray(parsePtr);
1363 }
1364 tokenPtr = &parsePtr->tokenPtr[parsePtr->numTokens];
1365 tokenPtr->type = TCL_TOKEN_OPERATOR;
1366 tokenPtr->start = infoPtr->start;
1367 tokenPtr->size = infoPtr->size;
1368 tokenPtr->numComponents = 0;
1369 parsePtr->numTokens++;
1370
1371 code = GetLexeme(infoPtr); /* skip over function name */
1372 if (code != TCL_OK) {
1373 return code;
1374 }
1375 if (infoPtr->lexeme != OPEN_PAREN) {
1376 goto syntaxError;
1377 }
1378 code = GetLexeme(infoPtr); /* skip over '(' */
1379 if (code != TCL_OK) {
1380 return code;
1381 }
1382
1383 while (infoPtr->lexeme != CLOSE_PAREN) {
1384 code = ParseCondExpr(infoPtr);
1385 if (code != TCL_OK) {
1386 return code;
1387 }
1388
1389 if (infoPtr->lexeme == COMMA) {
1390 code = GetLexeme(infoPtr); /* skip over , */
1391 if (code != TCL_OK) {
1392 return code;
1393 }
1394 } else if (infoPtr->lexeme != CLOSE_PAREN) {
1395 goto syntaxError;
1396 }
1397 }
1398
1399 exprTokenPtr = &parsePtr->tokenPtr[exprIndex];
1400 exprTokenPtr->size = (infoPtr->next - exprTokenPtr->start);
1401 exprTokenPtr->numComponents = parsePtr->numTokens - firstIndex;
1402 break;
1403
1404 default:
1405 goto syntaxError;
1406 }
1407
1408 /*
1409 * Advance to the next lexeme before returning.
1410 */
1411
1412 code = GetLexeme(infoPtr);
1413 if (code != TCL_OK) {
1414 return code;
1415 }
1416 parsePtr->term = infoPtr->next;
1417 return TCL_OK;
1418
1419 syntaxError:
1420 LogSyntaxError(infoPtr);
1421 return TCL_ERROR;
1422 }
1423
1424 /*
1425 *----------------------------------------------------------------------
1426 *
1427 * GetLexeme --
1428 *
1429 * Lexical scanner for Tcl expressions: scans a single operator or
1430 * other syntactic element from an expression string.
1431 *
1432 * Results:
1433 * TCL_OK is returned unless an error occurred. In that case a standard
1434 * Tcl error code is returned and, if infoPtr->parsePtr->interp is
1435 * non-NULL, the interpreter's result is set to hold an error
1436 * message. TCL_ERROR is returned if an integer overflow, or a
1437 * floating-point overflow or underflow occurred while reading in a
1438 * number. If the lexical analysis is successful, infoPtr->lexeme
1439 * refers to the next symbol in the expression string, and
1440 * infoPtr->next is advanced past the lexeme. Also, if the lexeme is a
1441 * LITERAL or FUNC_NAME, then infoPtr->start is set to the first
1442 * character of the lexeme; otherwise it is set NULL.
1443 *
1444 * Side effects:
1445 * If there is insufficient space in parsePtr to hold all the
1446 * information about the subexpression, then additional space is
1447 * malloc-ed..
1448 *
1449 *----------------------------------------------------------------------
1450 */
1451
1452 static int
1453 GetLexeme(infoPtr)
1454 ParseInfo *infoPtr; /* Holds state needed to parse the expr,
1455 * including the resulting lexeme. */
1456 {
1457 register char *src; /* Points to current source char. */
1458 char *termPtr; /* Points to char terminating a literal. */
1459 double doubleValue; /* Value of a scanned double literal. */
1460 char c;
1461 int startsWithDigit, offset;
1462 Tcl_Parse *parsePtr = infoPtr->parsePtr;
1463 Tcl_Interp *interp = parsePtr->interp;
1464 Tcl_UniChar ch;
1465
1466 /*
1467 * Record where the previous lexeme ended. Since we always read one
1468 * lexeme ahead during parsing, this helps us know the source length of
1469 * subexpression tokens.
1470 */
1471
1472 infoPtr->prevEnd = infoPtr->next;
1473
1474 /*
1475 * Scan over leading white space at the start of a lexeme. Note that a
1476 * backslash-newline is treated as a space.
1477 */
1478
1479 src = infoPtr->next;
1480 c = *src;
1481 while (isspace(UCHAR(c)) || (c == '\\')) { /* INTL: ISO space */
1482 if (c == '\\') {
1483 if (src[1] == '\n') {
1484 src += 2;
1485 } else {
1486 break; /* no longer white space */
1487 }
1488 } else {
1489 src++;
1490 }
1491 c = *src;
1492 }
1493 parsePtr->term = src;
1494 if (src >= infoPtr->lastChar) {
1495 infoPtr->lexeme = END;
1496 infoPtr->next = src;
1497 return TCL_OK;
1498 }
1499
1500 /*
1501 * Try to parse the lexeme first as an integer or floating-point
1502 * number. Don't check for a number if the first character c is
1503 * "+" or "-". If we did, we might treat a binary operator as unary
1504 * by mistake, which would eventually cause a syntax error.
1505 */
1506
1507 if ((c != '+') && (c != '-')) {
1508 startsWithDigit = isdigit(UCHAR(c)); /* INTL: digit */
1509 if (startsWithDigit && TclLooksLikeInt(src, -1)) {
1510 errno = 0;
1511 (void) strtoul(src, &termPtr, 0);
1512 if (errno == ERANGE) {
1513 if (interp != NULL) {
1514 char *s = "integer value too large to represent";
1515 Tcl_ResetResult(interp);
1516 Tcl_AppendToObj(Tcl_GetObjResult(interp), s, -1);
1517 Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW", s,
1518 (char *) NULL);
1519 }
1520 parsePtr->errorType = TCL_PARSE_BAD_NUMBER;
1521 return TCL_ERROR;
1522 }
1523 if (termPtr != src) {
1524 /*
1525 * src was the start of a valid integer, but was it
1526 * a bad octal? Stopping at a digit would cause that.
1527 */
1528 if (isdigit(UCHAR(*termPtr))) { /* INTL: digit. */
1529 /*
1530 * We only want to report an error for the number,
1531 * but we may have something like "08+1"
1532 */
1533 if (interp != NULL) {
1534 while (isdigit(UCHAR(*(++termPtr)))) {} /* INTL: digit. */
1535 Tcl_ResetResult(interp);
1536 offset = termPtr - src;
1537 c = src[offset];
1538 src[offset] = 0;
1539 Tcl_AppendResult(interp, "\"", src,
1540 "\" is an invalid octal number",
1541 (char *) NULL);
1542 src[offset] = c;
1543 }
1544 parsePtr->errorType = TCL_PARSE_BAD_NUMBER;
1545 return TCL_ERROR;
1546 }
1547
1548 infoPtr->lexeme = LITERAL;
1549 infoPtr->start = src;
1550 infoPtr->size = (termPtr - src);
1551 infoPtr->next = termPtr;
1552 parsePtr->term = termPtr;
1553 return TCL_OK;
1554 }
1555 } else if (startsWithDigit || (c == '.')
1556 || (c == 'n') || (c == 'N')) {
1557 errno = 0;
1558 doubleValue = strtod(src, &termPtr);
1559 if (termPtr != src) {
1560 if (errno != 0) {
1561 if (interp != NULL) {
1562 TclExprFloatError(interp, doubleValue);
1563 }
1564 parsePtr->errorType = TCL_PARSE_BAD_NUMBER;
1565 return TCL_ERROR;
1566 }
1567
1568 /*
1569 * src was the start of a valid double.
1570 */
1571
1572 infoPtr->lexeme = LITERAL;
1573 infoPtr->start = src;
1574 infoPtr->size = (termPtr - src);
1575 infoPtr->next = termPtr;
1576 parsePtr->term = termPtr;
1577 return TCL_OK;
1578 }
1579 }
1580 }
1581
1582 /*
1583 * Not an integer or double literal. Initialize the lexeme's fields
1584 * assuming the common case of a single character lexeme.
1585 */
1586
1587 infoPtr->start = src;
1588 infoPtr->size = 1;
1589 infoPtr->next = src+1;
1590 parsePtr->term = infoPtr->next;
1591
1592 switch (*src) {
1593 case '[':
1594 infoPtr->lexeme = OPEN_BRACKET;
1595 return TCL_OK;
1596
1597 case '{':
1598 infoPtr->lexeme = OPEN_BRACE;
1599 return TCL_OK;
1600
1601 case '(':
1602 infoPtr->lexeme = OPEN_PAREN;
1603 return TCL_OK;
1604
1605 case ')':
1606 infoPtr->lexeme = CLOSE_PAREN;
1607 return TCL_OK;
1608
1609 case '$':
1610 infoPtr->lexeme = DOLLAR;
1611 return TCL_OK;
1612
1613 case '\"':
1614 infoPtr->lexeme = QUOTE;
1615 return TCL_OK;
1616
1617 case ',':
1618 infoPtr->lexeme = COMMA;
1619 return TCL_OK;
1620
1621 case '*':
1622 infoPtr->lexeme = MULT;
1623 return TCL_OK;
1624
1625 case '/':
1626 infoPtr->lexeme = DIVIDE;
1627 return TCL_OK;
1628
1629 case '%':
1630 infoPtr->lexeme = MOD;
1631 return TCL_OK;
1632
1633 case '+':
1634 infoPtr->lexeme = PLUS;
1635 return TCL_OK;
1636
1637 case '-':
1638 infoPtr->lexeme = MINUS;
1639 return TCL_OK;
1640
1641 case '?':
1642 infoPtr->lexeme = QUESTY;
1643 return TCL_OK;
1644
1645 case ':':
1646 infoPtr->lexeme = COLON;
1647 return TCL_OK;
1648
1649 case '<':
1650 switch (src[1]) {
1651 case '<':
1652 infoPtr->lexeme = LEFT_SHIFT;
1653 infoPtr->size = 2;
1654 infoPtr->next = src+2;
1655 break;
1656 case '=':
1657 infoPtr->lexeme = LEQ;
1658 infoPtr->size = 2;
1659 infoPtr->next = src+2;
1660 break;
1661 default:
1662 infoPtr->lexeme = LESS;
1663 break;
1664 }
1665 parsePtr->term = infoPtr->next;
1666 return TCL_OK;
1667
1668 case '>':
1669 switch (src[1]) {
1670 case '>':
1671 infoPtr->lexeme = RIGHT_SHIFT;
1672 infoPtr->size = 2;
1673 infoPtr->next = src+2;
1674 break;
1675 case '=':
1676 infoPtr->lexeme = GEQ;
1677 infoPtr->size = 2;
1678 infoPtr->next = src+2;
1679 break;
1680 default:
1681 infoPtr->lexeme = GREATER;
1682 break;
1683 }
1684 parsePtr->term = infoPtr->next;
1685 return TCL_OK;
1686
1687 case '=':
1688 if (src[1] == '=') {
1689 infoPtr->lexeme = EQUAL;
1690 infoPtr->size = 2;
1691 infoPtr->next = src+2;
1692 } else {
1693 infoPtr->lexeme = UNKNOWN;
1694 }
1695 parsePtr->term = infoPtr->next;
1696 return TCL_OK;
1697
1698 case '!':
1699 if (src[1] == '=') {
1700 infoPtr->lexeme = NEQ;
1701 infoPtr->size = 2;
1702 infoPtr->next = src+2;
1703 } else {
1704 infoPtr->lexeme = NOT;
1705 }
1706 parsePtr->term = infoPtr->next;
1707 return TCL_OK;
1708
1709 case '&':
1710 if (src[1] == '&') {
1711 infoPtr->lexeme = AND;
1712 infoPtr->size = 2;
1713 infoPtr->next = src+2;
1714 } else {
1715 infoPtr->lexeme = BIT_AND;
1716 }
1717 parsePtr->term = infoPtr->next;
1718 return TCL_OK;
1719
1720 case '^':
1721 infoPtr->lexeme = BIT_XOR;
1722 return TCL_OK;
1723
1724 case '|':
1725 if (src[1] == '|') {
1726 infoPtr->lexeme = OR;
1727 infoPtr->size = 2;
1728 infoPtr->next = src+2;
1729 } else {
1730 infoPtr->lexeme = BIT_OR;
1731 }
1732 parsePtr->term = infoPtr->next;
1733 return TCL_OK;
1734
1735 case '~':
1736 infoPtr->lexeme = BIT_NOT;
1737 return TCL_OK;
1738
1739 default:
1740 offset = Tcl_UtfToUniChar(src, &ch);
1741 c = UCHAR(ch);
1742 if (isalpha(UCHAR(c))) { /* INTL: ISO only. */
1743 infoPtr->lexeme = FUNC_NAME;
1744 while (isalnum(UCHAR(c)) || (c == '_')) { /* INTL: ISO only. */
1745 src += offset;
1746 offset = Tcl_UtfToUniChar(src, &ch);
1747 c = UCHAR(ch);
1748 }
1749 infoPtr->size = (src - infoPtr->start);
1750 infoPtr->next = src;
1751 parsePtr->term = infoPtr->next;
1752 return TCL_OK;
1753 }
1754 infoPtr->lexeme = UNKNOWN;
1755 return TCL_OK;
1756 }
1757 }
1758
1759 /*
1760 *----------------------------------------------------------------------
1761 *
1762 * PrependSubExprTokens --
1763 *
1764 * This procedure is called after the operands of an subexpression have
1765 * been parsed. It generates two tokens: a TCL_TOKEN_SUB_EXPR token for
1766 * the subexpression, and a TCL_TOKEN_OPERATOR token for its operator.
1767 * These two tokens are inserted before the operand tokens.
1768 *
1769 * Results:
1770 * None.
1771 *
1772 * Side effects:
1773 * If there is insufficient space in parsePtr to hold the new tokens,
1774 * additional space is malloc-ed.
1775 *
1776 *----------------------------------------------------------------------
1777 */
1778
1779 static void
1780 PrependSubExprTokens(op, opBytes, src, srcBytes, firstIndex, infoPtr)
1781 char *op; /* Points to first byte of the operator
1782 * in the source script. */
1783 int opBytes; /* Number of bytes in the operator. */
1784 char *src; /* Points to first byte of the subexpression
1785 * in the source script. */
1786 int srcBytes; /* Number of bytes in subexpression's
1787 * source. */
1788 int firstIndex; /* Index of first token already emitted for
1789 * operator's first (or only) operand. */
1790 ParseInfo *infoPtr; /* Holds the parse state for the
1791 * expression being parsed. */
1792 {
1793 Tcl_Parse *parsePtr = infoPtr->parsePtr;
1794 Tcl_Token *tokenPtr, *firstTokenPtr;
1795 int numToMove;
1796
1797 if ((parsePtr->numTokens + 1) >= parsePtr->tokensAvailable) {
1798 TclExpandTokenArray(parsePtr);
1799 }
1800 firstTokenPtr = &parsePtr->tokenPtr[firstIndex];
1801 tokenPtr = (firstTokenPtr + 2);
1802 numToMove = (parsePtr->numTokens - firstIndex);
1803 memmove((VOID *) tokenPtr, (VOID *) firstTokenPtr,
1804 (size_t) (numToMove * sizeof(Tcl_Token)));
1805 parsePtr->numTokens += 2;
1806
1807 tokenPtr = firstTokenPtr;
1808 tokenPtr->type = TCL_TOKEN_SUB_EXPR;
1809 tokenPtr->start = src;
1810 tokenPtr->size = srcBytes;
1811 tokenPtr->numComponents = parsePtr->numTokens - (firstIndex + 1);
1812
1813 tokenPtr++;
1814 tokenPtr->type = TCL_TOKEN_OPERATOR;
1815 tokenPtr->start = op;
1816 tokenPtr->size = opBytes;
1817 tokenPtr->numComponents = 0;
1818 }
1819
1820 /*
1821 *----------------------------------------------------------------------
1822 *
1823 * LogSyntaxError --
1824 *
1825 * This procedure is invoked after an error occurs when parsing an
1826 * expression. It sets the interpreter result to an error message
1827 * describing the error.
1828 *
1829 * Results:
1830 * None.
1831 *
1832 * Side effects:
1833 * Sets the interpreter result to an error message describing the
1834 * expression that was being parsed when the error occurred.
1835 *
1836 *----------------------------------------------------------------------
1837 */
1838
1839 static void
1840 LogSyntaxError(infoPtr)
1841 ParseInfo *infoPtr; /* Holds the parse state for the
1842 * expression being parsed. */
1843 {
1844 int numBytes = (infoPtr->lastChar - infoPtr->originalExpr);
1845 char buffer[100];
1846
1847 sprintf(buffer, "syntax error in expression \"%.*s\"",
1848 ((numBytes > 60)? 60 : numBytes), infoPtr->originalExpr);
1849 Tcl_AppendStringsToObj(Tcl_GetObjResult(infoPtr->parsePtr->interp),
1850 buffer, (char *) NULL);
1851 infoPtr->parsePtr->errorType = TCL_PARSE_SYNTAX;
1852 infoPtr->parsePtr->term = infoPtr->start;
1853 }
1854
1855 /* End of tclparseexpr.c */

Properties

Name Value
svn:keywords Header

dashley@gmail.com
ViewVC Help
Powered by ViewVC 1.1.25