* Copyright (c) 1997 Sun Microsystems, Inc.
 * Copyright (c) 1998-2000 by Scriptics Corporation.
 * Contributions from Don Porter, NIST, 2006.  (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: tclCompExpr.c,v 1.53.2.7 2007/07/12 14:29:54 dgp Exp $
 * RCS: @(#) $Id: tclCompExpr.c,v 1.53.2.8 2007/07/19 22:52:57 dgp Exp $
 */

#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 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 */
} 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

/*
 * 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 inorder traversals of the completed tree we perform are known to visit
 * the leaves in the same order as the original parse.
 *
 * Those OpNodes that are themselves (roots of subexpression trees that are)
 * operands of some operator store in their parent field a "pointer" to the
 * OpNode of that operator.  The parent field permits a destructive inorder
 * 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.
 * 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 destructive inorder 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.
 *
 * Each lexeme belongs to one of four categories, which determine

    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*/
    0,  0,  0,  0,  0,  0,  0,  0,
};

/*
 * 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.

 * Declarations for local functions to this file:
 */

static void		CompileExprTree(Tcl_Interp *interp, OpNode *nodes,
			    Tcl_Obj *const litObjv[], Tcl_Obj *funcList,
			    Tcl_Token *tokenPtr, int *convertPtr,
			    CompileEnv *envPtr);
