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

dashley@gmail.com
ViewVC Help
Powered by ViewVC 1.1.25