path: root/generic/tclCompExpr.c

/*
 * tclCompExpr.c --
 *
 *	This file contains the code to parse and compile Tcl expressions
 *	and implementations of the Tcl commands corresponding to expression
 *	operators, such as the command ::tcl::mathop::+ .
 *
 * Contributions from Don Porter, NIST, 2006-2007. (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.
 */

#include "tclInt.h"
#include "tclCompile.h"		/* CompileEnv */

/*
 * Expression parsing takes place in the routine ParseExpr().  It takes a
 * string as input, parses that string, and generates a representation of
 * the expression in the form of a tree of operators, a list of literals,
 * a list of function names, and an array of Tcl_Token's within a Tcl_Parse
 * struct.  The tree is composed of OpNodes.
 */

typedef struct OpNode {
    int left;			/* "Pointer" to the left operand. */
    int right;			/* "Pointer" to the right operand. */
    union {
	int parent;		/* "Pointer" to the parent operand. */
	int prev;		/* "Pointer" joining incomplete tree stack */
    } p;
    unsigned char lexeme;	/* Code that identifies the operator. */
    unsigned char precedence;	/* Precedence of the operator */
    unsigned char mark;		/* Mark used to control traversal. */
    unsigned char constant;	/* Flag marking constant subexpressions. */
} OpNode;

/*
 * The storage for the tree is dynamically allocated array of OpNodes.  The
 * array is grown as parsing needs dictate according to a scheme similar to
 * Tcl's string growth algorithm, so that the resizing costs are O(N) and so
 * that we use at least half the memory allocated as expressions get large.
 *
 * Each OpNode in the tree represents an operator in the expression, either
 * unary or binary.  When parsing is completed successfully, a binary operator
 * OpNode will have its left and right fields filled with "pointers" to its
 * left and right operands.  A unary operator OpNode will have its right field
 * filled with a pointer to its single operand.  When an operand is a
 * subexpression the "pointer" takes the form of the index -- a non-negative
 * integer -- into the OpNode storage array where the root of that
 * subexpression parse tree is found.
 *
 * Non-operator elements of the expression do not get stored in the OpNode
 * tree.  They are stored in the other structures according to their type.
 * Literal values get appended to the literal list.  Elements that denote
 * forms of quoting or substitution known to the Tcl parser get stored as
 * Tcl_Tokens.  These non-operator elements of the expression are the
 * leaves of the completed parse tree.  When an operand of an OpNode is
 * one of these leaf elements, the following negative integer codes are used
 * to indicate which kind of elements it is.
 */

enum OperandTypes {
    OT_LITERAL = -3,	/* Operand is a literal in the literal list */
    OT_TOKENS = -2,	/* Operand is sequence of Tcl_Tokens */
    OT_EMPTY = -1	/* "Operand" is an empty string.  This is a
			 * special case used only to represent the
			 * EMPTY lexeme.  See below. */
};

/*
 * Readable macros to test whether a "pointer" value points to an operator.
 * They operate on the "non-negative integer -> operator; negative integer ->
 * a non-operator OperandType" distinction.
 */

#define IsOperator(l)	((l) >= 0)
#define NotOperator(l)	((l) < 0)

/*
 * Note that it is sufficient to store in the tree just the type of leaf
 * operand, without any explicit pointer to which leaf.  This is true because
 * the traversals of the completed tree we perform are known to visit
 * the leaves in the same order as the original parse.
 *
 * In a completed parse tree, those OpNodes that are themselves (roots of
 * subexpression trees that are) operands of some operator store in their
 * p.parent field a "pointer" to the OpNode of that operator.  The p.parent
 * field permits a traversal of the tree within a * non-recursive routine
 * (ConvertTreeToTokens() and CompileExprTree()).  This means that even
 * expression trees of great depth pose no risk of blowing the C stack.
 *
 * While the parse tree is being constructed, the same memory space is used
 * to hold the p.prev field which chains together a stack of incomplete
 * trees awaiting their right operands.
 *
 * The lexeme field is filled in with the lexeme of the operator that is
 * returned by the ParseLexeme() routine.  Only lexemes for unary and
 * binary operators get stored in an OpNode.  Other lexmes get different
 * treatement.
 *
 * The precedence field provides a place to store the precedence of the
 * operator, so it need not be looked up again and again.
 *
 * The mark field is use to control the traversal of the tree, so
 * that it can be done non-recursively.  The mark values are:
 */

enum Marks {
    MARK_LEFT,		/* Next step of traversal is to visit left subtree */
    MARK_RIGHT,		/* Next step of traversal is to visit right subtree */
    MARK_PARENT		/* Next step of traversal is to return to parent */
};

/*
 * The constant field is a boolean flag marking which subexpressions are
 * completely known at compile time, and are eligible for computing then
 * rather than waiting until run time.
 */

/*
 * Each lexeme belongs to one of four categories, which determine
 * its place in the parse tree.  We use the two high bits of the
 * (unsigned char) value to store a NODE_TYPE code.
 */

#define NODE_TYPE	0xC0

/*
 * The four category values are LEAF, UNARY, and BINARY, explained below,
 * and "uncategorized", which is used either temporarily, until context
 * determines which of the other three categories is correct, or for
 * lexemes like INVALID, which aren't really lexemes at all, but indicators
 * of a parsing error.  Note that the codes must be distinct to distinguish
 * categories, but need not take the form of a bit array.
 */

#define BINARY		0x40	/* This lexeme is a binary operator.  An
				 * OpNode representing it should go into the
				 * parse tree, and two operands should be
				 * parsed for it in the expression.  */
#define UNARY		0x80	/* This lexeme is a unary operator.  An OpNode
				 * representing it should go into the parse
				 * tree, and one operand should be parsed for
				 * it in the expression. */
#define LEAF		0xC0	/* This lexeme is a leaf operand in the parse
				 * tree.  No OpNode will be placed in the tree
				 * for it.  Either a literal value will be
				 * appended to the list of literals in this
				 * expression, or appropriate Tcl_Tokens will
				 * be appended in a Tcl_Parse struct to
				 * represent those leaves that require some
				 * form of substitution.
				 */

/* Uncategorized lexemes */

#define PLUS		1	/* Ambiguous.  Resolves to UNARY_PLUS or
				 * BINARY_PLUS according to context. */
#define MINUS		2	/* Ambiguous.  Resolves to UNARY_MINUS or
				 * BINARY_MINUS according to context. */
#define BAREWORD	3	/* Ambigous.  Resolves to BOOLEAN or to
				 * FUNCTION or a parse error according to
				 * context and value. */
#define INCOMPLETE	4	/* A parse error.  Used only when the single
				 * "=" is encountered.  */
#define INVALID		5	/* A parse error.  Used when any punctuation
				 * appears that's not a supported operator. */

/* Leaf lexemes */

#define NUMBER		( LEAF | 1)	/* For literal numbers */
#define SCRIPT		( LEAF | 2)	/* Script substitution; [foo] */
#define BOOLEAN		( LEAF | BAREWORD)	/* For literal booleans */
#define BRACED		( LEAF | 4)	/* Braced string; {foo bar} */
#define VARIABLE	( LEAF | 5)	/* Variable substitution; $x */
#define QUOTED		( LEAF | 6)	/* Quoted string; "foo $bar [soom]" */
#define EMPTY		( LEAF | 7)	/* Used only for an empty argument
					 * list to a function.  Represents
					 * the empty string within parens in
					 * the expression: rand() */

/* Unary operator lexemes */

#define UNARY_PLUS	( UNARY | PLUS)
#define UNARY_MINUS	( UNARY | MINUS)
#define FUNCTION	( UNARY | BAREWORD)	/* This is a bit of "creative
					 * interpretation" on the part of the
					 * parser.  A function call is parsed
					 * into the parse tree according to
					 * the perspective that the function
					 * name is a unary operator and its
					 * argument list, enclosed in parens,
					 * is its operand.  The additional
					 * requirements not implied generally
					 * by treatment as a unary operator --
					 * for example, the requirement that
					 * the operand be enclosed in parens --
					 * are hard coded in the relevant
					 * portions of ParseExpr().  We trade
					 * off the need to include such
					 * exceptional handling in the code
					 * against the need we would otherwise
					 * have for more lexeme categories. */
#define START		( UNARY | 4)	/* This lexeme isn't parsed from the
					 * expression text at all.  It
					 * represents the start of the
					 * expression and sits at the root of
					 * the parse tree where it serves as
					 * the start/end point of traversals. */
#define OPEN_PAREN	( UNARY | 5)	/* Another bit of creative
					 * interpretation, where we treat "("
					 * as a unary operator with the
					 * sub-expression between it and its
					 * matching ")" as its operand. See
					 * CLOSE_PAREN below. */
#define NOT		( UNARY | 6)
#define BIT_NOT		( UNARY | 7)

/* Binary operator lexemes */

#define BINARY_PLUS	( BINARY |  PLUS)
#define BINARY_MINUS	( BINARY |  MINUS)
#define COMMA		( BINARY |  3)	/* The "," operator is a low precedence
					 * binary operator that separates the
					 * arguments in a function call.  The
					 * additional constraint that this
					 * operator can only legally appear
					 * at the right places within a
					 * function call argument list are
					 * hard coded within ParseExpr().  */
#define MULT		( BINARY |  4)
#define DIVIDE		( BINARY |  5)
#define MOD		( BINARY |  6)
#define LESS		( BINARY |  7)
#define GREATER		( BINARY |  8)
#define BIT_AND		( BINARY |  9)
#define BIT_XOR		( BINARY | 10)
#define BIT_OR		( BINARY | 11)
#define QUESTION	( BINARY | 12)	/* These two lexemes make up the */
#define COLON		( BINARY | 13)	/* ternary conditional operator,
					 * $x ? $y : $z .  We treat them as
					 * two binary operators to avoid
					 * another lexeme category, and
					 * code the additional constraints
					 * directly in ParseExpr().  For
					 * instance, the right operand of
					 * a "?" operator must be a ":"
					 * operator. */
#define LEFT_SHIFT	( BINARY | 14)
#define RIGHT_SHIFT	( BINARY | 15)
#define LEQ		( BINARY | 16)
#define GEQ		( BINARY | 17)
#define EQUAL		( BINARY | 18)
#define NEQ		( BINARY | 19)
#define AND		( BINARY | 20)
#define OR		( BINARY | 21)
#define STREQ		( BINARY | 22)
#define STRNEQ		( BINARY | 23)
#define EXPON		( BINARY | 24)	/* Unlike the other binary operators,
					 * EXPON is right associative and this
					 * distinction is coded directly in
					 * ParseExpr(). */
#define IN_LIST		( BINARY | 25)
#define NOT_IN_LIST	( BINARY | 26)
#define CLOSE_PAREN	( BINARY | 27)	/* By categorizing the CLOSE_PAREN
					 * lexeme as a BINARY operator, the
					 * normal parsing rules for binary
					 * operators assure that a close paren
					 * will not directly follow another
					 * operator, and the machinery already
					 * in place to connect operands to
					 * operators according to precedence
					 * performs most of the work of
					 * matching open and close parens for
					 * us.  In the end though, a close
					 * paren is not really a binary
					 * operator, and some special coding
					 * in ParseExpr() make sure we never
					 * put an actual CLOSE_PAREN node
					 * in the parse tree.   The
					 * sub-expression between parens
					 * becomes the single argument of
					 * the matching OPEN_PAREN unary
					 * operator. */
#define END		( BINARY | 28)	/* This lexeme represents the end of
					 * the string being parsed.  Treating
					 * it as a binary operator follows the
					 * same logic as the CLOSE_PAREN lexeme
					 * and END pairs with START, in the
					 * same way that CLOSE_PAREN pairs with
					 * OPEN_PAREN. */
