/*
 * tclCompExpr.c --
 *
 *	This file contains the code to compile Tcl expressions.
 *
 * 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.2 2007/06/25 18:53:30 dgp Exp $
 */

#include "tclInt.h"
#include "tclCompile.h"

#undef USE_EXPR_TOKENS
#undef PARSE_DIRECT_EXPR_TOKENS

#ifdef PARSE_DIRECT_EXPR_TOKENS

/*
 * The ExprNode structure represents one node of the parse tree produced as an
 * interim structure by the expression parser.
 */

typedef struct ExprNode {
    unsigned char lexeme;	/* Code that identifies the type of this
				 * node. */
    int left;			/* Index of the left operand of this operator
				 * node. */
    int right;			/* Index of the right operand of this operator
				 * node. */
    int parent;			/* Index of the operator of this operand
				 * node. */
    int token;			/* Index of the Tcl_Tokens of this leaf
				 * node. */
} ExprNode;

#endif

/*
 * Integer codes indicating the form of an operand of an operator.
 */

enum OperandTypes {
    OT_NONE = -4, OT_LITERAL = -3, OT_TOKENS = -2, OT_EMPTY = -1
};

/*
 * The OpNode structure represents one operator node in the parse tree
 * produced as an interim structure by the expression parser.
 */

typedef struct OpNode {
    unsigned char lexeme;	/* Code that identifies the operator. */
    int left;			/* Index of the left operand. Non-negative
				 * integer is an index into the parse tree,
				 * pointing to another operator. Value
				 * OT_LITERAL indicates operand is the next
				 * entry in the literal list. Value OT_TOKENS
				 * indicates the operand is the next word in
				 * the Tcl_Parse struct. Value OT_NONE
				 * indicates we haven't yet parsed the operand
				 * for this operator. */
    int right;			/* Index of the right operand. Same
				 * interpretation as left, with addition of
				 * OT_EMPTY meaning zero arguments. */
    int parent;			/* Index of the operator of this operand
				 * node. */
} OpNode;

/*
 * Set of lexeme codes stored in ExprNode structs to label and categorize the
 * lexemes found.
 */

#define LEAF		(1<<7)
#define UNARY		(1<<6)
#define BINARY		(1<<5)

#define STRNEQ		( BINARY | 23)
#define EXPON		( BINARY | 24)
#define IN_LIST		( BINARY | 25)
#define NOT_IN_LIST	( BINARY | 26)
#define CLOSE_PAREN	( BINARY | 27)
#define END		( BINARY | 28)








































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

static int		ParseLexeme(const char *start, int numBytes,
			    unsigned char *lexemePtr, Tcl_Obj **literalPtr);
#if (!defined(PARSE_DIRECT_EXPR_TOKENS) || !defined(USE_EXPR_TOKENS))
static int		ParseExpr(Tcl_Interp *interp, const char *start,
			    int numBytes, OpNode **opTreePtr,
			    Tcl_Obj *litList, Tcl_Obj *funcList,
			    Tcl_Parse *parsePtr);
#endif
#ifdef PARSE_DIRECT_EXPR_TOKENS
static void		GenerateTokens(ExprNode *nodes, Tcl_Parse *scratchPtr,
			    Tcl_Parse *parsePtr);
#else
static void		ConvertTreeToTokens(Tcl_Interp *interp,
			    const char *start, int numBytes, OpNode *nodes,
			    Tcl_Obj *litList, Tcl_Token *tokenPtr,
			    Tcl_Parse *parsePtr);
static int		GenerateTokensForLiteral(const char *script,
			    int numBytes, Tcl_Obj *litList, int nextLiteral,
			    Tcl_Parse *parsePtr);
static int		CopyTokens(Tcl_Token *sourcePtr, Tcl_Parse *parsePtr);



#endif

