/* 

 * tclCompExpr.c --

 *

 *	This file contains the code to compile Tcl expressions.

 *

 * Copyright (c) 1997 Sun Microsystems, Inc.

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

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

 *

 * 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.13.2.3 2006/11/28 22:20:00 andreas_kupries Exp $

 */

#include "tclInt.h"

#include "tclCompile.h"

#if defined(__SYMBIAN32__) 

#include "tclSymbianGlobals.h"

#endif 

/*

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

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

 * the errno from tclExecute.c here.

 */

#ifndef TCL_GENERIC_ONLY

#include "tclPort.h"

#else

#define NO_ERRNO_H

#endif

#ifdef NO_ERRNO_H

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

#define ERANGE 34

#endif

/*

 * Boolean variable that controls whether expression compilation tracing

 * is enabled.

 */

#ifdef TCL_COMPILE_DEBUG

static int traceExprComp = 0;

#endif /* TCL_COMPILE_DEBUG */

/*

 * The ExprInfo structure describes the state of compiling an expression.

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

 * this module.

 */

typedef struct ExprInfo {

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

    Tcl_Parse *parsePtr;	/* Structure filled with information about

				 * the parsed expression. */

    CONST char *expr;		/* The expression that was originally passed

				 * to TclCompileExpr. */

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

    int hasOperators;		/* Set 1 if the expr has operators; 0 if

				 * expr is only a primary. If 1 after

				 * compiling an expr, a tryCvtToNumeric

				 * instruction is emitted to convert the

				 * primary to a number if possible. */

} ExprInfo;

/*

 * 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

/*

 * Table describing the expression operators. Entries in this table must

 * correspond to the definitions of numeric codes for operators just above.

 */

#if !defined(__SYMBIAN32__) || !defined(__WINSCW__)

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

#endif

TCL_DECLARE_MUTEX(opMutex)

typedef struct OperatorDesc {

    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},

    {NULL}

};

#if !defined(__SYMBIAN32__) || !defined(__WINSCW__)

/*

 * Hashtable used to map the names of expression operators to the index

 * of their OperatorDesc description.

 */

static Tcl_HashTable opHashTable;

#endif

/*

 * Declarations for local procedures to this file:

 */

static int		CompileCondExpr _ANSI_ARGS_((

			    Tcl_Token *exprTokenPtr, ExprInfo *infoPtr,

			    CompileEnv *envPtr, Tcl_Token **endPtrPtr));

static int		CompileLandOrLorExpr _ANSI_ARGS_((

			    Tcl_Token *exprTokenPtr, int opIndex,

			    ExprInfo *infoPtr, CompileEnv *envPtr,

			    Tcl_Token **endPtrPtr));

static int		CompileMathFuncCall _ANSI_ARGS_((

			    Tcl_Token *exprTokenPtr, CONST char *funcName,

			    ExprInfo *infoPtr, CompileEnv *envPtr,

			    Tcl_Token **endPtrPtr));

static int		CompileSubExpr _ANSI_ARGS_((

			    Tcl_Token *exprTokenPtr, ExprInfo *infoPtr,

			    CompileEnv *envPtr));

static void		LogSyntaxError _ANSI_ARGS_((ExprInfo *infoPtr));

/*

 * 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 bytecodes. This procedure is the top-level interface to the

 *	the expression compilation module, and is used by such public

 *	procedures as Tcl_ExprString, Tcl_ExprStringObj, Tcl_ExprLong,

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

 *

 * Side effects:

 *	Adds instructions to envPtr to evaluate the expression at runtime.

 *

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

 */

int

TclCompileExpr(interp, script, numBytes, envPtr)

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

{

    ExprInfo info;

    Tcl_Parse parse;

    Tcl_HashEntry *hPtr;

    int new, i, code;

    /*

     * 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) {

	    Tcl_InitHashTable(&opHashTable, TCL_STRING_KEYS);

	    for (i = 0;  operatorTable[i].name != NULL;  i++) {

		hPtr = Tcl_CreateHashEntry(&opHashTable,

			operatorTable[i].name, &new);

		if (new) {

		    Tcl_SetHashValue(hPtr, (ClientData) i);

		}

	    }

	    opTableInitialized = 1;

	}

	Tcl_MutexUnlock(&opMutex);

    }

    /*

     * Initialize the structure containing information abvout this

     * expression compilation.

     */

    info.interp = interp;

    info.parsePtr = &parse;

    info.expr = script;

    info.lastChar = (script + numBytes); 

    info.hasOperators = 0;

    /*

     * Parse the expression then compile it.

     */

    code = Tcl_ParseExpr(interp, script, numBytes, &parse);

    if (code != TCL_OK) {

	goto done;

    }

#ifdef TCL_TIP280

    /* TIP #280 : Track Lines within the expression */

    TclAdvanceLines (&envPtr->line, script, parse.tokenPtr->start);

#endif

    code = CompileSubExpr(parse.tokenPtr, &info, envPtr);

    if (code != TCL_OK) {

	Tcl_FreeParse(&parse);

	goto done;

    }

    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:

    return code;

}