/*
 * When ParseExpr() builds the parse tree it must choose which operands to
 * connect to which operators.  This is done according to operator precedence.
 * The greater an operator's precedence the greater claim it has to link to
 * an available operand.  The Precedence enumeration lists the precedence
 * values used by Tcl expression operators, from lowest to highest claim.
 * Each precedence level is commented with the operators that hold that
 * precedence.
 */

enum Precedence {
    PREC_END = 1,	/* END */
    PREC_START,		/* START */
    PREC_CLOSE_PAREN,	/* ")" */
    PREC_OPEN_PAREN,	/* "(" */
    PREC_COMMA,		/* "," */
    PREC_CONDITIONAL,	/* "?", ":" */
    PREC_OR,		/* "||" */
    PREC_AND,		/* "&&" */
    PREC_BIT_OR,	/* "|" */
    PREC_BIT_XOR,	/* "^" */
    PREC_BIT_AND,	/* "&" */
    PREC_EQUAL,		/* "==", "!=", "eq", "ne", "in", "ni" */
    PREC_COMPARE,	/* "<", ">", "<=", ">=" */
    PREC_SHIFT,		/* "<<", ">>" */
    PREC_ADD,		/* "+", "-" */
    PREC_MULT,		/* "*", "/", "%" */
    PREC_EXPON,		/* "**" */
    PREC_UNARY		/* "+", "-", FUNCTION, "!", "~" */
};

/*
 * Here the same information contained in the comments above is stored
 * in inverted form, so that given a lexeme, one can quickly look up
 * its precedence value.
 */

static const unsigned char prec[] = {
    /* Non-operator lexemes */
    0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,
    0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,
    0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,
    0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,
    0,
    /* Binary operator lexemes */
    PREC_ADD,		/* BINARY_PLUS */
    PREC_ADD,		/* BINARY_MINUS */
    PREC_COMMA,		/* COMMA */
    PREC_MULT,		/* MULT */
    PREC_MULT,		/* DIVIDE */
    PREC_MULT,		/* MOD */
    PREC_COMPARE,	/* LESS */
    PREC_COMPARE,	/* GREATER */
    PREC_BIT_AND,	/* BIT_AND */
    PREC_BIT_XOR,	/* BIT_XOR */
    PREC_BIT_OR,	/* BIT_OR */
    PREC_CONDITIONAL,	/* QUESTION */
    PREC_CONDITIONAL,	/* COLON */
    PREC_SHIFT,		/* LEFT_SHIFT */
    PREC_SHIFT,		/* RIGHT_SHIFT */
    PREC_COMPARE,	/* LEQ */
    PREC_COMPARE,	/* GEQ */
    PREC_EQUAL,		/* EQUAL */
    PREC_EQUAL,		/* NEQ */
    PREC_AND,		/* AND */
    PREC_OR,		/* OR */
    PREC_EQUAL,		/* STREQ */
    PREC_EQUAL,		/* STRNEQ */
    PREC_EXPON,		/* EXPON */
    PREC_EQUAL,		/* IN_LIST */
    PREC_EQUAL,		/* NOT_IN_LIST */
    PREC_CLOSE_PAREN,	/* CLOSE_PAREN */
    PREC_END,		/* END */
    /* Expansion room for more binary operators */
    0,  0,  0,
    0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,
    0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,
    0,
    /* Unary operator lexemes */
    PREC_UNARY,		/* UNARY_PLUS */
    PREC_UNARY,		/* UNARY_MINUS */
    PREC_UNARY,		/* FUNCTION */
    PREC_START,		/* START */
    PREC_OPEN_PAREN,	/* OPEN_PAREN */
    PREC_UNARY,		/* NOT*/
    PREC_UNARY,		/* BIT_NOT*/
};

/*
 * A table mapping lexemes to bytecode instructions, used by CompileExprTree().
 */

static const unsigned char instruction[] = {
    /* Non-operator lexemes */
    0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,
    0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,
    0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,
    0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,
    0,
    /* Binary operator lexemes */
    INST_ADD,		/* BINARY_PLUS */
    INST_SUB,		/* BINARY_MINUS */
    0,			/* COMMA */
    INST_MULT,		/* MULT */
    INST_DIV,		/* DIVIDE */
    INST_MOD,		/* MOD */
    INST_LT,		/* LESS */
    INST_GT,		/* GREATER */
    INST_BITAND,	/* BIT_AND */
    INST_BITXOR,	/* BIT_XOR */
    INST_BITOR,		/* BIT_OR */
    0,			/* QUESTION */
    0,			/* COLON */
    INST_LSHIFT,	/* LEFT_SHIFT */
    INST_RSHIFT,	/* RIGHT_SHIFT */
    INST_LE,		/* LEQ */
    INST_GE,		/* GEQ */
    INST_EQ,		/* EQUAL */
    INST_NEQ,		/* NEQ */
    0,			/* AND */
    0,			/* OR */
    INST_STR_EQ,	/* STREQ */
    INST_STR_NEQ,	/* STRNEQ */
    INST_EXPON,		/* EXPON */
    INST_LIST_IN,	/* IN_LIST */
    INST_LIST_NOT_IN,	/* NOT_IN_LIST */
    0,			/* CLOSE_PAREN */
    0,			/* END */
    /* Expansion room for more binary operators */
    0,  0,  0,
    0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,
    0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,
    0,
    /* Unary operator lexemes */
    INST_UPLUS,		/* UNARY_PLUS */
    INST_UMINUS,	/* UNARY_MINUS */
    0,			/* FUNCTION */
    0,			/* START */
    0,			/* OPEN_PAREN */
    INST_LNOT,		/* NOT*/
    INST_BITNOT,	/* BIT_NOT*/
};

/*
 * A table mapping a byte value to the corresponding lexeme for use by
 * ParseLexeme().
 */

static const unsigned char Lexeme[] = {
	INVALID		/* NUL */,	INVALID		/* SOH */,
	INVALID		/* STX */,	INVALID		/* ETX */,
	INVALID		/* EOT */,	INVALID		/* ENQ */,
	INVALID		/* ACK */,	INVALID		/* BEL */,
	INVALID		/* BS */,	INVALID		/* HT */,
	INVALID		/* LF */,	INVALID		/* VT */,
	INVALID		/* FF */,	INVALID		/* CR */,
	INVALID		/* SO */,	INVALID		/* SI */,
	INVALID		/* DLE */,	INVALID		/* DC1 */,
	INVALID		/* DC2 */,	INVALID		/* DC3 */,
	INVALID		/* DC4 */,	INVALID		/* NAK */,
	INVALID		/* SYN */,	INVALID		/* ETB */,
	INVALID		/* CAN */,	INVALID		/* EM */,
	INVALID		/* SUB */,	INVALID		/* ESC */,
	INVALID		/* FS */,	INVALID		/* GS */,
	INVALID		/* RS */,	INVALID		/* US */,
	INVALID		/* SPACE */,	0 		/* ! or != */,
	QUOTED		/* " */,	INVALID		/* # */,
	VARIABLE	/* $ */,	MOD		/* % */,
	0		/* & or && */,	INVALID		/* ' */,
	OPEN_PAREN	/* ( */,	CLOSE_PAREN	/* ) */,
	0		/* * or ** */,	PLUS		/* + */,
	COMMA		/* , */,	MINUS		/* - */,
	0		/* . */,	DIVIDE		/* / */,
	0, 0, 0, 0, 0, 0, 0, 0, 0, 0,			/* 0-9 */
	COLON		/* : */,	INVALID		/* ; */,
	0		/* < or << or <= */,
	0		/* == or INVALID */,
	0		/* > or >> or >= */,
	QUESTION	/* ? */,	INVALID		/* @ */,
	0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,		/* A-M */
	0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,		/* N-Z */
	SCRIPT		/* [ */,	INVALID		/* \ */,
	INVALID		/* ] */,	BIT_XOR		/* ^ */,
	INVALID		/* _ */,	INVALID		/* ` */,
	0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,		/* a-m */
	0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,		/* n-z */
	BRACED		/* { */,	0		/* | or || */,
	INVALID		/* } */,	BIT_NOT		/* ~ */,
	INVALID		/* DEL */
};

/*
 * The JumpList struct is used to create a stack of data needed for the
 * TclEmitForwardJump() and TclFixupForwardJump() calls that are performed
 * when compiling the short-circuiting operators QUESTION/COLON, AND, and OR.
 * Keeping a stack permits the CompileExprTree() routine to be non-recursive.
 */

typedef struct JumpList {
    JumpFixup jump;		/* Pass this argument to matching calls of
				 * TclEmitForwardJump() and
				 * TclFixupForwardJump(). */
    int depth;			/* Remember the currStackDepth of the
				 * CompileEnv here. */
    int offset;			/* Data used to compute jump lengths to pass
				 * to TclFixupForwardJump() */
    int convert;		/* Temporary storage used to compute whether
				 * numeric conversion will be needed following
				 * the operator we're compiling. */
    struct JumpList *next;	/* Point to next item on the stack */
} JumpList;

/*
 * Declarations for local functions to this file:
 */

static void		CompileExprTree(Tcl_Interp *interp, OpNode *nodes,
			    int index, Tcl_Obj *const **litObjvPtr,
			    Tcl_Obj *const *funcObjv, Tcl_Token *tokenPtr,
			    CompileEnv *envPtr, int optimize);
static void		ConvertTreeToTokens(const char *start, int numBytes,
			    OpNode *nodes, Tcl_Token *tokenPtr,
			    Tcl_Parse *parsePtr);
static int		ExecConstantExprTree(Tcl_Interp *interp, OpNode *nodes,
			    int index, Tcl_Obj * const **litObjvPtr);
static int		ParseExpr(Tcl_Interp *interp, const char *start,
			    int numBytes, OpNode **opTreePtr,
			    Tcl_Obj *litList, Tcl_Obj *funcList,
			    Tcl_Parse *parsePtr, int parseOnly);
static int		ParseLexeme(const char *start, int numBytes,
			    unsigned char *lexemePtr, Tcl_Obj **literalPtr);


/*
 *----------------------------------------------------------------------
 *
 * ParseExpr --
 *
 *	Given a string, the numBytes bytes starting at start, this function
 *	parses it as a Tcl expression and constructs a tree representing
 *	the structure of the expression.  The caller must pass in empty
 * 	lists as the funcList and litList arguments.  The elements of the
 *	parsed expression are returned to the caller as that tree, a list of
 *	literal values, a list of function names, and in Tcl_Tokens
 *	added to a Tcl_Parse struct passed in by the caller.
 *
 * Results:
 *	If the string is successfully parsed as a valid Tcl expression, TCL_OK
 *	is returned, and data about the expression structure is written to
 *	the last four arguments.  If the string cannot be parsed as a valid
 *	Tcl expression, TCL_ERROR is returned, and if interp is non-NULL, an
 *	error message is written to interp.
 *
 * Side effects:
 *	Memory will be allocated.  If TCL_OK is returned, the caller must
 *	clean up the returned data structures.  The (OpNode *) value written
 *	to opTreePtr should be passed to ckfree() and the parsePtr argument
 *	should be passed to Tcl_FreeParse().  The elements appended to the
 *	litList and funcList will automatically be freed whenever the
 *	refcount on those lists indicates they can be freed.
 *
 *----------------------------------------------------------------------
 */

