1/*
2 * tclParseExpr.c --
3 *
4 *	This file contains procedures that parse Tcl expressions. They
5 *	do so in a general-purpose fashion that can be used for many
6 *	different purposes, including compilation, direct execution,
7 *	code analysis, etc.
8 *
9 * Copyright (c) 1997 Sun Microsystems, Inc.
10 * Copyright (c) 1998-2000 by Scriptics Corporation.
11 * Contributions from Don Porter, NIST, 2002.  (not subject to US copyright)
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.17.2.2 2005/05/20 17:19:10 vasiljevic Exp $
17 */
18
19#include "tclInt.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
34extern 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
44static 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
53typedef 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    CONST char *start;		/* First character in lexeme. */
60    int size;			/* Number of bytes in lexeme. */
61    CONST char *next;		/* Position of the next character to be
62				 * scanned in the expression string. */
63    CONST 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    CONST char *originalExpr;	/* Points to the start of the expression
67				 * originally passed to Tcl_ParseExpr. */
68    CONST 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 * Basic lexemes:
77 */
78
79#define LITERAL		0
80#define FUNC_NAME	1
81#define OPEN_BRACKET	2
82#define OPEN_BRACE	3
83#define OPEN_PAREN	4
84#define CLOSE_PAREN	5
85#define DOLLAR		6
86#define QUOTE		7
87#define COMMA		8
88#define END		9
89#define UNKNOWN		10
90#define UNKNOWN_CHAR	11
91
92/*
93 * Binary numeric operators:
94 */
95
96#define MULT		12
97#define DIVIDE		13
98#define MOD		14
99#define PLUS		15
100#define MINUS		16
101#define LEFT_SHIFT	17
102#define RIGHT_SHIFT	18
103#define LESS		19
104#define GREATER		20
105#define LEQ		21
106#define GEQ		22
107#define EQUAL		23
108#define NEQ		24
109#define BIT_AND		25
110#define BIT_XOR		26
111#define BIT_OR		27
112#define AND		28
113#define OR		29
114#define QUESTY		30
115#define COLON		31
116
117/*
118 * Unary operators. Unary minus and plus are represented by the (binary)
119 * lexemes MINUS and PLUS.
120 */
121
122#define NOT		32
123#define BIT_NOT		33
124
125/*
126 * Binary string operators:
127 */
128
129#define STREQ		34
130#define STRNEQ		35
131
132/*
133 * Mapping from lexemes to strings; used for debugging messages. These
134 * entries must match the order and number of the lexeme definitions above.
135 */
136
137static char *lexemeStrings[] = {
138    "LITERAL", "FUNCNAME",
139    "[", "{", "(", ")", "$", "\"", ",", "END", "UNKNOWN", "UNKNOWN_CHAR",
140    "*", "/", "%", "+", "-",
141    "<<", ">>", "<", ">", "<=", ">=", "==", "!=",
142    "&", "^", "|", "&&", "||", "?", ":",
143    "!", "~", "eq", "ne",
144};
145
146/*
147 * Declarations for local procedures to this file:
148 */
149
150static int		GetLexeme _ANSI_ARGS_((ParseInfo *infoPtr));
151static void		LogSyntaxError _ANSI_ARGS_((ParseInfo *infoPtr,
152				CONST char *extraInfo));
153static int		ParseAddExpr _ANSI_ARGS_((ParseInfo *infoPtr));
154static int		ParseBitAndExpr _ANSI_ARGS_((ParseInfo *infoPtr));
155static int		ParseBitOrExpr _ANSI_ARGS_((ParseInfo *infoPtr));
156static int		ParseBitXorExpr _ANSI_ARGS_((ParseInfo *infoPtr));
157static int		ParseCondExpr _ANSI_ARGS_((ParseInfo *infoPtr));
158static int		ParseEqualityExpr _ANSI_ARGS_((ParseInfo *infoPtr));
159static int		ParseLandExpr _ANSI_ARGS_((ParseInfo *infoPtr));
160static int		ParseLorExpr _ANSI_ARGS_((ParseInfo *infoPtr));
161static int		ParseMaxDoubleLength _ANSI_ARGS_((CONST char *string,
162				CONST char *end));
163static int		ParseMultiplyExpr _ANSI_ARGS_((ParseInfo *infoPtr));
164static int		ParsePrimaryExpr _ANSI_ARGS_((ParseInfo *infoPtr));
165static int		ParseRelationalExpr _ANSI_ARGS_((ParseInfo *infoPtr));
166static int		ParseShiftExpr _ANSI_ARGS_((ParseInfo *infoPtr));
167static int		ParseUnaryExpr _ANSI_ARGS_((ParseInfo *infoPtr));
168static void		PrependSubExprTokens _ANSI_ARGS_((CONST char *op,
169				int opBytes, CONST char *src, int srcBytes,
170				int firstIndex, ParseInfo *infoPtr));
171
172/*
173 * Macro used to debug the execution of the recursive descent parser used
174 * to parse expressions.
175 */
176
177#ifdef TCL_COMPILE_DEBUG
178#define HERE(production, level) \
179    if (traceParseExpr) { \
180	fprintf(stderr, "%*s%s: lexeme=%s, next=\"%.20s\"\n", \
181		(level), " ", (production), \
182		lexemeStrings[infoPtr->lexeme], infoPtr->next); \
183    }
184#else
185#define HERE(production, level)
186#endif /* TCL_COMPILE_DEBUG */
187
188/*
189 *----------------------------------------------------------------------
190 *
191 * Tcl_ParseExpr --
192 *
193 *	Given a string, this procedure parses the first Tcl expression
194 *	in the string and returns information about the structure of
195 *	the expression. This procedure is the top-level interface to the
196 *	the expression parsing module.  No more that numBytes bytes will
197 *	be scanned.
198 *
199 * Results:
200 *	The return value is TCL_OK if the command was parsed successfully
201 *	and TCL_ERROR otherwise. If an error occurs and interp isn't NULL
202 *	then an error message is left in its result. On a successful return,
203 *	parsePtr is filled in with information about the expression that
204 *	was parsed.
205 *
206 * Side effects:
207 *	If there is insufficient space in parsePtr to hold all the
208 *	information about the expression, then additional space is
209 *	malloc-ed. If the procedure returns TCL_OK then the caller must
210 *	eventually invoke Tcl_FreeParse to release any additional space
211 *	that was allocated.
212 *
213 *----------------------------------------------------------------------
214 */
215
216int
217Tcl_ParseExpr(interp, string, numBytes, parsePtr)
218    Tcl_Interp *interp;		/* Used for error reporting. */
219    CONST char *string;		/* The source string to parse. */
220    int numBytes;		/* Number of bytes in string. If < 0, the
221				 * string consists of all bytes up to the
222				 * first null character. */
223    Tcl_Parse *parsePtr;	/* Structure to fill with information about
224				 * the parsed expression; any previous
225				 * information in the structure is
226				 * ignored. */
227{
228    ParseInfo info;
229    int code;
230
231    if (numBytes < 0) {
232	numBytes = (string? strlen(string) : 0);
233    }
234#ifdef TCL_COMPILE_DEBUG
235    if (traceParseExpr) {
236	fprintf(stderr, "Tcl_ParseExpr: string=\"%.*s\"\n",
237	        numBytes, string);
238    }
239#endif /* TCL_COMPILE_DEBUG */
240
241    parsePtr->commentStart = NULL;
242    parsePtr->commentSize = 0;
243    parsePtr->commandStart = NULL;
244    parsePtr->commandSize = 0;
245    parsePtr->numWords = 0;
246    parsePtr->tokenPtr = parsePtr->staticTokens;
247    parsePtr->numTokens = 0;
248    parsePtr->tokensAvailable = NUM_STATIC_TOKENS;
249    parsePtr->string = string;
250    parsePtr->end = (string + numBytes);
251    parsePtr->interp = interp;
252    parsePtr->term = string;
253    parsePtr->incomplete = 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, "extra tokens at end of expression");
283	goto error;
284    }
285    return TCL_OK;
286
287    error:
288    if (parsePtr->tokenPtr != parsePtr->staticTokens) {
289	ckfree((char *) parsePtr->tokenPtr);
290    }
291    return TCL_ERROR;
292}
293
294/*
295 *----------------------------------------------------------------------
296 *
297 * ParseCondExpr --
298 *
299 *	This procedure parses a Tcl conditional expression:
300 *	condExpr ::= lorExpr ['?' condExpr ':' condExpr]
301 *
302 *	Note that this is the topmost recursive-descent parsing routine used
303 *	by Tcl_ParseExpr to parse expressions. This avoids an extra procedure
304 *	call since such a procedure would only return the result of calling
305 *	ParseCondExpr. Other recursive-descent procedures that need to parse
306 *	complete expressions also call ParseCondExpr.
307 *
308 * Results:
309 *	The return value is TCL_OK on a successful parse and TCL_ERROR
310 *	on failure. If TCL_ERROR is returned, then the interpreter's result
311 *	contains an error message.
312 *
313 * Side effects:
314 *	If there is insufficient space in parsePtr to hold all the
315 *	information about the subexpression, then additional space is
316 *	malloc-ed.
317 *
318 *----------------------------------------------------------------------
319 */
320
321static int
322ParseCondExpr(infoPtr)
323    ParseInfo *infoPtr;		/* Holds the parse state for the
324				 * expression being parsed. */
325{
326    Tcl_Parse *parsePtr = infoPtr->parsePtr;
327    Tcl_Token *tokenPtr, *firstTokenPtr, *condTokenPtr;
328    int firstIndex, numToMove, code;
329    CONST char *srcStart;
330
331    HERE("condExpr", 1);
332    srcStart = infoPtr->start;
333    firstIndex = parsePtr->numTokens;
334
335    code = ParseLorExpr(infoPtr);
336    if (code != TCL_OK) {
337	return code;
338    }
339
340    if (infoPtr->lexeme == QUESTY) {
341	/*
342	 * Emit two tokens: one TCL_TOKEN_SUB_EXPR token for the entire
343	 * conditional expression, and a TCL_TOKEN_OPERATOR token for
344	 * the "?" operator. Note that these two tokens must be inserted
345	 * before the LOR operand tokens generated above.
346	 */
347
348	if ((parsePtr->numTokens + 1) >= parsePtr->tokensAvailable) {
349	    TclExpandTokenArray(parsePtr);
350	}
351	firstTokenPtr = &parsePtr->tokenPtr[firstIndex];
352	tokenPtr = (firstTokenPtr + 2);
353	numToMove = (parsePtr->numTokens - firstIndex);
354	memmove((VOID *) tokenPtr, (VOID *) firstTokenPtr,
355	        (size_t) (numToMove * sizeof(Tcl_Token)));
356	parsePtr->numTokens += 2;
357
358	tokenPtr = firstTokenPtr;
359	tokenPtr->type = TCL_TOKEN_SUB_EXPR;
360	tokenPtr->start = srcStart;
361
362	tokenPtr++;
363	tokenPtr->type = TCL_TOKEN_OPERATOR;
364	tokenPtr->start = infoPtr->start;
365	tokenPtr->size = 1;
366	tokenPtr->numComponents = 0;
367
368	/*
369	 * Skip over the '?'.
370	 */
371
372	code = GetLexeme(infoPtr);
373	if (code != TCL_OK) {
374	    return code;
375	}
376
377	/*
378	 * Parse the "then" expression.
379	 */
380
381	code = ParseCondExpr(infoPtr);
382	if (code != TCL_OK) {
383	    return code;
384	}
385	if (infoPtr->lexeme != COLON) {
386	    LogSyntaxError(infoPtr, "missing colon from ternary conditional");
387	    return TCL_ERROR;
388	}
389	code = GetLexeme(infoPtr); /* skip over the ':' */
390	if (code != TCL_OK) {
391	    return code;
392	}
393
394	/*
395	 * Parse the "else" expression.
396	 */
397
398	code = ParseCondExpr(infoPtr);
399	if (code != TCL_OK) {
400	    return code;
401	}
402
403	/*
404	 * Now set the size-related fields in the '?' subexpression token.
405	 */
406
407	condTokenPtr = &parsePtr->tokenPtr[firstIndex];
408	condTokenPtr->size = (infoPtr->prevEnd - srcStart);
409	condTokenPtr->numComponents = parsePtr->numTokens - (firstIndex+1);
410    }
411    return TCL_OK;
412}
413
414/*
415 *----------------------------------------------------------------------
416 *
417 * ParseLorExpr --
418 *
419 *	This procedure parses a Tcl logical or expression:
420 *	lorExpr ::= landExpr {'||' landExpr}
421 *
422 * Results:
423 *	The return value is TCL_OK on a successful parse and TCL_ERROR
424 *	on failure. If TCL_ERROR is returned, then the interpreter's result
425 *	contains an error message.
426 *
427 * Side effects:
428 *	If there is insufficient space in parsePtr to hold all the
429 *	information about the subexpression, then additional space is
430 *	malloc-ed.
431 *
432 *----------------------------------------------------------------------
433 */
434
435static int
436ParseLorExpr(infoPtr)
437    ParseInfo *infoPtr;		/* Holds the parse state for the
438				 * expression being parsed. */
439{
440    Tcl_Parse *parsePtr = infoPtr->parsePtr;
441    int firstIndex, code;
442    CONST char *srcStart, *operator;
443
444    HERE("lorExpr", 2);
445    srcStart = infoPtr->start;
446    firstIndex = parsePtr->numTokens;
447
448    code = ParseLandExpr(infoPtr);
449    if (code != TCL_OK) {
450	return code;
451    }
452
453    while (infoPtr->lexeme == OR) {
454	operator = infoPtr->start;
455	code = GetLexeme(infoPtr); /* skip over the '||' */
456	if (code != TCL_OK) {
457	    return code;
458	}
459	code = ParseLandExpr(infoPtr);
460	if (code != TCL_OK) {
461	    return code;
462	}
463
464	/*
465	 * Generate tokens for the LOR subexpression and the '||' operator.
466	 */
467
468	PrependSubExprTokens(operator, 2, srcStart,
469	        (infoPtr->prevEnd - srcStart), firstIndex, infoPtr);
470    }
471    return TCL_OK;
472}
473
474/*
475 *----------------------------------------------------------------------
476 *
477 * ParseLandExpr --
478 *
479 *	This procedure parses a Tcl logical and expression:
480 *	landExpr ::= bitOrExpr {'&&' bitOrExpr}
481 *
482 * Results:
483 *	The return value is TCL_OK on a successful parse and TCL_ERROR
484 *	on failure. If TCL_ERROR is returned, then the interpreter's result
485 *	contains an error message.
486 *
487 * Side effects:
488 *	If there is insufficient space in parsePtr to hold all the
489 *	information about the subexpression, then additional space is
490 *	malloc-ed.
491 *
492 *----------------------------------------------------------------------
493 */
494
495static int
496ParseLandExpr(infoPtr)
497    ParseInfo *infoPtr;		/* Holds the parse state for the
498				 * expression being parsed. */
499{
500    Tcl_Parse *parsePtr = infoPtr->parsePtr;
501    int firstIndex, code;
502    CONST char *srcStart, *operator;
503
504    HERE("landExpr", 3);
505    srcStart = infoPtr->start;
506    firstIndex = parsePtr->numTokens;
507
508    code = ParseBitOrExpr(infoPtr);
509    if (code != TCL_OK) {
510	return code;
511    }
512
513    while (infoPtr->lexeme == AND) {
514	operator = infoPtr->start;
515	code = GetLexeme(infoPtr); /* skip over the '&&' */
516	if (code != TCL_OK) {
517	    return code;
518	}
519	code = ParseBitOrExpr(infoPtr);
520	if (code != TCL_OK) {
521	    return code;
522	}
523
524	/*
525	 * Generate tokens for the LAND subexpression and the '&&' operator.
526	 */
527
528	PrependSubExprTokens(operator, 2, srcStart,
529	        (infoPtr->prevEnd - srcStart), firstIndex, infoPtr);
530    }
531    return TCL_OK;
532}
533
534/*
535 *----------------------------------------------------------------------
536 *
537 * ParseBitOrExpr --
538 *
539 *	This procedure parses a Tcl bitwise or expression:
540 *	bitOrExpr ::= bitXorExpr {'|' bitXorExpr}
541 *
542 * Results:
543 *	The return value is TCL_OK on a successful parse and TCL_ERROR
544 *	on failure. If TCL_ERROR is returned, then the interpreter's result
545 *	contains an error message.
546 *
547 * Side effects:
548 *	If there is insufficient space in parsePtr to hold all the
549 *	information about the subexpression, then additional space is
550 *	malloc-ed.
551 *
552 *----------------------------------------------------------------------
553 */
554
555static int
556ParseBitOrExpr(infoPtr)
557    ParseInfo *infoPtr;		/* Holds the parse state for the
558				 * expression being parsed. */
559{
560    Tcl_Parse *parsePtr = infoPtr->parsePtr;
561    int firstIndex, code;
562    CONST char *srcStart, *operator;
563
564    HERE("bitOrExpr", 4);
565    srcStart = infoPtr->start;
566    firstIndex = parsePtr->numTokens;
567
568    code = ParseBitXorExpr(infoPtr);
569    if (code != TCL_OK) {
570	return code;
571    }
572
573    while (infoPtr->lexeme == BIT_OR) {
574	operator = infoPtr->start;
575	code = GetLexeme(infoPtr); /* skip over the '|' */
576	if (code != TCL_OK) {
577	    return code;
578	}
579
580	code = ParseBitXorExpr(infoPtr);
581	if (code != TCL_OK) {
582	    return code;
583	}
584
585	/*
586	 * Generate tokens for the BITOR subexpression and the '|' operator.
587	 */
588
589	PrependSubExprTokens(operator, 1, srcStart,
590	        (infoPtr->prevEnd - srcStart), firstIndex, infoPtr);
591    }
592    return TCL_OK;
593}
594
595/*
596 *----------------------------------------------------------------------
597 *
598 * ParseBitXorExpr --
599 *
600 *	This procedure parses a Tcl bitwise exclusive or expression:
601 *	bitXorExpr ::= bitAndExpr {'^' bitAndExpr}
602 *
603 * Results:
604 *	The return value is TCL_OK on a successful parse and TCL_ERROR
605 *	on failure. If TCL_ERROR is returned, then the interpreter's result
606 *	contains an error message.
607 *
608 * Side effects:
609 *	If there is insufficient space in parsePtr to hold all the
610 *	information about the subexpression, then additional space is
611 *	malloc-ed.
612 *
613 *----------------------------------------------------------------------
614 */
615
616static int
617ParseBitXorExpr(infoPtr)
618    ParseInfo *infoPtr;		/* Holds the parse state for the
619				 * expression being parsed. */
620{
621    Tcl_Parse *parsePtr = infoPtr->parsePtr;
622    int firstIndex, code;
623    CONST char *srcStart, *operator;
624
625    HERE("bitXorExpr", 5);
626    srcStart = infoPtr->start;
627    firstIndex = parsePtr->numTokens;
628
629    code = ParseBitAndExpr(infoPtr);
630    if (code != TCL_OK) {
631	return code;
632    }
633
634    while (infoPtr->lexeme == BIT_XOR) {
635	operator = infoPtr->start;
636	code = GetLexeme(infoPtr); /* skip over the '^' */
637	if (code != TCL_OK) {
638	    return code;
639	}
640
641	code = ParseBitAndExpr(infoPtr);
642	if (code != TCL_OK) {
643	    return code;
644	}
645
646	/*
647	 * Generate tokens for the XOR subexpression and the '^' operator.
648	 */
649
650	PrependSubExprTokens(operator, 1, srcStart,
651	        (infoPtr->prevEnd - srcStart), firstIndex, infoPtr);
652    }
653    return TCL_OK;
654}
655
656/*
657 *----------------------------------------------------------------------
658 *
659 * ParseBitAndExpr --
660 *
661 *	This procedure parses a Tcl bitwise and expression:
662 *	bitAndExpr ::= equalityExpr {'&' equalityExpr}
663 *
664 * Results:
665 *	The return value is TCL_OK on a successful parse and TCL_ERROR
666 *	on failure. If TCL_ERROR is returned, then the interpreter's result
667 *	contains an error message.
668 *
669 * Side effects:
670 *	If there is insufficient space in parsePtr to hold all the
671 *	information about the subexpression, then additional space is
672 *	malloc-ed.
673 *
674 *----------------------------------------------------------------------
675 */
676
677static int
678ParseBitAndExpr(infoPtr)
679    ParseInfo *infoPtr;		/* Holds the parse state for the
680				 * expression being parsed. */
681{
682    Tcl_Parse *parsePtr = infoPtr->parsePtr;
683    int firstIndex, code;
684    CONST char *srcStart, *operator;
685
686    HERE("bitAndExpr", 6);
687    srcStart = infoPtr->start;
688    firstIndex = parsePtr->numTokens;
689
690    code = ParseEqualityExpr(infoPtr);
691    if (code != TCL_OK) {
692	return code;
693    }
694
695    while (infoPtr->lexeme == BIT_AND) {
696	operator = infoPtr->start;
697	code = GetLexeme(infoPtr); /* skip over the '&' */
698	if (code != TCL_OK) {
699	    return code;
700	}
701	code = ParseEqualityExpr(infoPtr);
702	if (code != TCL_OK) {
703	    return code;
704	}
705
706	/*
707	 * Generate tokens for the BITAND subexpression and '&' operator.
708	 */
709
710	PrependSubExprTokens(operator, 1, srcStart,
711	        (infoPtr->prevEnd - srcStart), firstIndex, infoPtr);
712    }
713    return TCL_OK;
714}
715
716/*
717 *----------------------------------------------------------------------
718 *
719 * ParseEqualityExpr --
720 *
721 *	This procedure parses a Tcl equality (inequality) expression:
722 *	equalityExpr ::= relationalExpr
723 *		{('==' | '!=' | 'ne' | 'eq') relationalExpr}
724 *
725 * Results:
726 *	The return value is TCL_OK on a successful parse and TCL_ERROR
727 *	on failure. If TCL_ERROR is returned, then the interpreter's result
728 *	contains an error message.
729 *
730 * Side effects:
731 *	If there is insufficient space in parsePtr to hold all the
732 *	information about the subexpression, then additional space is
733 *	malloc-ed.
734 *
735 *----------------------------------------------------------------------
736 */
737
738static int
739ParseEqualityExpr(infoPtr)
740    ParseInfo *infoPtr;		/* Holds the parse state for the
741				 * expression being parsed. */
742{
743    Tcl_Parse *parsePtr = infoPtr->parsePtr;
744    int firstIndex, lexeme, code;
745    CONST char *srcStart, *operator;
746
747    HERE("equalityExpr", 7);
748    srcStart = infoPtr->start;
749    firstIndex = parsePtr->numTokens;
750
751    code = ParseRelationalExpr(infoPtr);
752    if (code != TCL_OK) {
753	return code;
754    }
755
756    lexeme = infoPtr->lexeme;
757    while ((lexeme == EQUAL) || (lexeme == NEQ)
758	    || (lexeme == STREQ) || (lexeme == STRNEQ)) {
759	operator = infoPtr->start;
760	code = GetLexeme(infoPtr); /* skip over ==, !=, 'eq' or 'ne'  */
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 '==', '!=', 'eq' or 'ne'
771	 * 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
802static int
803ParseRelationalExpr(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    CONST 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
870static int
871ParseShiftExpr(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    CONST 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
932static int
933ParseAddExpr(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    CONST 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
994static int
995ParseMultiplyExpr(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    CONST 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
1056static int
1057ParseUnaryExpr(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    CONST 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
1119static int
1120ParsePrimaryExpr(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    CONST 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	    LogSyntaxError(infoPtr, "looking for close parenthesis");
1148	    return TCL_ERROR;
1149	}
1150	code = GetLexeme(infoPtr); /* skip over the ')' */
1151	if (code != TCL_OK) {
1152	    return code;
1153	}
1154	return TCL_OK;
1155    }
1156
1157    /*
1158     * Start a TCL_TOKEN_SUB_EXPR token for the primary.
1159     */
1160
1161    if (parsePtr->numTokens == parsePtr->tokensAvailable) {
1162	TclExpandTokenArray(parsePtr);
1163    }
1164    exprIndex = parsePtr->numTokens;
1165    exprTokenPtr = &parsePtr->tokenPtr[exprIndex];
1166    exprTokenPtr->type = TCL_TOKEN_SUB_EXPR;
1167    exprTokenPtr->start = infoPtr->start;
1168    parsePtr->numTokens++;
1169
1170    /*
1171     * Process the primary then finish setting the fields of the
1172     * TCL_TOKEN_SUB_EXPR token. Note that we can't use the pointer now
1173     * stored in "exprTokenPtr" in the code below since the token array
1174     * might be reallocated.
1175     */
1176
1177    firstIndex = parsePtr->numTokens;
1178    switch (lexeme) {
1179    case LITERAL:
1180	/*
1181	 * Int or double number.
1182	 */
1183
1184	tokenizeLiteral:
1185	if (parsePtr->numTokens == parsePtr->tokensAvailable) {
1186	    TclExpandTokenArray(parsePtr);
1187	}
1188	tokenPtr = &parsePtr->tokenPtr[parsePtr->numTokens];
1189	tokenPtr->type = TCL_TOKEN_TEXT;
1190	tokenPtr->start = infoPtr->start;
1191	tokenPtr->size = infoPtr->size;
1192	tokenPtr->numComponents = 0;
1193	parsePtr->numTokens++;
1194
1195	exprTokenPtr = &parsePtr->tokenPtr[exprIndex];
1196	exprTokenPtr->size = infoPtr->size;
1197	exprTokenPtr->numComponents = 1;
1198	break;
1199
1200    case DOLLAR:
1201	/*
1202	 * $var variable reference.
1203	 */
1204
1205	dollarPtr = (infoPtr->next - 1);
1206	code = Tcl_ParseVarName(interp, dollarPtr,
1207	        (infoPtr->lastChar - dollarPtr), parsePtr, 1);
1208	if (code != TCL_OK) {
1209	    return code;
1210	}
1211	infoPtr->next = dollarPtr + parsePtr->tokenPtr[firstIndex].size;
1212
1213	exprTokenPtr = &parsePtr->tokenPtr[exprIndex];
1214	exprTokenPtr->size = parsePtr->tokenPtr[firstIndex].size;
1215	exprTokenPtr->numComponents =
1216	        (parsePtr->tokenPtr[firstIndex].numComponents + 1);
1217	break;
1218
1219    case QUOTE:
1220	/*
1221	 * '"' string '"'
1222	 */
1223
1224	stringStart = infoPtr->next;
1225	code = Tcl_ParseQuotedString(interp, infoPtr->start,
1226	        (infoPtr->lastChar - stringStart), parsePtr, 1, &termPtr);
1227	if (code != TCL_OK) {
1228	    return code;
1229	}
1230	infoPtr->next = termPtr;
1231
1232	exprTokenPtr = &parsePtr->tokenPtr[exprIndex];
1233	exprTokenPtr->size = (termPtr - exprTokenPtr->start);
1234	exprTokenPtr->numComponents = parsePtr->numTokens - firstIndex;
1235
1236	/*
1237	 * If parsing the quoted string resulted in more than one token,
1238	 * insert a TCL_TOKEN_WORD token before them. This indicates that
1239	 * the quoted string represents a concatenation of multiple tokens.
1240	 */
1241
1242	if (exprTokenPtr->numComponents > 1) {
1243	    if (parsePtr->numTokens >= parsePtr->tokensAvailable) {
1244		TclExpandTokenArray(parsePtr);
1245	    }
1246	    tokenPtr = &parsePtr->tokenPtr[firstIndex];
1247	    numToMove = (parsePtr->numTokens - firstIndex);
1248	    memmove((VOID *) (tokenPtr + 1), (VOID *) tokenPtr,
1249	            (size_t) (numToMove * sizeof(Tcl_Token)));
1250	    parsePtr->numTokens++;
1251
1252	    exprTokenPtr = &parsePtr->tokenPtr[exprIndex];
1253	    exprTokenPtr->numComponents++;
1254
1255	    tokenPtr->type = TCL_TOKEN_WORD;
1256	    tokenPtr->start = exprTokenPtr->start;
1257	    tokenPtr->size = exprTokenPtr->size;
1258	    tokenPtr->numComponents = (exprTokenPtr->numComponents - 1);
1259	}
1260	break;
1261
1262    case OPEN_BRACKET:
1263	/*
1264	 * '[' command {command} ']'
1265	 */
1266
1267	if (parsePtr->numTokens == parsePtr->tokensAvailable) {
1268	    TclExpandTokenArray(parsePtr);
1269	}
1270	tokenPtr = &parsePtr->tokenPtr[parsePtr->numTokens];
1271	tokenPtr->type = TCL_TOKEN_COMMAND;
1272	tokenPtr->start = infoPtr->start;
1273	tokenPtr->numComponents = 0;
1274	parsePtr->numTokens++;
1275
1276	/*
1277	 * Call Tcl_ParseCommand repeatedly to parse the nested command(s)
1278	 * to find their end, then throw away that parse information.
1279	 */
1280
1281	src = infoPtr->next;
1282	while (1) {
1283	    if (Tcl_ParseCommand(interp, src, (parsePtr->end - src), 1,
1284		    &nested) != TCL_OK) {
1285		parsePtr->term = nested.term;
1286		parsePtr->errorType = nested.errorType;
1287		parsePtr->incomplete = nested.incomplete;
1288		return TCL_ERROR;
1289	    }
1290	    src = (nested.commandStart + nested.commandSize);
1291
1292	    /*
1293	     * This is equivalent to Tcl_FreeParse(&nested), but
1294	     * presumably inlined here for sake of runtime optimization
1295	     */
1296
1297	    if (nested.tokenPtr != nested.staticTokens) {
1298		ckfree((char *) nested.tokenPtr);
1299	    }
1300
1301	    /*
1302	     * Check for the closing ']' that ends the command substitution.
1303	     * It must have been the last character of the parsed command.
1304	     */
1305
1306	    if ((nested.term < parsePtr->end) && (*nested.term == ']')
1307		    && !nested.incomplete) {
1308		break;
1309	    }
1310	    if (src == parsePtr->end) {
1311		if (parsePtr->interp != NULL) {
1312		    Tcl_SetResult(interp, "missing close-bracket",
1313			    TCL_STATIC);
1314		}
1315		parsePtr->term = tokenPtr->start;
1316		parsePtr->errorType = TCL_PARSE_MISSING_BRACKET;
1317		parsePtr->incomplete = 1;
1318		return TCL_ERROR;
1319	    }
1320	}
1321	tokenPtr->size = (src - tokenPtr->start);
1322	infoPtr->next = src;
1323
1324	exprTokenPtr = &parsePtr->tokenPtr[exprIndex];
1325	exprTokenPtr->size = (src - tokenPtr->start);
1326	exprTokenPtr->numComponents = 1;
1327	break;
1328
1329    case OPEN_BRACE:
1330	/*
1331	 * '{' string '}'
1332	 */
1333
1334	code = Tcl_ParseBraces(interp, infoPtr->start,
1335	        (infoPtr->lastChar - infoPtr->start), parsePtr, 1,
1336		&termPtr);
1337	if (code != TCL_OK) {
1338	    return code;
1339	}
1340	infoPtr->next = termPtr;
1341
1342	exprTokenPtr = &parsePtr->tokenPtr[exprIndex];
1343	exprTokenPtr->size = (termPtr - infoPtr->start);
1344	exprTokenPtr->numComponents = parsePtr->numTokens - firstIndex;
1345
1346	/*
1347	 * If parsing the braced string resulted in more than one token,
1348	 * insert a TCL_TOKEN_WORD token before them. This indicates that
1349	 * the braced string represents a concatenation of multiple tokens.
1350	 */
1351
1352	if (exprTokenPtr->numComponents > 1) {
1353	    if (parsePtr->numTokens >= parsePtr->tokensAvailable) {
1354		TclExpandTokenArray(parsePtr);
1355	    }
1356	    tokenPtr = &parsePtr->tokenPtr[firstIndex];
1357	    numToMove = (parsePtr->numTokens - firstIndex);
1358	    memmove((VOID *) (tokenPtr + 1), (VOID *) tokenPtr,
1359	            (size_t) (numToMove * sizeof(Tcl_Token)));
1360	    parsePtr->numTokens++;
1361
1362	    exprTokenPtr = &parsePtr->tokenPtr[exprIndex];
1363	    exprTokenPtr->numComponents++;
1364
1365	    tokenPtr->type = TCL_TOKEN_WORD;
1366	    tokenPtr->start = exprTokenPtr->start;
1367	    tokenPtr->size = exprTokenPtr->size;
1368	    tokenPtr->numComponents = exprTokenPtr->numComponents-1;
1369	}
1370	break;
1371
1372/*
1373 *	Disable attempt to support functions named "eq" or "ne".  This
1374 *	is unworkable in the Tcl 8.4.* releases.  See Tcl Bugs 1971879
1375 *	and 1201589.
1376 *
1377    case STREQ:
1378    case STRNEQ:
1379*/
1380    case FUNC_NAME: {
1381	/*
1382	 * math_func '(' expr {',' expr} ')'
1383	 */
1384
1385	ParseInfo savedInfo = *infoPtr;
1386
1387	code = GetLexeme(infoPtr); /* skip over function name */
1388	if (code != TCL_OK) {
1389	    return code;
1390	}
1391	if (infoPtr->lexeme != OPEN_PAREN) {
1392	    int code;
1393	    Tcl_DString functionName;
1394	    Tcl_HashEntry *hPtr;
1395	    Interp *iPtr = (Interp *) infoPtr->parsePtr->interp;
1396	    Tcl_Obj *objPtr = Tcl_NewStringObj(savedInfo.start, savedInfo.size);
1397
1398	    /* Check for boolean literals (true, false, yes, no, on, off) */
1399	    Tcl_IncrRefCount(objPtr);
1400	    code = Tcl_ConvertToType(NULL, objPtr, &tclBooleanType);
1401	    Tcl_DecrRefCount(objPtr);
1402	    if (code == TCL_OK) {
1403		*infoPtr = savedInfo;
1404		goto tokenizeLiteral;
1405	    }
1406
1407	    /*
1408	     * Guess what kind of error we have by trying to tell
1409	     * whether we have a function or variable name here.
1410	     * Alas, this makes the parser more tightly bound with the
1411	     * rest of the interpreter, but that is the only way to
1412	     * give a sensible message here.  Still, it is not too
1413	     * serious as this is only done when generating an error.
1414	     */
1415
1416	    /*
1417	     * Look up the name as a function name.  We need a writable
1418	     * copy (DString) so we can terminate it with a NULL for
1419	     * the benefit of Tcl_FindHashEntry which operates on
1420	     * NULL-terminated string keys.
1421	     */
1422	    Tcl_DStringInit(&functionName);
1423	    hPtr = Tcl_FindHashEntry(&iPtr->mathFuncTable,
1424	    	Tcl_DStringAppend(&functionName,
1425			savedInfo.start, savedInfo.size));
1426	    Tcl_DStringFree(&functionName);
1427
1428	    /*
1429	     * Assume that we have an attempted variable reference
1430	     * unless we've got a function name, as the set of
1431	     * potential function names is typically much smaller.
1432	     */
1433	    if (hPtr != NULL) {
1434		LogSyntaxError(infoPtr,
1435			"expected parenthesis enclosing function arguments");
1436	    } else {
1437		LogSyntaxError(infoPtr,
1438			"variable references require preceding $");
1439	    }
1440	    return TCL_ERROR;
1441	}
1442
1443	if (parsePtr->numTokens == parsePtr->tokensAvailable) {
1444	    TclExpandTokenArray(parsePtr);
1445	}
1446	tokenPtr = &parsePtr->tokenPtr[parsePtr->numTokens];
1447	tokenPtr->type = TCL_TOKEN_OPERATOR;
1448	tokenPtr->start = savedInfo.start;
1449	tokenPtr->size = savedInfo.size;
1450	tokenPtr->numComponents = 0;
1451	parsePtr->numTokens++;
1452
1453	code = GetLexeme(infoPtr); /* skip over '(' */
1454	if (code != TCL_OK) {
1455	    return code;
1456	}
1457
1458	while (infoPtr->lexeme != CLOSE_PAREN) {
1459	    code = ParseCondExpr(infoPtr);
1460	    if (code != TCL_OK) {
1461		return code;
1462	    }
1463
1464	    if (infoPtr->lexeme == COMMA) {
1465		code = GetLexeme(infoPtr); /* skip over , */
1466		if (code != TCL_OK) {
1467		    return code;
1468		}
1469	    } else if (infoPtr->lexeme != CLOSE_PAREN) {
1470		LogSyntaxError(infoPtr,
1471			"missing close parenthesis at end of function call");
1472		return TCL_ERROR;
1473	    }
1474	}
1475
1476	exprTokenPtr = &parsePtr->tokenPtr[exprIndex];
1477	exprTokenPtr->size = (infoPtr->next - exprTokenPtr->start);
1478	exprTokenPtr->numComponents = parsePtr->numTokens - firstIndex;
1479	break;
1480    }
1481
1482    case COMMA:
1483	LogSyntaxError(infoPtr,
1484		"commas can only separate function arguments");
1485	return TCL_ERROR;
1486    case END:
1487	LogSyntaxError(infoPtr, "premature end of expression");
1488	return TCL_ERROR;
1489    case UNKNOWN:
1490	LogSyntaxError(infoPtr, "single equality character not legal in expressions");
1491	return TCL_ERROR;
1492    case UNKNOWN_CHAR:
1493	LogSyntaxError(infoPtr, "character not legal in expressions");
1494	return TCL_ERROR;
1495    case QUESTY:
1496	LogSyntaxError(infoPtr, "unexpected ternary 'then' separator");
1497	return TCL_ERROR;
1498    case COLON:
1499	LogSyntaxError(infoPtr, "unexpected ternary 'else' separator");
1500	return TCL_ERROR;
1501    case CLOSE_PAREN:
1502	LogSyntaxError(infoPtr, "unexpected close parenthesis");
1503	return TCL_ERROR;
1504
1505    default: {
1506	char buf[64];
1507
1508	sprintf(buf, "unexpected operator %s", lexemeStrings[lexeme]);
1509	LogSyntaxError(infoPtr, buf);
1510	return TCL_ERROR;
1511	}
1512    }
1513
1514    /*
1515     * Advance to the next lexeme before returning.
1516     */
1517
1518    code = GetLexeme(infoPtr);
1519    if (code != TCL_OK) {
1520	return code;
1521    }
1522    parsePtr->term = infoPtr->next;
1523    return TCL_OK;
1524}
1525
1526/*
1527 *----------------------------------------------------------------------
1528 *
1529 * GetLexeme --
1530 *
1531 *	Lexical scanner for Tcl expressions: scans a single operator or
1532 *	other syntactic element from an expression string.
1533 *
1534 * Results:
1535 *	TCL_OK is returned unless an error occurred. In that case a standard
1536 *	Tcl error code is returned and, if infoPtr->parsePtr->interp is
1537 *	non-NULL, the interpreter's result is set to hold an error
1538 *	message. TCL_ERROR is returned if an integer overflow, or a
1539 *	floating-point overflow or underflow occurred while reading in a
1540 *	number. If the lexical analysis is successful, infoPtr->lexeme
1541 *	refers to the next symbol in the expression string, and
1542 *	infoPtr->next is advanced past the lexeme. Also, if the lexeme is a
1543 *	LITERAL or FUNC_NAME, then infoPtr->start is set to the first
1544 *	character of the lexeme; otherwise it is set NULL.
1545 *
1546 * Side effects:
1547 *	If there is insufficient space in parsePtr to hold all the
1548 *	information about the subexpression, then additional space is
1549 *	malloc-ed..
1550 *
1551 *----------------------------------------------------------------------
1552 */
1553
1554static int
1555GetLexeme(infoPtr)
1556    ParseInfo *infoPtr;		/* Holds state needed to parse the expr,
1557				 * including the resulting lexeme. */
1558{
1559    register CONST char *src;	/* Points to current source char. */
1560    char c;
1561    int offset, length, numBytes;
1562    Tcl_Parse *parsePtr = infoPtr->parsePtr;
1563    Tcl_Interp *interp = parsePtr->interp;
1564    Tcl_UniChar ch;
1565
1566    /*
1567     * Record where the previous lexeme ended. Since we always read one
1568     * lexeme ahead during parsing, this helps us know the source length of
1569     * subexpression tokens.
1570     */
1571
1572    infoPtr->prevEnd = infoPtr->next;
1573
1574    /*
1575     * Scan over leading white space at the start of a lexeme.
1576     */
1577
1578    src = infoPtr->next;
1579    numBytes = parsePtr->end - src;
1580    do {
1581	char type;
1582	int scanned = TclParseWhiteSpace(src, numBytes, parsePtr, &type);
1583	src += scanned; numBytes -= scanned;
1584    } while  (numBytes && (*src == '\n') && (src++,numBytes--));
1585    parsePtr->term = src;
1586    if (numBytes == 0) {
1587	infoPtr->lexeme = END;
1588	infoPtr->next = src;
1589	return TCL_OK;
1590    }
1591
1592    /*
1593     * Try to parse the lexeme first as an integer or floating-point
1594     * number. Don't check for a number if the first character c is
1595     * "+" or "-". If we did, we might treat a binary operator as unary
1596     * by mistake, which would eventually cause a syntax error.
1597     */
1598
1599    c = *src;
1600    if ((c != '+') && (c != '-')) {
1601	CONST char *end = infoPtr->lastChar;
1602	if ((length = TclParseInteger(src, (end - src)))) {
1603	    /*
1604	     * First length bytes look like an integer.  Verify by
1605	     * attempting the conversion to the largest integer we have.
1606	     */
1607	    int code;
1608	    Tcl_WideInt wide;
1609	    Tcl_Obj *value = Tcl_NewStringObj(src, length);
1610
1611	    Tcl_IncrRefCount(value);
1612	    code = Tcl_GetWideIntFromObj(interp, value, &wide);
1613	    Tcl_DecrRefCount(value);
1614	    if (code == TCL_ERROR) {
1615		parsePtr->errorType = TCL_PARSE_BAD_NUMBER;
1616		return TCL_ERROR;
1617	    }
1618            infoPtr->lexeme = LITERAL;
1619	    infoPtr->start = src;
1620	    infoPtr->size = length;
1621            infoPtr->next = (src + length);
1622	    parsePtr->term = infoPtr->next;
1623            return TCL_OK;
1624	} else if ((length = ParseMaxDoubleLength(src, end))) {
1625	    /*
1626	     * There are length characters that could be a double.
1627	     * Let strtod() tells us for sure.  Need a writable copy
1628	     * so we can set an terminating NULL to keep strtod from
1629	     * scanning too far.
1630	     */
1631	    char *startPtr, *termPtr;
1632	    double doubleValue;
1633	    Tcl_DString toParse;
1634
1635	    errno = 0;
1636	    Tcl_DStringInit(&toParse);
1637	    startPtr = Tcl_DStringAppend(&toParse, src, length);
1638	    doubleValue = strtod(startPtr, &termPtr);
1639	    Tcl_DStringFree(&toParse);
1640	    if (termPtr != startPtr) {
1641		if (errno != 0) {
1642		    if (interp != NULL) {
1643			TclExprFloatError(interp, doubleValue);
1644		    }
1645		    parsePtr->errorType = TCL_PARSE_BAD_NUMBER;
1646		    return TCL_ERROR;
1647		}
1648
1649		/*
1650                 * startPtr was the start of a valid double, copied
1651		 * from src.
1652                 */
1653
1654		infoPtr->lexeme = LITERAL;
1655		infoPtr->start = src;
1656		if ((termPtr - startPtr) > length) {
1657		    infoPtr->size = length;
1658		} else {
1659		    infoPtr->size = (termPtr - startPtr);
1660		}
1661		infoPtr->next = src + infoPtr->size;
1662		parsePtr->term = infoPtr->next;
1663		return TCL_OK;
1664	    }
1665	}
1666    }
1667
1668    /*
1669     * Not an integer or double literal. Initialize the lexeme's fields
1670     * assuming the common case of a single character lexeme.
1671     */
1672
1673    infoPtr->start = src;
1674    infoPtr->size = 1;
1675    infoPtr->next = src+1;
1676    parsePtr->term = infoPtr->next;
1677
1678    switch (*src) {
1679	case '[':
1680	    infoPtr->lexeme = OPEN_BRACKET;
1681	    return TCL_OK;
1682
1683        case '{':
1684	    infoPtr->lexeme = OPEN_BRACE;
1685	    return TCL_OK;
1686
1687	case '(':
1688	    infoPtr->lexeme = OPEN_PAREN;
1689	    return TCL_OK;
1690
1691	case ')':
1692	    infoPtr->lexeme = CLOSE_PAREN;
1693	    return TCL_OK;
1694
1695	case '$':
1696	    infoPtr->lexeme = DOLLAR;
1697	    return TCL_OK;
1698
1699	case '\"':
1700	    infoPtr->lexeme = QUOTE;
1701	    return TCL_OK;
1702
1703	case ',':
1704	    infoPtr->lexeme = COMMA;
1705	    return TCL_OK;
1706
1707	case '*':
1708	    infoPtr->lexeme = MULT;
1709	    return TCL_OK;
1710
1711	case '/':
1712	    infoPtr->lexeme = DIVIDE;
1713	    return TCL_OK;
1714
1715	case '%':
1716	    infoPtr->lexeme = MOD;
1717	    return TCL_OK;
1718
1719	case '+':
1720	    infoPtr->lexeme = PLUS;
1721	    return TCL_OK;
1722
1723	case '-':
1724	    infoPtr->lexeme = MINUS;
1725	    return TCL_OK;
1726
1727	case '?':
1728	    infoPtr->lexeme = QUESTY;
1729	    return TCL_OK;
1730
1731	case ':':
1732	    infoPtr->lexeme = COLON;
1733	    return TCL_OK;
1734
1735	case '<':
1736	    infoPtr->lexeme = LESS;
1737	    if ((infoPtr->lastChar - src) > 1) {
1738		switch (src[1]) {
1739		    case '<':
1740			infoPtr->lexeme = LEFT_SHIFT;
1741			infoPtr->size = 2;
1742			infoPtr->next = src+2;
1743			break;
1744		    case '=':
1745			infoPtr->lexeme = LEQ;
1746			infoPtr->size = 2;
1747			infoPtr->next = src+2;
1748			break;
1749		}
1750	    }
1751	    parsePtr->term = infoPtr->next;
1752	    return TCL_OK;
1753
1754	case '>':
1755	    infoPtr->lexeme = GREATER;
1756	    if ((infoPtr->lastChar - src) > 1) {
1757		switch (src[1]) {
1758		    case '>':
1759			infoPtr->lexeme = RIGHT_SHIFT;
1760			infoPtr->size = 2;
1761			infoPtr->next = src+2;
1762			break;
1763		    case '=':
1764			infoPtr->lexeme = GEQ;
1765			infoPtr->size = 2;
1766			infoPtr->next = src+2;
1767			break;
1768		}
1769	    }
1770	    parsePtr->term = infoPtr->next;
1771	    return TCL_OK;
1772
1773	case '=':
1774	    infoPtr->lexeme = UNKNOWN;
1775	    if ((src[1] == '=') && ((infoPtr->lastChar - src) > 1)) {
1776		infoPtr->lexeme = EQUAL;
1777		infoPtr->size = 2;
1778		infoPtr->next = src+2;
1779	    }
1780	    parsePtr->term = infoPtr->next;
1781	    return TCL_OK;
1782
1783	case '!':
1784	    infoPtr->lexeme = NOT;
1785	    if ((src[1] == '=') && ((infoPtr->lastChar - src) > 1)) {
1786		infoPtr->lexeme = NEQ;
1787		infoPtr->size = 2;
1788		infoPtr->next = src+2;
1789	    }
1790	    parsePtr->term = infoPtr->next;
1791	    return TCL_OK;
1792
1793	case '&':
1794	    infoPtr->lexeme = BIT_AND;
1795	    if ((src[1] == '&') && ((infoPtr->lastChar - src) > 1)) {
1796		infoPtr->lexeme = AND;
1797		infoPtr->size = 2;
1798		infoPtr->next = src+2;
1799	    }
1800	    parsePtr->term = infoPtr->next;
1801	    return TCL_OK;
1802
1803	case '^':
1804	    infoPtr->lexeme = BIT_XOR;
1805	    return TCL_OK;
1806
1807	case '|':
1808	    infoPtr->lexeme = BIT_OR;
1809	    if ((src[1] == '|') && ((infoPtr->lastChar - src) > 1)) {
1810		infoPtr->lexeme = OR;
1811		infoPtr->size = 2;
1812		infoPtr->next = src+2;
1813	    }
1814	    parsePtr->term = infoPtr->next;
1815	    return TCL_OK;
1816
1817	case '~':
1818	    infoPtr->lexeme = BIT_NOT;
1819	    return TCL_OK;
1820
1821	case 'e':
1822	    if ((src[1] == 'q') && ((infoPtr->lastChar - src) > 1)) {
1823		infoPtr->lexeme = STREQ;
1824		infoPtr->size = 2;
1825		infoPtr->next = src+2;
1826		parsePtr->term = infoPtr->next;
1827		return TCL_OK;
1828	    } else {
1829		goto checkFuncName;
1830	    }
1831
1832	case 'n':
1833	    if ((src[1] == 'e') && ((infoPtr->lastChar - src) > 1)) {
1834		infoPtr->lexeme = STRNEQ;
1835		infoPtr->size = 2;
1836		infoPtr->next = src+2;
1837		parsePtr->term = infoPtr->next;
1838		return TCL_OK;
1839	    } else {
1840		goto checkFuncName;
1841	    }
1842
1843	default:
1844	checkFuncName:
1845	    length = (infoPtr->lastChar - src);
1846	    if (Tcl_UtfCharComplete(src, length)) {
1847		offset = Tcl_UtfToUniChar(src, &ch);
1848	    } else {
1849		char utfBytes[TCL_UTF_MAX];
1850		memcpy(utfBytes, src, (size_t) length);
1851		utfBytes[length] = '\0';
1852		offset = Tcl_UtfToUniChar(utfBytes, &ch);
1853	    }
1854	    c = UCHAR(ch);
1855	    if (isalpha(UCHAR(c))) {	/* INTL: ISO only. */
1856		infoPtr->lexeme = FUNC_NAME;
1857		while (isalnum(UCHAR(c)) || (c == '_')) { /* INTL: ISO only. */
1858		    src += offset; length -= offset;
1859		    if (Tcl_UtfCharComplete(src, length)) {
1860			offset = Tcl_UtfToUniChar(src, &ch);
1861		    } else {
1862			char utfBytes[TCL_UTF_MAX];
1863			memcpy(utfBytes, src, (size_t) length);
1864			utfBytes[length] = '\0';
1865			offset = Tcl_UtfToUniChar(utfBytes, &ch);
1866		    }
1867		    c = UCHAR(ch);
1868		}
1869		infoPtr->size = (src - infoPtr->start);
1870		infoPtr->next = src;
1871		parsePtr->term = infoPtr->next;
1872		return TCL_OK;
1873	    }
1874	    infoPtr->lexeme = UNKNOWN_CHAR;
1875	    return TCL_OK;
1876    }
1877}
1878
1879/*
1880 *----------------------------------------------------------------------
1881 *
1882 * TclParseInteger --
1883 *
1884 *	Scans up to numBytes bytes starting at src, and checks whether
1885 *	the leading bytes look like an integer's string representation.
1886 *
1887 * Results:
1888 *	Returns 0 if the leading bytes do not look like an integer.
1889 *	Otherwise, returns the number of bytes examined that look
1890 *	like an integer.  This may be less than numBytes if the integer
1891 *	is only the leading part of the string.
1892 *
1893 * Side effects:
1894 *	None.
1895 *
1896 *----------------------------------------------------------------------
1897 */
1898
1899int
1900TclParseInteger(string, numBytes)
1901    register CONST char *string;/* The string to examine. */
1902    register int numBytes;	/* Max number of bytes to scan. */
1903{
1904    register CONST char *p = string;
1905
1906    /* Take care of introductory "0x" */
1907    if ((numBytes > 1) && (p[0] == '0') && ((p[1] == 'x') || (p[1] == 'X'))) {
1908	int scanned;
1909	Tcl_UniChar ch;
1910	p+=2; numBytes -= 2;
1911 	scanned = TclParseHex(p, numBytes, &ch);
1912	if (scanned) {
1913	    return scanned + 2;
1914	}
1915
1916	/* Recognize the 0 as valid integer, but x is left behind */
1917	return 1;
1918    }
1919    while (numBytes && isdigit(UCHAR(*p))) {	/* INTL: digit */
1920	numBytes--; p++;
1921    }
1922    if (numBytes == 0) {
1923        return (p - string);
1924    }
1925    if ((*p != '.') && (*p != 'e') && (*p != 'E')) {
1926        return (p - string);
1927    }
1928    return 0;
1929}
1930
1931/*
1932 *----------------------------------------------------------------------
1933 *
1934 * ParseMaxDoubleLength --
1935 *
1936 *      Scans a sequence of bytes checking that the characters could
1937 *	be in a string rep of a double.
1938 *
1939 * Results:
1940 *	Returns the number of bytes starting with string, runing to, but
1941 *	not including end, all of which could be part of a string rep.
1942 *	of a double.  Only character identity is used, no actual
1943 *	parsing is done.
1944 *
1945 *	The legal bytes are '0' - '9', 'A' - 'F', 'a' - 'f',
1946 *	'.', '+', '-', 'i', 'I', 'n', 'N', 'p', 'P', 'x',  and 'X'.
1947 *	This covers the values "Inf" and "Nan" as well as the
1948 *	decimal and hexadecimal representations recognized by a
1949 *	C99-compliant strtod().
1950 *
1951 * Side effects:
1952 *	None.
1953 *
1954 *----------------------------------------------------------------------
1955 */
1956
1957static int
1958ParseMaxDoubleLength(string, end)
1959    register CONST char *string;/* The string to examine. */
1960    CONST char *end;		/* Point to the first character past the end
1961				 * of the string we are examining. */
1962{
1963    CONST char *p = string;
1964    while (p < end) {
1965	switch (*p) {
1966	    case '0': case '1': case '2': case '3': case '4': case '5':
1967	    case '6': case '7': case '8': case '9': case 'A': case 'B':
1968	    case 'C': case 'D': case 'E': case 'F': case 'I': case 'N':
1969	    case 'P': case 'X': case 'a': case 'b': case 'c': case 'd':
1970	    case 'e': case 'f': case 'i': case 'n': case 'p': case 'x':
1971	    case '.': case '+': case '-':
1972		p++;
1973		break;
1974	    default:
1975		goto done;
1976	}
1977    }
1978    done:
1979    return (p - string);
1980}
1981
1982/*
1983 *----------------------------------------------------------------------
1984 *
1985 * PrependSubExprTokens --
1986 *
1987 *	This procedure is called after the operands of an subexpression have
1988 *	been parsed. It generates two tokens: a TCL_TOKEN_SUB_EXPR token for
1989 *	the subexpression, and a TCL_TOKEN_OPERATOR token for its operator.
1990 *	These two tokens are inserted before the operand tokens.
1991 *
1992 * Results:
1993 *	None.
1994 *
1995 * Side effects:
1996 *	If there is insufficient space in parsePtr to hold the new tokens,
1997 *	additional space is malloc-ed.
1998 *
1999 *----------------------------------------------------------------------
2000 */
2001
2002static void
2003PrependSubExprTokens(op, opBytes, src, srcBytes, firstIndex, infoPtr)
2004    CONST char *op;		/* Points to first byte of the operator
2005				 * in the source script. */
2006    int opBytes;		/* Number of bytes in the operator. */
2007    CONST char *src;		/* Points to first byte of the subexpression
2008				 * in the source script. */
2009    int srcBytes;		/* Number of bytes in subexpression's
2010				 * source. */
2011    int firstIndex;		/* Index of first token already emitted for
2012				 * operator's first (or only) operand. */
2013    ParseInfo *infoPtr;		/* Holds the parse state for the
2014				 * expression being parsed. */
2015{
2016    Tcl_Parse *parsePtr = infoPtr->parsePtr;
2017    Tcl_Token *tokenPtr, *firstTokenPtr;
2018    int numToMove;
2019
2020    if ((parsePtr->numTokens + 1) >= parsePtr->tokensAvailable) {
2021	TclExpandTokenArray(parsePtr);
2022    }
2023    firstTokenPtr = &parsePtr->tokenPtr[firstIndex];
2024    tokenPtr = (firstTokenPtr + 2);
2025    numToMove = (parsePtr->numTokens - firstIndex);
2026    memmove((VOID *) tokenPtr, (VOID *) firstTokenPtr,
2027            (size_t) (numToMove * sizeof(Tcl_Token)));
2028    parsePtr->numTokens += 2;
2029
2030    tokenPtr = firstTokenPtr;
2031    tokenPtr->type = TCL_TOKEN_SUB_EXPR;
2032    tokenPtr->start = src;
2033    tokenPtr->size = srcBytes;
2034    tokenPtr->numComponents = parsePtr->numTokens - (firstIndex + 1);
2035
2036    tokenPtr++;
2037    tokenPtr->type = TCL_TOKEN_OPERATOR;
2038    tokenPtr->start = op;
2039    tokenPtr->size = opBytes;
2040    tokenPtr->numComponents = 0;
2041}
2042
2043/*
2044 *----------------------------------------------------------------------
2045 *
2046 * LogSyntaxError --
2047 *
2048 *	This procedure is invoked after an error occurs when parsing an
2049 *	expression. It sets the interpreter result to an error message
2050 *	describing the error.
2051 *
2052 * Results:
2053 *	None.
2054 *
2055 * Side effects:
2056 *	Sets the interpreter result to an error message describing the
2057 *	expression that was being parsed when the error occurred, and why
2058 *	the parser considers that to be a syntax error at all.
2059 *
2060 *----------------------------------------------------------------------
2061 */
2062
2063static void
2064LogSyntaxError(infoPtr, extraInfo)
2065    ParseInfo *infoPtr;		/* Holds the parse state for the
2066				 * expression being parsed. */
2067    CONST char *extraInfo;	/* String to provide extra information
2068				 * about the syntax error. */
2069{
2070    int numBytes = (infoPtr->lastChar - infoPtr->originalExpr);
2071    char buffer[100];
2072
2073    if (numBytes > 60) {
2074	sprintf(buffer, "syntax error in expression \"%.60s...\"",
2075		infoPtr->originalExpr);
2076    } else {
2077	sprintf(buffer, "syntax error in expression \"%.*s\"",
2078		numBytes, infoPtr->originalExpr);
2079    }
2080    Tcl_ResetResult(infoPtr->parsePtr->interp);
2081    Tcl_AppendStringsToObj(Tcl_GetObjResult(infoPtr->parsePtr->interp),
2082	    buffer, ": ", extraInfo, (char *) NULL);
2083    infoPtr->parsePtr->errorType = TCL_PARSE_SYNTAX;
2084    infoPtr->parsePtr->term = infoPtr->start;
2085}
2086