#if (!defined(PARSE_DIRECT_EXPR_TOKENS) || !defined(USE_EXPR_TOKENS))
/*
 *----------------------------------------------------------------------
 *
 * ParseExpr --
 *
 *	Given a string, the numBytes bytes starting at start, this function
 *	parses it as a Tcl expression and stores information about the

    while ((code == TCL_OK) && (lexeme != END)) {
	OpNode *nodePtr;
	Tcl_Token *tokenPtr = NULL;
	Tcl_Obj *literal = NULL;
	const char *lastStart = start - scanned;

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

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

		"\n    (parsing expression \"%.*s%s\")",
		(numBytes < limit) ? numBytes : limit - 3,
		parsePtr->string, (numBytes < limit) ? "" : "..."));
    }

    return code;
}
#endif

#ifndef PARSE_DIRECT_EXPR_TOKENS
/*
 *----------------------------------------------------------------------
 *
 * GenerateTokensForLiteral --
 *
 * Results:
 *	Number of bytes scanned.

		}
		nodePtr = nodes + nodePtr->parent;
	    }
	    break;
	}
    }
}
#endif

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ParseExpr --
 *
 *	Given a string, the numBytes bytes starting at start, this function

    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. */
{
#ifndef PARSE_DIRECT_EXPR_TOKENS
    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,

    Tcl_FreeParse(exprParsePtr);
    TclStackFree(interp, exprParsePtr);
    Tcl_DecrRefCount(funcList);
    Tcl_DecrRefCount(litList);
    ckfree((char *) opTree);
    return code;
#else
#define NUM_STATIC_NODES 64
    ExprNode staticNodes[NUM_STATIC_NODES];
    ExprNode *lastOrphanPtr, *nodes = staticNodes;
    int nodesAvailable = NUM_STATIC_NODES;
    int nodesUsed = 0;
    Tcl_Parse *scratchPtr = (Tcl_Parse *) TclStackAlloc(interp, sizeof(Tcl_Parse));
							/* Parsing scratch space */
    Tcl_Obj *msg = NULL, *post = NULL;
    int scanned = 0, code = TCL_OK, insertMark = 0;
    const char *mark = "_@_";
    const int limit = 25;
    static const unsigned char prec[] = {
	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,  15,	15, 5,	16, 16,	16, 13,	13, 11,	10, 9,	6,  6,	14, 14,
	13, 13, 12, 12,	8,  7,	12, 12,	17, 12,	12, 3,	1,  0,	0,  0,
	0,  18,	18, 18,	2,  4,	18, 18,	0,  0,	0,  0,	0,  0,	0,  0,
    };

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

    TclParseInit(interp, start, numBytes, scratchPtr);
    TclParseInit(interp, start, numBytes, parsePtr);

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

    nodes->lexeme = START;
    nodes->left = -1;
    nodes->right = -1;
    nodes->parent = -1;
    nodes->token = -1;
    lastOrphanPtr = nodes;
    nodesUsed++;

    while ((code == TCL_OK) && (lastOrphanPtr->lexeme != END)) {
	ExprNode *nodePtr, *lastNodePtr;
	Tcl_Token *tokenPtr;

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

	if (nodesUsed >= nodesAvailable) {
	    int lastOrphanIdx = lastOrphanPtr - nodes;
	    int size = nodesUsed * 2;
	    ExprNode *newPtr;

	    if (nodes == staticNodes) {
		nodes = NULL;
	    }
	    do {
		newPtr = (ExprNode *) attemptckrealloc((char *) nodes,
			(unsigned int) size * sizeof(ExprNode));
	    } while ((newPtr == NULL)
		    && ((size -= (size - nodesUsed) / 2) > nodesUsed));
	    if (newPtr == NULL) {
		TclNewLiteralStringObj(msg,
			"not enough memory to parse expression");
		code = TCL_ERROR;
		continue;
	    }
	    nodesAvailable = size;
	    if (nodes == NULL) {
		memcpy(newPtr, staticNodes,
			(size_t) nodesUsed * sizeof(ExprNode));
	    }
	    nodes = newPtr;
	    lastOrphanPtr = nodes + lastOrphanIdx;
	}
	nodePtr = nodes + nodesUsed;
	lastNodePtr = nodePtr - 1;

	/*
	 * Skip white space between lexemes.
	 */

	scanned = TclParseAllWhiteSpace(start, numBytes);
	start += scanned;
	numBytes -= scanned;

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

	/*
	 * Use context to categorize the lexemes that are ambiguous.
	 */

	if ((NODE_TYPE & nodePtr->lexeme) == 0) {
	    switch (nodePtr->lexeme) {
	    case INVALID:
		msg = Tcl_ObjPrintf(
			"invalid character \"%.*s\"", scanned, start);
		code = TCL_ERROR;
		continue;
	    case INCOMPLETE:
		msg = Tcl_ObjPrintf(
			"incomplete operator \"%.*s\"", scanned, start);
		code = TCL_ERROR;
		continue;
	    case BAREWORD:
		if (start[scanned+TclParseAllWhiteSpace(
			start+scanned, numBytes-scanned)] == '(') {
		    nodePtr->lexeme = FUNCTION;
		} else {
		    Tcl_Obj *objPtr = Tcl_NewStringObj(start, scanned);

		    Tcl_IncrRefCount(objPtr);
		    code = Tcl_ConvertToType(NULL, objPtr, &tclBooleanType);
		    Tcl_DecrRefCount(objPtr);
		    if (code == TCL_OK) {
			nodePtr->lexeme = BOOLEAN;
		    } else {
			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) ? "" : "...");
			continue;
		    }
		}
		break;
	    case PLUS:
	    case MINUS:
		if ((NODE_TYPE & lastNodePtr->lexeme) == LEAF) {
		    nodePtr->lexeme |= BINARY;
		} else {
		    nodePtr->lexeme |= UNARY;
		}
	    }
	}

	/*
	 * Add node to parse tree based on category.
	 */

	switch (NODE_TYPE & nodePtr->lexeme) {
	case LEAF: {
	    const char *end;

	    if ((NODE_TYPE & lastNodePtr->lexeme) == LEAF) {
		const char *operand =
			scratchPtr->tokenPtr[lastNodePtr->token].start;

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

	    if (scratchPtr->numTokens+1 >= scratchPtr->tokensAvailable) {
		TclExpandTokenArray(scratchPtr);
	    }
	    nodePtr->token = scratchPtr->numTokens;
	    tokenPtr = scratchPtr->tokenPtr + nodePtr->token;
	    tokenPtr->type = TCL_TOKEN_SUB_EXPR;
	    tokenPtr->start = start;
	    scratchPtr->numTokens++;

	    switch (nodePtr->lexeme) {
	    case NUMBER:
	    case BOOLEAN:
		tokenPtr = scratchPtr->tokenPtr + scratchPtr->numTokens;
		tokenPtr->type = TCL_TOKEN_TEXT;
		tokenPtr->start = start;
		tokenPtr->size = scanned;
		tokenPtr->numComponents = 0;
		scratchPtr->numTokens++;

		break;

	    case QUOTED:
		code = Tcl_ParseQuotedString(interp, start, numBytes,
			scratchPtr, 1, &end);
		if (code != TCL_OK) {
		    scanned = scratchPtr->term - start;
		    scanned += (scanned < numBytes);
		    continue;
		}
		scanned = end - start;
		break;

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

	    case VARIABLE:
		code = Tcl_ParseVarName(interp, start, numBytes, scratchPtr, 1);
		if (code != TCL_OK) {
		    scanned = scratchPtr->term - start;
		    scanned += (scanned < numBytes);
		    continue;
		}
		tokenPtr = scratchPtr->tokenPtr + nodePtr->token + 1;
		if (tokenPtr->type != TCL_TOKEN_VARIABLE) {
		    TclNewLiteralStringObj(msg, "invalid character \"$\"");
		    code = TCL_ERROR;
		    continue;
		}
		scanned = tokenPtr->size;
		break;

	    case SCRIPT: {
		Tcl_Parse *nestedPtr =
			(Tcl_Parse *) TclStackAlloc(interp, sizeof(Tcl_Parse));
		tokenPtr = scratchPtr->tokenPtr + scratchPtr->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;
		if (code != TCL_OK) {
		    scanned = parsePtr->term - start;
		    scanned += (scanned < numBytes);
		    continue;
		}
		scanned = end - start;
		tokenPtr->size = scanned;
		scratchPtr->numTokens++;
		break;
	    }
	    }

	    tokenPtr = scratchPtr->tokenPtr + nodePtr->token;
	    tokenPtr->size = scanned;
	    tokenPtr->numComponents = scratchPtr->numTokens - nodePtr->token - 1;

	    nodePtr->left = -1;
	    nodePtr->right = -1;
	    nodePtr->parent = -1;
	    lastOrphanPtr = nodePtr;
	    nodesUsed++;
	    break;
	}

	case UNARY:
	    if ((NODE_TYPE & lastNodePtr->lexeme) == LEAF) {
		msg = Tcl_ObjPrintf("missing operator at %s", mark);
		scanned = 0;
		insertMark = 1;
		code = TCL_ERROR;
		continue;
	    }
	    nodePtr->left = -1;
	    nodePtr->right = -1;
	    nodePtr->parent = -1;

	    if (scratchPtr->numTokens >= scratchPtr->tokensAvailable) {
		TclExpandTokenArray(scratchPtr);
	    }
	    nodePtr->token = scratchPtr->numTokens;
	    tokenPtr = scratchPtr->tokenPtr + nodePtr->token;
	    tokenPtr->type = TCL_TOKEN_OPERATOR;
	    tokenPtr->start = start;
	    tokenPtr->size = scanned;
	    tokenPtr->numComponents = 0;
	    scratchPtr->numTokens++;

	    lastOrphanPtr = nodePtr;
	    nodesUsed++;
	    break;

	case BINARY: {
	    ExprNode *otherPtr = NULL;
	    unsigned char precedence = prec[nodePtr->lexeme];

	    if ((nodePtr->lexeme == CLOSE_PAREN)
		    && (lastNodePtr->lexeme == OPEN_PAREN)) {
		if (lastNodePtr[-1].lexeme == FUNCTION) {
		    /*
		     * Normally, "()" is a syntax error, but as a special case
		     * accept it as an argument list for a function.
		     */

		    scanned = 0;
		    nodePtr->lexeme = EMPTY;
		    nodePtr->left = -1;
		    nodePtr->right = -1;
		    nodePtr->parent = -1;
		    nodePtr->token = -1;

		    lastOrphanPtr = nodePtr;
		    nodesUsed++;
		    break;

		}
		msg = Tcl_ObjPrintf("empty subexpression at %s", mark);
		scanned = 0;
		insertMark = 1;
		code = TCL_ERROR;
		continue;
	    }


	    if ((NODE_TYPE & lastNodePtr->lexeme) != LEAF) {
		if (prec[lastNodePtr->lexeme] > precedence) {
		    if (lastNodePtr->lexeme == OPEN_PAREN) {
			TclNewLiteralStringObj(msg, "unbalanced open paren");
		    } else if (lastNodePtr->lexeme == COMMA) {
			msg = Tcl_ObjPrintf(
				"missing function argument at %s", mark);
			scanned = 0;
			insertMark = 1;
		    } else if (lastNodePtr->lexeme == START) {
			TclNewLiteralStringObj(msg, "empty expression");
		    }
		} else if (nodePtr->lexeme == CLOSE_PAREN) {
		    TclNewLiteralStringObj(msg, "unbalanced close paren");
		} else if ((nodePtr->lexeme == COMMA)
			&& (lastNodePtr->lexeme == OPEN_PAREN)
			&& (lastNodePtr[-1].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;
		}
		code = TCL_ERROR;
		continue;
	    }

	    while (1) {
		if (lastOrphanPtr->parent >= 0) {
		    otherPtr = nodes + lastOrphanPtr->parent;
		} else if (lastOrphanPtr->left >= 0) {
		    Tcl_Panic("Tcl_ParseExpr: left closure programming error");
		} else {
		    lastOrphanPtr->parent = lastOrphanPtr - nodes;
		    otherPtr = lastOrphanPtr;
		}
		otherPtr--;

		if (prec[otherPtr->lexeme] < precedence) {
		    break;
		}

		if (prec[otherPtr->lexeme] == precedence) {
		    /*
		     * Special association rules for the ternary operators.
		     */

		    if ((otherPtr->lexeme == QUESTION)
			    && (lastOrphanPtr->lexeme != COLON)) {
			break;
		    }
		    if ((otherPtr->lexeme == COLON)
			    && (nodePtr->lexeme == QUESTION)) {
			break;
		    }

		    /*
		     * Right association rules for exponentiation.
		     */

		    if (nodePtr->lexeme == EXPON) {
			break;
		    }
		}

		/*
		 * Some checks before linking.
		 */

		if ((otherPtr->lexeme == OPEN_PAREN)
			&& (nodePtr->lexeme != CLOSE_PAREN)) {
		    lastOrphanPtr = otherPtr;
		    TclNewLiteralStringObj(msg, "unbalanced open paren");
		    code = TCL_ERROR;
		    break;
		}
		if ((otherPtr->lexeme == QUESTION)
			&& (lastOrphanPtr->lexeme != COLON)) {
		    msg = Tcl_ObjPrintf(
			    "missing operator \":\" at %s", mark);
		    scanned = 0;
		    insertMark = 1;
		    code = TCL_ERROR;
		    break;
		}
		if ((lastOrphanPtr->lexeme == COLON)
			&& (otherPtr->lexeme != QUESTION)) {
		    TclNewLiteralStringObj(msg,
			    "unexpected operator \":\" without preceding \"?\"");
		    code = TCL_ERROR;
		    break;
		}

		/*
		 * Link orphan as right operand of otherPtr.
		 */

		otherPtr->right = lastOrphanPtr - nodes;
		lastOrphanPtr->parent = otherPtr - nodes;
		lastOrphanPtr = otherPtr;

		if (otherPtr->lexeme == OPEN_PAREN) {
		    /*
		     * CLOSE_PAREN can only close one OPEN_PAREN.
		     */

		    tokenPtr = scratchPtr->tokenPtr + otherPtr->token;
		    tokenPtr->size = start + scanned - tokenPtr->start;
		    break;
		}
		if (otherPtr->lexeme == START) {
		    /*
		     * Don't backtrack beyond the start.
		     */

		    break;
		}
	    }
	    if (code != TCL_OK) {
		continue;
	    }

	    if (nodePtr->lexeme == CLOSE_PAREN) {
		if (otherPtr->lexeme == START) {
		    TclNewLiteralStringObj(msg, "unbalanced close paren");
		    code = TCL_ERROR;
		    continue;
		}

		/*
		 * Create no node for a CLOSE_PAREN lexeme.
		 */

		break;
	    }

	    if ((nodePtr->lexeme == COMMA) && ((otherPtr->lexeme != OPEN_PAREN)
		    || (otherPtr[-1].lexeme != FUNCTION))) {
		TclNewLiteralStringObj(msg,
			"unexpected \",\" outside function argument list");
		code = TCL_ERROR;
		continue;
	    }

	    if (lastOrphanPtr->lexeme == COLON) {
		TclNewLiteralStringObj(msg,
			"unexpected operator \":\" without preceding \"?\"");
		code = TCL_ERROR;
		continue;
	    }

	    /*
	     * Link orphan as left operand of new node.
	     */

	    nodePtr->right = -1;

	    if (scratchPtr->numTokens >= scratchPtr->tokensAvailable) {
		TclExpandTokenArray(scratchPtr);
	    }
	    nodePtr->token = scratchPtr->numTokens;
	    tokenPtr = scratchPtr->tokenPtr + nodePtr->token;
	    tokenPtr->type = TCL_TOKEN_OPERATOR;
	    tokenPtr->start = start;
	    tokenPtr->size = scanned;
	    tokenPtr->numComponents = 0;
	    scratchPtr->numTokens++;

	    nodePtr->left = lastOrphanPtr - nodes;
	    nodePtr->parent = lastOrphanPtr->parent;
	    lastOrphanPtr->parent = nodePtr - nodes;
	    lastOrphanPtr = nodePtr;
	    nodesUsed++;
	    break;
	}
	}

	start += scanned;
	numBytes -= scanned;
    }

    if (code == TCL_OK) {
	/*
	 * Shift tokens from scratch space to caller space.
	 */

	GenerateTokens(nodes, scratchPtr, parsePtr);
    } else {
	if (parsePtr->errorType == TCL_PARSE_SUCCESS) {
	    parsePtr->errorType = TCL_PARSE_SYNTAX;
	    parsePtr->term = start;
	}
	if (interp == NULL) {
	    if (msg) {
		Tcl_DecrRefCount(msg);
	    }
	} else {
	    if (msg == NULL) {
		msg = Tcl_GetObjResult(interp);
	    }
	    Tcl_AppendPrintfToObj(msg,
		    "\nin expression \"%s%.*s%.*s%s%s%.*s%s\"",
		    ((start - limit) < scratchPtr->string) ? "" : "...",
		    ((start - limit) < scratchPtr->string)
		    ? (start - scratchPtr->string) : limit - 3,
		    ((start - limit) < scratchPtr->string) 
		    ? scratchPtr->string : start - limit + 3,
		    (scanned < limit) ? scanned : limit - 3, start,
		    (scanned < limit) ? "" : "...",
		    insertMark ? mark : "",
		    (start + scanned + limit > scratchPtr->end)
		    ? scratchPtr->end - (start + scanned) : limit-3, 
		    start + scanned,
		    (start + scanned + limit > scratchPtr->end) ? "" : "...");
	    if (post != NULL) {
		Tcl_AppendToObj(msg, ";\n", -1);
		Tcl_AppendObjToObj(msg, post);
		Tcl_DecrRefCount(post);
	    }
	    Tcl_SetObjResult(interp, msg);
	    numBytes = scratchPtr->end - scratchPtr->string;
	    Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
		    "\n    (parsing expression \"%.*s%s\")",
		    (numBytes < limit) ? numBytes : limit - 3,
		    scratchPtr->string, (numBytes < limit) ? "" : "..."));
	}
    }

    if (nodes != staticNodes) {
	ckfree((char *)nodes);
    }
    Tcl_FreeParse(scratchPtr);
    TclStackFree(interp, scratchPtr);
    return code;