static int
ParseExpr(
    Tcl_Interp *interp,		/* Used for error reporting. */
    const char *start,		/* Start of source string to parse. */
    int numBytes,		/* Number of bytes in string. */
    OpNode **opTreePtr,		/* Points to space where a pointer to the
				 * allocated OpNode tree should go. */
    Tcl_Obj *litList,		/* List to append literals to. */
    Tcl_Obj *funcList,		/* List to append function names to. */
    Tcl_Parse *parsePtr,	/* Structure to fill with tokens representing
				 * those operands that require run time
				 * substitutions. */
    int parseOnly)		/* A boolean indicating whether the caller's
				 * aim is just a parse, or whether it will go
				 * on to compile the expression.  Different
				 * optimizations are appropriate for the
				 * two scenarios. */
{
    OpNode *nodes = NULL;	/* Pointer to the OpNode storage array where
				 * we build the parse tree. */
    int nodesAvailable = 64;	/* Initial size of the storage array.  This
				 * value establishes a minimum tree memory cost
				 * of only about 1 kibyte, and is large enough
				 * for most expressions to parse with no need
				 * for array growth and reallocation. */
    int nodesUsed = 0;		/* Number of OpNodes filled. */
    int scanned = 0;		/* Capture number of byte scanned by
				 * parsing routines. */
    int lastParsed;		/* Stores info about what the lexeme parsed
				 * the previous pass through the parsing loop
				 * was.  If it was an operator, lastParsed is
				 * the index of the OpNode for that operator.
				 * If it was not an operator, lastParsed holds
				 * an OperandTypes value encoding what we
				 * need to know about it. */
    int incomplete;		/* Index of the most recent incomplete tree
				 * in the OpNode array.  Heads a stack of
				 * incomplete trees linked by p.prev. */
    int complete = OT_EMPTY;	/* "Index" of the complete tree (that is, a
				 * complete subexpression) determined at the
				 * moment.   OT_EMPTY is a nonsense value
				 * used only to silence compiler warnings.
				 * During a parse, complete will always hold
				 * an index or an OperandTypes value pointing
				 * to an actual leaf at the time the complete
				 * tree is needed. */

    /* These variables control generation of the error message. */
    Tcl_Obj *msg = NULL;	/* The error message. */
    Tcl_Obj *post = NULL;	/* In a few cases, an additional postscript
				 * for the error message, supplying more
				 * information after the error msg and
				 * location have been reported. */
    const char *mark = "_@_";	/* In the portion of the complete error message
				 * where the error location is reported, this
				 * "mark" substring is inserted into the
				 * string being parsed to aid in pinpointing
				 * the location of the syntax error in the
				 * expression. */
    int insertMark = 0;		/* A boolean controlling whether the "mark"
				 * should be inserted. */
    const int limit = 25;	/* Portions of the error message are
				 * constructed out of substrings of the
				 * original expression.  In order to keep the
				 * error message readable, we impose this limit
				 * on the substring size we extract. */

    TclParseInit(interp, start, numBytes, parsePtr);

    nodes = (OpNode *) attemptckalloc(nodesAvailable * sizeof(OpNode));
    if (nodes == NULL) {
	TclNewLiteralStringObj(msg, "not enough memory to parse expression");
	goto error;
    }

    /* Initialize the parse tree with the special "START" node. */
    nodes->lexeme = START;
    nodes->precedence = prec[START];
    nodes->mark = MARK_RIGHT;
    nodes->constant = 1;
    incomplete = lastParsed = nodesUsed;
    nodesUsed++;

    /*
     * Main parsing loop parses one lexeme per iteration.  We exit the
     * loop only when there's a syntax error with a "goto error" which
     * takes us to the error handling code following the loop, or when
     * we've successfully completed the parse and we return to the caller.
     */

    while (1) {
	OpNode *nodePtr;	/* Points to the OpNode we may fill this
				 * pass through the loop. */
	unsigned char lexeme;	/* The lexeme we parse this iteration. */
	Tcl_Obj *literal;	/* Filled by the ParseLexeme() call when
				 * a literal is parsed that has a Tcl_Obj
				 * rep worth preserving. */

	/*
	 * Each pass through this loop adds up to one more OpNode. Allocate
	 * space for one if required.
	 */

	if (nodesUsed >= nodesAvailable) {
	    int size = nodesUsed * 2;
	    OpNode *newPtr;

	    do {
		newPtr = (OpNode *) attemptckrealloc((char *) nodes,
			(unsigned int) size * sizeof(OpNode));
	    } while ((newPtr == NULL)
		    && ((size -= (size - nodesUsed) / 2) > nodesUsed));
	    if (newPtr == NULL) {
		TclNewLiteralStringObj(msg,
			"not enough memory to parse expression");
		goto error;
	    }
	    nodesAvailable = size;
	    nodes = newPtr;
	}
	nodePtr = nodes + nodesUsed;

	/* Skip white space between lexemes. */
	scanned = TclParseAllWhiteSpace(start, numBytes);
	start += scanned;
	numBytes -= scanned;

	scanned = ParseLexeme(start, numBytes, &lexeme, &literal);

	/* Use context to categorize the lexemes that are ambiguous. */
	if ((NODE_TYPE & lexeme) == 0) {
	    switch (lexeme) {
	    case INVALID:
		msg = Tcl_ObjPrintf(
			"invalid character \"%.*s\"", scanned, start);
		goto error;
	    case INCOMPLETE:
		msg = Tcl_ObjPrintf(
			"incomplete operator \"%.*s\"", scanned, start);
		goto error;
	    case BAREWORD:

		/*
		 * Most barewords in an expression are a syntax error.
		 * The exceptions are that when a bareword is followed by
		 * an open paren, it might be a function call, and when the
		 * bareword is a legal literal boolean value, we accept that
		 * as well.
		 */

		if (start[scanned+TclParseAllWhiteSpace(
			start+scanned, numBytes-scanned)] == '(') {
		    lexeme = FUNCTION;

		    /*
		     * When we compile the expression we'll need the function
		     * name, and there's no place in the parse tree to store
		     * it, so we keep a separate list of all the function
		     * names we've parsed in the order we found them.
		     */

		    Tcl_ListObjAppendElement(NULL, funcList, literal);
		} else {
		    int b;
		    if (Tcl_GetBooleanFromObj(NULL, literal, &b) == TCL_OK) {
			lexeme = BOOLEAN;
		    } else {
			Tcl_DecrRefCount(literal);
			msg = Tcl_ObjPrintf(
				"invalid bareword \"%.*s%s\"",
				(scanned < limit) ? scanned : limit - 3, start,
				(scanned < limit) ? "" : "...");
			post = Tcl_ObjPrintf(
				"should be \"$%.*s%s\" or \"{%.*s%s}\"",
				(scanned < limit) ? scanned : limit - 3,
				start, (scanned < limit) ? "" : "...",
				(scanned < limit) ? scanned : limit - 3,
				start, (scanned < limit) ? "" : "...");
			Tcl_AppendPrintfToObj(post,
				" or \"%.*s%s(...)\" or ...",
				(scanned < limit) ? scanned : limit - 3,
				start, (scanned < limit) ? "" : "...");
			if (start[0] == '0') {
			    const char *stop;
			    TclParseNumber(NULL, NULL, NULL, start, scanned,
				    &stop, TCL_PARSE_NO_WHITESPACE);

			    if (isdigit(UCHAR(*stop)) || (stop == start + 1)) {
				parsePtr->errorType = TCL_PARSE_BAD_NUMBER;

				switch (start[1]) {
				case 'b':
				    Tcl_AppendToObj(post,
					    " (invalid binary number?)", -1);
				    break;
				case 'o':
				    Tcl_AppendToObj(post,
					    " (invalid octal number?)", -1);
				    break;
				default:
				    if (isdigit(UCHAR(start[1]))) {
				        Tcl_AppendToObj(post,
						" (invalid octal number?)", -1);
				    }
				    break;
				}
			    }
			}
			goto error;
		    }
		}
		break;
	    case PLUS:
	    case MINUS:
		if (IsOperator(lastParsed)) {

		    /*
		     * A "+" or "-" coming just after another operator
		     * must be interpreted as a unary operator.
		     */

		    lexeme |= UNARY;
		} else {
		    lexeme |= BINARY;
		}
	    }
	}	/* Uncategorized lexemes */

	/* Handle lexeme based on its category. */
	switch (NODE_TYPE & lexeme) {

	/*
	 * Each LEAF results in either a literal getting appended to the
	 * litList, or a sequence of Tcl_Tokens representing a Tcl word
	 * getting appended to the parsePtr->tokens.  No OpNode is filled
	 * for this lexeme.
	 */

	case LEAF: {
	    Tcl_Token *tokenPtr;
	    const char *end = start;
	    int wordIndex;
	    int code = TCL_OK;

	    /*
	     * A leaf operand appearing just after something that's not an
	     * operator is a syntax error.
	     */

	    if (NotOperator(lastParsed)) {
		msg = Tcl_ObjPrintf("missing operator at %s", mark);
		scanned = 0;
		insertMark = 1;

		/* Free any literal to avoid a memleak. */
		if ((lexeme == NUMBER) || (lexeme == BOOLEAN)) {
		    Tcl_DecrRefCount(literal);
		}
		goto error;
	    }

	    switch (lexeme) {
	    case NUMBER:
	    case BOOLEAN:
		/*
		 * TODO: Consider using a dict or hash to collapse all
		 * duplicate literals into a single representative value.
		 * (Like what is done with [split $s {}]).
		 * Pro:	~75% memory saving on expressions like
		 *	{1+1+1+1+1+.....+1} (Convert "pointer + Tcl_Obj" cost
		 *	to "pointer" cost only)
		 * Con:	Cost of the dict store/retrieve on every literal
		 *	in every expression when expressions like the above
		 *	tend to be uncommon.
		 *	The memory savings is temporary; Compiling to bytecode
		 *	will collapse things as literals are registered
		 * 	anyway, so the savings applies only to the time
		 *	between parsing and compiling.  Possibly important
		 *	due to high-water mark nature of memory allocation.
		 */
		Tcl_ListObjAppendElement(NULL, litList, literal);
		complete = lastParsed = OT_LITERAL;
		start += scanned;
		numBytes -= scanned;
		continue;

	    default:
		break;
	    }

	    /*
	     * Remaining LEAF cases may involve filling Tcl_Tokens, so
	     * make room for at least 2 more tokens.
	     */

	    TclGrowParseTokenArray(parsePtr, 2);
	    wordIndex = parsePtr->numTokens;
	    tokenPtr = parsePtr->tokenPtr + wordIndex;
	    tokenPtr->type = TCL_TOKEN_WORD;
	    tokenPtr->start = start;
	    parsePtr->numTokens++;

	    switch (lexeme) {
	    case QUOTED:
		code = Tcl_ParseQuotedString(NULL, start, numBytes,
			parsePtr, 1, &end);
		scanned = end - start;
		break;

	    case BRACED:
		code = Tcl_ParseBraces(NULL, start, numBytes,
			    parsePtr, 1, &end);
		scanned = end - start;
		break;

	    case VARIABLE:
		code = Tcl_ParseVarName(NULL, start, numBytes, parsePtr, 1);

		/*
		 * Handle the quirk that Tcl_ParseVarName reports a successful
		 * parse even when it gets only a "$" with no variable name.
		 */

		tokenPtr = parsePtr->tokenPtr + wordIndex + 1;
		if (code == TCL_OK && tokenPtr->type != TCL_TOKEN_VARIABLE) {
		    TclNewLiteralStringObj(msg, "invalid character \"$\"");
		    goto error;
		}
		scanned = tokenPtr->size;
		break;

	    case SCRIPT: {
		Tcl_Parse *nestedPtr =
			(Tcl_Parse *) TclStackAlloc(interp, sizeof(Tcl_Parse));

		tokenPtr = parsePtr->tokenPtr + parsePtr->numTokens;
		tokenPtr->type = TCL_TOKEN_COMMAND;
		tokenPtr->start = start;
		tokenPtr->numComponents = 0;

		end = start + numBytes;
		start++;
		while (1) {
		    code = Tcl_ParseCommand(interp, start, (end - start), 1,
			    nestedPtr);
		    if (code != TCL_OK) {
			parsePtr->term = nestedPtr->term;
			parsePtr->errorType = nestedPtr->errorType;
			parsePtr->incomplete = nestedPtr->incomplete;
			break;
		    }
		    start = (nestedPtr->commandStart + nestedPtr->commandSize);
		    Tcl_FreeParse(nestedPtr);
		    if ((nestedPtr->term < end) && (*(nestedPtr->term) == ']')
			    && !(nestedPtr->incomplete)) {
			break;
		    }

		    if (start == end) {
			TclNewLiteralStringObj(msg, "missing close-bracket");
			parsePtr->term = tokenPtr->start;
			parsePtr->errorType = TCL_PARSE_MISSING_BRACKET;
			parsePtr->incomplete = 1;
			code = TCL_ERROR;
			break;
		    }
		}
		TclStackFree(interp, nestedPtr);
		end = start;
		start = tokenPtr->start;
		scanned = end - start;
		tokenPtr->size = scanned;
		parsePtr->numTokens++;
		break;
	    }
	    }
	    if (code != TCL_OK) {

		/*
		 * Here we handle all the syntax errors generated by
		 * the Tcl_Token generating parsing routines called in the
		 * switch just above.  If the value of parsePtr->incomplete
		 * is 1, then the error was an unbalanced '[', '(', '{',
		 * or '"' and parsePtr->term is pointing to that unbalanced
		 * character.  If the value of parsePtr->incomplete is 0,
		 * then the error is one of lacking whitespace following a
		 * quoted word, for example: expr {[an error {foo}bar]},
		 * and parsePtr->term points to where the whitespace is
		 * missing.  We reset our values of start and scanned so that
		 * when our error message is constructed, the location of
		 * the syntax error is sure to appear in it, even if the
		 * quoted expression is truncated.
		 */

		start = parsePtr->term;
		scanned = parsePtr->incomplete;
		goto error;
	    }

	    tokenPtr = parsePtr->tokenPtr + wordIndex;
	    tokenPtr->size = scanned;
	    tokenPtr->numComponents = parsePtr->numTokens - wordIndex - 1;
	    if (!parseOnly && ((lexeme == QUOTED) || (lexeme == BRACED))) {

		/*
		 * When this expression is destined to be compiled, and a
		 * braced or quoted word within an expression is known at
		 * compile time (no runtime substitutions in it), we can
		 * store it as a literal rather than in its tokenized form.
		 * This is an advantage since the compiled bytecode is going
		 * to need the argument in Tcl_Obj form eventually, so it's
		 * just as well to get there now.  Another advantage is that
		 * with this conversion, larger constant expressions might
		 * be grown and optimized.
		 *
		 * On the contrary, if the end goal of this parse is to
		 * fill a Tcl_Parse for a caller of Tcl_ParseExpr(), then it's
		 * wasteful to convert to a literal only to convert back again
		 * later.
		 */

		literal = Tcl_NewObj();
		if (TclWordKnownAtCompileTime(tokenPtr, literal)) {
		    Tcl_ListObjAppendElement(NULL, litList, literal);
		    complete = lastParsed = OT_LITERAL;
		    parsePtr->numTokens = wordIndex;
		    break;
		}
		Tcl_DecrRefCount(literal);
	    }
	    complete = lastParsed = OT_TOKENS;
	    break;
	} /* case LEAF */

	case UNARY:

	    /*
	     * A unary operator appearing just after something that's not an
	     * operator is a syntax error -- something trying to be the left
	     * operand of an operator that doesn't take one.
	     */

	    if (NotOperator(lastParsed)) {
		msg = Tcl_ObjPrintf("missing operator at %s", mark);
		scanned = 0;
		insertMark = 1;
		goto error;
	    }

	    /* Create an OpNode for the unary operator */
	    nodePtr->lexeme = lexeme;
	    nodePtr->precedence = prec[lexeme];
	    nodePtr->mark = MARK_RIGHT;

	    /*
	     * A FUNCTION cannot be a constant expression, because Tcl allows
	     * functions to return variable results with the same arguments;
	     * for example, rand().  Other unary operators can root a constant
	     * expression, so long as the argument is a constant expression.
	     */

	    nodePtr->constant = (lexeme != FUNCTION);

	    /*
	     * This unary operator is a new incomplete tree, so push it
	     * onto our stack of incomplete trees.  Also remember it as
	     * the last lexeme we parsed.
	     */

	    nodePtr->p.prev = incomplete;
	    incomplete = lastParsed = nodesUsed;
	    nodesUsed++;
	    break;

	case BINARY: {
	    OpNode *incompletePtr;
	    unsigned char precedence = prec[lexeme];

	    /*
	     * A binary operator appearing just after another operator is a
	     * syntax error -- one of the two operators is missing an operand.
	     */

	    if (IsOperator(lastParsed)) {
		if ((lexeme == CLOSE_PAREN)
			&& (nodePtr[-1].lexeme == OPEN_PAREN)) {
		    if (nodePtr[-2].lexeme == FUNCTION) {

			/*
			 * Normally, "()" is a syntax error, but as a special
			 * case accept it as an argument list for a function.
			 * Treat this as a special LEAF lexeme, and restart
			 * the parsing loop with zero characters scanned.
			 * We'll parse the ")" again the next time through,
			 * but with the OT_EMPTY leaf as the subexpression
			 * between the parens.
			 */

			scanned = 0;
			complete = lastParsed = OT_EMPTY;
			break;
		    }
		    msg = Tcl_ObjPrintf("empty subexpression at %s", mark);
		    scanned = 0;
		    insertMark = 1;
		    goto error;
		}

		if (nodePtr[-1].precedence > precedence) {
		    if (nodePtr[-1].lexeme == OPEN_PAREN) {
			TclNewLiteralStringObj(msg, "unbalanced open paren");
			parsePtr->errorType = TCL_PARSE_MISSING_PAREN;
		    } else if (nodePtr[-1].lexeme == COMMA) {
			msg = Tcl_ObjPrintf(
				"missing function argument at %s", mark);
			scanned = 0;
			insertMark = 1;
		    } else if (nodePtr[-1].lexeme == START) {
			TclNewLiteralStringObj(msg, "empty expression");
		    }
		} else {
		    if (lexeme == CLOSE_PAREN) {
			TclNewLiteralStringObj(msg, "unbalanced close paren");
		    } else if ((lexeme == COMMA)
			    && (nodePtr[-1].lexeme == OPEN_PAREN)
			    && (nodePtr[-2].lexeme == FUNCTION)) {
			msg = Tcl_ObjPrintf(
				"missing function argument at %s", mark);
			scanned = 0;
			insertMark = 1;
		    }
		}
		if (msg == NULL) {
		    msg = Tcl_ObjPrintf("missing operand at %s", mark);
		    scanned = 0;
		    insertMark = 1;
		}
		goto error;
	    }

	    /*
	     * Here is where the tree comes together.  At this point, we
	     * have a stack of incomplete trees corresponding to
	     * substrings that are incomplete expressions, followed by
	     * a complete tree corresponding to a substring that is itself
	     * a complete expression, followed by the binary operator we have
	     * just parsed.  The incomplete trees can each be completed by
	     * adding a right operand.
	     *
	     * To illustrate with an example, when we parse the expression
	     * "1+2*3-4" and we reach this point having just parsed the "-"
	     * operator, we have these incomplete trees: START, "1+", and
	     * "2*".  Next we have the complete subexpression "3".  Last is
	     * the "-" we've just parsed.
	     *
	     * The next step is to join our complete tree to an operator.
	     * The choice is governed by the precedence and associativity
	     * of the competing operators.  If we connect it as the right
	     * operand of our most recent incomplete tree, we get a new
	     * complete tree, and we can repeat the process.  The while
	     * loop following repeats this until precedence indicates it
	     * is time to join the complete tree as the left operand of
	     * the just parsed binary operator.
	     *
	     * Continuing the example, the first pass through the loop
	     * will join "3" to "2*"; the next pass will join "2*3" to
	     * "1+".  Then we'll exit the loop and join "1+2*3" to "-".
	     * When we return to parse another lexeme, our stack of
	     * incomplete trees is START and "1+2*3-".
	     */

	    while (1) {
		incompletePtr = nodes + incomplete;

		if (incompletePtr->precedence < precedence) {
		    break;
		}

		if (incompletePtr->precedence == precedence) {

		    /* Right association rules for exponentiation. */
		    if (lexeme == EXPON) {
			break;
		    }

		    /*
		     * Special association rules for the conditional operators.
		     * The "?" and ":" operators have equal precedence, but
		     * must be linked up in sensible pairs.
		     */

		    if ((incompletePtr->lexeme == QUESTION)
			    && (NotOperator(complete)
			    || (nodes[complete].lexeme != COLON))) {
			break;
		    }
		    if ((incompletePtr->lexeme == COLON)
			    && (lexeme == QUESTION)) {
			break;
		    }
		}

		/* Some special syntax checks... */

		/* Parens must balance */
		if ((incompletePtr->lexeme == OPEN_PAREN)
			&& (lexeme != CLOSE_PAREN)) {
		    TclNewLiteralStringObj(msg, "unbalanced open paren");
		    parsePtr->errorType = TCL_PARSE_MISSING_PAREN;
		    goto error;
		}

		/* Right operand of "?" must be ":" */
		if ((incompletePtr->lexeme == QUESTION)
			&& (NotOperator(complete)
			|| (nodes[complete].lexeme != COLON))) {
		    msg = Tcl_ObjPrintf(
			    "missing operator \":\" at %s", mark);
		    scanned = 0;
		    insertMark = 1;
		    goto error;
		}

		/* Operator ":" may only be right operand of "?" */
		if (IsOperator(complete)
			&& (nodes[complete].lexeme == COLON)
			&& (incompletePtr->lexeme != QUESTION)) {
		    TclNewLiteralStringObj(msg,
			    "unexpected operator \":\" "
			    "without preceding \"?\"");
		    goto error;
		}

		/*
		 * Attach complete tree as right operand of most recent
		 * incomplete tree.
		 */

		incompletePtr->right = complete;
		if (IsOperator(complete)) {
		    nodes[complete].p.parent = incomplete;
		    incompletePtr->constant = incompletePtr->constant
			    && nodes[complete].constant;
		} else {
		    incompletePtr->constant = incompletePtr->constant
			    && (complete == OT_LITERAL);
		}

		/*
		 * The QUESTION/COLON and FUNCTION/OPEN_PAREN combinations each
		 * make up a single operator.  Force them to agree whether they
		 * have a constant expression.
		 */

		if ((incompletePtr->lexeme == QUESTION)
			|| (incompletePtr->lexeme == FUNCTION)) {
		    nodes[complete].constant = incompletePtr->constant;
		}

		if (incompletePtr->lexeme == START) {

		    /*
		     * Completing the START tree indicates we're done.
		     * Transfer the parse tree to the caller and return.
		     */

		    *opTreePtr = nodes;
		    return TCL_OK;
		}

		/*
		 * With a right operand attached, last incomplete tree has
		 * become the complete tree.  Pop it from the incomplete
		 * tree stack.
		 */

		complete = incomplete;
		incomplete = incompletePtr->p.prev;

		/* CLOSE_PAREN can only close one OPEN_PAREN. */
		if (incompletePtr->lexeme == OPEN_PAREN) {
		    break;
		}
	    }

	    /* More syntax checks... */

	    /* Parens must balance. */
	    if (lexeme == CLOSE_PAREN) {
		if (incompletePtr->lexeme != OPEN_PAREN) {
		    TclNewLiteralStringObj(msg, "unbalanced close paren");
		    goto error;
		}
	    }

	    /* Commas must appear only in function argument lists. */
	    if (lexeme == COMMA) {
		if  ((incompletePtr->lexeme != OPEN_PAREN)
			|| (incompletePtr[-1].lexeme != FUNCTION)) {
		    TclNewLiteralStringObj(msg,
			    "unexpected \",\" outside function argument list");
		    goto error;
		}
	    }

	    /* Operator ":" may only be right operand of "?" */
	    if (IsOperator(complete) && (nodes[complete].lexeme == COLON)) {
		TclNewLiteralStringObj(msg,
			"unexpected operator \":\" without preceding \"?\"");
		goto error;
	    }

	    /* Create no node for a CLOSE_PAREN lexeme. */
	    if (lexeme == CLOSE_PAREN) {
		break;
	    }

	    /* Link complete tree as left operand of new node. */
	    nodePtr->lexeme = lexeme;
	    nodePtr->precedence = precedence;
	    nodePtr->mark = MARK_LEFT;
	    nodePtr->left = complete;

	    /*
	     * The COMMA operator cannot be optimized, since the function
	     * needs all of its arguments, and optimization would reduce
	     * the number.  Other binary operators root constant expressions
	     * when both arguments are constant expressions.
	     */

	    nodePtr->constant = (lexeme != COMMA);

	    if (IsOperator(complete)) {
		nodes[complete].p.parent = nodesUsed;
		nodePtr->constant = nodePtr->constant
			&& nodes[complete].constant;
	    } else {
		nodePtr->constant = nodePtr->constant
			&& (complete == OT_LITERAL);
	    }

	    /*
	     * With a left operand attached and a right operand missing,
	     * the just-parsed binary operator is root of a new incomplete
	     * tree.  Push it onto the stack of incomplete trees.
	     */

	    nodePtr->p.prev = incomplete;
	    incomplete = lastParsed = nodesUsed;
	    nodesUsed++;
	    break;
	}	/* case BINARY */
	}	/* lexeme handler */

	/* Advance past the just-parsed lexeme */
	start += scanned;
	numBytes -= scanned;
    }	/* main parsing loop */

  error:

    /*
     * We only get here if there's been an error.
     * Any errors that didn't get a suitable parsePtr->errorType,
     * get recorded as syntax errors.
     */

    if (parsePtr->errorType == TCL_PARSE_SUCCESS) {
	parsePtr->errorType = TCL_PARSE_SYNTAX;
    }

    /* Free any partial parse tree we've built. */
    if (nodes != NULL) {
	ckfree((char*) nodes);
    }

    if (interp == NULL) {

	/* Nowhere to report an error message, so just free it */
	if (msg) {
	    Tcl_DecrRefCount(msg);
	}
    } else {

	/*
	 * Construct the complete error message.  Start with the simple
	 * error message, pulled from the interp result if necessary...
	 */

	if (msg == NULL) {
	    msg = Tcl_GetObjResult(interp);
	}

	/*
	 * Add a detailed quote from the bad expression, displaying and
	 * sometimes marking the precise location of the syntax error.
	 */

	Tcl_AppendPrintfToObj(msg, "\nin expression \"%s%.*s%.*s%s%s%.*s%s\"",
		((start - limit) < parsePtr->string) ? "" : "...",
		((start - limit) < parsePtr->string)
			? (int) (start - parsePtr->string) : limit - 3,
		((start - limit) < parsePtr->string)
			? parsePtr->string : start - limit + 3,
		(scanned < limit) ? scanned : limit - 3, start,
		(scanned < limit) ? "" : "...", insertMark ? mark : "",
		(start + scanned + limit > parsePtr->end)
			? (int) (parsePtr->end - start) - scanned : limit-3,
		start + scanned,
		(start + scanned + limit > parsePtr->end) ? "" : "...");

	/* Next, append any postscript message. */
	if (post != NULL) {
	    Tcl_AppendToObj(msg, ";\n", -1);
	    Tcl_AppendObjToObj(msg, post);
	    Tcl_DecrRefCount(post);
	}
	Tcl_SetObjResult(interp, msg);

	/* Finally, place context information in the errorInfo. */
	numBytes = parsePtr->end - parsePtr->string;
	Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
		"\n    (parsing expression \"%.*s%s\")",
		(numBytes < limit) ? numBytes : limit - 3,
		parsePtr->string, (numBytes < limit) ? "" : "..."));
    }

    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * ConvertTreeToTokens --
 *
 *	Given a string, the numBytes bytes starting at start, and an OpNode
 *	tree and Tcl_Token array created by passing that same string to
 *	ParseExpr(), this function writes into *parsePtr the sequence of
 * 	Tcl_Tokens needed so to satisfy the historical interface provided
 * 	by Tcl_ParseExpr().  Note that this routine exists only for the sake
 *	of the public Tcl_ParseExpr() routine.  It is not used by Tcl itself
 * 	at all.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The Tcl_Parse *parsePtr is filled with Tcl_Tokens representing the
 *	parsed expression.
 *
 *----------------------------------------------------------------------
 */