static void		ConvertTreeToTokens(Tcl_Interp *interp,
static void		ConvertTreeToTokens(const char *start, int numBytes,
			    const char *start, int numBytes, OpNode *nodes,
			    Tcl_Obj *litList, Tcl_Token *tokenPtr,
			    OpNode *nodes, Tcl_Token *tokenPtr,
			    Tcl_Parse *parsePtr);
static int		CopyTokens(Tcl_Token *sourcePtr, Tcl_Parse *parsePtr);
static int		GenerateTokensForLiteral(const char *script,
			    int numBytes, Tcl_Obj *litList, int nextLiteral,
			    Tcl_Parse *parsePtr);
			    int numBytes, Tcl_Parse *parsePtr);
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);

 *----------------------------------------------------------------------
 */

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. If < 0, the
    int numBytes,		/* Number of bytes in string. */
				 * string consists of all bytes up to the
				 * first null character. */
    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. */

				 * 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 code = TCL_OK;		/* Return code */
    int scanned = 0;		/* Capture number of byte scanned by 
				 * parsing routines. */
    unsigned char lexeme = START;	/* Most recent lexeme parsed. */
    int lastOpen = 0;		/* Index of the OpNode of the OPEN_PAREN
				 * operator we most recently matched. */
    int lastParsed = 0;		/* Stores info about what the lexeme parsed
    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 and operator, lastParsed holds
				 * If it was not an operator, lastParsed holds
				 * an OperandTypes value encoding what we
				 * need to know about it.  The initial value
				 * is 0 indicating that as we start the "last
				 * thing we parsed" was the START lexeme stored
				 * in node 0. */
				 * 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_NONE;	/* "Index" of the complete tree (that is, a
				 * complete subexpression) determined at the
				 * moment.   OT_NONE 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. */

				 * 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. */

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

    TclParseInit(interp, start, numBytes, parsePtr);

    nodes = (OpNode *) attemptckalloc(nodesAvailable * sizeof(OpNode));
    if (nodes == NULL) {
	TclNewLiteralStringObj(msg, "not enough memory to parse expression");
	code = TCL_ERROR;
    } else {
	/*
	 * Initialize the parse tree with the special "START" node.
	goto error;
    }

    /* Initialize the parse tree with the special "START" node. */
	 */

	nodes->lexeme = lexeme;
	nodes->precedence = prec[lexeme];
	nodes->left = OT_NONE;
	nodes->right = OT_NONE;
	nodes->parent = -1;
	nodesUsed++;
    }
    nodes->lexeme = START;
    nodes->precedence = prec[START];
    nodes->left = OT_NONE;
    nodes->right = OT_NONE;
    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 ((code == TCL_OK) && (lexeme != END)) {
    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. */
	const char *lastStart = start - scanned;
				/* Compute where the lexeme parsed the
				 * previous pass through the loop began.
				 * This is helpful for detecting invalid

		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");
		code = TCL_ERROR;
		continue;
		goto error;
	    }
	    nodesAvailable = size;
	    nodes = newPtr;
	}
	nodePtr = nodes + nodesUsed;

	/*
	 * Skip white space between lexemes.
	/* 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.
	/* 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);
		code = TCL_ERROR;
		continue;
		goto error;
	    case INCOMPLETE:
		msg = Tcl_ObjPrintf(
			"incomplete operator \"%.*s\"", scanned, start);
		code = TCL_ERROR;
		continue;
		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);

				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) ? "" : "...");
			code = TCL_ERROR;
			continue;
			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.
	/* 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;
	    const char *end = start;
	    int wordIndex;
	    int code = TCL_OK;

	    /*
	     * Store away any literals on the list now, so they'll
	     * be available for our caller to free if we error out
	     * A leaf operand appearing just after something that's not an
	     * operator is a syntax error.
	     * of this routine.  [Bug 1705778, leak K23]
	     */

	    switch (lexeme) {
	    case NUMBER:
	    case BOOLEAN:
		Tcl_ListObjAppendElement(NULL, litList, literal);
		break;
	    default:
		break;
	    }

	    if (NotOperator(lastParsed)) {
		msg = Tcl_ObjPrintf("missing operator at %s", mark);
		if (lastStart[0] == '0') {
		    Tcl_Obj *copy = Tcl_NewStringObj(lastStart,
			    start + scanned - lastStart);
		    if (TclCheckBadOctal(NULL, Tcl_GetString(copy))) {
			TclNewLiteralStringObj(post,
				"looks like invalid octal number");
		    }
		    Tcl_DecrRefCount(copy);
		}
		scanned = 0;
		insertMark = 1;
		parsePtr->errorType = TCL_PARSE_BAD_NUMBER;
		code = TCL_ERROR;
		continue;

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

	    switch (lexeme) {
	    case NUMBER:
	    case BOOLEAN:
		Tcl_ListObjAppendElement(NULL, litList, literal);
		lastParsed = OT_LITERAL;
		complete = lastParsed = OT_LITERAL;
		start += scanned;
		numBytes -= scanned;
		continue;
	    default:
		break;
	    }

	    tokenPtr->start = start;
	    parsePtr->numTokens++;

	    switch (lexeme) {
	    case QUOTED:
		code = Tcl_ParseQuotedString(interp, start, numBytes,
			parsePtr, 1, &end);
		if (code != TCL_OK) {
		    /* TODO: This adjustment of scanned is untested and
		     * and uncommented.  Correct that.  Its only possible
		     * purpose is to influence the error message. */
		    scanned = parsePtr->term - start;
		    scanned += (scanned < numBytes);
		    continue;
		}
		scanned = end - start;
		break;

	    case BRACED:
		code = Tcl_ParseBraces(interp, start, numBytes,
			    parsePtr, 1, &end);
		if (code != TCL_OK) {
		    continue;
		}
		scanned = end - start;
		break;

	    case VARIABLE:
		code = Tcl_ParseVarName(interp, start, numBytes, parsePtr, 1);
		if (code != TCL_OK) {
		    /* TODO: This adjustment of scanned is untested and

		/*
		     * and uncommented.  Correct that.  Its only possible
		     * purpose is to influence the error message. */
		    scanned = parsePtr->term - start;
		 * Handle the quirk that Tcl_ParseVarName reports a successful
		 * parse even when it gets only a "$" with no variable name.
		    scanned += (scanned < numBytes);
		    continue;
		}
		 */

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

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

			code = TCL_ERROR;
			break;
		    }
		}
		TclStackFree(interp, nestedPtr);
		end = start;
		start = tokenPtr->start;
		if (code != TCL_OK) {
		    /* TODO: This adjustment of scanned is untested and
		     * and uncommented.  Correct that.  Its only possible
		     * purpose is to influence the error message. */
		    scanned = parsePtr->term - start;
		    scanned += (scanned < numBytes);
		    continue;
		}
		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))) {

		 * wasteful to convert to a literal only to convert back again
		 * later.
		 */

		literal = Tcl_NewObj();
		if (TclWordKnownAtCompileTime(tokenPtr, literal)) {
		    Tcl_ListObjAppendElement(NULL, litList, literal);
		    lastParsed = OT_LITERAL;
		    complete = lastParsed = OT_LITERAL;
		    parsePtr->numTokens = wordIndex;
		    break;
		}
		Tcl_DecrRefCount(literal);
	    }
	    lastParsed = OT_TOKENS;
	    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.
	     */
	case UNARY:

	    if (NotOperator(lastParsed)) {
		msg = Tcl_ObjPrintf("missing operator at %s", mark);
		scanned = 0;
		insertMark = 1;
		code = TCL_ERROR;
		continue;
		goto error;
	    }
	    lastParsed = nodesUsed;
	    nodePtr->lexeme = lexeme;
	    nodePtr->precedence = prec[lexeme];
	    nodePtr->left = OT_NONE;
	    nodePtr->right = OT_NONE;
	    nodePtr->parent = nodePtr - nodes - 1;

	    /* Create an OpNode for the unary operator */
	    nodePtr->lexeme = lexeme;		/* Remember the operator... */
	    nodePtr->precedence = prec[lexeme];	/* ... and its precedence. */
	    nodePtr->left = OT_NONE;		/* No left operand */
	    nodePtr->right = OT_NONE;		/* Right operand not
						 * yet known. */

	    /*
	     * 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 *otherPtr = NULL;
	    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;
			lastParsed = OT_EMPTY;
			complete = lastParsed = OT_EMPTY;

			/* TODO: explain */
			nodePtr[-1].left--;
			break;
		    }
		    msg = Tcl_ObjPrintf("empty subexpression at %s", mark);
		    scanned = 0;
		    insertMark = 1;
		    code = TCL_ERROR;
		    continue;
		    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) {

		    }
		}
		if (msg == NULL) {
		    msg = Tcl_ObjPrintf("missing operand at %s", mark);
		    scanned = 0;
		    insertMark = 1;
		}
		code = TCL_ERROR;
		continue;
		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
	    if (lastParsed == OT_NONE) {
		otherPtr = nodes + lastOpen - 1;
		lastParsed = lastOpen;
	     * 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.
	    } else {
		otherPtr = nodePtr - 1;
	    }
	     *
	     * 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) {
		/*
		 * lastParsed is "index" of item to be linked.
		 * otherPtr points to competing operator.
		incompletePtr = nodes + incomplete;
		 */

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

		if (otherPtr->precedence == precedence) {
		    /*
		     * Right association rules for exponentiation.
		if (incompletePtr->precedence == precedence) {

		    /* Right association rules for exponentiation. */
		     */

		    if (lexeme == EXPON) {
			break;
		    }

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

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

		/*
		 * We should link the lastParsed item to the otherPtr as its
		 * right operand. First make some syntax checks.
		/* Some special syntax checks... */
		 */

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

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

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

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

		otherPtr->right = lastParsed;
		if (lastParsed >= 0) {
		    nodes[lastParsed].parent = otherPtr - nodes;
		incompletePtr->right = complete;
		if (IsOperator(complete)) {
		    nodes[complete].p.parent = incomplete;
		}
		lastParsed = otherPtr - nodes;

		if (otherPtr->lexeme == OPEN_PAREN) {
		if (incompletePtr->lexeme == START) {

		    /*
		     * CLOSE_PAREN can only close one OPEN_PAREN.
		     * Completing the START tree indicates we're done.
		     * Transfer the parse tree to the caller and return.
		     */

		    *opTreePtr = nodes;
		    return TCL_OK;
		}

		    break;
		}
		if (otherPtr->lexeme == START) {
		    /*
		     * Don't backtrack beyond the start.
		     */
		/*
		 * 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;
		}
		otherPtr = nodes + otherPtr->parent;
	    }
	    if (code != TCL_OK) {
		continue;
	    }

	    /* More syntax checks... */

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

		lastOpen = otherPtr - nodes;
		otherPtr->left++;

	    /* 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;
		}
		/*
		 * Create no node for a CLOSE_PAREN lexeme.
		 */

		break;
		/* TODO: explain */
		incompletePtr->left++;
	    }
	    if (lexeme == COMMA) {

		if  ((otherPtr->lexeme != OPEN_PAREN)
			|| (otherPtr[-1].lexeme != FUNCTION)) {
		    TclNewLiteralStringObj(msg,
			    "unexpected \",\" outside function argument list");
	    /* Operator ":" may only be right operand of "?" */
	    if (IsOperator(complete) && (nodes[complete].lexeme == COLON)) {
		TclNewLiteralStringObj(msg,
			"unexpected operator \":\" without preceding \"?\"");
		    code = TCL_ERROR;
		    continue;
		}
		goto error;
	    }
		otherPtr->left++;
	    }
	    if (IsOperator(lastParsed) && (nodes[lastParsed].lexeme == COLON)) {
		TclNewLiteralStringObj(msg,
			"unexpected operator \":\" without preceding \"?\"");
		code = TCL_ERROR;
		continue;

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

		/* TODO: explain */
		incompletePtr->left++;
		break;
	    }

	    /* Link complete tree as left operand of new node. */
	    if (lexeme == END) {
		continue;
	    nodePtr->lexeme = lexeme;
	    nodePtr->precedence = precedence;
	    nodePtr->right = OT_NONE;
	    nodePtr->left = complete;
	    if (IsOperator(complete)) {
		nodes[complete].p.parent = nodesUsed;
	    }

	    /*
	     * Link orphan as left operand of new node.
	     * 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->lexeme = lexeme;
	    nodePtr->precedence = precedence;
	    nodePtr->right = -1;
	    nodePtr->p.prev = incomplete;
	    nodePtr->left = lastParsed;
	    if (lastParsed < 0) {
		nodePtr->parent = nodePtr - nodes - 1;
	    } else {
		nodePtr->parent = nodes[lastParsed].parent;
		nodes[lastParsed].parent = nodePtr - nodes;
	    }
	    lastParsed = nodesUsed;
	    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 (code != TCL_OK && nodes != NULL) {
    if (nodes != NULL) {
	ckfree((char*) nodes);
    }
    if (code == TCL_OK) {

	*opTreePtr = nodes;
    } else if (interp == NULL) {
    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)
			? (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)
			? 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) ? "" : "..."));
    }

    if (code != TCL_OK && parsePtr->errorType == TCL_PARSE_SUCCESS) {
	parsePtr->errorType = TCL_PARSE_SYNTAX;
    }
    return code;
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * GenerateTokensForLiteral --
 *

 *----------------------------------------------------------------------
 */

static int
GenerateTokensForLiteral(
    const char *script,
    int numBytes,
    Tcl_Obj *litList,
    int nextLiteral,
    Tcl_Parse *parsePtr)
{
    int scanned;
    const char *start = script;
    Tcl_Token *destPtr;
    unsigned char lexeme;

    /*
     * Have to reparse to get pointers into source string.
    /* Have to reparse to get pointers into source string. */
     */

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

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

 *	parsed expression.
 *
 *----------------------------------------------------------------------
 */

static void
ConvertTreeToTokens(
    Tcl_Interp *interp,
    const char *start,
    int numBytes,
    OpNode *nodes,
    Tcl_Obj *litList,
    Tcl_Token *tokenPtr,
    Tcl_Parse *parsePtr)
{
    OpNode *nodePtr = nodes;
    int nextLiteral = 0;
    int scanned, copied, tokenIdx;
    unsigned char lexeme;
    Tcl_Token *destPtr;

    while (1) {
	switch (NODE_TYPE & nodePtr->lexeme) {
	case UNARY:

			destPtr++;
			destPtr->type = TCL_TOKEN_OPERATOR;
			destPtr->start = start;
			destPtr->size = scanned;
			destPtr->numComponents = 0;
			parsePtr->numTokens += 2;
		    }
		    start +=scanned;
		    start += scanned;
		    numBytes -= scanned;
		}
		switch (right) {
		case OT_EMPTY:
		    break;
		case OT_LITERAL:
		    scanned = GenerateTokensForLiteral(start, numBytes,
			    litList, nextLiteral++, parsePtr);
			    parsePtr);
		    start +=scanned;
		    numBytes -= scanned;
		    break;
		case OT_TOKENS:
		    copied = CopyTokens(tokenPtr, parsePtr);
		    scanned = tokenPtr->start + tokenPtr->size - start;
		    start +=scanned;

		} else {
		    tokenIdx = OT_NONE - nodePtr->right;
		    nodePtr->right = OT_NONE;
		    destPtr = parsePtr->tokenPtr + tokenIdx;
		    destPtr->size = start - destPtr->start;
		    destPtr->numComponents = parsePtr->numTokens - tokenIdx - 1;
		}
		nodePtr = nodes + nodePtr->parent;
		nodePtr = nodes + nodePtr->p.parent;
	    }
	    break;
	case BINARY:
	    if (nodePtr->left > OT_NONE) {
		int left = nodePtr->left;

		nodePtr->left = OT_NONE;

		    destPtr++;
		    destPtr->type = TCL_TOKEN_OPERATOR;
		    parsePtr->numTokens += 2;
		}
		switch (left) {
		case OT_LITERAL:
		    scanned = GenerateTokensForLiteral(start, numBytes,
			    litList, nextLiteral++, parsePtr);
			    parsePtr);
		    start +=scanned;
		    numBytes -= scanned;
		    break;
		case OT_TOKENS:
		    copied = CopyTokens(tokenPtr, parsePtr);
		    scanned = tokenPtr->start + tokenPtr->size - start;
		    start +=scanned;

		    destPtr->numComponents = 0;
		}
		start +=scanned;
		numBytes -= scanned;
		switch (right) {
		case OT_LITERAL:
		    scanned = GenerateTokensForLiteral(start, numBytes,
			    litList, nextLiteral++, parsePtr);
			    parsePtr);
		    start +=scanned;
		    numBytes -= scanned;
		    break;
		case OT_TOKENS:
		    copied = CopyTokens(tokenPtr, parsePtr);
		    scanned = tokenPtr->start + tokenPtr->size - start;
		    start +=scanned;

		if ((nodePtr->lexeme != COMMA) && (nodePtr->lexeme != COLON)) {
		    tokenIdx = OT_NONE - nodePtr->left;
		    nodePtr->left = OT_NONE;
		    destPtr = parsePtr->tokenPtr + tokenIdx;
		    destPtr->size = start - destPtr->start;
		    destPtr->numComponents = parsePtr->numTokens-tokenIdx-1;
		}
		nodePtr = nodes + nodePtr->parent;
		nodePtr = nodes + nodePtr->p.parent;
	    }
	    break;
	}
    }
}