#endif
}

#ifdef PARSE_DIRECT_EXPR_TOKENS
/*
 *----------------------------------------------------------------------
 *
 * GenerateTokens --
 *
 * 	Routine that generates Tcl_Tokens that represent a Tcl expression and
 * 	writes them to *parsePtr. The parse tree of the expression is in the
 * 	array of ExprNodes, nodes. Some of the Tcl_Tokens are copied from
 * 	scratch space at *scratchPtr, where the parsing pass that constructed
 * 	the parse tree left them.
 *
 *----------------------------------------------------------------------
 */

static void
GenerateTokens(
    ExprNode *nodes,
    Tcl_Parse *scratchPtr,
    Tcl_Parse *parsePtr)
{
    ExprNode *nodePtr = nodes + nodes->right;
    Tcl_Token *sourcePtr, *destPtr, *tokenPtr = scratchPtr->tokenPtr;
    int toCopy;
    const char *end = tokenPtr->start + tokenPtr->size;

    while (nodePtr->lexeme != START) {
	switch (NODE_TYPE & nodePtr->lexeme) {
	case BINARY:
	    if (nodePtr->left >= 0) {
		if ((nodePtr->lexeme != COMMA) && (nodePtr->lexeme != COLON)) {
		    sourcePtr = scratchPtr->tokenPtr + nodePtr->token;
		    if (parsePtr->numTokens + 1 >= parsePtr->tokensAvailable) {
			TclExpandTokenArray(parsePtr);
		    }
		    destPtr = parsePtr->tokenPtr + parsePtr->numTokens;
		    nodePtr->token = parsePtr->numTokens;
		    destPtr->type = TCL_TOKEN_SUB_EXPR;
		    destPtr->start = tokenPtr->start;
		    destPtr++;
		    *destPtr = *sourcePtr;
		    parsePtr->numTokens += 2;
		}
		nodePtr = nodes + nodePtr->left;
		nodes[nodePtr->parent].left = -1;
	    } else if (nodePtr->right >= 0) {
		tokenPtr += tokenPtr->numComponents + 1;
		nodePtr = nodes + nodePtr->right;
		nodes[nodePtr->parent].right = -1;
	    } else {
		if ((nodePtr->lexeme != COMMA) && (nodePtr->lexeme != COLON)) {
		    destPtr = parsePtr->tokenPtr + nodePtr->token;
		    destPtr->size = end - destPtr->start;
		    destPtr->numComponents =
			    parsePtr->numTokens - nodePtr->token - 1;
		}
		nodePtr = nodes + nodePtr->parent;
	    }
	    break;

	case UNARY:
	    if (nodePtr->right >= 0) {
		sourcePtr = scratchPtr->tokenPtr + nodePtr->token;
		if (nodePtr->lexeme != OPEN_PAREN) {
		    if (parsePtr->numTokens + 1 >= parsePtr->tokensAvailable) {
			TclExpandTokenArray(parsePtr);
		    }
		    destPtr = parsePtr->tokenPtr + parsePtr->numTokens;
		    nodePtr->token = parsePtr->numTokens;
		    destPtr->type = TCL_TOKEN_SUB_EXPR;
		    destPtr->start = tokenPtr->start;
		    destPtr++;
		    *destPtr = *sourcePtr;
		    parsePtr->numTokens += 2;
		}
		if (tokenPtr == sourcePtr) {
		    tokenPtr += tokenPtr->numComponents + 1;
		}
		nodePtr = nodes + nodePtr->right;
		nodes[nodePtr->parent].right = -1;
	    } else {
		if (nodePtr->lexeme != OPEN_PAREN) {
		    destPtr = parsePtr->tokenPtr + nodePtr->token;
		    destPtr->size = end - destPtr->start;
		    destPtr->numComponents =
			    parsePtr->numTokens - nodePtr->token - 1;
		} else {
		    sourcePtr = scratchPtr->tokenPtr + nodePtr->token;
		    end = sourcePtr->start + sourcePtr->size;
		}
		nodePtr = nodes + nodePtr->parent;
	    }
	    break;

	case LEAF:
	    switch (nodePtr->lexeme) {
	    case EMPTY:
		break;

	    case BRACED:
	    case QUOTED:
		sourcePtr = scratchPtr->tokenPtr + nodePtr->token;
		end = sourcePtr->start + sourcePtr->size;
		if (sourcePtr->numComponents > 1) {
		    toCopy = sourcePtr->numComponents;
		    if (tokenPtr == sourcePtr) {
			tokenPtr += toCopy + 1;
		    }
		    sourcePtr->numComponents++;
		    while (parsePtr->numTokens + toCopy + 1
			    >= parsePtr->tokensAvailable) {
			TclExpandTokenArray(parsePtr);
		    }
		    destPtr = parsePtr->tokenPtr + parsePtr->numTokens;
		    *destPtr++ = *sourcePtr;
		    *destPtr = *sourcePtr++;
		    destPtr->type = TCL_TOKEN_WORD;
		    destPtr->numComponents = toCopy;
		    destPtr++;
		    memcpy(destPtr, sourcePtr,
			    (size_t) (toCopy * sizeof(Tcl_Token)));
		    parsePtr->numTokens += toCopy + 2;
		    break;
		}

	    default:
		sourcePtr = scratchPtr->tokenPtr + nodePtr->token;
		end = sourcePtr->start + sourcePtr->size;
		toCopy = sourcePtr->numComponents + 1;
		if (tokenPtr == sourcePtr) {
		    tokenPtr += toCopy;
		}
		while (parsePtr->numTokens + toCopy - 1
			>= parsePtr->tokensAvailable) {
		    TclExpandTokenArray(parsePtr);
		}
		destPtr = parsePtr->tokenPtr + parsePtr->numTokens;
		memcpy(destPtr, sourcePtr,
			(size_t) (toCopy * sizeof(Tcl_Token)));
		parsePtr->numTokens += toCopy;
		break;

	    }
	    nodePtr = nodes + nodePtr->parent;
	    break;

	}
    }
}
#endif

