/* 

  * tclParseExpr.c --

  *

  *	This file contains procedures that parse Tcl expressions. They

  *	do so in a general-purpose fashion that can be used for many

  *	different purposes, including compilation, direct execution,

  *	code analysis, etc.

  *

  * Copyright (c) 1997 Sun Microsystems, Inc.

  * Copyright (c) 1998-2000 by Scriptics Corporation.

  * Portions Copyright (c) 2007-2008 Nokia Corporation and/or its subsidiaries. All rights reserved.  

  * Contributions from Don Porter, NIST, 2002.  (not subject to US copyright)

  *

  * See the file "license.terms" for information on usage and redistribution

  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.

  *

  * RCS: @(#) $Id: tclParseExpr.c,v 1.17.2.2 2005/05/20 17:19:10 vasiljevic Exp $

  */

 #include "tclInt.h"

 /*

  * The stuff below is a bit of a hack so that this file can be used in

  * environments that include no UNIX, i.e. no errno: just arrange to use

  * the errno from tclExecute.c here.

  */

 #ifndef TCL_GENERIC_ONLY

 #include "tclPort.h"

 #else

 #define NO_ERRNO_H

 #endif

 #ifdef NO_ERRNO_H

 extern int errno;			/* Use errno from tclExecute.c. */

 #define ERANGE 34

 #endif

 /*

  * Boolean variable that controls whether expression parse tracing

  * is enabled.

  */

 #ifdef TCL_COMPILE_DEBUG

 static int traceParseExpr = 0;

 #endif /* TCL_COMPILE_DEBUG */

 /*

  * The ParseInfo structure holds state while parsing an expression.

  * A pointer to an ParseInfo record is passed among the routines in

  * this module.

  */

 typedef struct ParseInfo {

     Tcl_Parse *parsePtr;	/* Points to structure to fill in with

 				 * information about the expression. */

     int lexeme;			/* Type of last lexeme scanned in expr.

 				 * See below for definitions. Corresponds to

 				 * size characters beginning at start. */

     CONST char *start;		/* First character in lexeme. */

     int size;			/* Number of bytes in lexeme. */

     CONST char *next;		/* Position of the next character to be

 				 * scanned in the expression string. */

     CONST char *prevEnd;	/* Points to the character just after the

 				 * last one in the previous lexeme. Used to

 				 * compute size of subexpression tokens. */

     CONST char *originalExpr;	/* Points to the start of the expression

 				 * originally passed to Tcl_ParseExpr. */

     CONST char *lastChar;	/* Points just after last byte of expr. */

 } ParseInfo;

 /*

  * Definitions of the different lexemes that appear in expressions. The

  * order of these must match the corresponding entries in the

  * operatorStrings array below.

  *

  * Basic lexemes:

  */

 #define LITERAL		0

 #define FUNC_NAME	1

 #define OPEN_BRACKET	2

 #define OPEN_BRACE	3

 #define OPEN_PAREN	4

 #define CLOSE_PAREN	5

 #define DOLLAR		6

 #define QUOTE		7

 #define COMMA		8

 #define END		9

 #define UNKNOWN		10

 #define UNKNOWN_CHAR	11

 /*

  * Binary numeric operators:

  */

 #define MULT		12

 #define DIVIDE		13

 #define MOD		14

 #define PLUS		15

 #define MINUS		16

 #define LEFT_SHIFT	17

 #define RIGHT_SHIFT	18

 #define LESS		19

 #define GREATER		20

 #define LEQ		21

 #define GEQ		22

 #define EQUAL		23

 #define NEQ		24

 #define BIT_AND		25

 #define BIT_XOR		26

 #define BIT_OR		27

 #define AND		28

 #define OR		29

 #define QUESTY		30

 #define COLON		31

 /*

  * Unary operators. Unary minus and plus are represented by the (binary)

  * lexemes MINUS and PLUS.

  */

 #define NOT		32

 #define BIT_NOT		33

 /*

  * Binary string operators:

  */

 #define STREQ		34

 #define STRNEQ		35

 /*

  * Mapping from lexemes to strings; used for debugging messages. These

  * entries must match the order and number of the lexeme definitions above.

  */

 static char *lexemeStrings[] = {

     "LITERAL", "FUNCNAME",

     "[", "{", "(", ")", "$", "\"", ",", "END", "UNKNOWN", "UNKNOWN_CHAR",

     "*", "/", "%", "+", "-",

     "<<", ">>", "<", ">", "<=", ">=", "==", "!=",

     "&", "^", "|", "&&", "||", "?", ":",

     "!", "~", "eq", "ne",

 };

 /*

  * Declarations for local procedures to this file:

  */

 static int		GetLexeme _ANSI_ARGS_((ParseInfo *infoPtr));

 static void		LogSyntaxError _ANSI_ARGS_((ParseInfo *infoPtr,

 				CONST char *extraInfo));

 static int		ParseAddExpr _ANSI_ARGS_((ParseInfo *infoPtr));

 static int		ParseBitAndExpr _ANSI_ARGS_((ParseInfo *infoPtr));

 static int		ParseBitOrExpr _ANSI_ARGS_((ParseInfo *infoPtr));

 static int		ParseBitXorExpr _ANSI_ARGS_((ParseInfo *infoPtr));

 static int		ParseCondExpr _ANSI_ARGS_((ParseInfo *infoPtr));

 static int		ParseEqualityExpr _ANSI_ARGS_((ParseInfo *infoPtr));

 static int		ParseLandExpr _ANSI_ARGS_((ParseInfo *infoPtr));

 static int		ParseLorExpr _ANSI_ARGS_((ParseInfo *infoPtr));

 static int		ParseMaxDoubleLength _ANSI_ARGS_((CONST char *string,

 				CONST char *end));

 static int		ParseMultiplyExpr _ANSI_ARGS_((ParseInfo *infoPtr));

 static int		ParsePrimaryExpr _ANSI_ARGS_((ParseInfo *infoPtr));

 static int		ParseRelationalExpr _ANSI_ARGS_((ParseInfo *infoPtr));

 static int		ParseShiftExpr _ANSI_ARGS_((ParseInfo *infoPtr));

 static int		ParseUnaryExpr _ANSI_ARGS_((ParseInfo *infoPtr));

 static void		PrependSubExprTokens _ANSI_ARGS_((CONST char *op,

 				int opBytes, CONST char *src, int srcBytes,

 				int firstIndex, ParseInfo *infoPtr));

 /*

  * Macro used to debug the execution of the recursive descent parser used

  * to parse expressions.

  */

 #ifdef TCL_COMPILE_DEBUG

 #define HERE(production, level) \

     if (traceParseExpr) { \

 	fprintf(stderr, "%*s%s: lexeme=%s, next=\"%.20s\"\n", \

 		(level), " ", (production), \

 		lexemeStrings[infoPtr->lexeme], infoPtr->next); \

     }

 #else

 #define HERE(production, level)

 #endif /* TCL_COMPILE_DEBUG */

 /*

  *----------------------------------------------------------------------

  *

  * Tcl_ParseExpr --

  *

  *	Given a string, this procedure parses the first Tcl expression

  *	in the string and returns information about the structure of

  *	the expression. This procedure is the top-level interface to the

  *	the expression parsing module.  No more that numBytes bytes will

  *	be scanned.

  *

  * Results:

  *	The return value is TCL_OK if the command was parsed successfully

  *	and TCL_ERROR otherwise. If an error occurs and interp isn't NULL

  *	then an error message is left in its result. On a successful return,

  *	parsePtr is filled in with information about the expression that 

  *	was parsed.

  *

  * Side effects:

  *	If there is insufficient space in parsePtr to hold all the

  *	information about the expression, then additional space is

  *	malloc-ed. If the procedure returns TCL_OK then the caller must

  *	eventually invoke Tcl_FreeParse to release any additional space

  *	that was allocated.

  *

  *----------------------------------------------------------------------

  */

 EXPORT_C int

 Tcl_ParseExpr(interp, string, numBytes, parsePtr)

     Tcl_Interp *interp;		/* Used for error reporting. */

     CONST char *string;		/* The source string to parse. */

     int numBytes;		/* Number of bytes in string. If < 0, the

 				 * string consists of all bytes up to the

 				 * first null character. */

     Tcl_Parse *parsePtr;	/* Structure to fill with information about

 				 * the parsed expression; any previous

 				 * information in the structure is

 				 * ignored. */

 {

     ParseInfo info;

     int code;

     if (numBytes < 0) {

 	numBytes = (string? strlen(string) : 0);

     }

 #ifdef TCL_COMPILE_DEBUG

     if (traceParseExpr) {

 	fprintf(stderr, "Tcl_ParseExpr: string=\"%.*s\"\n",

 	        numBytes, string);

     }

 #endif /* TCL_COMPILE_DEBUG */

     parsePtr->commentStart = NULL;

     parsePtr->commentSize = 0;

     parsePtr->commandStart = NULL;

     parsePtr->commandSize = 0;

     parsePtr->numWords = 0;

     parsePtr->tokenPtr = parsePtr->staticTokens;

     parsePtr->numTokens = 0;

     parsePtr->tokensAvailable = NUM_STATIC_TOKENS;

     parsePtr->string = string;

     parsePtr->end = (string + numBytes);

     parsePtr->interp = interp;

     parsePtr->term = string;

     parsePtr->incomplete = 0;

     /*

      * Initialize the ParseInfo structure that holds state while parsing

      * the expression.

      */

     info.parsePtr = parsePtr;

     info.lexeme = UNKNOWN;

     info.start = NULL;

     info.size = 0;

     info.next = string;

     info.prevEnd = string;

     info.originalExpr = string;

     info.lastChar = (string + numBytes); /* just after last char of expr */

     /*

      * Get the first lexeme then parse the expression.

      */

     code = GetLexeme(&info);

     if (code != TCL_OK) {

 	goto error;

     }

     code = ParseCondExpr(&info);

     if (code != TCL_OK) {

 	goto error;

     }

     if (info.lexeme != END) {

 	LogSyntaxError(&info, "extra tokens at end of expression");

 	goto error;

     }

     return TCL_OK;

     error:

     if (parsePtr->tokenPtr != parsePtr->staticTokens) {

 	ckfree((char *) parsePtr->tokenPtr);

     }

     return TCL_ERROR;

 }

 /*

  *----------------------------------------------------------------------

  *

  * ParseCondExpr --

  *

  *	This procedure parses a Tcl conditional expression:

  *	condExpr ::= lorExpr ['?' condExpr ':' condExpr]

  *

  *	Note that this is the topmost recursive-descent parsing routine used

  *	by Tcl_ParseExpr to parse expressions. This avoids an extra procedure

  *	call since such a procedure would only return the result of calling

  *	ParseCondExpr. Other recursive-descent procedures that need to parse

  *	complete expressions also call ParseCondExpr.

  *

  * Results:

  *	The return value is TCL_OK on a successful parse and TCL_ERROR

  *	on failure. If TCL_ERROR is returned, then the interpreter's result

  *	contains an error message.

  *

  * Side effects:

  *	If there is insufficient space in parsePtr to hold all the

  *	information about the subexpression, then additional space is

  *	malloc-ed.

  *

  *----------------------------------------------------------------------

  */

 static int

 ParseCondExpr(infoPtr)

     ParseInfo *infoPtr;		/* Holds the parse state for the

 				 * expression being parsed. */

 {

     Tcl_Parse *parsePtr = infoPtr->parsePtr;

     Tcl_Token *tokenPtr, *firstTokenPtr, *condTokenPtr;

     int firstIndex, numToMove, code;

     CONST char *srcStart;

     HERE("condExpr", 1);

     srcStart = infoPtr->start;

     firstIndex = parsePtr->numTokens;

     code = ParseLorExpr(infoPtr);

     if (code != TCL_OK) {

 	return code;

     }

     if (infoPtr->lexeme == QUESTY) {

 	/*

 	 * Emit two tokens: one TCL_TOKEN_SUB_EXPR token for the entire

 	 * conditional expression, and a TCL_TOKEN_OPERATOR token for 

 	 * the "?" operator. Note that these two tokens must be inserted

 	 * before the LOR operand tokens generated above.

 	 */

 	if ((parsePtr->numTokens + 1) >= parsePtr->tokensAvailable) {

 	    TclExpandTokenArray(parsePtr);

 	}

 	firstTokenPtr = &parsePtr->tokenPtr[firstIndex];

 	tokenPtr = (firstTokenPtr + 2);

 	numToMove = (parsePtr->numTokens - firstIndex);

 	memmove((VOID *) tokenPtr, (VOID *) firstTokenPtr,

 	        (size_t) (numToMove * sizeof(Tcl_Token)));

 	parsePtr->numTokens += 2;

 	tokenPtr = firstTokenPtr;

 	tokenPtr->type = TCL_TOKEN_SUB_EXPR;

 	tokenPtr->start = srcStart;

 	tokenPtr++;

 	tokenPtr->type = TCL_TOKEN_OPERATOR;

 	tokenPtr->start = infoPtr->start;

 	tokenPtr->size = 1;

 	tokenPtr->numComponents = 0;

 	/*

 	 * Skip over the '?'.

 	 */

 	code = GetLexeme(infoPtr); 

 	if (code != TCL_OK) {

 	    return code;

 	}

 	/*

 	 * Parse the "then" expression.

 	 */

 	code = ParseCondExpr(infoPtr);

 	if (code != TCL_OK) {

 	    return code;

 	}

 	if (infoPtr->lexeme != COLON) {

 	    LogSyntaxError(infoPtr, "missing colon from ternary conditional");

 	    return TCL_ERROR;

 	}

 	code = GetLexeme(infoPtr); /* skip over the ':' */

 	if (code != TCL_OK) {

 	    return code;

 	}

 	/*

 	 * Parse the "else" expression.

 	 */

 	code = ParseCondExpr(infoPtr);

 	if (code != TCL_OK) {

 	    return code;

 	}

 	/*

 	 * Now set the size-related fields in the '?' subexpression token.

 	 */

 	condTokenPtr = &parsePtr->tokenPtr[firstIndex];

 	condTokenPtr->size = (infoPtr->prevEnd - srcStart);

 	condTokenPtr->numComponents = parsePtr->numTokens - (firstIndex+1);

     }

     return TCL_OK;

 }

 /*

  *----------------------------------------------------------------------

  *

  * ParseLorExpr --

  *

  *	This procedure parses a Tcl logical or expression:

  *	lorExpr ::= landExpr {'||' landExpr}

  *

  * Results:

  *	The return value is TCL_OK on a successful parse and TCL_ERROR

  *	on failure. If TCL_ERROR is returned, then the interpreter's result

  *	contains an error message.

  *

  * Side effects:

  *	If there is insufficient space in parsePtr to hold all the

  *	information about the subexpression, then additional space is

  *	malloc-ed.

  *

  *----------------------------------------------------------------------

  */

 static int

 ParseLorExpr(infoPtr)

     ParseInfo *infoPtr;		/* Holds the parse state for the

 				 * expression being parsed. */

 {

     Tcl_Parse *parsePtr = infoPtr->parsePtr;

     int firstIndex, code;

     CONST char *srcStart, *operator;

     HERE("lorExpr", 2);

     srcStart = infoPtr->start;

     firstIndex = parsePtr->numTokens;

     code = ParseLandExpr(infoPtr);

     if (code != TCL_OK) {

 	return code;

     }

     while (infoPtr->lexeme == OR) {

 	operator = infoPtr->start;

 	code = GetLexeme(infoPtr); /* skip over the '||' */

 	if (code != TCL_OK) {

 	    return code;

 	}

 	code = ParseLandExpr(infoPtr);

 	if (code != TCL_OK) {

 	    return code;

 	}

 	/*

 	 * Generate tokens for the LOR subexpression and the '||' operator.

 	 */

 	PrependSubExprTokens(operator, 2, srcStart,

 	        (infoPtr->prevEnd - srcStart), firstIndex, infoPtr);

     }

     return TCL_OK;

 }

 /*

  *----------------------------------------------------------------------

  *

  * ParseLandExpr --

  *

  *	This procedure parses a Tcl logical and expression:

  *	landExpr ::= bitOrExpr {'&&' bitOrExpr}

  *

  * Results:

  *	The return value is TCL_OK on a successful parse and TCL_ERROR

  *	on failure. If TCL_ERROR is returned, then the interpreter's result

  *	contains an error message.

  *

  * Side effects:

  *	If there is insufficient space in parsePtr to hold all the

  *	information about the subexpression, then additional space is

  *	malloc-ed.

  *

  *----------------------------------------------------------------------

  */

 static int

 ParseLandExpr(infoPtr)

     ParseInfo *infoPtr;		/* Holds the parse state for the

 				 * expression being parsed. */

 {

     Tcl_Parse *parsePtr = infoPtr->parsePtr;

     int firstIndex, code;

     CONST char *srcStart, *operator;

     HERE("landExpr", 3);

     srcStart = infoPtr->start;

     firstIndex = parsePtr->numTokens;

     code = ParseBitOrExpr(infoPtr);

     if (code != TCL_OK) {

 	return code;

     }

     while (infoPtr->lexeme == AND) {

 	operator = infoPtr->start;

 	code = GetLexeme(infoPtr); /* skip over the '&&' */

 	if (code != TCL_OK) {

 	    return code;

 	}

 	code = ParseBitOrExpr(infoPtr);

 	if (code != TCL_OK) {

 	    return code;

 	}

 	/*

 	 * Generate tokens for the LAND subexpression and the '&&' operator.

 	 */

 	PrependSubExprTokens(operator, 2, srcStart,

 	        (infoPtr->prevEnd - srcStart), firstIndex, infoPtr);

     }

     return TCL_OK;

 }

 /*

  *----------------------------------------------------------------------

  *

  * ParseBitOrExpr --

  *

  *	This procedure parses a Tcl bitwise or expression:

  *	bitOrExpr ::= bitXorExpr {'|' bitXorExpr}

  *

  * Results:

  *	The return value is TCL_OK on a successful parse and TCL_ERROR

  *	on failure. If TCL_ERROR is returned, then the interpreter's result

  *	contains an error message.

  *

  * Side effects:

  *	If there is insufficient space in parsePtr to hold all the

  *	information about the subexpression, then additional space is

  *	malloc-ed.

  *

  *----------------------------------------------------------------------

  */

 static int

 ParseBitOrExpr(infoPtr)

     ParseInfo *infoPtr;		/* Holds the parse state for the

 				 * expression being parsed. */

 {

     Tcl_Parse *parsePtr = infoPtr->parsePtr;

     int firstIndex, code;

     CONST char *srcStart, *operator;

     HERE("bitOrExpr", 4);

     srcStart = infoPtr->start;

     firstIndex = parsePtr->numTokens;

     code = ParseBitXorExpr(infoPtr);

     if (code != TCL_OK) {

 	return code;

     }

     while (infoPtr->lexeme == BIT_OR) {

 	operator = infoPtr->start;

 	code = GetLexeme(infoPtr); /* skip over the '|' */

 	if (code != TCL_OK) {

 	    return code;

 	}

 	code = ParseBitXorExpr(infoPtr);

 	if (code != TCL_OK) {

 	    return code;

 	}

 	/*

 	 * Generate tokens for the BITOR subexpression and the '|' operator.

 	 */

 	PrependSubExprTokens(operator, 1, srcStart,

 	        (infoPtr->prevEnd - srcStart), firstIndex, infoPtr);

     }

     return TCL_OK;

 }

 /*

  *----------------------------------------------------------------------

  *

  * ParseBitXorExpr --

  *

  *	This procedure parses a Tcl bitwise exclusive or expression:

  *	bitXorExpr ::= bitAndExpr {'^' bitAndExpr}

  *

  * Results:

  *	The return value is TCL_OK on a successful parse and TCL_ERROR

  *	on failure. If TCL_ERROR is returned, then the interpreter's result

  *	contains an error message.

  *

  * Side effects:

  *	If there is insufficient space in parsePtr to hold all the

  *	information about the subexpression, then additional space is

  *	malloc-ed.

  *

  *----------------------------------------------------------------------

  */

 static int

 ParseBitXorExpr(infoPtr)

     ParseInfo *infoPtr;		/* Holds the parse state for the

 				 * expression being parsed. */

 {

     Tcl_Parse *parsePtr = infoPtr->parsePtr;

     int firstIndex, code;

     CONST char *srcStart, *operator;

     HERE("bitXorExpr", 5);

     srcStart = infoPtr->start;

     firstIndex = parsePtr->numTokens;

     code = ParseBitAndExpr(infoPtr);

     if (code != TCL_OK) {

 	return code;

     }

     while (infoPtr->lexeme == BIT_XOR) {

 	operator = infoPtr->start;

 	code = GetLexeme(infoPtr); /* skip over the '^' */

 	if (code != TCL_OK) {

 	    return code;

 	}

 	code = ParseBitAndExpr(infoPtr);

 	if (code != TCL_OK) {

 	    return code;

 	}

 	/*

 	 * Generate tokens for the XOR subexpression and the '^' operator.

 	 */

 	PrependSubExprTokens(operator, 1, srcStart,

 	        (infoPtr->prevEnd - srcStart), firstIndex, infoPtr);

     }

     return TCL_OK;

 }

 /*

  *----------------------------------------------------------------------

  *

  * ParseBitAndExpr --

  *

  *	This procedure parses a Tcl bitwise and expression:

  *	bitAndExpr ::= equalityExpr {'&' equalityExpr}

  *

  * Results:

  *	The return value is TCL_OK on a successful parse and TCL_ERROR

  *	on failure. If TCL_ERROR is returned, then the interpreter's result

  *	contains an error message.

  *

  * Side effects:

  *	If there is insufficient space in parsePtr to hold all the

  *	information about the subexpression, then additional space is

  *	malloc-ed.

  *

  *----------------------------------------------------------------------

  */

 static int

 ParseBitAndExpr(infoPtr)

     ParseInfo *infoPtr;		/* Holds the parse state for the

 				 * expression being parsed. */

 {

     Tcl_Parse *parsePtr = infoPtr->parsePtr;

     int firstIndex, code;

     CONST char *srcStart, *operator;

     HERE("bitAndExpr", 6);

     srcStart = infoPtr->start;

     firstIndex = parsePtr->numTokens;

     code = ParseEqualityExpr(infoPtr);

     if (code != TCL_OK) {

 	return code;

     }

     while (infoPtr->lexeme == BIT_AND) {

 	operator = infoPtr->start;

 	code = GetLexeme(infoPtr); /* skip over the '&' */

 	if (code != TCL_OK) {

 	    return code;

 	}

 	code = ParseEqualityExpr(infoPtr);

 	if (code != TCL_OK) {

 	    return code;

 	}

 	/*

 	 * Generate tokens for the BITAND subexpression and '&' operator.

 	 */

 	PrependSubExprTokens(operator, 1, srcStart,

 	        (infoPtr->prevEnd - srcStart), firstIndex, infoPtr);

     }

     return TCL_OK;

 }

 /*

  *----------------------------------------------------------------------

  *

  * ParseEqualityExpr --

  *

  *	This procedure parses a Tcl equality (inequality) expression:

  *	equalityExpr ::= relationalExpr

  *		{('==' | '!=' | 'ne' | 'eq') relationalExpr}

  *

  * Results:

  *	The return value is TCL_OK on a successful parse and TCL_ERROR

  *	on failure. If TCL_ERROR is returned, then the interpreter's result

  *	contains an error message.

  *

  * Side effects:

  *	If there is insufficient space in parsePtr to hold all the

  *	information about the subexpression, then additional space is

  *	malloc-ed.

  *

  *----------------------------------------------------------------------

  */

 static int

 ParseEqualityExpr(infoPtr)

     ParseInfo *infoPtr;		/* Holds the parse state for the

 				 * expression being parsed. */

 {

     Tcl_Parse *parsePtr = infoPtr->parsePtr;

     int firstIndex, lexeme, code;

     CONST char *srcStart, *operator;

     HERE("equalityExpr", 7);

     srcStart = infoPtr->start;

     firstIndex = parsePtr->numTokens;

     code = ParseRelationalExpr(infoPtr);

     if (code != TCL_OK) {

 	return code;

     }

     lexeme = infoPtr->lexeme;

     while ((lexeme == EQUAL) || (lexeme == NEQ)

 	    || (lexeme == STREQ) || (lexeme == STRNEQ)) {

 	operator = infoPtr->start;

 	code = GetLexeme(infoPtr); /* skip over ==, !=, 'eq' or 'ne'  */

 	if (code != TCL_OK) {

 	    return code;

 	}

 	code = ParseRelationalExpr(infoPtr);

 	if (code != TCL_OK) {

 	    return code;

 	}

 	/*

 	 * Generate tokens for the subexpression and '==', '!=', 'eq' or 'ne'

 	 * operator.

 	 */

 	PrependSubExprTokens(operator, 2, srcStart,

 	        (infoPtr->prevEnd - srcStart), firstIndex, infoPtr);

 	lexeme = infoPtr->lexeme;

     }

     return TCL_OK;

 }

 /*

  *----------------------------------------------------------------------

  *

  * ParseRelationalExpr --

  *

  *	This procedure parses a Tcl relational expression:

  *	relationalExpr ::= shiftExpr {('<' | '>' | '<=' | '>=') shiftExpr}

  *

  * Results:

  *	The return value is TCL_OK on a successful parse and TCL_ERROR

  *	on failure. If TCL_ERROR is returned, then the interpreter's result

  *	contains an error message.

  *

  * Side effects:

  *	If there is insufficient space in parsePtr to hold all the

  *	information about the subexpression, then additional space is

  *	malloc-ed.

  *

  *----------------------------------------------------------------------

  */

 static int

 ParseRelationalExpr(infoPtr)

     ParseInfo *infoPtr;		/* Holds the parse state for the

 				 * expression being parsed. */

 {

     Tcl_Parse *parsePtr = infoPtr->parsePtr;

     int firstIndex, lexeme, operatorSize, code;

     CONST char *srcStart, *operator;

     HERE("relationalExpr", 8);

     srcStart = infoPtr->start;

     firstIndex = parsePtr->numTokens;

     code = ParseShiftExpr(infoPtr);

     if (code != TCL_OK) {

 	return code;

     }

     lexeme = infoPtr->lexeme;

     while ((lexeme == LESS) || (lexeme == GREATER) || (lexeme == LEQ)

             || (lexeme == GEQ)) {

 	operator = infoPtr->start;

 	if ((lexeme == LEQ) || (lexeme == GEQ)) {

 	    operatorSize = 2;

 	} else {

 	    operatorSize = 1;

 	}

 	code = GetLexeme(infoPtr); /* skip over the operator */

 	if (code != TCL_OK) {

 	    return code;

 	}

 	code = ParseShiftExpr(infoPtr);

 	if (code != TCL_OK) {

 	    return code;

 	}

 	/*

 	 * Generate tokens for the subexpression and the operator.

 	 */

 	PrependSubExprTokens(operator, operatorSize, srcStart,

 	        (infoPtr->prevEnd - srcStart), firstIndex, infoPtr);

 	lexeme = infoPtr->lexeme;

     }

     return TCL_OK;

 }

 /*

  *----------------------------------------------------------------------

  *

  * ParseShiftExpr --

  *

  *	This procedure parses a Tcl shift expression:

  *	shiftExpr ::= addExpr {('<<' | '>>') addExpr}

  *

  * Results:

  *	The return value is TCL_OK on a successful parse and TCL_ERROR

  *	on failure. If TCL_ERROR is returned, then the interpreter's result

  *	contains an error message.

  *

  * Side effects:

  *	If there is insufficient space in parsePtr to hold all the

  *	information about the subexpression, then additional space is

  *	malloc-ed.

  *

  *----------------------------------------------------------------------

  */

 static int

 ParseShiftExpr(infoPtr)

     ParseInfo *infoPtr;		/* Holds the parse state for the

 				 * expression being parsed. */

 {

     Tcl_Parse *parsePtr = infoPtr->parsePtr;

     int firstIndex, lexeme, code;

     CONST char *srcStart, *operator;

     HERE("shiftExpr", 9);

     srcStart = infoPtr->start;

     firstIndex = parsePtr->numTokens;

     code = ParseAddExpr(infoPtr);

     if (code != TCL_OK) {

 	return code;

     }

     lexeme = infoPtr->lexeme;

     while ((lexeme == LEFT_SHIFT) || (lexeme == RIGHT_SHIFT)) {

 	operator = infoPtr->start;

 	code = GetLexeme(infoPtr); /* skip over << or >> */

 	if (code != TCL_OK) {

 	    return code;

 	}

 	code = ParseAddExpr(infoPtr);

 	if (code != TCL_OK) {

 	    return code;

 	}

 	/*

 	 * Generate tokens for the subexpression and '<<' or '>>' operator.

 	 */

 	PrependSubExprTokens(operator, 2, srcStart,

 	        (infoPtr->prevEnd - srcStart), firstIndex, infoPtr);

 	lexeme = infoPtr->lexeme;

     }

     return TCL_OK;

 }

 /*

  *----------------------------------------------------------------------

  *

  * ParseAddExpr --

  *

  *	This procedure parses a Tcl addition expression:

  *	addExpr ::= multiplyExpr {('+' | '-') multiplyExpr}

  *

  * Results:

  *	The return value is TCL_OK on a successful parse and TCL_ERROR

  *	on failure. If TCL_ERROR is returned, then the interpreter's result

  *	contains an error message.

  *

  * Side effects:

  *	If there is insufficient space in parsePtr to hold all the

  *	information about the subexpression, then additional space is

  *	malloc-ed.

  *

  *----------------------------------------------------------------------

  */

 static int

 ParseAddExpr(infoPtr)

     ParseInfo *infoPtr;		/* Holds the parse state for the

 				 * expression being parsed. */

 {

     Tcl_Parse *parsePtr = infoPtr->parsePtr;

     int firstIndex, lexeme, code;

     CONST char *srcStart, *operator;

     HERE("addExpr", 10);

     srcStart = infoPtr->start;

     firstIndex = parsePtr->numTokens;

     code = ParseMultiplyExpr(infoPtr);

     if (code != TCL_OK) {

 	return code;

     }

     lexeme = infoPtr->lexeme;

     while ((lexeme == PLUS) || (lexeme == MINUS)) {

 	operator = infoPtr->start;

 	code = GetLexeme(infoPtr); /* skip over + or - */

 	if (code != TCL_OK) {

 	    return code;

 	}

 	code = ParseMultiplyExpr(infoPtr);

 	if (code != TCL_OK) {

 	    return code;

 	}

 	/*

 	 * Generate tokens for the subexpression and '+' or '-' operator.

 	 */

 	PrependSubExprTokens(operator, 1, srcStart,

 	        (infoPtr->prevEnd - srcStart), firstIndex, infoPtr);

 	lexeme = infoPtr->lexeme;

     }

     return TCL_OK;

 }

 /*

  *----------------------------------------------------------------------

  *

  * ParseMultiplyExpr --

  *

  *	This procedure parses a Tcl multiply expression:

  *	multiplyExpr ::= unaryExpr {('*' | '/' | '%') unaryExpr}

  *

  * Results:

  *	The return value is TCL_OK on a successful parse and TCL_ERROR

  *	on failure. If TCL_ERROR is returned, then the interpreter's result

  *	contains an error message.

  *

  * Side effects:

  *	If there is insufficient space in parsePtr to hold all the

  *	information about the subexpression, then additional space is

  *	malloc-ed.

  *

  *----------------------------------------------------------------------

  */

 static int

 ParseMultiplyExpr(infoPtr)

     ParseInfo *infoPtr;		/* Holds the parse state for the

 				 * expression being parsed. */

 {

     Tcl_Parse *parsePtr = infoPtr->parsePtr;

     int firstIndex, lexeme, code;

     CONST char *srcStart, *operator;

     HERE("multiplyExpr", 11);

     srcStart = infoPtr->start;

     firstIndex = parsePtr->numTokens;

     code = ParseUnaryExpr(infoPtr);

     if (code != TCL_OK) {

 	return code;

     }

     lexeme = infoPtr->lexeme;

     while ((lexeme == MULT) || (lexeme == DIVIDE) || (lexeme == MOD)) {

 	operator = infoPtr->start;

 	code = GetLexeme(infoPtr); /* skip over * or / or % */

 	if (code != TCL_OK) {

 	    return code;

 	}

 	code = ParseUnaryExpr(infoPtr);

 	if (code != TCL_OK) {

 	    return code;

 	}

 	/*

 	 * Generate tokens for the subexpression and * or / or % operator.

 	 */

 	PrependSubExprTokens(operator, 1, srcStart,

 	        (infoPtr->prevEnd - srcStart), firstIndex, infoPtr);

 	lexeme = infoPtr->lexeme;

     }

     return TCL_OK;

 }

 /*

  *----------------------------------------------------------------------

  *

  * ParseUnaryExpr --

  *

  *	This procedure parses a Tcl unary expression:

  *	unaryExpr ::= ('+' | '-' | '~' | '!') unaryExpr | primaryExpr

  *

  * Results:

  *	The return value is TCL_OK on a successful parse and TCL_ERROR

  *	on failure. If TCL_ERROR is returned, then the interpreter's result

  *	contains an error message.

  *

  * Side effects:

  *	If there is insufficient space in parsePtr to hold all the

  *	information about the subexpression, then additional space is

  *	malloc-ed.

  *

  *----------------------------------------------------------------------

  */

 static int

 ParseUnaryExpr(infoPtr)

     ParseInfo *infoPtr;		/* Holds the parse state for the

 				 * expression being parsed. */

 {

     Tcl_Parse *parsePtr = infoPtr->parsePtr;

     int firstIndex, lexeme, code;

     CONST char *srcStart, *operator;

     HERE("unaryExpr", 12);

     srcStart = infoPtr->start;

     firstIndex = parsePtr->numTokens;

     lexeme = infoPtr->lexeme;

     if ((lexeme == PLUS) || (lexeme == MINUS) || (lexeme == BIT_NOT)

             || (lexeme == NOT)) {

 	operator = infoPtr->start;

 	code = GetLexeme(infoPtr); /* skip over the unary operator */

 	if (code != TCL_OK) {

 	    return code;

 	}

 	code = ParseUnaryExpr(infoPtr);

 	if (code != TCL_OK) {

 	    return code;

 	}

 	/*

 	 * Generate tokens for the subexpression and the operator.

 	 */

 	PrependSubExprTokens(operator, 1, srcStart,

 	        (infoPtr->prevEnd - srcStart), firstIndex, infoPtr);

     } else {			/* must be a primaryExpr */

 	code = ParsePrimaryExpr(infoPtr);

 	if (code != TCL_OK) {

 	    return code;

 	}

     }

     return TCL_OK;

 }

 /*

  *----------------------------------------------------------------------

  *

  * ParsePrimaryExpr --

  *

  *	This procedure parses a Tcl primary expression:

  *	primaryExpr ::= literal | varReference | quotedString |

  *			'[' command ']' | mathFuncCall | '(' condExpr ')'

  *

  * Results:

  *	The return value is TCL_OK on a successful parse and TCL_ERROR

  *	on failure. If TCL_ERROR is returned, then the interpreter's result

  *	contains an error message.

  *

  * Side effects:

  *	If there is insufficient space in parsePtr to hold all the

  *	information about the subexpression, then additional space is

  *	malloc-ed.

  *

  *----------------------------------------------------------------------

  */

 static int

 ParsePrimaryExpr(infoPtr)

     ParseInfo *infoPtr;		/* Holds the parse state for the

 				 * expression being parsed. */

 {

     Tcl_Parse *parsePtr = infoPtr->parsePtr;

     Tcl_Interp *interp = parsePtr->interp;

     Tcl_Token *tokenPtr, *exprTokenPtr;

     Tcl_Parse nested;

     CONST char *dollarPtr, *stringStart, *termPtr, *src;

     int lexeme, exprIndex, firstIndex, numToMove, code;

     /*

      * We simply recurse on parenthesized subexpressions.

      */

     HERE("primaryExpr", 13);

     lexeme = infoPtr->lexeme;

     if (lexeme == OPEN_PAREN) {

 	code = GetLexeme(infoPtr); /* skip over the '(' */

 	if (code != TCL_OK) {

 	    return code;

 	}

 	code = ParseCondExpr(infoPtr);

 	if (code != TCL_OK) {

 	    return code;

 	}

 	if (infoPtr->lexeme != CLOSE_PAREN) {

 	    LogSyntaxError(infoPtr, "looking for close parenthesis");

 	    return TCL_ERROR;

 	}

 	code = GetLexeme(infoPtr); /* skip over the ')' */

 	if (code != TCL_OK) {

 	    return code;

 	}

 	return TCL_OK;

     }

     /*

      * Start a TCL_TOKEN_SUB_EXPR token for the primary.

      */

     if (parsePtr->numTokens == parsePtr->tokensAvailable) {

 	TclExpandTokenArray(parsePtr);

     }

     exprIndex = parsePtr->numTokens;

     exprTokenPtr = &parsePtr->tokenPtr[exprIndex];

     exprTokenPtr->type = TCL_TOKEN_SUB_EXPR;

     exprTokenPtr->start = infoPtr->start;

     parsePtr->numTokens++;

     /*

      * Process the primary then finish setting the fields of the

      * TCL_TOKEN_SUB_EXPR token. Note that we can't use the pointer now

      * stored in "exprTokenPtr" in the code below since the token array

      * might be reallocated.

      */

     firstIndex = parsePtr->numTokens;

     switch (lexeme) {

     case LITERAL:

 	/*

 	 * Int or double number.

 	 */

 	tokenizeLiteral:

 	if (parsePtr->numTokens == parsePtr->tokensAvailable) {

 	    TclExpandTokenArray(parsePtr);

 	}

 	tokenPtr = &parsePtr->tokenPtr[parsePtr->numTokens];

 	tokenPtr->type = TCL_TOKEN_TEXT;

 	tokenPtr->start = infoPtr->start;

 	tokenPtr->size = infoPtr->size;

 	tokenPtr->numComponents = 0;

 	parsePtr->numTokens++;

 	exprTokenPtr = &parsePtr->tokenPtr[exprIndex];

 	exprTokenPtr->size = infoPtr->size;

 	exprTokenPtr->numComponents = 1;

 	break;

     case DOLLAR:

 	/*

 	 * $var variable reference.

 	 */

 	dollarPtr = (infoPtr->next - 1);

 	code = Tcl_ParseVarName(interp, dollarPtr,

 	        (infoPtr->lastChar - dollarPtr), parsePtr, 1);

 	if (code != TCL_OK) {

 	    return code;

 	}

 	infoPtr->next = dollarPtr + parsePtr->tokenPtr[firstIndex].size;

 	exprTokenPtr = &parsePtr->tokenPtr[exprIndex];

 	exprTokenPtr->size = parsePtr->tokenPtr[firstIndex].size;

 	exprTokenPtr->numComponents =

 	        (parsePtr->tokenPtr[firstIndex].numComponents + 1);

 	break;

     case QUOTE:

 	/*

 	 * '"' string '"'

 	 */

 	stringStart = infoPtr->next;

 	code = Tcl_ParseQuotedString(interp, infoPtr->start,

 	        (infoPtr->lastChar - stringStart), parsePtr, 1, &termPtr);

 	if (code != TCL_OK) {

 	    return code;

 	}

 	infoPtr->next = termPtr;

 	exprTokenPtr = &parsePtr->tokenPtr[exprIndex];

 	exprTokenPtr->size = (termPtr - exprTokenPtr->start);

 	exprTokenPtr->numComponents = parsePtr->numTokens - firstIndex;

 	/*

 	 * If parsing the quoted string resulted in more than one token,

 	 * insert a TCL_TOKEN_WORD token before them. This indicates that

 	 * the quoted string represents a concatenation of multiple tokens.

 	 */

 	if (exprTokenPtr->numComponents > 1) {

 	    if (parsePtr->numTokens >= parsePtr->tokensAvailable) {

 		TclExpandTokenArray(parsePtr);

 	    }

 	    tokenPtr = &parsePtr->tokenPtr[firstIndex];

 	    numToMove = (parsePtr->numTokens - firstIndex);

 	    memmove((VOID *) (tokenPtr + 1), (VOID *) tokenPtr,

 	            (size_t) (numToMove * sizeof(Tcl_Token)));

 	    parsePtr->numTokens++;

 	    exprTokenPtr = &parsePtr->tokenPtr[exprIndex];

 	    exprTokenPtr->numComponents++;

 	    tokenPtr->type = TCL_TOKEN_WORD;

 	    tokenPtr->start = exprTokenPtr->start;

 	    tokenPtr->size = exprTokenPtr->size;

 	    tokenPtr->numComponents = (exprTokenPtr->numComponents - 1);

 	}

 	break;

     case OPEN_BRACKET:

 	/*

 	 * '[' command {command} ']'

 	 */

 	if (parsePtr->numTokens == parsePtr->tokensAvailable) {

 	    TclExpandTokenArray(parsePtr);

 	}

 	tokenPtr = &parsePtr->tokenPtr[parsePtr->numTokens];

 	tokenPtr->type = TCL_TOKEN_COMMAND;

 	tokenPtr->start = infoPtr->start;

 	tokenPtr->numComponents = 0;

 	parsePtr->numTokens++;

 	/*

 	 * Call Tcl_ParseCommand repeatedly to parse the nested command(s)

 	 * to find their end, then throw away that parse information.

 	 */

 	src = infoPtr->next;

 	while (1) {

 	    if (Tcl_ParseCommand(interp, src, (parsePtr->end - src), 1,

 		    &nested) != TCL_OK) {

 		parsePtr->term = nested.term;

 		parsePtr->errorType = nested.errorType;

 		parsePtr->incomplete = nested.incomplete;

 		return TCL_ERROR;

 	    }

 	    src = (nested.commandStart + nested.commandSize);

 	    /*

 	     * This is equivalent to Tcl_FreeParse(&nested), but

 	     * presumably inlined here for sake of runtime optimization

 	     */

 	    if (nested.tokenPtr != nested.staticTokens) {

 		ckfree((char *) nested.tokenPtr);

 	    }

 	    /*

 	     * Check for the closing ']' that ends the command substitution.

 	     * It must have been the last character of the parsed command.

 	     */

 	    if ((nested.term < parsePtr->end) && (*nested.term == ']') 

 		    && !nested.incomplete) {

 		break;

 	    }

 	    if (src == parsePtr->end) {

 		if (parsePtr->interp != NULL) {

 		    Tcl_SetResult(interp, "missing close-bracket",

 			    TCL_STATIC);

 		}

 		parsePtr->term = tokenPtr->start;

 		parsePtr->errorType = TCL_PARSE_MISSING_BRACKET;

 		parsePtr->incomplete = 1;

 		return TCL_ERROR;

 	    }

 	}

 	tokenPtr->size = (src - tokenPtr->start);

 	infoPtr->next = src;

 	exprTokenPtr = &parsePtr->tokenPtr[exprIndex];

 	exprTokenPtr->size = (src - tokenPtr->start);

 	exprTokenPtr->numComponents = 1;

 	break;

     case OPEN_BRACE:

 	/*

 	 * '{' string '}'

 	 */

 	code = Tcl_ParseBraces(interp, infoPtr->start,

 	        (infoPtr->lastChar - infoPtr->start), parsePtr, 1,

 		&termPtr);

 	if (code != TCL_OK) {

 	    return code;

 	}

 	infoPtr->next = termPtr;

 	exprTokenPtr = &parsePtr->tokenPtr[exprIndex];

 	exprTokenPtr->size = (termPtr - infoPtr->start);

 	exprTokenPtr->numComponents = parsePtr->numTokens - firstIndex;

 	/*

 	 * If parsing the braced string resulted in more than one token,

 	 * insert a TCL_TOKEN_WORD token before them. This indicates that

 	 * the braced string represents a concatenation of multiple tokens.

 	 */

 	if (exprTokenPtr->numComponents > 1) {

 	    if (parsePtr->numTokens >= parsePtr->tokensAvailable) {

 		TclExpandTokenArray(parsePtr);

 	    }

 	    tokenPtr = &parsePtr->tokenPtr[firstIndex];

 	    numToMove = (parsePtr->numTokens - firstIndex);

 	    memmove((VOID *) (tokenPtr + 1), (VOID *) tokenPtr,

 	            (size_t) (numToMove * sizeof(Tcl_Token)));

 	    parsePtr->numTokens++;

 	    exprTokenPtr = &parsePtr->tokenPtr[exprIndex];

 	    exprTokenPtr->numComponents++;

 	    tokenPtr->type = TCL_TOKEN_WORD;

 	    tokenPtr->start = exprTokenPtr->start;

 	    tokenPtr->size = exprTokenPtr->size;

 	    tokenPtr->numComponents = exprTokenPtr->numComponents-1;

 	}

 	break;

     case STREQ:

     case STRNEQ:

     case FUNC_NAME: {

 	/*

 	 * math_func '(' expr {',' expr} ')'

 	 */

 	ParseInfo savedInfo = *infoPtr;

 	code = GetLexeme(infoPtr); /* skip over function name */

 	if (code != TCL_OK) {

 	    return code;

 	}

 	if (infoPtr->lexeme != OPEN_PAREN) {

 	    int code;

 	    Tcl_DString functionName;

 	    Tcl_HashEntry *hPtr;

 	    Interp *iPtr = (Interp *) infoPtr->parsePtr->interp;

 	    Tcl_Obj *objPtr = Tcl_NewStringObj(savedInfo.start, savedInfo.size);

 	    /* Check for boolean literals (true, false, yes, no, on, off) */

 	    Tcl_IncrRefCount(objPtr);

 	    code = Tcl_ConvertToType(NULL, objPtr, &tclBooleanType);

 	    Tcl_DecrRefCount(objPtr);

 	    if (code == TCL_OK) {

 		*infoPtr = savedInfo;

 		goto tokenizeLiteral;

 	    }

 	    /*

 	     * Guess what kind of error we have by trying to tell

 	     * whether we have a function or variable name here.

 	     * Alas, this makes the parser more tightly bound with the

 	     * rest of the interpreter, but that is the only way to

 	     * give a sensible message here.  Still, it is not too

 	     * serious as this is only done when generating an error.

 	     */

 	    /*

 	     * Look up the name as a function name.  We need a writable

 	     * copy (DString) so we can terminate it with a NULL for

 	     * the benefit of Tcl_FindHashEntry which operates on

 	     * NULL-terminated string keys.

 	     */

 	    Tcl_DStringInit(&functionName);

 	    hPtr = Tcl_FindHashEntry(&iPtr->mathFuncTable, 

 	    	Tcl_DStringAppend(&functionName,

 			savedInfo.start, savedInfo.size));

 	    Tcl_DStringFree(&functionName);

 	    /*

 	     * Assume that we have an attempted variable reference

 	     * unless we've got a function name, as the set of

 	     * potential function names is typically much smaller.

 	     */

 	    if (hPtr != NULL) {

 		LogSyntaxError(infoPtr,

 			"expected parenthesis enclosing function arguments");

 	    } else {

 		LogSyntaxError(infoPtr,

 			"variable references require preceding $");

 	    }

 	    return TCL_ERROR;

 	}

 	if (parsePtr->numTokens == parsePtr->tokensAvailable) {

 	    TclExpandTokenArray(parsePtr);

 	}

 	tokenPtr = &parsePtr->tokenPtr[parsePtr->numTokens];

 	tokenPtr->type = TCL_TOKEN_OPERATOR;

 	tokenPtr->start = savedInfo.start;

 	tokenPtr->size = savedInfo.size;

 	tokenPtr->numComponents = 0;

 	parsePtr->numTokens++;

 	code = GetLexeme(infoPtr); /* skip over '(' */

 	if (code != TCL_OK) {

 	    return code;

 	}

 	while (infoPtr->lexeme != CLOSE_PAREN) {

 	    code = ParseCondExpr(infoPtr);

 	    if (code != TCL_OK) {

 		return code;

 	    }

 	    if (infoPtr->lexeme == COMMA) {

 		code = GetLexeme(infoPtr); /* skip over , */

 		if (code != TCL_OK) {

 		    return code;

 		}

 	    } else if (infoPtr->lexeme != CLOSE_PAREN) {

 		LogSyntaxError(infoPtr,

 			"missing close parenthesis at end of function call");

 		return TCL_ERROR;

 	    }

 	}

 	exprTokenPtr = &parsePtr->tokenPtr[exprIndex];

 	exprTokenPtr->size = (infoPtr->next - exprTokenPtr->start);

 	exprTokenPtr->numComponents = parsePtr->numTokens - firstIndex;

 	break;

     }

     case COMMA:

 	LogSyntaxError(infoPtr,

 		"commas can only separate function arguments");

 	return TCL_ERROR;

     case END:

 	LogSyntaxError(infoPtr, "premature end of expression");

 	return TCL_ERROR;

     case UNKNOWN:

 	LogSyntaxError(infoPtr, "single equality character not legal in expressions");

 	return TCL_ERROR;

     case UNKNOWN_CHAR:

 	LogSyntaxError(infoPtr, "character not legal in expressions");

 	return TCL_ERROR;

     case QUESTY:

 	LogSyntaxError(infoPtr, "unexpected ternary 'then' separator");

 	return TCL_ERROR;

     case COLON:

 	LogSyntaxError(infoPtr, "unexpected ternary 'else' separator");

 	return TCL_ERROR;

     case CLOSE_PAREN:

 	LogSyntaxError(infoPtr, "unexpected close parenthesis");

 	return TCL_ERROR;

     default: {

 	char buf[64];

 	sprintf(buf, "unexpected operator %s", lexemeStrings[lexeme]);

 	LogSyntaxError(infoPtr, buf);

 	return TCL_ERROR;

 	}

     }

     /*

      * Advance to the next lexeme before returning.

      */

     code = GetLexeme(infoPtr);

     if (code != TCL_OK) {

 	return code;

     }

     parsePtr->term = infoPtr->next;

     return TCL_OK;

 }

 /*

  *----------------------------------------------------------------------

  *

  * GetLexeme --

  *

  *	Lexical scanner for Tcl expressions: scans a single operator or

  *	other syntactic element from an expression string.

  *

  * Results:

  *	TCL_OK is returned unless an error occurred. In that case a standard

  *	Tcl error code is returned and, if infoPtr->parsePtr->interp is

  *	non-NULL, the interpreter's result is set to hold an error

  *	message. TCL_ERROR is returned if an integer overflow, or a

  *	floating-point overflow or underflow occurred while reading in a

  *	number. If the lexical analysis is successful, infoPtr->lexeme

  *	refers to the next symbol in the expression string, and

  *	infoPtr->next is advanced past the lexeme. Also, if the lexeme is a

  *	LITERAL or FUNC_NAME, then infoPtr->start is set to the first

  *	character of the lexeme; otherwise it is set NULL.

  *

  * Side effects:

  *	If there is insufficient space in parsePtr to hold all the

  *	information about the subexpression, then additional space is

  *	malloc-ed..

  *

  *----------------------------------------------------------------------

  */

 static int

 GetLexeme(infoPtr)

     ParseInfo *infoPtr;		/* Holds state needed to parse the expr,

 				 * including the resulting lexeme. */

 {

     register CONST char *src;	/* Points to current source char. */

     char c;

     int offset, length, numBytes;

     Tcl_Parse *parsePtr = infoPtr->parsePtr;

     Tcl_Interp *interp = parsePtr->interp;

     Tcl_UniChar ch;

     /*

      * Record where the previous lexeme ended. Since we always read one

      * lexeme ahead during parsing, this helps us know the source length of

      * subexpression tokens.

      */

     infoPtr->prevEnd = infoPtr->next;

     /*

      * Scan over leading white space at the start of a lexeme. 

      */

     src = infoPtr->next;

     numBytes = parsePtr->end - src;

     do {

 	char type;

 	int scanned = TclParseWhiteSpace(src, numBytes, parsePtr, &type);

 	src += scanned; numBytes -= scanned;

     } while  (numBytes && (*src == '\n') && (src++,numBytes--));

     parsePtr->term = src;

     if (numBytes == 0) {

 	infoPtr->lexeme = END;

 	infoPtr->next = src;

 	return TCL_OK;

     }

     /*

      * Try to parse the lexeme first as an integer or floating-point

      * number. Don't check for a number if the first character c is

      * "+" or "-". If we did, we might treat a binary operator as unary

      * by mistake, which would eventually cause a syntax error.

      */

     c = *src;

     if ((c != '+') && (c != '-')) {

 	CONST char *end = infoPtr->lastChar;

 	if ((length = TclParseInteger(src, (end - src)))) {

 	    /*

 	     * First length bytes look like an integer.  Verify by

 	     * attempting the conversion to the largest integer we have.

 	     */

 	    int code;

 	    Tcl_WideInt wide;

 	    Tcl_Obj *value = Tcl_NewStringObj(src, length);

 	    Tcl_IncrRefCount(value);

 	    code = Tcl_GetWideIntFromObj(interp, value, &wide);

 	    Tcl_DecrRefCount(value);

 	    if (code == TCL_ERROR) {

 		parsePtr->errorType = TCL_PARSE_BAD_NUMBER;

 		return TCL_ERROR;

 	    }

             infoPtr->lexeme = LITERAL;

 	    infoPtr->start = src;

 	    infoPtr->size = length;

             infoPtr->next = (src + length);

 	    parsePtr->term = infoPtr->next;

             return TCL_OK;

 	} else if ((length = ParseMaxDoubleLength(src, end))) {

 	    /*

 	     * There are length characters that could be a double.

 	     * Let strtod() tells us for sure.  Need a writable copy

 	     * so we can set an terminating NULL to keep strtod from

 	     * scanning too far.

 	     */

 	    char *startPtr, *termPtr;

 	    double doubleValue;

 	    Tcl_DString toParse;

 	    errno = 0;

 	    Tcl_DStringInit(&toParse);

 	    startPtr = Tcl_DStringAppend(&toParse, src, length);

 	    doubleValue = strtod(startPtr, &termPtr);

 	    Tcl_DStringFree(&toParse);

 	    if (termPtr != startPtr) {

 		if (errno != 0) {

 		    if (interp != NULL) {

 			TclExprFloatError(interp, doubleValue);

 		    }

 		    parsePtr->errorType = TCL_PARSE_BAD_NUMBER;

 		    return TCL_ERROR;

 		}

 		/*

                  * startPtr was the start of a valid double, copied

 		 * from src.

                  */

 		infoPtr->lexeme = LITERAL;

 		infoPtr->start = src;

 		if ((termPtr - startPtr) > length) {

 		    infoPtr->size = length;

 		} else {

 		    infoPtr->size = (termPtr - startPtr);

 		}

 		infoPtr->next = src + infoPtr->size;

 		parsePtr->term = infoPtr->next;

 		return TCL_OK;

 	    }

 	}

     }

     /*

      * Not an integer or double literal. Initialize the lexeme's fields

      * assuming the common case of a single character lexeme.

      */

     infoPtr->start = src;

     infoPtr->size = 1;

     infoPtr->next = src+1;

     parsePtr->term = infoPtr->next;

     switch (*src) {

 	case '[':

 	    infoPtr->lexeme = OPEN_BRACKET;

 	    return TCL_OK;

         case '{':

 	    infoPtr->lexeme = OPEN_BRACE;

 	    return TCL_OK;

 	case '(':

 	    infoPtr->lexeme = OPEN_PAREN;

 	    return TCL_OK;

 	case ')':

 	    infoPtr->lexeme = CLOSE_PAREN;

 	    return TCL_OK;

 	case '$':

 	    infoPtr->lexeme = DOLLAR;

 	    return TCL_OK;

 	case '\"':

 	    infoPtr->lexeme = QUOTE;

 	    return TCL_OK;

 	case ',':

 	    infoPtr->lexeme = COMMA;

 	    return TCL_OK;

 	case '*':

 	    infoPtr->lexeme = MULT;

 	    return TCL_OK;

 	case '/':

 	    infoPtr->lexeme = DIVIDE;

 	    return TCL_OK;

 	case '%':

 	    infoPtr->lexeme = MOD;

 	    return TCL_OK;

 	case '+':

 	    infoPtr->lexeme = PLUS;

 	    return TCL_OK;

 	case '-':

 	    infoPtr->lexeme = MINUS;

 	    return TCL_OK;

 	case '?':

 	    infoPtr->lexeme = QUESTY;

 	    return TCL_OK;

 	case ':':

 	    infoPtr->lexeme = COLON;

 	    return TCL_OK;

 	case '<':

 	    infoPtr->lexeme = LESS;

 	    if ((infoPtr->lastChar - src) > 1) {

 		switch (src[1]) {

 		    case '<':

 			infoPtr->lexeme = LEFT_SHIFT;

 			infoPtr->size = 2;

 			infoPtr->next = src+2;

 			break;

 		    case '=':

 			infoPtr->lexeme = LEQ;

 			infoPtr->size = 2;

 			infoPtr->next = src+2;

 			break;

 		}

 	    }

 	    parsePtr->term = infoPtr->next;

 	    return TCL_OK;

 	case '>':

 	    infoPtr->lexeme = GREATER;

 	    if ((infoPtr->lastChar - src) > 1) {

 		switch (src[1]) {

 		    case '>':

 			infoPtr->lexeme = RIGHT_SHIFT;

 			infoPtr->size = 2;

 			infoPtr->next = src+2;

 			break;

 		    case '=':

 			infoPtr->lexeme = GEQ;

 			infoPtr->size = 2;

 			infoPtr->next = src+2;

 			break;

 		}

 	    }

 	    parsePtr->term = infoPtr->next;

 	    return TCL_OK;

 	case '=':

 	    infoPtr->lexeme = UNKNOWN;

 	    if ((src[1] == '=') && ((infoPtr->lastChar - src) > 1)) {

 		infoPtr->lexeme = EQUAL;

 		infoPtr->size = 2;

 		infoPtr->next = src+2;

 	    }

 	    parsePtr->term = infoPtr->next;

 	    return TCL_OK;

 	case '!':

 	    infoPtr->lexeme = NOT;

 	    if ((src[1] == '=') && ((infoPtr->lastChar - src) > 1)) {

 		infoPtr->lexeme = NEQ;

 		infoPtr->size = 2;

 		infoPtr->next = src+2;

 	    }

 	    parsePtr->term = infoPtr->next;

 	    return TCL_OK;

 	case '&':

 	    infoPtr->lexeme = BIT_AND;

 	    if ((src[1] == '&') && ((infoPtr->lastChar - src) > 1)) {

 		infoPtr->lexeme = AND;

 		infoPtr->size = 2;

 		infoPtr->next = src+2;

 	    }

 	    parsePtr->term = infoPtr->next;

 	    return TCL_OK;

 	case '^':

 	    infoPtr->lexeme = BIT_XOR;

 	    return TCL_OK;

 	case '|':

 	    infoPtr->lexeme = BIT_OR;

 	    if ((src[1] == '|') && ((infoPtr->lastChar - src) > 1)) {

 		infoPtr->lexeme = OR;

 		infoPtr->size = 2;

 		infoPtr->next = src+2;

 	    }

 	    parsePtr->term = infoPtr->next;

 	    return TCL_OK;

 	case '~':

 	    infoPtr->lexeme = BIT_NOT;

 	    return TCL_OK;

 	case 'e':

 	    if ((src[1] == 'q') && ((infoPtr->lastChar - src) > 1)) {

 		infoPtr->lexeme = STREQ;

 		infoPtr->size = 2;

 		infoPtr->next = src+2;

 		parsePtr->term = infoPtr->next;

 		return TCL_OK;

 	    } else {

 		goto checkFuncName;

 	    }

 	case 'n':

 	    if ((src[1] == 'e') && ((infoPtr->lastChar - src) > 1)) {

 		infoPtr->lexeme = STRNEQ;

 		infoPtr->size = 2;

 		infoPtr->next = src+2;

 		parsePtr->term = infoPtr->next;

 		return TCL_OK;

 	    } else {

 		goto checkFuncName;

 	    }

 	default:

 	checkFuncName:

 	    length = (infoPtr->lastChar - src);

 	    if (Tcl_UtfCharComplete(src, length)) {

 		offset = Tcl_UtfToUniChar(src, &ch);

 	    } else {

 		char utfBytes[TCL_UTF_MAX];

 		memcpy(utfBytes, src, (size_t) length);

 		utfBytes[length] = '\0';

 		offset = Tcl_UtfToUniChar(utfBytes, &ch);

 	    }

 	    c = UCHAR(ch);

 	    if (isalpha(UCHAR(c))) {	/* INTL: ISO only. */

 		infoPtr->lexeme = FUNC_NAME;

 		while (isalnum(UCHAR(c)) || (c == '_')) { /* INTL: ISO only. */

 		    src += offset; length -= offset;

 		    if (Tcl_UtfCharComplete(src, length)) {

 			offset = Tcl_UtfToUniChar(src, &ch);

 		    } else {

 			char utfBytes[TCL_UTF_MAX];

 			memcpy(utfBytes, src, (size_t) length);

 			utfBytes[length] = '\0';

 			offset = Tcl_UtfToUniChar(utfBytes, &ch);

 		    }

 		    c = UCHAR(ch);

 		}

 		infoPtr->size = (src - infoPtr->start);

 		infoPtr->next = src;

 		parsePtr->term = infoPtr->next;

 		return TCL_OK;

 	    }

 	    infoPtr->lexeme = UNKNOWN_CHAR;

 	    return TCL_OK;

     }

 }

 /*

  *----------------------------------------------------------------------

  *

  * TclParseInteger --

  *

  *	Scans up to numBytes bytes starting at src, and checks whether

  *	the leading bytes look like an integer's string representation.

  *

  * Results:

  *	Returns 0 if the leading bytes do not look like an integer.

  *	Otherwise, returns the number of bytes examined that look

  *	like an integer.  This may be less than numBytes if the integer

  *	is only the leading part of the string.

  *

  * Side effects:

  *	None.

  *

  *----------------------------------------------------------------------

  */

 int

 TclParseInteger(string, numBytes)

     register CONST char *string;/* The string to examine. */

     register int numBytes;	/* Max number of bytes to scan. */

 {

     register CONST char *p = string;

     /* Take care of introductory "0x" */

     if ((numBytes > 1) && (p[0] == '0') && ((p[1] == 'x') || (p[1] == 'X'))) {

 	int scanned;

 	Tcl_UniChar ch;

 	p+=2; numBytes -= 2;

  	scanned = TclParseHex(p, numBytes, &ch);

 	if (scanned) {

 	    return scanned + 2;

 	}

 	/* Recognize the 0 as valid integer, but x is left behind */

 	return 1;

     }

     while (numBytes && isdigit(UCHAR(*p))) {	/* INTL: digit */

 	numBytes--; p++;

     }

     if (numBytes == 0) {

         return (p - string);

     }

     if ((*p != '.') && (*p != 'e') && (*p != 'E')) {

         return (p - string);

     }

     return 0;

 }

 /*

  *----------------------------------------------------------------------

  *

  * ParseMaxDoubleLength --

  *

  *      Scans a sequence of bytes checking that the characters could

  *	be in a string rep of a double.

  *

  * Results:

  *	Returns the number of bytes starting with string, runing to, but

  *	not including end, all of which could be part of a string rep.

  *	of a double.  Only character identity is used, no actual

  *	parsing is done.

  *

  *	The legal bytes are '0' - '9', 'A' - 'F', 'a' - 'f', 

  *	'.', '+', '-', 'i', 'I', 'n', 'N', 'p', 'P', 'x',  and 'X'.

  *	This covers the values "Inf" and "Nan" as well as the

  *	decimal and hexadecimal representations recognized by a

  *	C99-compliant strtod().

  *

  * Side effects:

  *	None.

  *

  *----------------------------------------------------------------------

  */

 static int

 ParseMaxDoubleLength(string, end)

     register CONST char *string;/* The string to examine. */

     CONST char *end;		/* Point to the first character past the end

 				 * of the string we are examining. */

 {

     CONST char *p = string;

     while (p < end) {

 	switch (*p) {

 	    case '0': case '1': case '2': case '3': case '4': case '5':

 	    case '6': case '7': case '8': case '9': case 'A': case 'B':

 	    case 'C': case 'D': case 'E': case 'F': case 'I': case 'N':

 	    case 'P': case 'X': case 'a': case 'b': case 'c': case 'd':

 	    case 'e': case 'f': case 'i': case 'n': case 'p': case 'x':

 	    case '.': case '+': case '-':

 		p++;

 		break;

 	    default:

 		goto done;

 	}

     }

     done:

     return (p - string);

 }

 /*

  *----------------------------------------------------------------------

  *

  * PrependSubExprTokens --

  *

  *	This procedure is called after the operands of an subexpression have

  *	been parsed. It generates two tokens: a TCL_TOKEN_SUB_EXPR token for

  *	the subexpression, and a TCL_TOKEN_OPERATOR token for its operator.

  *	These two tokens are inserted before the operand tokens.

  *

  * Results:

  *	None.

  *

  * Side effects:

  *	If there is insufficient space in parsePtr to hold the new tokens,

  *	additional space is malloc-ed.

  *

  *----------------------------------------------------------------------

  */

 static void

 PrependSubExprTokens(op, opBytes, src, srcBytes, firstIndex, infoPtr)

     CONST char *op;		/* Points to first byte of the operator

 				 * in the source script. */

     int opBytes;		/* Number of bytes in the operator. */

     CONST char *src;		/* Points to first byte of the subexpression

 				 * in the source script. */

     int srcBytes;		/* Number of bytes in subexpression's

 				 * source. */

     int firstIndex;		/* Index of first token already emitted for

 				 * operator's first (or only) operand. */

     ParseInfo *infoPtr;		/* Holds the parse state for the

 				 * expression being parsed. */

 {

     Tcl_Parse *parsePtr = infoPtr->parsePtr;

     Tcl_Token *tokenPtr, *firstTokenPtr;

     int numToMove;

     if ((parsePtr->numTokens + 1) >= parsePtr->tokensAvailable) {

 	TclExpandTokenArray(parsePtr);

     }

     firstTokenPtr = &parsePtr->tokenPtr[firstIndex];

     tokenPtr = (firstTokenPtr + 2);

     numToMove = (parsePtr->numTokens - firstIndex);

     memmove((VOID *) tokenPtr, (VOID *) firstTokenPtr,

             (size_t) (numToMove * sizeof(Tcl_Token)));

     parsePtr->numTokens += 2;

     tokenPtr = firstTokenPtr;

     tokenPtr->type = TCL_TOKEN_SUB_EXPR;

     tokenPtr->start = src;

     tokenPtr->size = srcBytes;

     tokenPtr->numComponents = parsePtr->numTokens - (firstIndex + 1);

     tokenPtr++;

     tokenPtr->type = TCL_TOKEN_OPERATOR;

     tokenPtr->start = op;

     tokenPtr->size = opBytes;

     tokenPtr->numComponents = 0;

 }

 /*

  *----------------------------------------------------------------------

  *

  * LogSyntaxError --

  *

  *	This procedure is invoked after an error occurs when parsing an

  *	expression. It sets the interpreter result to an error message

  *	describing the error.

  *

  * Results:

  *	None.

  *

  * Side effects:

  *	Sets the interpreter result to an error message describing the

  *	expression that was being parsed when the error occurred, and why

  *	the parser considers that to be a syntax error at all.

  *

  *----------------------------------------------------------------------

  */

 static void

 LogSyntaxError(infoPtr, extraInfo)

     ParseInfo *infoPtr;		/* Holds the parse state for the

 				 * expression being parsed. */

     CONST char *extraInfo;	/* String to provide extra information

 				 * about the syntax error. */

 {

     int numBytes = (infoPtr->lastChar - infoPtr->originalExpr);

     char buffer[100];

     if (numBytes > 60) {

 	sprintf(buffer, "syntax error in expression \"%.60s...\"",

 		infoPtr->originalExpr);

     } else {

 	sprintf(buffer, "syntax error in expression \"%.*s\"",

 		numBytes, infoPtr->originalExpr);

     }

     Tcl_ResetResult(infoPtr->parsePtr->interp);

     Tcl_AppendStringsToObj(Tcl_GetObjResult(infoPtr->parsePtr->interp),

 	    buffer, ": ", extraInfo, (char *) NULL);

     infoPtr->parsePtr->errorType = TCL_PARSE_SYNTAX;

     infoPtr->parsePtr->term = infoPtr->start;

 }