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

Properties

Name Value
svn:keywords Header

dashley@gmail.com
ViewVC Help
Powered by ViewVC 1.1.25