/*
 *----------------------------------------------------------------------
 *
 * ParseLexeme --
 *
 *	Parse a single lexeme from the start of a string, scanning no more

	Tcl_SetStringObj(literal, start, (int) (end-start));
	*literalPtr = literal;
    } else {
	Tcl_DecrRefCount(literal);
    }
    return (end-start);
}

#ifdef USE_EXPR_TOKENS
/*
 * Boolean variable that controls whether expression compilation tracing is
 * enabled.
 */

#ifdef TCL_COMPILE_DEBUG
static int traceExprComp = 0;
#endif /* TCL_COMPILE_DEBUG */

/*
 * Definitions of numeric codes representing each expression operator. The
 * order of these must match the entries in the operatorTable below. Also the
 * codes for the relational operators (OP_LESS, OP_GREATER, OP_LE, OP_GE,
 * OP_EQ, and OP_NE) must be consecutive and in that order. Note that OP_PLUS
 * and OP_MINUS represent both unary and binary operators.
 */

#define OP_MULT		0
#define OP_DIVIDE	1
#define OP_MOD		2
#define OP_PLUS		3
#define OP_MINUS	4
#define OP_LSHIFT	5
#define OP_RSHIFT	6
#define OP_LESS		7
#define OP_GREATER	8
#define OP_LE		9
#define OP_GE		10
#define OP_EQ		11
#define OP_NEQ		12
#define OP_BITAND	13
#define OP_BITXOR	14
#define OP_BITOR	15
#define OP_LAND		16
#define OP_LOR		17
#define OP_QUESTY	18
#define OP_LNOT		19
#define OP_BITNOT	20
#define OP_STREQ	21
#define OP_STRNEQ	22
#define OP_EXPON	23
#define OP_IN_LIST	24
#define OP_NOT_IN_LIST	25