/*

    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 */
    int code = ParseExpr(interp, start, numBytes, &opTree, litList,
	    funcList, exprParsePtr, 1 /* parseOnly */);
    int errorType = exprParsePtr->errorType;
    const char* term = exprParsePtr->term;

    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(interp, start, numBytes, opTree, litList,
		exprParsePtr->tokenPtr, parsePtr);
	ConvertTreeToTokens(start, numBytes,
		opTree, exprParsePtr->tokenPtr, parsePtr);
    } else {
	parsePtr->term = term;
	parsePtr->errorType = errorType;
	parsePtr->term = exprParsePtr->term;
	parsePtr->errorType = exprParsePtr->errorType;
    }

    Tcl_FreeParse(exprParsePtr);
    TclStackFree(interp, exprParsePtr);
    Tcl_DecrRefCount(funcList);
    Tcl_DecrRefCount(litList);
    ckfree((char *) opTree);
    return code;
}

/*
 *----------------------------------------------------------------------
 *

 *----------------------------------------------------------------------
 */

int
TclCompileExpr(
    Tcl_Interp *interp,		/* Used for error reporting. */
    const char *script,		/* The source script to compile. */
    int numBytes,		/* Number of bytes in script. If < 0, the
    int numBytes,		/* Number of bytes in script. */
				 * string consists of all bytes up to the
				 * first null character. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    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));

			TclEmitInstInt4(INST_INVOKE_STK4, numWords, envPtr);
		    }
		    *convertPtr = 1;
		} else {
		    TclEmitOpcode(instruction[nodePtr->lexeme], envPtr);
		    *convertPtr = 0;
		}
		nodePtr = nodes + nodePtr->parent;
		nodePtr = nodes + nodePtr->p.parent;
	    }
	    break;
	case BINARY:
	    if (nodePtr->left > OT_NONE) {
		int left = nodePtr->left;
		nodePtr->left = OT_NONE;
		/* TODO: reduce constant expressions */

		    freePtr = jumpPtr;
		    jumpPtr = jumpPtr->next;
		    TclStackFree(interp, freePtr);
		    freePtr = jumpPtr;
		    jumpPtr = jumpPtr->next;
		    TclStackFree(interp, freePtr);
		}
		nodePtr = nodes + nodePtr->parent;
		nodePtr = nodes + nodePtr->p.parent;
	    }
	    break;
	}
    }
}