/*

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

 *

 * 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()

{

    Tcl_MutexLock(&opMutex);

    if (opTableInitialized) {

        Tcl_DeleteHashTable(&opHashTable);

        opTableInitialized = 0;

    }

    Tcl_MutexUnlock(&opMutex);

}

/*

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

 *

 * 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:

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

 *

 * Side effects:

 *	Adds instructions to envPtr to evaluate the subexpression.

 *

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

 */

static int

CompileSubExpr(exprTokenPtr, infoPtr, envPtr)

    Tcl_Token *exprTokenPtr;	/* Points to TCL_TOKEN_SUB_EXPR token

				 * to compile. */

    ExprInfo *infoPtr;		/* Describes the compilation state for the

				 * expression being compiled. */

    CompileEnv *envPtr;		/* Holds resulting instructions. */

{

    Tcl_Interp *interp = infoPtr->interp;

    Tcl_Token *tokenPtr, *endPtr = NULL; /* silence gcc 4 warning */

    Tcl_Token *afterSubexprPtr;

    OperatorDesc *opDescPtr;

    Tcl_HashEntry *hPtr;

    CONST char *operator;

    Tcl_DString opBuf;

    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);

    }

    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;

	    }

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

	    break;

        case TCL_TOKEN_TEXT:

	    if (tokenPtr->size > 0) {

		objIndex = TclRegisterNewLiteral(envPtr, tokenPtr->start,

	                tokenPtr->size);

	    } else {

		objIndex = TclRegisterNewLiteral(envPtr, "", 0);

	    }

	    TclEmitPush(objIndex, envPtr);

	    tokenPtr += 1;

	    break;

        case TCL_TOKEN_BS:

	    length = Tcl_UtfBackslash(tokenPtr->start, (int *) NULL,

		    buffer);

	    if (length > 0) {

		objIndex = TclRegisterNewLiteral(envPtr, buffer, length);

	    } else {

		objIndex = TclRegisterNewLiteral(envPtr, "", 0);

	    }

	    TclEmitPush(objIndex, envPtr);

	    tokenPtr += 1;

	    break;

        case TCL_TOKEN_COMMAND:

	    code = TclCompileScript(interp, tokenPtr->start+1,

		    tokenPtr->size-2, /*nested*/ 0, envPtr);

	    if (code != TCL_OK) {

		goto done;

	    }

	    tokenPtr += 1;

	    break;

        case TCL_TOKEN_VARIABLE:

	    code = TclCompileTokens(interp, tokenPtr, 1, envPtr);

	    if (code != TCL_OK) {

		goto done;

	    }

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

	    break;

        case TCL_TOKEN_SUB_EXPR:

	    code = CompileSubExpr(tokenPtr, infoPtr, envPtr);

	    if (code != TCL_OK) {

		goto done;

	    }

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

	    break;

        case TCL_TOKEN_OPERATOR:

	    /*

	     * Look up the operator.  If the operator isn't found, treat it

	     * as a math function.

	     */

	    Tcl_DStringInit(&opBuf);

	    operator = Tcl_DStringAppend(&opBuf, 

		    tokenPtr->start, tokenPtr->size);

	    hPtr = Tcl_FindHashEntry(&opHashTable, operator);

	    if (hPtr == NULL) {

		code = CompileMathFuncCall(exprTokenPtr, operator, infoPtr,

			envPtr, &endPtr);

		Tcl_DStringFree(&opBuf);

		if (code != TCL_OK) {

		    goto done;

		}

		tokenPtr = endPtr;

		break;

	    }

	    Tcl_DStringFree(&opBuf);

	    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;

		}

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

		if (opDescPtr->numOperands == 2) {

		    code = CompileSubExpr(tokenPtr, infoPtr, envPtr);

		    if (code != TCL_OK) {

			goto done;

		    }

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

		}

		TclEmitOpcode(opDescPtr->instruction, envPtr);

		infoPtr->hasOperators = 1;

		break;

	    }

	    /*

	     * The operator requires special treatment, and is either

	     * "+" or "-", or one of "&&", "||" or "?".

	     */

	    switch (opIndex) {

	        case OP_PLUS:

	        case OP_MINUS:

		    tokenPtr++;

		    code = CompileSubExpr(tokenPtr, infoPtr, envPtr);

		    if (code != TCL_OK) {

			goto done;

		    }

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

		    /*

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

		     */

		    afterSubexprPtr = exprTokenPtr

			    + exprTokenPtr->numComponents+1;

		    if (tokenPtr == afterSubexprPtr) {

			TclEmitOpcode(((opIndex==OP_PLUS)?

			        INST_UPLUS : INST_UMINUS),

			        envPtr);

			break;

		    }

		    /*

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

		     */

		    code = CompileSubExpr(tokenPtr, infoPtr, envPtr);

		    if (code != TCL_OK) {

			goto done;

		    }

		    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;