/*
 * Table describing the expression operators. Entries in this table must
 * correspond to the definitions of numeric codes for operators just above.
 */

static int opTableInitialized = 0; /* 0 means not yet initialized. */

TCL_DECLARE_MUTEX(opMutex)

typedef struct OperatorDesc {
    const char *name;		/* Name of the operator. */
    int numOperands;		/* Number of operands. 0 if the operator
				 * requires special handling. */
    int instruction;		/* Instruction opcode for the operator.
				 * Ignored if numOperands is 0. */
} OperatorDesc;

static OperatorDesc operatorTable[] = {
    {"*",   2,  INST_MULT},
    {"/",   2,  INST_DIV},
    {"%",   2,  INST_MOD},
    {"+",   0},
    {"-",   0},
    {"<<",  2,  INST_LSHIFT},
    {">>",  2,  INST_RSHIFT},
    {"<",   2,  INST_LT},
    {">",   2,  INST_GT},
    {"<=",  2,  INST_LE},
    {">=",  2,  INST_GE},
    {"==",  2,  INST_EQ},
    {"!=",  2,  INST_NEQ},
    {"&",   2,  INST_BITAND},
    {"^",   2,  INST_BITXOR},
    {"|",   2,  INST_BITOR},
    {"&&",  0},
    {"||",  0},
    {"?",   0},
    {"!",   1,  INST_LNOT},
    {"~",   1,  INST_BITNOT},
    {"eq",  2,  INST_STR_EQ},
    {"ne",  2,  INST_STR_NEQ},
    {"**",  2,	INST_EXPON},
    {"in",  2,	INST_LIST_IN},
    {"ni",  2,	INST_LIST_NOT_IN},
    {NULL}
};

/*
 * Hashtable used to map the names of expression operators to the index of
 * their OperatorDesc description.
 */

static Tcl_HashTable opHashTable;

#endif /* USE_EXPR_TOKENS */

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