static int

    ParseLexeme(occdPtr->operator, strlen(occdPtr->operator), &lexeme, NULL);
    nodes[0].lexeme = START;
    nodes[0].right = 1;
    nodes[1].lexeme = lexeme;
    nodes[1].left = OT_LITERAL;
    nodes[1].right = OT_LITERAL;
    nodes[1].parent = 0;
    nodes[1].p.parent = 0;

    return OpCmd(interp, nodes, objv+1);
}

int
TclSortingOpCmd(
    ClientData clientData,

	    nodes[2*(i-1)-1].lexeme = lexeme;
	    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)].left = lastAnd;
	    nodes[lastAnd].parent = 2*(i-1);
	    nodes[lastAnd].p.parent = 2*(i-1);

	    nodes[2*(i-1)].right = 2*(i-1)+1;
	    nodes[2*(i-1)+1].parent= 2*(i-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].left = OT_LITERAL;
	nodes[2*(objc-2)-1].right = OT_LITERAL;

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

	code = OpCmd(interp, nodes, litObjv);

	TclStackFree(interp, nodes);
	TclStackFree(interp, litObjv);
    }
    return code;

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

	code = OpCmd(interp, nodes, litObjv);

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

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

	code = OpCmd(interp, nodes, objv+1);

	TclStackFree(interp, nodes);

	return code;
    }