/* 
 * tclCompExpr.c --
 *
 *	This file contains the code to compile Tcl expressions.
 *
 * Copyright (c) 1997 Sun Microsystems, Inc.
 * Copyright (c) 1998-2000 by Scriptics Corporation.
 *
 * 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.6 2000/05/26 08:53:40 hobbs Exp $
 * RCS: @(#) $Id: tclCompExpr.c,v 1.6.14.1 2002/02/05 02:21:58 wolfsuit Exp $
 */

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

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

 *	Tcl_ExprDouble, Tcl_ExprBoolean, and Tcl_ExprBooleanObj.
 *
 * Results:
 *	The return value is TCL_OK on a successful compilation and TCL_ERROR
 *	on failure. If TCL_ERROR is returned, then the interpreter's result
 *	contains an error message.
 *
 *	envPtr->maxStackDepth is updated with the maximum number of stack
 *	elements needed to execute the expression.
 *
 *	envPtr->exprIsJustVarRef is set 1 if the expression consisted of
 *	a single variable reference as in the expression of "if $b then...".
 *	Otherwise it is set 0. This is used to implement Tcl's two level
 *	expression substitution semantics properly.
 *
 *	envPtr->exprIsComparison is set 1 if the top-level operator in the
 *	expr is a comparison. Otherwise it is set 0. If 1, because the

				 * string consists of all bytes up to the
				 * first null character. */
    CompileEnv *envPtr;		/* Holds resulting instructions. */
{
    ExprInfo info;
    Tcl_Parse parse;
    Tcl_HashEntry *hPtr;
    int maxDepth, new, i, code;
    int new, i, code;

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

    if (numBytes < 0) {

    info.exprIsJustVarRef = 1;	/* will be set 0 if anything else is seen */
    info.exprIsComparison = 0;

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

    maxDepth = 0;
    code = Tcl_ParseExpr(interp, script, numBytes, &parse);
    if (code != TCL_OK) {
	goto done;
    }

    code = CompileSubExpr(parse.tokenPtr, &info, envPtr);
    if (code != TCL_OK) {
	Tcl_FreeParse(&parse);
	goto done;
    }
    maxDepth = envPtr->maxStackDepth;
    
    if (!info.hasOperators) {
	/*
	 * 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(&parse);

    done:
    envPtr->maxStackDepth = maxDepth;
    envPtr->exprIsJustVarRef = info.exprIsJustVarRef;
    envPtr->exprIsComparison = info.exprIsComparison;
    return code;
}

/*
 *----------------------------------------------------------------------

 *	subexpression at runtime.
 *
 * Results:
 *	The return value is TCL_OK on a successful compilation and TCL_ERROR
 *	on failure. If TCL_ERROR is returned, then the interpreter's result
 *	contains an error message.
 *
 *	envPtr->maxStackDepth is updated with the maximum number of stack
 *	elements needed to execute the subexpression.
 *
 *	envPtr->exprIsJustVarRef is set 1 if the subexpression consisted of
 *	a single variable reference as in the expression of "if $b then...".
 *	Otherwise it is set 0. This is used to implement Tcl's two level
 *	expression substitution semantics properly.
 *
 *	envPtr->exprIsComparison is set 1 if the top-level operator in the
 *	subexpression is a comparison. Otherwise it is set 0. If 1, because

{
    Tcl_Interp *interp = infoPtr->interp;
    Tcl_Token *tokenPtr, *endPtr, *afterSubexprPtr;
    OperatorDesc *opDescPtr;
    Tcl_HashEntry *hPtr;
    char *operator;
    char savedChar;
    int maxDepth, objIndex, opIndex, length, code;
    int objIndex, opIndex, length, code;
    char buffer[TCL_UTF_MAX];

    if (exprTokenPtr->type != TCL_TOKEN_SUB_EXPR) {
	panic("CompileSubExpr: token type %d not TCL_TOKEN_SUB_EXPR\n",
	        exprTokenPtr->type);
    }
    maxDepth = 0;
    code = TCL_OK;

    /*
     * Switch on the type of the first token after the subexpression token.
     * After processing it, advance tokenPtr to point just after the
     * subexpression's last token.
     */
    
    tokenPtr = exprTokenPtr+1;
    TRACE(exprTokenPtr->start, exprTokenPtr->size,
	    tokenPtr->start, tokenPtr->size);
    switch (tokenPtr->type) {
        case TCL_TOKEN_WORD:
	    code = TclCompileTokens(interp, tokenPtr+1,
	            tokenPtr->numComponents, envPtr);
	    if (code != TCL_OK) {
		goto done;
	    }
	    maxDepth = envPtr->maxStackDepth;
	    tokenPtr += (tokenPtr->numComponents + 1);
	    infoPtr->exprIsJustVarRef = 0;
	    break;
	    
        case TCL_TOKEN_TEXT:
	    if (tokenPtr->size > 0) {
		objIndex = TclRegisterLiteral(envPtr, tokenPtr->start,
	                tokenPtr->size, /*onHeap*/ 0);
	    } else {
		objIndex = TclRegisterLiteral(envPtr, "", 0, /*onHeap*/ 0);
	    }
	    TclEmitPush(objIndex, envPtr);
	    maxDepth = 1;
	    tokenPtr += 1;
	    infoPtr->exprIsJustVarRef = 0;
	    break;
	    
        case TCL_TOKEN_BS:
	    length = Tcl_UtfBackslash(tokenPtr->start, (int *) NULL,
		    buffer);
	    if (length > 0) {
		objIndex = TclRegisterLiteral(envPtr, buffer, length,
	                /*onHeap*/ 0);
	    } else {
		objIndex = TclRegisterLiteral(envPtr, "", 0, /*onHeap*/ 0);
	    }
	    TclEmitPush(objIndex, envPtr);
	    maxDepth = 1;
	    tokenPtr += 1;
	    infoPtr->exprIsJustVarRef = 0;
	    break;
	    
        case TCL_TOKEN_COMMAND:
	    code = TclCompileScript(interp, tokenPtr->start+1,
		    tokenPtr->size-2, /*nested*/ 1, envPtr);
	    if (code != TCL_OK) {
		goto done;
	    }
	    maxDepth = envPtr->maxStackDepth;
	    tokenPtr += 1;
	    infoPtr->exprIsJustVarRef = 0;
	    break;
	    
        case TCL_TOKEN_VARIABLE:
	    code = TclCompileTokens(interp, tokenPtr, 1, envPtr);
	    if (code != TCL_OK) {
		goto done;
	    }
	    maxDepth = envPtr->maxStackDepth;
	    tokenPtr += (tokenPtr->numComponents + 1);
	    break;
	    
        case TCL_TOKEN_SUB_EXPR:
	    infoPtr->exprIsComparison = 0;
	    code = CompileSubExpr(tokenPtr, infoPtr, envPtr);
	    if (code != TCL_OK) {
		goto done;
	    }
	    maxDepth = envPtr->maxStackDepth;
	    tokenPtr += (tokenPtr->numComponents + 1);
	    break;
	    
        case TCL_TOKEN_OPERATOR:
	    /*
	     * Look up the operator. Temporarily overwrite the character
	     * just after the end of the operator with a 0 byte. If the

	    if (hPtr == NULL) {
		code = CompileMathFuncCall(exprTokenPtr, operator, infoPtr,
			envPtr, &endPtr);
		operator[tokenPtr->size] = (char) savedChar;
		if (code != TCL_OK) {
		    goto done;
		}
		maxDepth = envPtr->maxStackDepth;
		tokenPtr = endPtr;
		infoPtr->exprIsJustVarRef = 0;
		infoPtr->exprIsComparison = 0;
		break;
	    }
	    operator[tokenPtr->size] = (char) savedChar;
	    opIndex = (int) Tcl_GetHashValue(hPtr);
	    opDescPtr = &(operatorTable[opIndex]);

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

	    if (opDescPtr->numOperands > 0) {
		tokenPtr++;
		code = CompileSubExpr(tokenPtr, infoPtr, envPtr);
		if (code != TCL_OK) {
		    goto done;
		}
		maxDepth = envPtr->maxStackDepth;
		tokenPtr += (tokenPtr->numComponents + 1);

		if (opDescPtr->numOperands == 2) {
		    code = CompileSubExpr(tokenPtr, infoPtr, envPtr);
		    if (code != TCL_OK) {
			goto done;
		    }
		    maxDepth = TclMax((envPtr->maxStackDepth + 1),
		            maxDepth);
		    tokenPtr += (tokenPtr->numComponents + 1);
		}
		TclEmitOpcode(opDescPtr->instruction, envPtr);
		infoPtr->hasOperators = 1;
		infoPtr->exprIsJustVarRef = 0;
		infoPtr->exprIsComparison =
		    (((opIndex >= OP_LESS) && (opIndex <= OP_NEQ))

	        case OP_PLUS:
	        case OP_MINUS:
		    tokenPtr++;
		    code = CompileSubExpr(tokenPtr, infoPtr, envPtr);
		    if (code != TCL_OK) {
			goto done;
		    }
		    maxDepth = envPtr->maxStackDepth;
		    tokenPtr += (tokenPtr->numComponents + 1);
		    
		    /*
		     * Check whether the "+" or "-" is unary.
		     */
		    
		    afterSubexprPtr = exprTokenPtr

		     * The "+" or "-" is binary.
		     */
		    
		    code = CompileSubExpr(tokenPtr, infoPtr, envPtr);
		    if (code != TCL_OK) {
			goto done;
		    }
		    maxDepth = TclMax((envPtr->maxStackDepth + 1),
			    maxDepth);
		    tokenPtr += (tokenPtr->numComponents + 1);
		    TclEmitOpcode(((opIndex==OP_PLUS)? INST_ADD : INST_SUB),
			    envPtr);
		    break;

	        case OP_LAND:
	        case OP_LOR:
		    code = CompileLandOrLorExpr(exprTokenPtr, opIndex,
			    infoPtr, envPtr, &endPtr);
		    if (code != TCL_OK) {
			goto done;
		    }
		    maxDepth = envPtr->maxStackDepth;
		    tokenPtr = endPtr;
		    break;
			
	        case OP_QUESTY:
		    code = CompileCondExpr(exprTokenPtr, infoPtr,
			    envPtr, &endPtr);
		    if (code != TCL_OK) {
			goto done;
		    }
		    maxDepth = envPtr->maxStackDepth;
		    tokenPtr = endPtr;
		    break;
		    
		default:
		    panic("CompileSubExpr: unexpected operator %d requiring special treatment\n",
		        opIndex);
	    } /* end switch on operator requiring special treatment */

    
    if (tokenPtr != (exprTokenPtr + exprTokenPtr->numComponents+1)) {
	LogSyntaxError(infoPtr);
	code = TCL_ERROR;
    }
    
    done:
    envPtr->maxStackDepth = maxDepth;
    return code;
}

/*
 *----------------------------------------------------------------------
 *
 * CompileLandOrLorExpr --
 *
 *	This procedure compiles a Tcl logical and ("&&") or logical or
 *	("||") subexpression.
 *
 * Results:
 *	The return value is TCL_OK on a successful compilation and TCL_ERROR
 *	on failure. If TCL_OK is returned, a pointer to the token just after
 *	the last one in the subexpression is stored at the address in
 *	endPtrPtr. If TCL_ERROR is returned, then the interpreter's result
 *	contains an error message.
 *
 *	envPtr->maxStackDepth is updated with the maximum number of stack
 *	elements needed to execute the expression.
 *
 * Side effects:
 *	Adds instructions to envPtr to evaluate the expression at runtime.
 *
 *----------------------------------------------------------------------
 */

static int

{
    JumpFixup shortCircuitFixup; /* Used to fix up the short circuit jump
				  * after the first subexpression. */
    JumpFixup lhsTrueFixup, lhsEndFixup;
    				 /* Used to fix up jumps used to convert the
				  * first operand to 0 or 1. */
    Tcl_Token *tokenPtr;
    int dist, maxDepth, code;
    int dist, code;
    int savedStackDepth = envPtr->currStackDepth;

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

    maxDepth = 0;
    tokenPtr = exprTokenPtr+2;
    code = CompileSubExpr(tokenPtr, infoPtr, envPtr);
    if (code != TCL_OK) {
	goto done;
    }
    maxDepth = envPtr->maxStackDepth;
    tokenPtr += (tokenPtr->numComponents + 1);

    /*
     * Convert the first operand to the result that Tcl requires:
     * "0" or "1". Eventually we'll use a new instruction for this.
     */
    
    TclEmitForwardJump(envPtr, TCL_TRUE_JUMP, &lhsTrueFixup);
    TclEmitPush(TclRegisterLiteral(envPtr, "0", 1, /*onHeap*/ 0), envPtr);
    TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &lhsEndFixup);
    dist = (envPtr->codeNext - envPtr->codeStart) - lhsTrueFixup.codeOffset;
    if (TclFixupForwardJump(envPtr, &lhsTrueFixup, dist, 127)) {
        badDist:
	panic("CompileLandOrLorExpr: bad jump distance %d\n", dist);
    }
    envPtr->currStackDepth = savedStackDepth;
    TclEmitPush(TclRegisterLiteral(envPtr, "1", 1, /*onHeap*/ 0), envPtr);
    dist = (envPtr->codeNext - envPtr->codeStart) - lhsEndFixup.codeOffset;
    if (TclFixupForwardJump(envPtr, &lhsEndFixup, dist, 127)) {
	goto badDist;
    }

    /*

     * Emit code for the second operand.
     */

    code = CompileSubExpr(tokenPtr, infoPtr, envPtr);
    if (code != TCL_OK) {
	goto done;
    }
    maxDepth = TclMax((envPtr->maxStackDepth + 1), maxDepth);
    tokenPtr += (tokenPtr->numComponents + 1);

    /*
     * Emit a "logical and" or "logical or" instruction. This does not try
     * to "short- circuit" the evaluation of both operands, but instead
     * ensures that we either have a "1" or a "0" result.
     */

    dist = (envPtr->codeNext - envPtr->codeStart)
	    - shortCircuitFixup.codeOffset;
    TclFixupForwardJump(envPtr, &shortCircuitFixup, dist, 127);
    *endPtrPtr = tokenPtr;

    done:
    envPtr->maxStackDepth = maxDepth;
    envPtr->currStackDepth = savedStackDepth + 1;
    return code;
}

/*
 *----------------------------------------------------------------------
 *
 * CompileCondExpr --
 *
 *	This procedure compiles a Tcl conditional expression:
 *	condExpr ::= lorExpr ['?' condExpr ':' condExpr]
 *
 * Results:
 *	The return value is TCL_OK on a successful compilation and TCL_ERROR
 *	on failure. If TCL_OK is returned, a pointer to the token just after
 *	the last one in the subexpression is stored at the address in
 *	endPtrPtr. If TCL_ERROR is returned, then the interpreter's result
 *	contains an error message.
 *
 *	envPtr->maxStackDepth is updated with the maximum number of stack
 *	elements needed to execute the expression.
 *
 * Side effects:
 *	Adds instructions to envPtr to evaluate the expression at runtime.
 *
 *----------------------------------------------------------------------
 */

static int

				 * subexpression is stored here. */
{
    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;
    int elseCodeOffset, dist, maxDepth, code;
    int elseCodeOffset, dist, code;
    int savedStackDepth = envPtr->currStackDepth;

    /*
     * Emit code for the test.
     */

    maxDepth = 0;
    tokenPtr = exprTokenPtr+2;
    code = CompileSubExpr(tokenPtr, infoPtr, envPtr);
    if (code != TCL_OK) {
	goto done;
    }
    maxDepth = envPtr->maxStackDepth;
    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.
     */

    infoPtr->hasOperators = 0;
    code = CompileSubExpr(tokenPtr, infoPtr, envPtr);
    if (code != TCL_OK) {
	goto done;
    }
    maxDepth = TclMax(envPtr->maxStackDepth, maxDepth);
    tokenPtr += (tokenPtr->numComponents + 1);
    if (!infoPtr->hasOperators) {
	TclEmitOpcode(INST_TRY_CVT_TO_NUMERIC, envPtr);
    }

    /*
     * 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);
    infoPtr->hasOperators = 0;
    code = CompileSubExpr(tokenPtr, infoPtr, envPtr);
    if (code != TCL_OK) {
	goto done;
    }
    maxDepth = TclMax(envPtr->maxStackDepth, maxDepth);
    tokenPtr += (tokenPtr->numComponents + 1);
    if (!infoPtr->hasOperators) {
	TclEmitOpcode(INST_TRY_CVT_TO_NUMERIC, envPtr);
    }

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

     */
    
    dist = (elseCodeOffset - jumpAroundThenFixup.codeOffset);
    TclFixupForwardJump(envPtr, &jumpAroundThenFixup, dist, 127);
    *endPtrPtr = tokenPtr;

    done:
    envPtr->maxStackDepth = maxDepth;
    envPtr->currStackDepth = savedStackDepth + 1;
    return code;
}

/*
 *----------------------------------------------------------------------
 *
 * CompileMathFuncCall --
 *
 *	This procedure compiles a call on a math function in an expression:
 *	mathFuncCall ::= funcName '(' [condExpr {',' condExpr}] ')'
 *
 * Results:
 *	The return value is TCL_OK on a successful compilation and TCL_ERROR
 *	on failure. If TCL_OK is returned, a pointer to the token just after
 *	the last one in the subexpression is stored at the address in
 *	endPtrPtr. If TCL_ERROR is returned, then the interpreter's result
 *	contains an error message.
 *
 *	envPtr->maxStackDepth is updated with the maximum number of stack
 *	elements needed to execute the function.
 *
 * Side effects:
 *	Adds instructions to envPtr to evaluate the math function at
 *	runtime.
 *
 *----------------------------------------------------------------------
 */

				 * subexpression is stored here. */
{
    Tcl_Interp *interp = infoPtr->interp;
    Interp *iPtr = (Interp *) interp;
    MathFunc *mathFuncPtr;
    Tcl_HashEntry *hPtr;
    Tcl_Token *tokenPtr, *afterSubexprPtr;
    int maxDepth, code, i;
    int code, i;

    /*
     * Look up the MathFunc record for the function.
     */

    code = TCL_OK;
    maxDepth = 0;
    hPtr = Tcl_FindHashEntry(&iPtr->mathFuncTable, funcName);
    if (hPtr == NULL) {
	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
		"unknown math function \"", funcName, "\"", (char *) NULL);
	code = TCL_ERROR;
	goto done;
    }
    mathFuncPtr = (MathFunc *) Tcl_GetHashValue(hPtr);

    /*
     * If not a builtin function, push an object with the function's name.
     */

    if (mathFuncPtr->builtinFuncIndex < 0) {
	TclEmitPush(TclRegisterLiteral(envPtr, funcName, -1, /*onHeap*/ 0),
	        envPtr);
	maxDepth = 1;
    }

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

    tokenPtr = exprTokenPtr+2;

	    }
	    infoPtr->exprIsComparison = 0;
	    code = CompileSubExpr(tokenPtr, infoPtr, envPtr);
	    if (code != TCL_OK) {
		goto done;
	    }
	    tokenPtr += (tokenPtr->numComponents + 1);
	    maxDepth++;
	}
	if (tokenPtr != afterSubexprPtr) {
	    Tcl_ResetResult(interp);
	    Tcl_AppendToObj(Tcl_GetObjResult(interp),
		    "too many arguments for math function", -1);
	    code = TCL_ERROR;
	    goto done;

    /*
     * Compile the call on the math function. Note that the "objc" argument
     * count for non-builtin functions is incremented by 1 to include the
     * function name itself.
     */

    if (mathFuncPtr->builtinFuncIndex >= 0) { /* a builtin function */
	/*
	 * Adjust the current stack depth by the number of arguments
	 * of the builtin function. This cannot be handled by the 
	 * TclEmitInstInt1 macro as the number of arguments is not
	 * passed as an operand.
	 */

	if (envPtr->maxStackDepth < envPtr->currStackDepth) {
	    envPtr->maxStackDepth = envPtr->currStackDepth;
	}
	TclEmitInstInt1(INST_CALL_BUILTIN_FUNC1, 
	TclEmitInstInt1(INST_CALL_BUILTIN_FUNC1,
	        mathFuncPtr->builtinFuncIndex, envPtr);
	envPtr->currStackDepth -= mathFuncPtr->numArgs;
    } else {
	TclEmitInstInt1(INST_CALL_FUNC1, (mathFuncPtr->numArgs+1), envPtr);
    }
    *endPtrPtr = afterSubexprPtr;

    done:
    envPtr->maxStackDepth = maxDepth;
    return code;
}

/*
 *----------------------------------------------------------------------
 *
 * LogSyntaxError --