#ifdef USE_EXPR_TOKENS
static void		CompileCondExpr(Tcl_Interp *interp,
			    Tcl_Token *exprTokenPtr, int *convertPtr,
			    CompileEnv *envPtr);
static void		CompileLandOrLorExpr(Tcl_Interp *interp,
			    Tcl_Token *exprTokenPtr, int opIndex,
			    CompileEnv *envPtr);
static void		CompileMathFuncCall(Tcl_Interp *interp,
			    Tcl_Token *exprTokenPtr, const char *funcName,
			    CompileEnv *envPtr);
static void		CompileSubExpr(Tcl_Interp *interp,
			    Tcl_Token *exprTokenPtr, int *convertPtr,
			    CompileEnv *envPtr);
#endif /* USE_EXPR_TOKENS */
static void		CompileExprTree(Tcl_Interp *interp, OpNode *nodes,
				Tcl_Obj *const litObjv[], Tcl_Obj *funcList,
				Tcl_Token *tokenPtr, int *convertPtr,
				CompileEnv *envPtr);

/*
 * Macro used to debug the execution of the expression compiler.
 */

#ifdef TCL_COMPILE_DEBUG
#define TRACE(exprBytes, exprLength, tokenBytes, tokenLength) \
    if (traceExprComp) { \
	fprintf(stderr, "CompileSubExpr: \"%.*s\", token \"%.*s\"\n", \
		(exprLength), (exprBytes), (tokenLength), (tokenBytes)); \
    }
#else
#define TRACE(exprBytes, exprLength, tokenBytes, tokenLength)
#endif /* TCL_COMPILE_DEBUG */

/*
 *----------------------------------------------------------------------
 *
 * TclCompileExpr --
 *
 *	This procedure compiles a string containing a Tcl expression into Tcl

    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
				 * string consists of all bytes up to the
				 * first null character. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
#ifndef USE_EXPR_TOKENS
    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 */

    Tcl_FreeParse(parsePtr);
    TclStackFree(interp, parsePtr);
    Tcl_DecrRefCount(funcList);
    Tcl_DecrRefCount(litList);
    ckfree((char *) opTree);
    return code;
#else
    Tcl_Parse *parsePtr =
	    (Tcl_Parse *) TclStackAlloc(interp, sizeof(Tcl_Parse));
    int needsNumConversion = 1;

    /*
     * If this is the first time we've been called, initialize the table of
     * expression operators.
     */

    if (numBytes < 0) {
	numBytes = (script? strlen(script) : 0);
    }
    if (!opTableInitialized) {
	Tcl_MutexLock(&opMutex);
	if (!opTableInitialized) {
	    int i;

	    Tcl_InitHashTable(&opHashTable, TCL_STRING_KEYS);
	    for (i = 0;  operatorTable[i].name != NULL;  i++) {
		int new;

		Tcl_HashEntry *hPtr = Tcl_CreateHashEntry(&opHashTable,
			operatorTable[i].name, &new);
		if (new) {
		    Tcl_SetHashValue(hPtr, (ClientData) INT2PTR(i));
		}
	    }
	    opTableInitialized = 1;
	}
	Tcl_MutexUnlock(&opMutex);
    }

    /*
     * Parse the expression then compile it.
     */

    if (TCL_OK != Tcl_ParseExpr(interp, script, numBytes, parsePtr)) {
	TclStackFree(interp, parsePtr);
	return TCL_ERROR;
    }

    /* TIP #280 : Track Lines within the expression */
    TclAdvanceLines (&envPtr->line, script, parsePtr->tokenPtr->start);

    CompileSubExpr(interp, parsePtr->tokenPtr, &needsNumConversion, envPtr);

    if (needsNumConversion) {
	/*
	 * Attempt to convert the primary's object to an int or double. This
	 * is done in order to support Tcl's policy of interpreting operands
	 * if at all possible as first integers, else floating-point numbers.
	 */

	TclEmitOpcode(INST_TRY_CVT_TO_NUMERIC, envPtr);
    }
    Tcl_FreeParse(parsePtr);
    TclStackFree(interp, parsePtr);

    return TCL_OK;
#endif
}

/*
 *----------------------------------------------------------------------
 *
 * CompileExprTree --
 *	[???]
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Adds instructions to envPtr to evaluate the expression at runtime.
 *
 *----------------------------------------------------------------------
 */

typedef struct JumpList {
    JumpFixup jump;
    int depth;
    int offset;
    int convert;
    struct JumpList *next;
} JumpList;

static void
CompileExprTree(
    Tcl_Interp *interp,
    OpNode *nodes,
    Tcl_Obj *const litObjv[],
    Tcl_Obj *funcList,
    Tcl_Token *tokenPtr,

    TclOpCmdClientData *occdPtr = (TclOpCmdClientData *)clientData;
    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, occdPtr->expected);
	return TCL_ERROR;
    }
    return TclVariadicOpCmd(clientData, interp, objc, objv);
}

/*
 *----------------------------------------------------------------------
 *
 * TclFinalizeCompilation --
 *
 *	Clean up the compilation environment so it can later be properly
 *	reinitialized. This procedure is called by Tcl_Finalize().
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Cleans up the compilation environment. At the moment, just the table
 *	of expression operators is freed.
 *
 *----------------------------------------------------------------------
 */

void
TclFinalizeCompilation(void)
{
#ifdef USE_EXPR_TOKENS
    Tcl_MutexLock(&opMutex);
    if (opTableInitialized) {
	Tcl_DeleteHashTable(&opHashTable);
	opTableInitialized = 0;
    }
    Tcl_MutexUnlock(&opMutex);
#endif
}

#ifdef USE_EXPR_TOKENS
/*
 *----------------------------------------------------------------------
 *
 * CompileSubExpr --
 *
 *	Given a pointer to a TCL_TOKEN_SUB_EXPR token describing a
 *	subexpression, this procedure emits instructions to evaluate the
 *	subexpression at runtime.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Adds instructions to envPtr to evaluate the subexpression.
 *
 *----------------------------------------------------------------------
 */