static void
ConvertTreeToTokens(
    const char *start,
    int numBytes,
    OpNode *nodes,
    Tcl_Token *tokenPtr,
    Tcl_Parse *parsePtr)
{
    int subExprTokenIdx = 0;
    OpNode *nodePtr = nodes;
    int next = nodePtr->right;

    while (1) {
	Tcl_Token *subExprTokenPtr;
	int scanned, parentIdx;
	unsigned char lexeme;

	/*
	 * Advance the mark so the next exit from this node won't retrace
	 * steps over ground already covered.
	 */

	nodePtr->mark++;

	/* Handle next child node or leaf */
	switch (next) {
	case OT_EMPTY:

	    /* No tokens and no characters for the OT_EMPTY leaf. */
	    break;

	case OT_LITERAL:

	    /* Skip any white space that comes before the literal */
	    scanned = TclParseAllWhiteSpace(start, numBytes);
	    start +=scanned;
	    numBytes -= scanned;

	    /* Reparse the literal to get pointers into source string */
	    scanned = ParseLexeme(start, numBytes, &lexeme, NULL);

	    TclGrowParseTokenArray(parsePtr, 2);
	    subExprTokenPtr = parsePtr->tokenPtr + parsePtr->numTokens;
	    subExprTokenPtr->type = TCL_TOKEN_SUB_EXPR;
	    subExprTokenPtr->start = start;
	    subExprTokenPtr->size = scanned;
	    subExprTokenPtr->numComponents = 1;
	    subExprTokenPtr[1].type = TCL_TOKEN_TEXT;
	    subExprTokenPtr[1].start = start;
	    subExprTokenPtr[1].size = scanned;
	    subExprTokenPtr[1].numComponents = 0;

	    parsePtr->numTokens += 2;
	    start +=scanned;
	    numBytes -= scanned;
	    break;

	case OT_TOKENS: {

	    /*
	     * tokenPtr points to a token sequence that came from parsing
	     * a Tcl word.  A Tcl word is made up of a sequence of one or
	     * more elements.  When the word is only a single element, it's
	     * been the historical practice to replace the TCL_TOKEN_WORD
	     * token directly with a TCL_TOKEN_SUB_EXPR token.  However,
	     * when the word has multiple elements, a TCL_TOKEN_WORD token
	     * is kept as a grouping device so that TCL_TOKEN_SUB_EXPR
	     * always has only one element.  Wise or not, these are the
	     * rules the Tcl expr parser has followed, and for the sake
	     * of those few callers of Tcl_ParseExpr() we do not change
	     * them now.  Internally, we can do better.
	     */

	    int toCopy = tokenPtr->numComponents + 1;

	    if (tokenPtr->numComponents == tokenPtr[1].numComponents + 1) {

		/*
		 * Single element word.  Copy tokens and convert the leading
		 * token to TCL_TOKEN_SUB_EXPR.
		 */

		TclGrowParseTokenArray(parsePtr, toCopy);
		subExprTokenPtr = parsePtr->tokenPtr + parsePtr->numTokens;
		memcpy(subExprTokenPtr, tokenPtr,
			(size_t) toCopy * sizeof(Tcl_Token));
		subExprTokenPtr->type = TCL_TOKEN_SUB_EXPR;
		parsePtr->numTokens += toCopy;
	    } else {

		/*
		 * Multiple element word.  Create a TCL_TOKEN_SUB_EXPR
		 * token to lead, with fields initialized from the leading
		 * token, then copy entire set of word tokens.
		 */

		TclGrowParseTokenArray(parsePtr, toCopy+1);
		subExprTokenPtr = parsePtr->tokenPtr + parsePtr->numTokens;
		*subExprTokenPtr = *tokenPtr;
		subExprTokenPtr->type = TCL_TOKEN_SUB_EXPR;
		subExprTokenPtr->numComponents++;
		subExprTokenPtr++;
		memcpy(subExprTokenPtr, tokenPtr,
			(size_t) toCopy * sizeof(Tcl_Token));
		parsePtr->numTokens += toCopy + 1;
	    }

	    scanned = tokenPtr->start + tokenPtr->size - start;
	    start +=scanned;
	    numBytes -= scanned;
	    tokenPtr += toCopy;
	    break;
	}

	default:

	    /* Advance to the child node, which is an operator. */
	    nodePtr = nodes + next;

	    /* Skip any white space that comes before the subexpression */
	    scanned = TclParseAllWhiteSpace(start, numBytes);
	    start +=scanned;
	    numBytes -= scanned;

	    /* Generate tokens for the operator / subexpression... */
	    switch (nodePtr->lexeme) {
	    case OPEN_PAREN:
	    case COMMA:
	    case COLON:

		/*
		 * Historical practice has been to have no Tcl_Tokens for
		 * these operators.
		 */

		break;

	    default: {

		/*
		 * Remember the index of the last subexpression we were
		 * working on -- that of our parent.  We'll stack it later.
		 */

		parentIdx = subExprTokenIdx;

		/*
		 * Verify space for the two leading Tcl_Tokens representing
		 * the subexpression rooted by this operator.  The first
		 * Tcl_Token will be of type TCL_TOKEN_SUB_EXPR; the second
		 * of type TCL_TOKEN_OPERATOR.
		 */

		TclGrowParseTokenArray(parsePtr, 2);
		subExprTokenIdx = parsePtr->numTokens;
		subExprTokenPtr = parsePtr->tokenPtr + subExprTokenIdx;
		parsePtr->numTokens += 2;
		subExprTokenPtr->type = TCL_TOKEN_SUB_EXPR;
		subExprTokenPtr[1].type = TCL_TOKEN_OPERATOR;

		/*
		 * Our current position scanning the string is the starting
		 * point for this subexpression.
		 */

		subExprTokenPtr->start = start;

		/*
		 * Eventually, we know that the numComponents field of the
		 * Tcl_Token of type TCL_TOKEN_OPERATOR will be 0.  This means
		 * we can make other use of this field for now to track the
		 * stack of subexpressions we have pending.
		 */

		subExprTokenPtr[1].numComponents = parentIdx;
		break;
	    }
	    }
	    break;
	}

	/* Determine which way to exit the node on this pass. */
    router:
	switch (nodePtr->mark) {
	case MARK_LEFT:
	    next = nodePtr->left;
	    break;

	case MARK_RIGHT:
	    next = nodePtr->right;

	    /* Skip any white space that comes before the operator */
	    scanned = TclParseAllWhiteSpace(start, numBytes);
	    start +=scanned;
	    numBytes -= scanned;

	    /*
	     * Here we scan from the string the operator corresponding to
	     * nodePtr->lexeme.
	     */

	    scanned = ParseLexeme(start, numBytes, &lexeme, NULL);

	    switch(nodePtr->lexeme) {
	    case OPEN_PAREN:
	    case COMMA:
	    case COLON:

		/* No tokens for these lexemes -> nothing to do. */
		break;

	    default:

		/*
		 * Record in the TCL_TOKEN_OPERATOR token the pointers into
		 * the string marking where the operator is.
		 */

		subExprTokenPtr = parsePtr->tokenPtr + subExprTokenIdx;
		subExprTokenPtr[1].start = start;
		subExprTokenPtr[1].size = scanned;
		break;
	    }

	    start +=scanned;
	    numBytes -= scanned;
	    break;

	case MARK_PARENT:
	    switch (nodePtr->lexeme) {
	    case START:

		/* When we get back to the START node, we're done. */
		return;

	    case COMMA:
	    case COLON:

		/* No tokens for these lexemes -> nothing to do. */
		break;

	    case OPEN_PAREN:

		/* Skip past matching close paren. */
		scanned = TclParseAllWhiteSpace(start, numBytes);
		start +=scanned;
		numBytes -= scanned;
		scanned = ParseLexeme(start, numBytes, &lexeme, NULL);
		start +=scanned;
		numBytes -= scanned;
		break;

	    default: {

		/*
		 * Before we leave this node/operator/subexpression for the
		 * last time, finish up its tokens....
		 *
		 * Our current position scanning the string is where the
		 * substring for the subexpression ends.
		 */

		subExprTokenPtr = parsePtr->tokenPtr + subExprTokenIdx;
		subExprTokenPtr->size = start - subExprTokenPtr->start;

		/*
		 * All the Tcl_Tokens allocated and filled belong to
		 * this subexpresion.  The first token is the leading
		 * TCL_TOKEN_SUB_EXPR token, and all the rest (one fewer)
		 * are its components.
		 */

		subExprTokenPtr->numComponents =
			(parsePtr->numTokens - subExprTokenIdx) - 1;

		/*
		 * Finally, as we return up the tree to our parent, pop the
		 * parent subexpression off our subexpression stack, and
		 * fill in the zero numComponents for the operator Tcl_Token.
		 */

		parentIdx = subExprTokenPtr[1].numComponents;
		subExprTokenPtr[1].numComponents = 0;
		subExprTokenIdx = parentIdx;
		break;
	    }
	    }

	    /* Since we're returning to parent, skip child handling code. */
	    nodePtr = nodes + nodePtr->p.parent;
	    goto router;
	}
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ParseExpr --
 *
 *	Given a string, the numBytes bytes starting at start, this function
 *	parses it as a Tcl expression and stores information about the
 *	structure of the expression in the Tcl_Parse struct indicated by the
 *	caller.
 *
 * Results:
 *	If the string is successfully parsed as a valid Tcl expression, TCL_OK
 *	is returned, and data about the expression structure is written to
 *	*parsePtr. If the string cannot be parsed as a valid Tcl expression,
 *	TCL_ERROR is returned, and if interp is non-NULL, an error message is
 *	written to interp.
 *
 * 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
 *	function returns TCL_OK then the caller must eventually invoke
 *	Tcl_FreeParse to release any additional space that was allocated.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_ParseExpr(
    Tcl_Interp *interp,		/* Used for error reporting. */
    const char *start,		/* Start of 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. */
{
    int code;
    OpNode *opTree = NULL;	/* Will point to the tree of operators */
    Tcl_Obj *litList = Tcl_NewObj();	/* List to hold the literals */
    Tcl_Obj *funcList = Tcl_NewObj();	/* List to hold the functon names*/
    Tcl_Parse *exprParsePtr =
	    (Tcl_Parse *) TclStackAlloc(interp, sizeof(Tcl_Parse));
				/* Holds the Tcl_Tokens of substitutions */

    if (numBytes < 0) {
	numBytes = (start ? strlen(start) : 0);
    }

    code = ParseExpr(interp, start, numBytes, &opTree, litList,
	    funcList, exprParsePtr, 1 /* parseOnly */);
    Tcl_DecrRefCount(funcList);
    Tcl_DecrRefCount(litList);

    TclParseInit(interp, start, numBytes, parsePtr);
    if (code == TCL_OK) {
	ConvertTreeToTokens(start, numBytes,
		opTree, exprParsePtr->tokenPtr, parsePtr);
    } else {
	parsePtr->term = exprParsePtr->term;
	parsePtr->errorType = exprParsePtr->errorType;
    }

    Tcl_FreeParse(exprParsePtr);
    TclStackFree(interp, exprParsePtr);
    ckfree((char *) opTree);
    return code;
}

/*
 *----------------------------------------------------------------------
 *
 * ParseLexeme --
 *
 *	Parse a single lexeme from the start of a string, scanning no more
 *	than numBytes bytes.
 *
 * Results:
 *	Returns the number of bytes scanned to produce the lexeme.
 *
 * Side effects:
 *	Code identifying lexeme parsed is writen to *lexemePtr.
 *
 *----------------------------------------------------------------------
 */

static int
ParseLexeme(
    const char *start,		/* Start of lexeme to parse. */
    int numBytes,		/* Number of bytes in string. */
    unsigned char *lexemePtr,	/* Write code of parsed lexeme to this
				 * storage. */
    Tcl_Obj **literalPtr)	/* Write corresponding literal value to this
				   storage, if non-NULL. */
{
    const char *end;
    int scanned;
    Tcl_UniChar ch;
    Tcl_Obj *literal = NULL;
    unsigned char byte;

    if (numBytes == 0) {
	*lexemePtr = END;
	return 0;
    }
    byte = (unsigned char)(*start);
    if (byte < sizeof(Lexeme) && Lexeme[byte] != 0) {
	*lexemePtr = Lexeme[byte];
	return 1;
    }
    switch (byte) {
    case '*':
	if ((numBytes > 1) && (start[1] == '*')) {
	    *lexemePtr = EXPON;
	    return 2;
	}
	*lexemePtr = MULT;
	return 1;

    case '=':
	if ((numBytes > 1) && (start[1] == '=')) {
	    *lexemePtr = EQUAL;
	    return 2;
	}
	*lexemePtr = INCOMPLETE;
	return 1;

    case '!':
	if ((numBytes > 1) && (start[1] == '=')) {
	    *lexemePtr = NEQ;
	    return 2;
	}
	*lexemePtr = NOT;
	return 1;

    case '&':
	if ((numBytes > 1) && (start[1] == '&')) {
	    *lexemePtr = AND;
	    return 2;
	}
	*lexemePtr = BIT_AND;
	return 1;

    case '|':
	if ((numBytes > 1) && (start[1] == '|')) {
	    *lexemePtr = OR;
	    return 2;
	}
	*lexemePtr = BIT_OR;
	return 1;

    case '<':
	if (numBytes > 1) {
	    switch (start[1]) {
	    case '<':
		*lexemePtr = LEFT_SHIFT;
		return 2;
	    case '=':
		*lexemePtr = LEQ;
		return 2;
	    }
	}
	*lexemePtr = LESS;
	return 1;

    case '>':
	if (numBytes > 1) {
	    switch (start[1]) {
	    case '>':
		*lexemePtr = RIGHT_SHIFT;
		return 2;
	    case '=':
		*lexemePtr = GEQ;
		return 2;
	    }
	}
	*lexemePtr = GREATER;
	return 1;

    case 'i':
	if ((numBytes > 1) && (start[1] == 'n')
		&& ((numBytes == 2) || !isalpha(UCHAR(start[2])))) {

	    /*
	     * Must make this check so we can tell the difference between
	     * the "in" operator and the "int" function name and the
	     * "infinity" numeric value.
	     */

	    *lexemePtr = IN_LIST;
	    return 2;
	}
	break;

    case 'e':
	if ((numBytes > 1) && (start[1] == 'q')
		&& ((numBytes == 2) || !isalpha(UCHAR(start[2])))) {
	    *lexemePtr = STREQ;
	    return 2;
	}
	break;

    case 'n':
	if ((numBytes > 1) && ((numBytes == 2) || !isalpha(UCHAR(start[2])))) {
	    switch (start[1]) {
	    case 'e':
		*lexemePtr = STRNEQ;
		return 2;
	    case 'i':
		*lexemePtr = NOT_IN_LIST;
		return 2;
	    }
	}
    }

    literal = Tcl_NewObj();
    if (TclParseNumber(NULL, literal, NULL, start, numBytes, &end,
	    TCL_PARSE_NO_WHITESPACE) == TCL_OK) {
	if (end < start + numBytes && !isalnum(UCHAR(*end))
		&& UCHAR(*end) != '_') {
	
	number:
	    TclInitStringRep(literal, start, end-start);
	    *lexemePtr = NUMBER;
	    if (literalPtr) {
		*literalPtr = literal;
	    } else {
		Tcl_DecrRefCount(literal);
	    }
	    return (end-start);
	} else {
	    unsigned char lexeme;

	    /*
	     * We have a number followed directly by bareword characters
	     * (alpha, digit, underscore).  Is this a number followed by
	     * bareword syntax error?  Or should we join into one bareword?
	     * Example: Inf + luence + () becomes a valid function call.
	     * [Bug 3401704]
	     */
	    if (literal->typePtr == &tclDoubleType) {
		const char *p = start;
		while (p < end) {
		    if (!isalnum(UCHAR(*p++))) {
			/*
			 * The number has non-bareword characters, so we 
			 * must treat it as a number.
			 */
			goto number;
		    }
		}
	    }
	    ParseLexeme(end, numBytes-(end-start), &lexeme, NULL);
	    if ((NODE_TYPE & lexeme) == BINARY) {
		/*
		 * The bareword characters following the number take the
		 * form of an operator (eq, ne, in, ni, ...) so we treat
		 * as number + operator.
		 */
		goto number;
	    }
	    /*
	     * Otherwise, fall through and parse the whole as a bareword.
	     */
	}
    }

    if (Tcl_UtfCharComplete(start, numBytes)) {
	scanned = Tcl_UtfToUniChar(start, &ch);
    } else {
	char utfBytes[TCL_UTF_MAX];
	memcpy(utfBytes, start, (size_t) numBytes);
	utfBytes[numBytes] = '\0';
	scanned = Tcl_UtfToUniChar(utfBytes, &ch);
    }
    if (!isalnum(UCHAR(ch))) {
	*lexemePtr = INVALID;
	Tcl_DecrRefCount(literal);
	return scanned;
    }
    end = start;
    while (isalnum(UCHAR(ch)) || (UCHAR(ch) == '_')) {
	end += scanned;
	numBytes -= scanned;
	if (Tcl_UtfCharComplete(end, numBytes)) {
	    scanned = Tcl_UtfToUniChar(end, &ch);
	} else {
	    char utfBytes[TCL_UTF_MAX];
	    memcpy(utfBytes, end, (size_t) numBytes);
	    utfBytes[numBytes] = '\0';
	    scanned = Tcl_UtfToUniChar(utfBytes, &ch);
	}
    }
    *lexemePtr = BAREWORD;
    if (literalPtr) {
	Tcl_SetStringObj(literal, start, (int) (end-start));
	*literalPtr = literal;
    } else {
	Tcl_DecrRefCount(literal);
    }
    return (end-start);
}

/*
 *----------------------------------------------------------------------
 *
 * TclCompileExpr --
 *
 *	This procedure compiles a string containing a Tcl expression into Tcl
 *	bytecodes.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Adds instructions to envPtr to evaluate the expression at runtime.
 *
 *----------------------------------------------------------------------
 */

void
TclCompileExpr(
    Tcl_Interp *interp,		/* Used for error reporting. */
    const char *script,		/* The source script to compile. */
    int numBytes,		/* Number of bytes in script. */
    CompileEnv *envPtr,		/* Holds resulting instructions. */
    int optimize)               /* 0 for one-off expressions */
{
    OpNode *opTree = NULL;	/* Will point to the tree of operators */
    Tcl_Obj *litList = Tcl_NewObj();	/* List to hold the literals */
    Tcl_Obj *funcList = Tcl_NewObj();	/* List to hold the functon names*/
    Tcl_Parse *parsePtr =
	    (Tcl_Parse *) TclStackAlloc(interp, sizeof(Tcl_Parse));
				/* Holds the Tcl_Tokens of substitutions */

    int code = ParseExpr(interp, script, numBytes, &opTree, litList,
	    funcList, parsePtr, 0 /* parseOnly */);

    if (code == TCL_OK) {

	/* Valid parse; compile the tree. */
	int objc;
	Tcl_Obj *const *litObjv;
	Tcl_Obj **funcObjv;

	/* TIP #280 : Track Lines within the expression */
	TclAdvanceLines(&envPtr->line, script,
		script + TclParseAllWhiteSpace(script, numBytes));

	TclListObjGetElements(NULL, litList, &objc, (Tcl_Obj ***)&litObjv);
	TclListObjGetElements(NULL, funcList, &objc, &funcObjv);
	CompileExprTree(interp, opTree, 0, &litObjv, funcObjv,
		parsePtr->tokenPtr, envPtr, optimize);
    } else {
	TclCompileSyntaxError(interp, envPtr);
    }

    Tcl_FreeParse(parsePtr);
    TclStackFree(interp, parsePtr);
    Tcl_DecrRefCount(funcList);
    Tcl_DecrRefCount(litList);
    ckfree((char *) opTree);
}

/*
 *----------------------------------------------------------------------
 *
 * ExecConstantExprTree --
 *	Compiles and executes bytecode for the subexpression tree at index
 *	in the nodes array.  This subexpression must be constant, made up
 *	of only constant operators (not functions) and literals.
 *
 * Results:
 *	A standard Tcl return code and result left in interp.
 *
 * Side effects:
 *	Consumes subtree of nodes rooted at index.  Advances the pointer
 *	*litObjvPtr.
 *
 *----------------------------------------------------------------------
 */

static int
ExecConstantExprTree(
    Tcl_Interp *interp,
    OpNode *nodes,
    int index,
    Tcl_Obj *const **litObjvPtr)
{
    CompileEnv *envPtr;
    ByteCode *byteCodePtr;
    int code;
    Tcl_Obj *byteCodeObj = Tcl_NewObj();

    /*
     * Note we are compiling an expression with literal arguments. This means
     * there can be no [info frame] calls when we execute the resulting
     * bytecode, so there's no need to tend to TIP 280 issues.
     */

    envPtr = (CompileEnv *) TclStackAlloc(interp, sizeof(CompileEnv));
    TclInitCompileEnv(interp, envPtr, NULL, 0, NULL, 0);
    CompileExprTree(interp, nodes, index, litObjvPtr, NULL, NULL, envPtr,
	    0 /* optimize */);
    TclEmitOpcode(INST_DONE, envPtr);
    Tcl_IncrRefCount(byteCodeObj);
    TclInitByteCodeObj(byteCodeObj, envPtr);
    TclFreeCompileEnv(envPtr);
    TclStackFree(interp, envPtr);
    byteCodePtr = (ByteCode *) byteCodeObj->internalRep.twoPtrValue.ptr1;
    code = TclExecuteByteCode(interp, byteCodePtr);
    Tcl_DecrRefCount(byteCodeObj);
    return code;
}

/*
 *----------------------------------------------------------------------
 *
 * CompileExprTree --
 *	Compiles and writes to envPtr instructions for the subexpression
 *	tree at index in the nodes array.  (*litObjvPtr) must point to the
 *	proper location in a corresponding literals list.  Likewise, when
 *	non-NULL, funcObjv and tokenPtr must point into matching arrays of
 * 	function names and Tcl_Token's derived from earlier call to
 *	ParseExpr().  When optimize is true, any constant subexpressions
 *	will be precomputed.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Adds instructions to envPtr to evaluate the expression at runtime.
 *	Consumes subtree of nodes rooted at index.  Advances the pointer
 *	*litObjvPtr.
 *
 *----------------------------------------------------------------------
 */

static void
CompileExprTree(
    Tcl_Interp *interp,
    OpNode *nodes,
    int index,
    Tcl_Obj *const **litObjvPtr,
    Tcl_Obj *const *funcObjv,
    Tcl_Token *tokenPtr,
    CompileEnv *envPtr,
    int optimize)
{
    OpNode *nodePtr = nodes + index;
    OpNode *rootPtr = nodePtr;
    int numWords = 0;
    JumpList *jumpPtr = NULL;
    int convert = 1;

    while (1) {
	int next;
	JumpList *freePtr, *newJump;

	if (nodePtr->mark == MARK_LEFT) {
	    next = nodePtr->left;

	    switch (nodePtr->lexeme) {
	    case QUESTION:
		newJump = (JumpList *) TclStackAlloc(interp, sizeof(JumpList));
		newJump->next = jumpPtr;
		jumpPtr = newJump;
		newJump = (JumpList *) TclStackAlloc(interp, sizeof(JumpList));
		newJump->next = jumpPtr;
		jumpPtr = newJump;
		jumpPtr->depth = envPtr->currStackDepth;
		convert = 1;
		break;
	    case AND:
	    case OR:
		newJump = (JumpList *) TclStackAlloc(interp, sizeof(JumpList));
		newJump->next = jumpPtr;
		jumpPtr = newJump;
		newJump = (JumpList *) TclStackAlloc(interp, sizeof(JumpList));
		newJump->next = jumpPtr;
		jumpPtr = newJump;
		newJump = (JumpList *) TclStackAlloc(interp, sizeof(JumpList));
		newJump->next = jumpPtr;
		jumpPtr = newJump;
		jumpPtr->depth = envPtr->currStackDepth;
		break;
	    }
	} else if (nodePtr->mark == MARK_RIGHT) {
	    next = nodePtr->right;

	    switch (nodePtr->lexeme) {
	    case FUNCTION: {
		Tcl_DString cmdName;
		const char *p;
		int length;

		Tcl_DStringInit(&cmdName);
		Tcl_DStringAppend(&cmdName, "tcl::mathfunc::", -1);
		p = TclGetStringFromObj(*funcObjv, &length);
		funcObjv++;
		Tcl_DStringAppend(&cmdName, p, length);
		TclEmitPush(TclRegisterNewNSLiteral(envPtr,
			Tcl_DStringValue(&cmdName),
			Tcl_DStringLength(&cmdName)), envPtr);
		Tcl_DStringFree(&cmdName);

		/*
		 * Start a count of the number of words in this function
		 * command invocation.  In case there's already a count
		 * in progress (nested functions), save it in our unused
		 * "left" field for restoring later.
		 */

		nodePtr->left = numWords;
		numWords = 2;	/* Command plus one argument */
		break;
	    }
	    case QUESTION:
		TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, &(jumpPtr->jump));
		break;
	    case COLON:
		TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP,
			&(jumpPtr->next->jump));
		envPtr->currStackDepth = jumpPtr->depth;
		jumpPtr->offset = (envPtr->codeNext - envPtr->codeStart);
		jumpPtr->convert = convert;
		convert = 1;
		break;
	    case AND:
		TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, &(jumpPtr->jump));
		break;
	    case OR:
		TclEmitForwardJump(envPtr, TCL_TRUE_JUMP, &(jumpPtr->jump));
		break;
	    }
	} else {
	    switch (nodePtr->lexeme) {
	    case START:
	    case QUESTION:
		if (convert && (nodePtr == rootPtr)) {
		    TclEmitOpcode(INST_TRY_CVT_TO_NUMERIC, envPtr);
		}
		break;
	    case OPEN_PAREN:

		/* do nothing */
		break;
	    case FUNCTION:

		/*
		 * Use the numWords count we've kept to invoke the
		 * function command with the correct number of arguments.
		 */

		if (numWords < 255) {
		    TclEmitInstInt1(INST_INVOKE_STK1, numWords, envPtr);
		} else {
		    TclEmitInstInt4(INST_INVOKE_STK4, numWords, envPtr);
		}

		/* Restore any saved numWords value. */
		numWords = nodePtr->left;
		convert = 1;
		break;
	    case COMMA:

		/* Each comma implies another function argument. */
		numWords++;
		break;
	    case COLON:
		if (TclFixupForwardJump(envPtr, &(jumpPtr->next->jump),
			(envPtr->codeNext - envPtr->codeStart)
			- jumpPtr->next->jump.codeOffset, 127)) {
		    jumpPtr->offset += 3;
		}
		TclFixupForwardJump(envPtr, &(jumpPtr->jump),
			jumpPtr->offset - jumpPtr->jump.codeOffset, 127);
		convert |= jumpPtr->convert;
		envPtr->currStackDepth = jumpPtr->depth + 1;
		freePtr = jumpPtr;
		jumpPtr = jumpPtr->next;
		TclStackFree(interp, freePtr);
		freePtr = jumpPtr;
		jumpPtr = jumpPtr->next;
		TclStackFree(interp, freePtr);
		break;
	    case AND:
	    case OR:
		TclEmitForwardJump(envPtr, (nodePtr->lexeme == AND)
			?  TCL_FALSE_JUMP : TCL_TRUE_JUMP,
			&(jumpPtr->next->jump));
		TclEmitPush(TclRegisterNewLiteral(envPtr,
			(nodePtr->lexeme == AND) ? "1" : "0", 1), envPtr);
		TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP,
			&(jumpPtr->next->next->jump));
		TclFixupForwardJumpToHere(envPtr, &(jumpPtr->next->jump), 127);
		if (TclFixupForwardJumpToHere(envPtr, &(jumpPtr->jump), 127)) {
		    jumpPtr->next->next->jump.codeOffset += 3;
		}
		TclEmitPush(TclRegisterNewLiteral(envPtr,
			(nodePtr->lexeme == AND) ? "0" : "1", 1), envPtr);
		TclFixupForwardJumpToHere(envPtr, &(jumpPtr->next->next->jump),
			127);
		convert = 0;
		envPtr->currStackDepth = jumpPtr->depth + 1;
		freePtr = jumpPtr;
		jumpPtr = jumpPtr->next;
		TclStackFree(interp, freePtr);
		freePtr = jumpPtr;
		jumpPtr = jumpPtr->next;
		TclStackFree(interp, freePtr);
		freePtr = jumpPtr;
		jumpPtr = jumpPtr->next;
		TclStackFree(interp, freePtr);
		break;
	    default:
		TclEmitOpcode(instruction[nodePtr->lexeme], envPtr);
		convert = 0;
		break;
	    }
	    if (nodePtr == rootPtr) {

		/* We're done */
		return;
	    }
	    nodePtr = nodes + nodePtr->p.parent;
	    continue;
	}

	nodePtr->mark++;
	switch (next) {
	case OT_EMPTY:
	    numWords = 1;	/* No arguments, so just the command */
	    break;
	case OT_LITERAL: {
	    Tcl_Obj *const *litObjv = *litObjvPtr;
	    Tcl_Obj *literal = *litObjv;

	    if (optimize) {
		int length, index;
		const char *bytes = TclGetStringFromObj(literal, &length);
		LiteralEntry *lePtr;
		Tcl_Obj *objPtr;

		index = TclRegisterNewLiteral(envPtr, bytes, length);
		lePtr = envPtr->literalArrayPtr + index;
		objPtr = lePtr->objPtr;
		if ((objPtr->typePtr == NULL) && (literal->typePtr != NULL)) {
		    /*
		     * Would like to do this:
		     *
		     * lePtr->objPtr = literal;
		     * Tcl_IncrRefCount(literal);
		     * Tcl_DecrRefCount(objPtr);
		     *
		     * However, the design of the "global" and "local"
		     * LiteralTable does not permit the value of lePtr->objPtr
		     * to change.  So rather than replace lePtr->objPtr, we
		     * do surgery to transfer our desired intrep into it.
		     *
		     */
		    objPtr->typePtr = literal->typePtr;
		    objPtr->internalRep = literal->internalRep;
		    literal->typePtr = NULL;
		}
		TclEmitPush(index, envPtr);
	    } else {
		/*
		 * When optimize==0, we know the expression is a one-off
		 * and there's nothing to be gained from sharing literals
		 * when they won't live long, and the copies we have already
		 * have an appropriate intrep.  In this case, skip literal
		 * registration that would enable sharing, and use the routine
		 * that preserves intreps.
		 */
		TclEmitPush(TclAddLiteralObj(envPtr, literal, NULL), envPtr);
	    }
	    (*litObjvPtr)++;
	    break;
	}
	case OT_TOKENS:
	    TclCompileTokens(interp, tokenPtr+1, tokenPtr->numComponents,
		    envPtr);
	    tokenPtr += tokenPtr->numComponents + 1;
	    break;
	default:
	    if (optimize && nodes[next].constant) {
		Tcl_InterpState save = Tcl_SaveInterpState(interp, TCL_OK);
		if (ExecConstantExprTree(interp, nodes, next, litObjvPtr)
			== TCL_OK) {
		    TclEmitPush(TclAddLiteralObj(envPtr,
			    Tcl_GetObjResult(interp), NULL), envPtr);
		} else {
		    TclCompileSyntaxError(interp, envPtr);
		}
		Tcl_RestoreInterpState(interp, save);
		convert = 0;
	    } else {
		nodePtr = nodes + next;
	    }
	}
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TclSingleOpCmd --
 *	Implements the commands: ~, !, <<, >>, %, !=, ne, in, ni
 *	in the ::tcl::mathop namespace.  These commands have no
 *	extension to arbitrary arguments; they accept only exactly one
 *	or exactly two arguments as suitable for the operator.
 *
 * Results:
 *	A standard Tcl return code and result left in interp.
 *
 * Side effects:
 * 	None.
 *
 *----------------------------------------------------------------------
 */

int
TclSingleOpCmd(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    TclOpCmdClientData *occdPtr = (TclOpCmdClientData *)clientData;
    unsigned char lexeme;
    OpNode nodes[2];
    Tcl_Obj *const *litObjv = objv + 1;

    if (objc != 1+occdPtr->i.numArgs) {
	Tcl_WrongNumArgs(interp, 1, objv, occdPtr->expected);
	return TCL_ERROR;
    }

    ParseLexeme(occdPtr->op, strlen(occdPtr->op), &lexeme, NULL);
    nodes[0].lexeme = START;
    nodes[0].mark = MARK_RIGHT;
    nodes[0].right = 1;
    nodes[1].lexeme = lexeme;
    if (objc == 2) {
	nodes[1].mark = MARK_RIGHT;
    } else {
	nodes[1].mark = MARK_LEFT;
	nodes[1].left = OT_LITERAL;
    }
    nodes[1].right = OT_LITERAL;
    nodes[1].p.parent = 0;

    return ExecConstantExprTree(interp, nodes, 0, &litObjv);
}

/*
 *----------------------------------------------------------------------
 *
 * TclSortingOpCmd --
 *	Implements the commands: <, <=, >, >=, ==, eq
 *	in the ::tcl::mathop namespace.  These commands are defined for
 *	arbitrary number of arguments by computing the AND of the base
 * 	operator applied to all neighbor argument pairs.
 *
 * Results:
 *	A standard Tcl return code and result left in interp.
 *
 * Side effects:
 * 	None.
 *
 *----------------------------------------------------------------------
 */

int
TclSortingOpCmd(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    int code = TCL_OK;

    if (objc < 3) {
	Tcl_SetObjResult(interp, Tcl_NewBooleanObj(1));
    } else {
	TclOpCmdClientData *occdPtr = (TclOpCmdClientData *)clientData;
	Tcl_Obj **litObjv = (Tcl_Obj **) TclStackAlloc(interp,
		2*(objc-2)*sizeof(Tcl_Obj *));
	OpNode *nodes = (OpNode *) TclStackAlloc(interp,
		2*(objc-2)*sizeof(OpNode));
	unsigned char lexeme;
	int i, lastAnd = 1;
	Tcl_Obj *const *litObjPtrPtr = litObjv;

	ParseLexeme(occdPtr->op, strlen(occdPtr->op), &lexeme, NULL);

	litObjv[0] = objv[1];
	nodes[0].lexeme = START;
	nodes[0].mark = MARK_RIGHT;
	for (i=2; i<objc-1; i++) {
	    litObjv[2*(i-1)-1] = objv[i];
	    nodes[2*(i-1)-1].lexeme = lexeme;
	    nodes[2*(i-1)-1].mark = MARK_LEFT;
	    nodes[2*(i-1)-1].left = OT_LITERAL;
	    nodes[2*(i-1)-1].right = OT_LITERAL;

	    litObjv[2*(i-1)] = objv[i];
	    nodes[2*(i-1)].lexeme = AND;
	    nodes[2*(i-1)].mark = MARK_LEFT;
	    nodes[2*(i-1)].left = lastAnd;
	    nodes[lastAnd].p.parent = 2*(i-1);

	    nodes[2*(i-1)].right = 2*(i-1)+1;
	    nodes[2*(i-1)+1].p.parent= 2*(i-1);

	    lastAnd = 2*(i-1);
	}
	litObjv[2*(objc-2)-1] = objv[objc-1];

	nodes[2*(objc-2)-1].lexeme = lexeme;
	nodes[2*(objc-2)-1].mark = MARK_LEFT;
	nodes[2*(objc-2)-1].left = OT_LITERAL;
	nodes[2*(objc-2)-1].right = OT_LITERAL;

	nodes[0].right = lastAnd;
	nodes[lastAnd].p.parent = 0;

	code = ExecConstantExprTree(interp, nodes, 0, &litObjPtrPtr);

	TclStackFree(interp, nodes);
	TclStackFree(interp, litObjv);
    }
    return code;
}

/*
 *----------------------------------------------------------------------
 *
 * TclVariadicOpCmd --
 *	Implements the commands: +, *, &, |, ^, **
 *	in the ::tcl::mathop namespace.  These commands are defined for
 *	arbitrary number of arguments by repeatedly applying the base
 *	operator with suitable associative rules.  When fewer than two
 *	arguments are provided, suitable identity values are returned.
 *
 * Results:
 *	A standard Tcl return code and result left in interp.
 *
 * Side effects:
 * 	None.
 *
 *----------------------------------------------------------------------
 */

int
TclVariadicOpCmd(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    TclOpCmdClientData *occdPtr = (TclOpCmdClientData *)clientData;
    unsigned char lexeme;
    int code;

    if (objc < 2) {
	Tcl_SetObjResult(interp, Tcl_NewIntObj(occdPtr->i.identity));
	return TCL_OK;
    }

    ParseLexeme(occdPtr->op, strlen(occdPtr->op), &lexeme, NULL);
    lexeme |= BINARY;

    if (objc == 2) {
	Tcl_Obj *litObjv[2];
	OpNode nodes[2];
	int decrMe = 0;
	Tcl_Obj *const *litObjPtrPtr = litObjv;

	if (lexeme == EXPON) {
	    litObjv[1] = Tcl_NewIntObj(occdPtr->i.identity);
	    Tcl_IncrRefCount(litObjv[1]);
	    decrMe = 1;
	    litObjv[0] = objv[1];
	    nodes[0].lexeme = START;
	    nodes[0].mark = MARK_RIGHT;
	    nodes[0].right = 1;
	    nodes[1].lexeme = lexeme;
	    nodes[1].mark = MARK_LEFT;
	    nodes[1].left = OT_LITERAL;
	    nodes[1].right = OT_LITERAL;
	    nodes[1].p.parent = 0;
	} else {
	    if (lexeme == DIVIDE) {
		litObjv[0] = Tcl_NewDoubleObj(1.0);
	    } else {
		litObjv[0] = Tcl_NewIntObj(occdPtr->i.identity);
	    }
	    Tcl_IncrRefCount(litObjv[0]);
	    litObjv[1] = objv[1];
	    nodes[0].lexeme = START;
	    nodes[0].mark = MARK_RIGHT;
	    nodes[0].right = 1;
	    nodes[1].lexeme = lexeme;
	    nodes[1].mark = MARK_LEFT;
	    nodes[1].left = OT_LITERAL;
	    nodes[1].right = OT_LITERAL;
	    nodes[1].p.parent = 0;
	}

	code = ExecConstantExprTree(interp, nodes, 0, &litObjPtrPtr);

	Tcl_DecrRefCount(litObjv[decrMe]);
	return code;
    } else {
	Tcl_Obj *const *litObjv = objv + 1;
	OpNode *nodes = (OpNode *) TclStackAlloc(interp,
		(objc-1)*sizeof(OpNode));
	int i, lastOp = OT_LITERAL;

	nodes[0].lexeme = START;
	nodes[0].mark = MARK_RIGHT;
	if (lexeme == EXPON) {
	    for (i=objc-2; i>0; i-- ) {
		nodes[i].lexeme = lexeme;
		nodes[i].mark = MARK_LEFT;
		nodes[i].left = OT_LITERAL;
		nodes[i].right = lastOp;
		if (lastOp >= 0) {
		    nodes[lastOp].p.parent = i;
		}
		lastOp = i;
	    }
	} else {
	    for (i=1; i<objc-1; i++ ) {
		nodes[i].lexeme = lexeme;
		nodes[i].mark = MARK_LEFT;
		nodes[i].left = lastOp;
		if (lastOp >= 0) {
		    nodes[lastOp].p.parent = i;
		}
		nodes[i].right = OT_LITERAL;
		lastOp = i;
	    }
	}
	nodes[0].right = lastOp;
	nodes[lastOp].p.parent = 0;

	code = ExecConstantExprTree(interp, nodes, 0, &litObjv);

	TclStackFree(interp, nodes);

	return code;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TclNoIdentOpCmd --
 *	Implements the commands: -, /
 *	in the ::tcl::mathop namespace.  These commands are defined for
 *	arbitrary non-zero number of arguments by repeatedly applying
 *	the base operator with suitable associative rules.  When no
 *	arguments are provided, an error is raised.
 *
 * Results:
 *	A standard Tcl return code and result left in interp.
 *
 * Side effects:
 * 	None.
 *
 *----------------------------------------------------------------------
 */

int
TclNoIdentOpCmd(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    TclOpCmdClientData *occdPtr = (TclOpCmdClientData *)clientData;
    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, occdPtr->expected);
	return TCL_ERROR;
    }
    return TclVariadicOpCmd(clientData, interp, objc, objv);
}
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */