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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 44 - (hide annotations) (download)
Fri Oct 14 02:09:58 2016 UTC (7 years, 4 months ago) by dashley
File MIME type: text/plain
File size: 51572 byte(s)
Rename for reorganization.
1 dashley 25 /* $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