static void
CompileSubExpr(
    Tcl_Interp *interp,		/* Interp in which to compile expression */
    Tcl_Token *exprTokenPtr,	/* Points to TCL_TOKEN_SUB_EXPR token to
				 * compile. */
    int *convertPtr,		/* Writes 0 here if it is determined the
				 * final INST_TRY_CVT_TO_NUMERIC is
				 * not needed */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    /*
     * Switch on the type of the first token after the subexpression token.
     */

    Tcl_Token *tokenPtr = exprTokenPtr+1;
    TRACE(exprTokenPtr->start, exprTokenPtr->size,
	    tokenPtr->start, tokenPtr->size);
    switch (tokenPtr->type) {
    case TCL_TOKEN_WORD:
	TclCompileTokens(interp, tokenPtr+1, tokenPtr->numComponents, envPtr);
	break;

    case TCL_TOKEN_TEXT:
	TclEmitPush(TclRegisterNewLiteral(envPtr,
		tokenPtr->start, tokenPtr->size), envPtr);
	break;

    case TCL_TOKEN_BS: {
	char buffer[TCL_UTF_MAX];
	int length = Tcl_UtfBackslash(tokenPtr->start, NULL, buffer);
	TclEmitPush(TclRegisterNewLiteral(envPtr, buffer, length), envPtr);
	break;
    }

    case TCL_TOKEN_COMMAND:
	TclCompileScript(interp, tokenPtr->start+1, tokenPtr->size-2, envPtr);
	break;

    case TCL_TOKEN_VARIABLE:
	TclCompileTokens(interp, tokenPtr, 1, envPtr);
	break;

    case TCL_TOKEN_SUB_EXPR:
	CompileSubExpr(interp, tokenPtr, convertPtr, envPtr);
	break;

    case TCL_TOKEN_OPERATOR: {
	/*
	 * Look up the operator. If the operator isn't found, treat it as a
	 * math function.
	 */

	OperatorDesc *opDescPtr;
	Tcl_HashEntry *hPtr;
	const char *operator;
	Tcl_DString opBuf;
	int opIndex;

	Tcl_DStringInit(&opBuf);
	operator = Tcl_DStringAppend(&opBuf, tokenPtr->start, tokenPtr->size);
	hPtr = Tcl_FindHashEntry(&opHashTable, operator);
	if (hPtr == NULL) {
	    CompileMathFuncCall(interp, exprTokenPtr, operator, envPtr);
	    Tcl_DStringFree(&opBuf);
	    break;
	}
	Tcl_DStringFree(&opBuf);
	opIndex = PTR2INT(Tcl_GetHashValue(hPtr));
	opDescPtr = &(operatorTable[opIndex]);

	/*
	 * If the operator is "normal", compile it using information from the
	 * operator table.
	 */

	if (opDescPtr->numOperands > 0) {
	    tokenPtr++;
	    CompileSubExpr(interp, tokenPtr, convertPtr, envPtr);
	    tokenPtr += (tokenPtr->numComponents + 1);

	    if (opDescPtr->numOperands == 2) {
		CompileSubExpr(interp, tokenPtr, convertPtr, envPtr);
	    }
	    TclEmitOpcode(opDescPtr->instruction, envPtr);
	    *convertPtr = 0;
	    break;
	}

	/*
	 * The operator requires special treatment, and is either "+" or "-",
	 * or one of "&&", "||" or "?".
	 */

	switch (opIndex) {
	case OP_PLUS:
	case OP_MINUS: {
	    Tcl_Token *afterSubexprPtr = exprTokenPtr
		    + exprTokenPtr->numComponents+1;
	    tokenPtr++;
	    CompileSubExpr(interp, tokenPtr, convertPtr, envPtr);
	    tokenPtr += (tokenPtr->numComponents + 1);

	    /*
	     * Check whether the "+" or "-" is unary.
	     */

	    if (tokenPtr == afterSubexprPtr) {
		TclEmitOpcode(((opIndex==OP_PLUS)? INST_UPLUS : INST_UMINUS),
			envPtr);
		break;
	    }

	    /*
	     * The "+" or "-" is binary.
	     */

	    CompileSubExpr(interp, tokenPtr, convertPtr, envPtr);
	    TclEmitOpcode(((opIndex==OP_PLUS)? INST_ADD : INST_SUB), envPtr);
	    *convertPtr = 0;
	    break;
	}

	case OP_LAND:
	case OP_LOR:
	    CompileLandOrLorExpr(interp, exprTokenPtr, opIndex, envPtr);
	    *convertPtr = 0;
	    break;

	case OP_QUESTY:
	    CompileCondExpr(interp, exprTokenPtr, convertPtr, envPtr);
	    break;

	default:
	    Tcl_Panic("CompileSubExpr: unexpected operator %d "
		    "requiring special treatment", opIndex);
	} /* end switch on operator requiring special treatment */
	break;

    }

    default:
	Tcl_Panic("CompileSubExpr: unexpected token type %d", tokenPtr->type);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * CompileLandOrLorExpr --
 *
 *	This procedure compiles a Tcl logical and ("&&") or logical or ("||")
 *	subexpression.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Adds instructions to envPtr to evaluate the expression at runtime.
 *
 *----------------------------------------------------------------------
 */

static void
CompileLandOrLorExpr(
    Tcl_Interp *interp,		/* Interp in which compile takes place */
    Tcl_Token *exprTokenPtr,	/* Points to TCL_TOKEN_SUB_EXPR token
				 * containing the "&&" or "||" operator. */
    int opIndex,		/* A code describing the expression operator:
				 * either OP_LAND or OP_LOR. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    JumpFixup shortCircuitFixup;/* Used to fix up the short circuit jump after
				 * the first subexpression. */
    JumpFixup shortCircuitFixup2;
				/* Used to fix up the second jump to the
				 * short-circuit target. */
    JumpFixup endFixup;		/* Used to fix up jump to the end. */
    int convert = 0;
    int savedStackDepth = envPtr->currStackDepth;
    Tcl_Token *tokenPtr = exprTokenPtr+2;

    /*
     * Emit code for the first operand.
     */

    CompileSubExpr(interp, tokenPtr, &convert, envPtr);
    tokenPtr += (tokenPtr->numComponents + 1);

    /*
     * Emit the short-circuit jump.
     */

    TclEmitForwardJump(envPtr,
	    ((opIndex==OP_LAND)? TCL_FALSE_JUMP : TCL_TRUE_JUMP),
	    &shortCircuitFixup);

    /*
     * Emit code for the second operand.
     */

    CompileSubExpr(interp, tokenPtr, &convert, envPtr);

    /*
     * The result is the boolean value of the second operand. We code this in
     * a somewhat contorted manner to be able to reuse the shortCircuit value
     * and save one INST_JUMP.
     */

    TclEmitForwardJump(envPtr,
	    ((opIndex==OP_LAND)? TCL_FALSE_JUMP : TCL_TRUE_JUMP),
	    &shortCircuitFixup2);

    if (opIndex == OP_LAND) {
	TclEmitPush(TclRegisterNewLiteral(envPtr, "1", 1), envPtr);
    } else {
	TclEmitPush(TclRegisterNewLiteral(envPtr, "0", 1), envPtr);
    }
    TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &endFixup);

    /*
     * Fixup the short-circuit jumps and push the shortCircuit value. Note
     * that shortCircuitFixup2 is always a short jump.
     */

    TclFixupForwardJumpToHere(envPtr, &shortCircuitFixup2, 127);
    if (TclFixupForwardJumpToHere(envPtr, &shortCircuitFixup, 127)) {
	/*
	 * shortCircuit jump grown by 3 bytes: update endFixup.
	 */

	 endFixup.codeOffset += 3;
    }

    if (opIndex == OP_LAND) {
	TclEmitPush(TclRegisterNewLiteral(envPtr, "0", 1), envPtr);
    } else {
	TclEmitPush(TclRegisterNewLiteral(envPtr, "1", 1), envPtr);
    }

    TclFixupForwardJumpToHere(envPtr, &endFixup, 127);
    envPtr->currStackDepth = savedStackDepth + 1;
}

/*
 *----------------------------------------------------------------------
 *
 * CompileCondExpr --
 *
 *	This procedure compiles a Tcl conditional expression:
 *	condExpr ::= lorExpr ['?' condExpr ':' condExpr]
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Adds instructions to envPtr to evaluate the expression at runtime.
 *
 *----------------------------------------------------------------------
 */

static void
CompileCondExpr(
    Tcl_Interp *interp,		/* Interp in which compile takes place */
    Tcl_Token *exprTokenPtr,	/* Points to TCL_TOKEN_SUB_EXPR token
				 * containing the "?" operator. */
    int *convertPtr,		/* Describes the compilation state for the
				 * expression being compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    JumpFixup jumpAroundThenFixup, jumpAroundElseFixup;
				/* Used to update or replace one-byte jumps
				 * around the then and else expressions when
				 * their target PCs are determined. */
    Tcl_Token *tokenPtr = exprTokenPtr+2;
    int elseCodeOffset, dist, convert = 0;
    int convertThen = 1, convertElse = 1;
    int savedStackDepth = envPtr->currStackDepth;

    /*
     * Emit code for the test.
     */

    CompileSubExpr(interp, tokenPtr, &convert, envPtr);
    tokenPtr += (tokenPtr->numComponents + 1);

    /*
     * Emit the jump to the "else" expression if the test was false.
     */

    TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, &jumpAroundThenFixup);

    /*
     * Compile the "then" expression. Note that if a subexpression is only a
     * primary, we need to try to convert it to numeric. We do this to support
     * Tcl's policy of interpreting operands if at all possible as first
     * integers, else floating-point numbers.
     */

    CompileSubExpr(interp, tokenPtr, &convertThen, envPtr);
    tokenPtr += (tokenPtr->numComponents + 1);

    /*
     * Emit an unconditional jump around the "else" condExpr.
     */

    TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &jumpAroundElseFixup);

    /*
     * Compile the "else" expression.
     */

    envPtr->currStackDepth = savedStackDepth;
    elseCodeOffset = (envPtr->codeNext - envPtr->codeStart);
    CompileSubExpr(interp, tokenPtr, &convertElse, envPtr);

    /*
     * Fix up the second jump around the "else" expression.
     */

    dist = (envPtr->codeNext - envPtr->codeStart)
	    - jumpAroundElseFixup.codeOffset;
    if (TclFixupForwardJump(envPtr, &jumpAroundElseFixup, dist, 127)) {
	/*
	 * Update the else expression's starting code offset since it moved
	 * down 3 bytes too.
	 */

	elseCodeOffset += 3;
    }

    /*
     * Fix up the first jump to the "else" expression if the test was false.
     */

    dist = (elseCodeOffset - jumpAroundThenFixup.codeOffset);
    TclFixupForwardJump(envPtr, &jumpAroundThenFixup, dist, 127);
    *convertPtr = convertThen || convertElse;

    envPtr->currStackDepth = savedStackDepth + 1;
}

/*
 *----------------------------------------------------------------------
 *
 * CompileMathFuncCall --
 *
 *	This procedure compiles a call on a math function in an expression:
 *	mathFuncCall ::= funcName '(' [condExpr {',' condExpr}] ')'
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Adds instructions to envPtr to evaluate the math function at
 *	runtime.
 *
 *----------------------------------------------------------------------
 */

static void
CompileMathFuncCall(
    Tcl_Interp *interp,		/* Interp in which compile takes place */
    Tcl_Token *exprTokenPtr,	/* Points to TCL_TOKEN_SUB_EXPR token
				 * containing the math function call. */
    const char *funcName,	/* Name of the math function. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    Tcl_DString cmdName;
    int objIndex;
    Tcl_Token *tokenPtr, *afterSubexprPtr;
    int argCount;

    /*
     * Prepend "tcl::mathfunc::" to the function name, to produce the name of
     * a command that evaluates the function.  Push that command name on the
     * stack, in a literal registered to the namespace so that resolution can
     * be cached.
     */

    Tcl_DStringInit(&cmdName);
    Tcl_DStringAppend(&cmdName, "tcl::mathfunc::", -1);
    Tcl_DStringAppend(&cmdName, funcName, -1);
    objIndex = TclRegisterNewNSLiteral(envPtr, Tcl_DStringValue(&cmdName),
	    Tcl_DStringLength(&cmdName));
    TclEmitPush(objIndex, envPtr);
    Tcl_DStringFree(&cmdName);

    /*
     * Compile any arguments for the function.
     */

    argCount = 1;
    tokenPtr = exprTokenPtr+2;
    afterSubexprPtr = exprTokenPtr + (exprTokenPtr->numComponents + 1);
    while (tokenPtr != afterSubexprPtr) {
	int convert = 0;

	++argCount;
	CompileSubExpr(interp, tokenPtr, &convert, envPtr);
	tokenPtr += (tokenPtr->numComponents + 1);
    }

    /*
     * Invoke the function.
     */

    if (argCount < 255) {
	TclEmitInstInt1(INST_INVOKE_STK1, argCount, envPtr);
    } else {
	TclEmitInstInt4(INST_INVOKE_STK4, argCount, envPtr);
    }
}
#endif

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */