/[dtapublic]/projs/trunk/shared_source/c_tcl_base_7_5_w_mods/tclcompexpr.c
ViewVC logotype

Diff of /projs/trunk/shared_source/c_tcl_base_7_5_w_mods/tclcompexpr.c

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

to_be_filed/sf_code/esrgpcpj/shared/tcl_base/tclcompexpr.c revision 29 by dashley, Sat Oct 8 07:08:47 2016 UTC projs/trunk/shared_source/c_tcl_base_7_5_w_mods/tclcompexpr.c revision 71 by dashley, Sat Nov 5 11:07:06 2016 UTC
# Line 1  Line 1 
 /* $Header: /cvsroot/esrg/sfesrg/esrgpcpj/shared/tcl_base/tclcompexpr.c,v 1.1.1.1 2001/06/13 04:35:43 dtashley Exp $ */  
   
 /*  
  * tclCompExpr.c --  
  *  
  *      This file contains the code to compile Tcl expressions.  
  *  
  * Copyright (c) 1997 Sun Microsystems, Inc.  
  *  
  * 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.1.1.1 2001/06/13 04:35:43 dtashley Exp $  
  */  
   
 #include "tclInt.h"  
 #include "tclCompile.h"  
   
 /*  
  * 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. */  
     char *expr;                 /* The expression that was originally passed  
                                  * to TclCompileExpr. */  
     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. */  
     int exprIsJustVarRef;       /* Set 1 if the expr consists of just a  
                                  * variable reference as in the expression  
                                  * of "if $b then...". Otherwise 0. If 1 the  
                                  * expr is compiled out-of-line in order to  
                                  * implement expr's 2 level substitution  
                                  * semantics properly. */  
     int exprIsComparison;       /* Set 1 if the top-level operator in the  
                                  * expr is a comparison. Otherwise 0. If 1,  
                                  * because the operands might be strings,  
                                  * the expr is compiled out-of-line in order  
                                  * to implement expr's 2 level substitution  
                                  * semantics properly. */  
 } 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  
   
 /*  
  * 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 {  
     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;  
   
 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},  
     {NULL}  
 };  
   
 /*  
  * Hashtable used to map the names of expression operators to the index  
  * of their OperatorDesc description.  
  */  
   
 static Tcl_HashTable opHashTable;  
   
 /*  
  * 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, 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.  
  *  
  *      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  
  *      operands might be strings, the expr is compiled out-of-line in order  
  *      to implement expr's 2 level substitution semantics properly.  
  *  
  * 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. */  
     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 maxDepth, 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;  
     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;  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * TclFinalizeCompilation --  
  *  
  *      Clean up the compilation environment so it can later be  
  *      properly reinitialized. This procedure is called by  
  *      TclFinalizeCompExecEnv() in tclObj.c, which in turn 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.  
  *  
  *      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  
  *      the operands might be strings, the expr is compiled out-of-line in  
  *      order to implement expr's 2 level substitution semantics properly.  
  *  
  * 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, *afterSubexprPtr;  
     OperatorDesc *opDescPtr;  
     Tcl_HashEntry *hPtr;  
     char *operator;  
     char savedChar;  
     int maxDepth, 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  
              * operator isn't found, treat it as a math function.  
              */  
   
             /*  
              * TODO: Note that the string is modified in place.  This is unsafe  
              * and will break if any of the routines called while the string is  
              * modified have side effects that depend on the original string  
              * being unmodified (e.g. adding an entry to the literal table).  
              */  
   
             operator = tokenPtr->start;  
             savedChar = operator[tokenPtr->size];  
             operator[tokenPtr->size] = 0;  
             hPtr = Tcl_FindHashEntry(&opHashTable, operator);  
             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));  
                 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;  
                     }  
                     maxDepth = envPtr->maxStackDepth;  
                     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;  
                     }  
                     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 */  
             infoPtr->hasOperators = 1;  
             infoPtr->exprIsJustVarRef = 0;  
             infoPtr->exprIsComparison = 0;  
             break;  
   
         default:  
             panic("CompileSubExpr: unexpected token type %d\n",  
                     tokenPtr->type);  
     }  
   
     /*  
      * Verify that the subexpression token had the required number of  
      * subtokens: that we've advanced tokenPtr just beyond the  
      * subexpression's last token. For example, a "*" subexpression must  
      * contain the tokens for exactly two operands.  
      */  
       
     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  
 CompileLandOrLorExpr(exprTokenPtr, opIndex, infoPtr, envPtr, endPtrPtr)  
     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. */  
     ExprInfo *infoPtr;           /* Describes the compilation state for the  
                                   * expression being compiled. */  
     CompileEnv *envPtr;          /* Holds resulting instructions. */  
     Tcl_Token **endPtrPtr;       /* If successful, a pointer to the token  
                                   * just after the last token in the  
                                   * subexpression is stored here. */  
 {  
     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;  
   
     /*  
      * 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);  
     }  
     TclEmitPush(TclRegisterLiteral(envPtr, "1", 1, /*onHeap*/ 0), envPtr);  
     dist = (envPtr->codeNext - envPtr->codeStart) - lhsEndFixup.codeOffset;  
     if (TclFixupForwardJump(envPtr, &lhsEndFixup, dist, 127)) {  
         goto badDist;  
     }  
   
     /*  
      * Emit the "short circuit" jump around the rest of the expression.  
      * Duplicate the "0" or "1" on top of the stack first to keep the  
      * jump from consuming it.  
      */  
   
     TclEmitOpcode(INST_DUP, envPtr);  
     TclEmitForwardJump(envPtr,  
             ((opIndex==OP_LAND)? TCL_FALSE_JUMP : TCL_TRUE_JUMP),  
             &shortCircuitFixup);  
   
     /*  
      * 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.  
      */  
   
     TclEmitOpcode(((opIndex==OP_LAND)? INST_LAND : INST_LOR), envPtr);  
   
     /*  
      * Now that we know the target of the forward jump, update it with the  
      * correct distance.  
      */  
   
     dist = (envPtr->codeNext - envPtr->codeStart)  
             - shortCircuitFixup.codeOffset;  
     TclFixupForwardJump(envPtr, &shortCircuitFixup, dist, 127);  
     *endPtrPtr = tokenPtr;  
   
     done:  
     envPtr->maxStackDepth = maxDepth;  
     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  
 CompileCondExpr(exprTokenPtr, infoPtr, envPtr, endPtrPtr)  
     Tcl_Token *exprTokenPtr;    /* Points to TCL_TOKEN_SUB_EXPR token  
                                  * containing the "?" operator. */  
     ExprInfo *infoPtr;          /* Describes the compilation state for the  
                                  * expression being compiled. */  
     CompileEnv *envPtr;         /* Holds resulting instructions. */  
     Tcl_Token **endPtrPtr;      /* If successful, a pointer to the token  
                                  * just after the last token in the  
                                  * 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;  
   
     /*  
      * 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.  
      */  
   
     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 = (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);  
     *endPtrPtr = tokenPtr;  
   
     done:  
     envPtr->maxStackDepth = maxDepth;  
     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.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 static int  
 CompileMathFuncCall(exprTokenPtr, funcName, infoPtr, envPtr, endPtrPtr)  
     Tcl_Token *exprTokenPtr;    /* Points to TCL_TOKEN_SUB_EXPR token  
                                  * containing the math function call. */  
     char *funcName;             /* Name of the math function. */  
     ExprInfo *infoPtr;          /* Describes the compilation state for the  
                                  * expression being compiled. */  
     CompileEnv *envPtr;         /* Holds resulting instructions. */  
     Tcl_Token **endPtrPtr;      /* If successful, a pointer to the token  
                                  * just after the last token in the  
                                  * 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;  
   
     /*  
      * 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;  
     afterSubexprPtr = exprTokenPtr + (exprTokenPtr->numComponents + 1);  
     if (mathFuncPtr->numArgs > 0) {  
         for (i = 0;  i < mathFuncPtr->numArgs;  i++) {  
             if (tokenPtr == afterSubexprPtr) {  
                 Tcl_ResetResult(interp);  
                 Tcl_AppendToObj(Tcl_GetObjResult(interp),  
                         "too few arguments for math function", -1);  
                 code = TCL_ERROR;  
                 goto done;  
             }  
             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;  
         }  
     } else 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 */  
         TclEmitInstInt1(INST_CALL_BUILTIN_FUNC1,  
                 mathFuncPtr->builtinFuncIndex, envPtr);  
     } else {  
         TclEmitInstInt1(INST_CALL_FUNC1, (mathFuncPtr->numArgs+1), envPtr);  
     }  
     *endPtrPtr = afterSubexprPtr;  
   
     done:  
     envPtr->maxStackDepth = maxDepth;  
     return code;  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * LogSyntaxError --  
  *  
  *      This procedure is invoked after an error occurs when compiling an  
  *      expression. It sets the interpreter result to an error message  
  *      describing the error.  
  *  
  * Results:  
  *      None.  
  *  
  * Side effects:  
  *      Sets the interpreter result to an error message describing the  
  *      expression that was being compiled when the error occurred.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 static void  
 LogSyntaxError(infoPtr)  
     ExprInfo *infoPtr;          /* Describes the compilation state for the  
                                  * expression being compiled. */  
 {  
     int numBytes = (infoPtr->lastChar - infoPtr->expr);  
     char buffer[100];  
   
     sprintf(buffer, "syntax error in expression \"%.*s\"",  
             ((numBytes > 60)? 60 : numBytes), infoPtr->expr);  
     Tcl_AppendStringsToObj(Tcl_GetObjResult(infoPtr->interp),  
             buffer, (char *) NULL);  
 }  
   
   
 /* $History: tclcompexpr.c $  
  *  
  * *****************  Version 1  *****************  
  * User: Dtashley     Date: 1/02/01    Time: 1:27a  
  * Created in $/IjuScripter, IjuConsole/Source/Tcl Base  
  * Initial check-in.  
  */  
   
 /* End of TCLCOMPEXPR.C */  
1    /* $Header$ */
2    /*
3     * tclCompExpr.c --
4     *
5     *      This file contains the code to compile Tcl expressions.
6     *
7     * Copyright (c) 1997 Sun Microsystems, Inc.
8     *
9     * See the file "license.terms" for information on usage and redistribution
10     * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
11     *
12     * RCS: @(#) $Id: tclcompexpr.c,v 1.1.1.1 2001/06/13 04:35:43 dtashley Exp $
13     */
14    
15    #include "tclInt.h"
16    #include "tclCompile.h"
17    
18    /*
19     * The stuff below is a bit of a hack so that this file can be used in
20     * environments that include no UNIX, i.e. no errno: just arrange to use
21     * the errno from tclExecute.c here.
22     */
23    
24    #ifndef TCL_GENERIC_ONLY
25    #include "tclPort.h"
26    #else
27    #define NO_ERRNO_H
28    #endif
29    
30    #ifdef NO_ERRNO_H
31    extern int errno;                       /* Use errno from tclExecute.c. */
32    #define ERANGE 34
33    #endif
34    
35    /*
36     * Boolean variable that controls whether expression compilation tracing
37     * is enabled.
38     */
39    
40    #ifdef TCL_COMPILE_DEBUG
41    static int traceExprComp = 0;
42    #endif /* TCL_COMPILE_DEBUG */
43    
44    /*
45     * The ExprInfo structure describes the state of compiling an expression.
46     * A pointer to an ExprInfo record is passed among the routines in
47     * this module.
48     */
49    
50    typedef struct ExprInfo {
51        Tcl_Interp *interp;         /* Used for error reporting. */
52        Tcl_Parse *parsePtr;        /* Structure filled with information about
53                                     * the parsed expression. */
54        char *expr;                 /* The expression that was originally passed
55                                     * to TclCompileExpr. */
56        char *lastChar;             /* Points just after last byte of expr. */
57        int hasOperators;           /* Set 1 if the expr has operators; 0 if
58                                     * expr is only a primary. If 1 after
59                                     * compiling an expr, a tryCvtToNumeric
60                                     * instruction is emitted to convert the
61                                     * primary to a number if possible. */
62        int exprIsJustVarRef;       /* Set 1 if the expr consists of just a
63                                     * variable reference as in the expression
64                                     * of "if $b then...". Otherwise 0. If 1 the
65                                     * expr is compiled out-of-line in order to
66                                     * implement expr's 2 level substitution
67                                     * semantics properly. */
68        int exprIsComparison;       /* Set 1 if the top-level operator in the
69                                     * expr is a comparison. Otherwise 0. If 1,
70                                     * because the operands might be strings,
71                                     * the expr is compiled out-of-line in order
72                                     * to implement expr's 2 level substitution
73                                     * semantics properly. */
74    } ExprInfo;
75    
76    /*
77     * Definitions of numeric codes representing each expression operator.
78     * The order of these must match the entries in the operatorTable below.
79     * Also the codes for the relational operators (OP_LESS, OP_GREATER,
80     * OP_LE, OP_GE, OP_EQ, and OP_NE) must be consecutive and in that order.
81     * Note that OP_PLUS and OP_MINUS represent both unary and binary operators.
82     */
83    
84    #define OP_MULT         0
85    #define OP_DIVIDE       1
86    #define OP_MOD          2
87    #define OP_PLUS         3
88    #define OP_MINUS        4
89    #define OP_LSHIFT       5
90    #define OP_RSHIFT       6
91    #define OP_LESS         7
92    #define OP_GREATER      8
93    #define OP_LE           9
94    #define OP_GE           10
95    #define OP_EQ           11
96    #define OP_NEQ          12
97    #define OP_BITAND       13
98    #define OP_BITXOR       14
99    #define OP_BITOR        15
100    #define OP_LAND         16
101    #define OP_LOR          17
102    #define OP_QUESTY       18
103    #define OP_LNOT         19
104    #define OP_BITNOT       20
105    
106    /*
107     * Table describing the expression operators. Entries in this table must
108     * correspond to the definitions of numeric codes for operators just above.
109     */
110    
111    static int opTableInitialized = 0; /* 0 means not yet initialized. */
112    
113    TCL_DECLARE_MUTEX(opMutex)
114    
115    typedef struct OperatorDesc {
116        char *name;                 /* Name of the operator. */
117        int numOperands;            /* Number of operands. 0 if the operator
118                                     * requires special handling. */
119        int instruction;            /* Instruction opcode for the operator.
120                                     * Ignored if numOperands is 0. */
121    } OperatorDesc;
122    
123    OperatorDesc operatorTable[] = {
124        {"*",   2,  INST_MULT},
125        {"/",   2,  INST_DIV},
126        {"%",   2,  INST_MOD},
127        {"+",   0},
128        {"-",   0},
129        {"<<",  2,  INST_LSHIFT},
130        {">>",  2,  INST_RSHIFT},
131        {"<",   2,  INST_LT},
132        {">",   2,  INST_GT},
133        {"<=",  2,  INST_LE},
134        {">=",  2,  INST_GE},
135        {"==",  2,  INST_EQ},
136        {"!=",  2,  INST_NEQ},
137        {"&",   2,  INST_BITAND},
138        {"^",   2,  INST_BITXOR},
139        {"|",   2,  INST_BITOR},
140        {"&&",  0},
141        {"||",  0},
142        {"?",   0},
143        {"!",   1,  INST_LNOT},
144        {"~",   1,  INST_BITNOT},
145        {NULL}
146    };
147    
148    /*
149     * Hashtable used to map the names of expression operators to the index
150     * of their OperatorDesc description.
151     */
152    
153    static Tcl_HashTable opHashTable;
154    
155    /*
156     * Declarations for local procedures to this file:
157     */
158    
159    static int              CompileCondExpr _ANSI_ARGS_((
160                                Tcl_Token *exprTokenPtr, ExprInfo *infoPtr,
161                                CompileEnv *envPtr, Tcl_Token **endPtrPtr));
162    static int              CompileLandOrLorExpr _ANSI_ARGS_((
163                                Tcl_Token *exprTokenPtr, int opIndex,
164                                ExprInfo *infoPtr, CompileEnv *envPtr,
165                                Tcl_Token **endPtrPtr));
166    static int              CompileMathFuncCall _ANSI_ARGS_((
167                                Tcl_Token *exprTokenPtr, char *funcName,
168                                ExprInfo *infoPtr, CompileEnv *envPtr,
169                                Tcl_Token **endPtrPtr));
170    static int              CompileSubExpr _ANSI_ARGS_((
171                                Tcl_Token *exprTokenPtr, ExprInfo *infoPtr,
172                                CompileEnv *envPtr));
173    static void             LogSyntaxError _ANSI_ARGS_((ExprInfo *infoPtr));
174    
175    /*
176     * Macro used to debug the execution of the expression compiler.
177     */
178    
179    #ifdef TCL_COMPILE_DEBUG
180    #define TRACE(exprBytes, exprLength, tokenBytes, tokenLength) \
181        if (traceExprComp) { \
182            fprintf(stderr, "CompileSubExpr: \"%.*s\", token \"%.*s\"\n", \
183                    (exprLength), (exprBytes), (tokenLength), (tokenBytes)); \
184        }
185    #else
186    #define TRACE(exprBytes, exprLength, tokenBytes, tokenLength)
187    #endif /* TCL_COMPILE_DEBUG */
188    
189    /*
190     *----------------------------------------------------------------------
191     *
192     * TclCompileExpr --
193     *
194     *      This procedure compiles a string containing a Tcl expression into
195     *      Tcl bytecodes. This procedure is the top-level interface to the
196     *      the expression compilation module, and is used by such public
197     *      procedures as Tcl_ExprString, Tcl_ExprStringObj, Tcl_ExprLong,
198     *      Tcl_ExprDouble, Tcl_ExprBoolean, and Tcl_ExprBooleanObj.
199     *
200     * Results:
201     *      The return value is TCL_OK on a successful compilation and TCL_ERROR
202     *      on failure. If TCL_ERROR is returned, then the interpreter's result
203     *      contains an error message.
204     *
205     *      envPtr->maxStackDepth is updated with the maximum number of stack
206     *      elements needed to execute the expression.
207     *
208     *      envPtr->exprIsJustVarRef is set 1 if the expression consisted of
209     *      a single variable reference as in the expression of "if $b then...".
210     *      Otherwise it is set 0. This is used to implement Tcl's two level
211     *      expression substitution semantics properly.
212     *
213     *      envPtr->exprIsComparison is set 1 if the top-level operator in the
214     *      expr is a comparison. Otherwise it is set 0. If 1, because the
215     *      operands might be strings, the expr is compiled out-of-line in order
216     *      to implement expr's 2 level substitution semantics properly.
217     *
218     * Side effects:
219     *      Adds instructions to envPtr to evaluate the expression at runtime.
220     *
221     *----------------------------------------------------------------------
222     */
223    
224    int
225    TclCompileExpr(interp, script, numBytes, envPtr)
226        Tcl_Interp *interp;         /* Used for error reporting. */
227        char *script;               /* The source script to compile. */
228        int numBytes;               /* Number of bytes in script. If < 0, the
229                                     * string consists of all bytes up to the
230                                     * first null character. */
231        CompileEnv *envPtr;         /* Holds resulting instructions. */
232    {
233        ExprInfo info;
234        Tcl_Parse parse;
235        Tcl_HashEntry *hPtr;
236        int maxDepth, new, i, code;
237    
238        /*
239         * If this is the first time we've been called, initialize the table
240         * of expression operators.
241         */
242    
243        if (numBytes < 0) {
244            numBytes = (script? strlen(script) : 0);
245        }
246        if (!opTableInitialized) {
247            Tcl_MutexLock(&opMutex);
248            if (!opTableInitialized) {
249                Tcl_InitHashTable(&opHashTable, TCL_STRING_KEYS);
250                for (i = 0;  operatorTable[i].name != NULL;  i++) {
251                    hPtr = Tcl_CreateHashEntry(&opHashTable,
252                            operatorTable[i].name, &new);
253                    if (new) {
254                        Tcl_SetHashValue(hPtr, (ClientData) i);
255                    }
256                }
257                opTableInitialized = 1;
258            }
259            Tcl_MutexUnlock(&opMutex);
260        }
261    
262        /*
263         * Initialize the structure containing information abvout this
264         * expression compilation.
265         */
266    
267        info.interp = interp;
268        info.parsePtr = &parse;
269        info.expr = script;
270        info.lastChar = (script + numBytes);
271        info.hasOperators = 0;
272        info.exprIsJustVarRef = 1;  /* will be set 0 if anything else is seen */
273        info.exprIsComparison = 0;
274    
275        /*
276         * Parse the expression then compile it.
277         */
278    
279        maxDepth = 0;
280        code = Tcl_ParseExpr(interp, script, numBytes, &parse);
281        if (code != TCL_OK) {
282            goto done;
283        }
284    
285        code = CompileSubExpr(parse.tokenPtr, &info, envPtr);
286        if (code != TCL_OK) {
287            Tcl_FreeParse(&parse);
288            goto done;
289        }
290        maxDepth = envPtr->maxStackDepth;
291        
292        if (!info.hasOperators) {
293            /*
294             * Attempt to convert the primary's object to an int or double.
295             * This is done in order to support Tcl's policy of interpreting
296             * operands if at all possible as first integers, else
297             * floating-point numbers.
298             */
299            
300            TclEmitOpcode(INST_TRY_CVT_TO_NUMERIC, envPtr);
301        }
302        Tcl_FreeParse(&parse);
303    
304        done:
305        envPtr->maxStackDepth = maxDepth;
306        envPtr->exprIsJustVarRef = info.exprIsJustVarRef;
307        envPtr->exprIsComparison = info.exprIsComparison;
308        return code;
309    }
310    
311    /*
312     *----------------------------------------------------------------------
313     *
314     * TclFinalizeCompilation --
315     *
316     *      Clean up the compilation environment so it can later be
317     *      properly reinitialized. This procedure is called by
318     *      TclFinalizeCompExecEnv() in tclObj.c, which in turn is called
319     *      by Tcl_Finalize().
320     *
321     * Results:
322     *      None.
323     *
324     * Side effects:
325     *      Cleans up the compilation environment. At the moment, just the
326     *      table of expression operators is freed.
327     *
328     *----------------------------------------------------------------------
329     */
330    
331    void
332    TclFinalizeCompilation()
333    {
334        Tcl_MutexLock(&opMutex);
335        if (opTableInitialized) {
336            Tcl_DeleteHashTable(&opHashTable);
337            opTableInitialized = 0;
338        }
339        Tcl_MutexUnlock(&opMutex);
340    }
341    
342    /*
343     *----------------------------------------------------------------------
344     *
345     * CompileSubExpr --
346     *
347     *      Given a pointer to a TCL_TOKEN_SUB_EXPR token describing a
348     *      subexpression, this procedure emits instructions to evaluate the
349     *      subexpression at runtime.
350     *
351     * Results:
352     *      The return value is TCL_OK on a successful compilation and TCL_ERROR
353     *      on failure. If TCL_ERROR is returned, then the interpreter's result
354     *      contains an error message.
355     *
356     *      envPtr->maxStackDepth is updated with the maximum number of stack
357     *      elements needed to execute the subexpression.
358     *
359     *      envPtr->exprIsJustVarRef is set 1 if the subexpression consisted of
360     *      a single variable reference as in the expression of "if $b then...".
361     *      Otherwise it is set 0. This is used to implement Tcl's two level
362     *      expression substitution semantics properly.
363     *
364     *      envPtr->exprIsComparison is set 1 if the top-level operator in the
365     *      subexpression is a comparison. Otherwise it is set 0. If 1, because
366     *      the operands might be strings, the expr is compiled out-of-line in
367     *      order to implement expr's 2 level substitution semantics properly.
368     *
369     * Side effects:
370     *      Adds instructions to envPtr to evaluate the subexpression.
371     *
372     *----------------------------------------------------------------------
373     */
374    
375    static int
376    CompileSubExpr(exprTokenPtr, infoPtr, envPtr)
377        Tcl_Token *exprTokenPtr;    /* Points to TCL_TOKEN_SUB_EXPR token
378                                     * to compile. */
379        ExprInfo *infoPtr;          /* Describes the compilation state for the
380                                     * expression being compiled. */
381        CompileEnv *envPtr;         /* Holds resulting instructions. */
382    {
383        Tcl_Interp *interp = infoPtr->interp;
384        Tcl_Token *tokenPtr, *endPtr, *afterSubexprPtr;
385        OperatorDesc *opDescPtr;
386        Tcl_HashEntry *hPtr;
387        char *operator;
388        char savedChar;
389        int maxDepth, objIndex, opIndex, length, code;
390        char buffer[TCL_UTF_MAX];
391    
392        if (exprTokenPtr->type != TCL_TOKEN_SUB_EXPR) {
393            panic("CompileSubExpr: token type %d not TCL_TOKEN_SUB_EXPR\n",
394                    exprTokenPtr->type);
395        }
396        maxDepth = 0;
397        code = TCL_OK;
398    
399        /*
400         * Switch on the type of the first token after the subexpression token.
401         * After processing it, advance tokenPtr to point just after the
402         * subexpression's last token.
403         */
404        
405        tokenPtr = exprTokenPtr+1;
406        TRACE(exprTokenPtr->start, exprTokenPtr->size,
407                tokenPtr->start, tokenPtr->size);
408        switch (tokenPtr->type) {
409            case TCL_TOKEN_WORD:
410                code = TclCompileTokens(interp, tokenPtr+1,
411                        tokenPtr->numComponents, envPtr);
412                if (code != TCL_OK) {
413                    goto done;
414                }
415                maxDepth = envPtr->maxStackDepth;
416                tokenPtr += (tokenPtr->numComponents + 1);
417                infoPtr->exprIsJustVarRef = 0;
418                break;
419                
420            case TCL_TOKEN_TEXT:
421                if (tokenPtr->size > 0) {
422                    objIndex = TclRegisterLiteral(envPtr, tokenPtr->start,
423                            tokenPtr->size, /*onHeap*/ 0);
424                } else {
425                    objIndex = TclRegisterLiteral(envPtr, "", 0, /*onHeap*/ 0);
426                }
427                TclEmitPush(objIndex, envPtr);
428                maxDepth = 1;
429                tokenPtr += 1;
430                infoPtr->exprIsJustVarRef = 0;
431                break;
432                
433            case TCL_TOKEN_BS:
434                length = Tcl_UtfBackslash(tokenPtr->start, (int *) NULL,
435                        buffer);
436                if (length > 0) {
437                    objIndex = TclRegisterLiteral(envPtr, buffer, length,
438                            /*onHeap*/ 0);
439                } else {
440                    objIndex = TclRegisterLiteral(envPtr, "", 0, /*onHeap*/ 0);
441                }
442                TclEmitPush(objIndex, envPtr);
443                maxDepth = 1;
444                tokenPtr += 1;
445                infoPtr->exprIsJustVarRef = 0;
446                break;
447                
448            case TCL_TOKEN_COMMAND:
449                code = TclCompileScript(interp, tokenPtr->start+1,
450                        tokenPtr->size-2, /*nested*/ 1, envPtr);
451                if (code != TCL_OK) {
452                    goto done;
453                }
454                maxDepth = envPtr->maxStackDepth;
455                tokenPtr += 1;
456                infoPtr->exprIsJustVarRef = 0;
457                break;
458                
459            case TCL_TOKEN_VARIABLE:
460                code = TclCompileTokens(interp, tokenPtr, 1, envPtr);
461                if (code != TCL_OK) {
462                    goto done;
463                }
464                maxDepth = envPtr->maxStackDepth;
465                tokenPtr += (tokenPtr->numComponents + 1);
466                break;
467                
468            case TCL_TOKEN_SUB_EXPR:
469                infoPtr->exprIsComparison = 0;
470                code = CompileSubExpr(tokenPtr, infoPtr, envPtr);
471                if (code != TCL_OK) {
472                    goto done;
473                }
474                maxDepth = envPtr->maxStackDepth;
475                tokenPtr += (tokenPtr->numComponents + 1);
476                break;
477                
478            case TCL_TOKEN_OPERATOR:
479                /*
480                 * Look up the operator. Temporarily overwrite the character
481                 * just after the end of the operator with a 0 byte. If the
482                 * operator isn't found, treat it as a math function.
483                 */
484    
485                /*
486                 * TODO: Note that the string is modified in place.  This is unsafe
487                 * and will break if any of the routines called while the string is
488                 * modified have side effects that depend on the original string
489                 * being unmodified (e.g. adding an entry to the literal table).
490                 */
491    
492                operator = tokenPtr->start;
493                savedChar = operator[tokenPtr->size];
494                operator[tokenPtr->size] = 0;
495                hPtr = Tcl_FindHashEntry(&opHashTable, operator);
496                if (hPtr == NULL) {
497                    code = CompileMathFuncCall(exprTokenPtr, operator, infoPtr,
498                            envPtr, &endPtr);
499                    operator[tokenPtr->size] = (char) savedChar;
500                    if (code != TCL_OK) {
501                        goto done;
502                    }
503                    maxDepth = envPtr->maxStackDepth;
504                    tokenPtr = endPtr;
505                    infoPtr->exprIsJustVarRef = 0;
506                    infoPtr->exprIsComparison = 0;
507                    break;
508                }
509                operator[tokenPtr->size] = (char) savedChar;
510                opIndex = (int) Tcl_GetHashValue(hPtr);
511                opDescPtr = &(operatorTable[opIndex]);
512    
513                /*
514                 * If the operator is "normal", compile it using information
515                 * from the operator table.
516                 */
517    
518                if (opDescPtr->numOperands > 0) {
519                    tokenPtr++;
520                    code = CompileSubExpr(tokenPtr, infoPtr, envPtr);
521                    if (code != TCL_OK) {
522                        goto done;
523                    }
524                    maxDepth = envPtr->maxStackDepth;
525                    tokenPtr += (tokenPtr->numComponents + 1);
526    
527                    if (opDescPtr->numOperands == 2) {
528                        code = CompileSubExpr(tokenPtr, infoPtr, envPtr);
529                        if (code != TCL_OK) {
530                            goto done;
531                        }
532                        maxDepth = TclMax((envPtr->maxStackDepth + 1),
533                                maxDepth);
534                        tokenPtr += (tokenPtr->numComponents + 1);
535                    }
536                    TclEmitOpcode(opDescPtr->instruction, envPtr);
537                    infoPtr->hasOperators = 1;
538                    infoPtr->exprIsJustVarRef = 0;
539                    infoPtr->exprIsComparison =
540                            ((opIndex >= OP_LESS) && (opIndex <= OP_NEQ));
541                    break;
542                }
543                
544                /*
545                 * The operator requires special treatment, and is either
546                 * "+" or "-", or one of "&&", "||" or "?".
547                 */
548                
549                switch (opIndex) {
550                    case OP_PLUS:
551                    case OP_MINUS:
552                        tokenPtr++;
553                        code = CompileSubExpr(tokenPtr, infoPtr, envPtr);
554                        if (code != TCL_OK) {
555                            goto done;
556                        }
557                        maxDepth = envPtr->maxStackDepth;
558                        tokenPtr += (tokenPtr->numComponents + 1);
559                        
560                        /*
561                         * Check whether the "+" or "-" is unary.
562                         */
563                        
564                        afterSubexprPtr = exprTokenPtr
565                                + exprTokenPtr->numComponents+1;
566                        if (tokenPtr == afterSubexprPtr) {
567                            TclEmitOpcode(((opIndex==OP_PLUS)?
568                                    INST_UPLUS : INST_UMINUS),
569                                    envPtr);
570                            break;
571                        }
572                        
573                        /*
574                         * The "+" or "-" is binary.
575                         */
576                        
577                        code = CompileSubExpr(tokenPtr, infoPtr, envPtr);
578                        if (code != TCL_OK) {
579                            goto done;
580                        }
581                        maxDepth = TclMax((envPtr->maxStackDepth + 1),
582                                maxDepth);
583                        tokenPtr += (tokenPtr->numComponents + 1);
584                        TclEmitOpcode(((opIndex==OP_PLUS)? INST_ADD : INST_SUB),
585                                envPtr);
586                        break;
587    
588                    case OP_LAND:
589                    case OP_LOR:
590                        code = CompileLandOrLorExpr(exprTokenPtr, opIndex,
591                                infoPtr, envPtr, &endPtr);
592                        if (code != TCL_OK) {
593                            goto done;
594                        }
595                        maxDepth = envPtr->maxStackDepth;
596                        tokenPtr = endPtr;
597                        break;
598                            
599                    case OP_QUESTY:
600                        code = CompileCondExpr(exprTokenPtr, infoPtr,
601                                envPtr, &endPtr);
602                        if (code != TCL_OK) {
603                            goto done;
604                        }
605                        maxDepth = envPtr->maxStackDepth;
606                        tokenPtr = endPtr;
607                        break;
608                        
609                    default:
610                        panic("CompileSubExpr: unexpected operator %d requiring special treatment\n",
611                            opIndex);
612                } /* end switch on operator requiring special treatment */
613                infoPtr->hasOperators = 1;
614                infoPtr->exprIsJustVarRef = 0;
615                infoPtr->exprIsComparison = 0;
616                break;
617    
618            default:
619                panic("CompileSubExpr: unexpected token type %d\n",
620                        tokenPtr->type);
621        }
622    
623        /*
624         * Verify that the subexpression token had the required number of
625         * subtokens: that we've advanced tokenPtr just beyond the
626         * subexpression's last token. For example, a "*" subexpression must
627         * contain the tokens for exactly two operands.
628         */
629        
630        if (tokenPtr != (exprTokenPtr + exprTokenPtr->numComponents+1)) {
631            LogSyntaxError(infoPtr);
632            code = TCL_ERROR;
633        }
634        
635        done:
636        envPtr->maxStackDepth = maxDepth;
637        return code;
638    }
639    
640    /*
641     *----------------------------------------------------------------------
642     *
643     * CompileLandOrLorExpr --
644     *
645     *      This procedure compiles a Tcl logical and ("&&") or logical or
646     *      ("||") subexpression.
647     *
648     * Results:
649     *      The return value is TCL_OK on a successful compilation and TCL_ERROR
650     *      on failure. If TCL_OK is returned, a pointer to the token just after
651     *      the last one in the subexpression is stored at the address in
652     *      endPtrPtr. If TCL_ERROR is returned, then the interpreter's result
653     *      contains an error message.
654     *
655     *      envPtr->maxStackDepth is updated with the maximum number of stack
656     *      elements needed to execute the expression.
657     *
658     * Side effects:
659     *      Adds instructions to envPtr to evaluate the expression at runtime.
660     *
661     *----------------------------------------------------------------------
662     */
663    
664    static int
665    CompileLandOrLorExpr(exprTokenPtr, opIndex, infoPtr, envPtr, endPtrPtr)
666        Tcl_Token *exprTokenPtr;     /* Points to TCL_TOKEN_SUB_EXPR token
667                                      * containing the "&&" or "||" operator. */
668        int opIndex;                 /* A code describing the expression
669                                      * operator: either OP_LAND or OP_LOR. */
670        ExprInfo *infoPtr;           /* Describes the compilation state for the
671                                      * expression being compiled. */
672        CompileEnv *envPtr;          /* Holds resulting instructions. */
673        Tcl_Token **endPtrPtr;       /* If successful, a pointer to the token
674                                      * just after the last token in the
675                                      * subexpression is stored here. */
676    {
677        JumpFixup shortCircuitFixup; /* Used to fix up the short circuit jump
678                                      * after the first subexpression. */
679        JumpFixup lhsTrueFixup, lhsEndFixup;
680                                     /* Used to fix up jumps used to convert the
681                                      * first operand to 0 or 1. */
682        Tcl_Token *tokenPtr;
683        int dist, maxDepth, code;
684    
685        /*
686         * Emit code for the first operand.
687         */
688    
689        maxDepth = 0;
690        tokenPtr = exprTokenPtr+2;
691        code = CompileSubExpr(tokenPtr, infoPtr, envPtr);
692        if (code != TCL_OK) {
693            goto done;
694        }
695        maxDepth = envPtr->maxStackDepth;
696        tokenPtr += (tokenPtr->numComponents + 1);
697    
698        /*
699         * Convert the first operand to the result that Tcl requires:
700         * "0" or "1". Eventually we'll use a new instruction for this.
701         */
702        
703        TclEmitForwardJump(envPtr, TCL_TRUE_JUMP, &lhsTrueFixup);
704        TclEmitPush(TclRegisterLiteral(envPtr, "0", 1, /*onHeap*/ 0), envPtr);
705        TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &lhsEndFixup);
706        dist = (envPtr->codeNext - envPtr->codeStart) - lhsTrueFixup.codeOffset;
707        if (TclFixupForwardJump(envPtr, &lhsTrueFixup, dist, 127)) {
708            badDist:
709            panic("CompileLandOrLorExpr: bad jump distance %d\n", dist);
710        }
711        TclEmitPush(TclRegisterLiteral(envPtr, "1", 1, /*onHeap*/ 0), envPtr);
712        dist = (envPtr->codeNext - envPtr->codeStart) - lhsEndFixup.codeOffset;
713        if (TclFixupForwardJump(envPtr, &lhsEndFixup, dist, 127)) {
714            goto badDist;
715        }
716    
717        /*
718         * Emit the "short circuit" jump around the rest of the expression.
719         * Duplicate the "0" or "1" on top of the stack first to keep the
720         * jump from consuming it.
721         */
722    
723        TclEmitOpcode(INST_DUP, envPtr);
724        TclEmitForwardJump(envPtr,
725                ((opIndex==OP_LAND)? TCL_FALSE_JUMP : TCL_TRUE_JUMP),
726                &shortCircuitFixup);
727    
728        /*
729         * Emit code for the second operand.
730         */
731    
732        code = CompileSubExpr(tokenPtr, infoPtr, envPtr);
733        if (code != TCL_OK) {
734            goto done;
735        }
736        maxDepth = TclMax((envPtr->maxStackDepth + 1), maxDepth);
737        tokenPtr += (tokenPtr->numComponents + 1);
738    
739        /*
740         * Emit a "logical and" or "logical or" instruction. This does not try
741         * to "short- circuit" the evaluation of both operands, but instead
742         * ensures that we either have a "1" or a "0" result.
743         */
744    
745        TclEmitOpcode(((opIndex==OP_LAND)? INST_LAND : INST_LOR), envPtr);
746    
747        /*
748         * Now that we know the target of the forward jump, update it with the
749         * correct distance.
750         */
751    
752        dist = (envPtr->codeNext - envPtr->codeStart)
753                - shortCircuitFixup.codeOffset;
754        TclFixupForwardJump(envPtr, &shortCircuitFixup, dist, 127);
755        *endPtrPtr = tokenPtr;
756    
757        done:
758        envPtr->maxStackDepth = maxDepth;
759        return code;
760    }
761    
762    /*
763     *----------------------------------------------------------------------
764     *
765     * CompileCondExpr --
766     *
767     *      This procedure compiles a Tcl conditional expression:
768     *      condExpr ::= lorExpr ['?' condExpr ':' condExpr]
769     *
770     * Results:
771     *      The return value is TCL_OK on a successful compilation and TCL_ERROR
772     *      on failure. If TCL_OK is returned, a pointer to the token just after
773     *      the last one in the subexpression is stored at the address in
774     *      endPtrPtr. If TCL_ERROR is returned, then the interpreter's result
775     *      contains an error message.
776     *
777     *      envPtr->maxStackDepth is updated with the maximum number of stack
778     *      elements needed to execute the expression.
779     *
780     * Side effects:
781     *      Adds instructions to envPtr to evaluate the expression at runtime.
782     *
783     *----------------------------------------------------------------------
784     */
785    
786    static int
787    CompileCondExpr(exprTokenPtr, infoPtr, envPtr, endPtrPtr)
788        Tcl_Token *exprTokenPtr;    /* Points to TCL_TOKEN_SUB_EXPR token
789                                     * containing the "?" operator. */
790        ExprInfo *infoPtr;          /* Describes the compilation state for the
791                                     * expression being compiled. */
792        CompileEnv *envPtr;         /* Holds resulting instructions. */
793        Tcl_Token **endPtrPtr;      /* If successful, a pointer to the token
794                                     * just after the last token in the
795                                     * subexpression is stored here. */
796    {
797        JumpFixup jumpAroundThenFixup, jumpAroundElseFixup;
798                                    /* Used to update or replace one-byte jumps
799                                     * around the then and else expressions when
800                                     * their target PCs are determined. */
801        Tcl_Token *tokenPtr;
802        int elseCodeOffset, dist, maxDepth, code;
803    
804        /*
805         * Emit code for the test.
806         */
807    
808        maxDepth = 0;
809        tokenPtr = exprTokenPtr+2;
810        code = CompileSubExpr(tokenPtr, infoPtr, envPtr);
811        if (code != TCL_OK) {
812            goto done;
813        }
814        maxDepth = envPtr->maxStackDepth;
815        tokenPtr += (tokenPtr->numComponents + 1);
816        
817        /*
818         * Emit the jump to the "else" expression if the test was false.
819         */
820        
821        TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, &jumpAroundThenFixup);
822    
823        /*
824         * Compile the "then" expression. Note that if a subexpression is only
825         * a primary, we need to try to convert it to numeric. We do this to
826         * support Tcl's policy of interpreting operands if at all possible as
827         * first integers, else floating-point numbers.
828         */
829    
830        infoPtr->hasOperators = 0;
831        code = CompileSubExpr(tokenPtr, infoPtr, envPtr);
832        if (code != TCL_OK) {
833            goto done;
834        }
835        maxDepth = TclMax(envPtr->maxStackDepth, maxDepth);
836        tokenPtr += (tokenPtr->numComponents + 1);
837        if (!infoPtr->hasOperators) {
838            TclEmitOpcode(INST_TRY_CVT_TO_NUMERIC, envPtr);
839        }
840    
841        /*
842         * Emit an unconditional jump around the "else" condExpr.
843         */
844        
845        TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP,
846                &jumpAroundElseFixup);
847    
848        /*
849         * Compile the "else" expression.
850         */
851    
852        elseCodeOffset = (envPtr->codeNext - envPtr->codeStart);
853        infoPtr->hasOperators = 0;
854        code = CompileSubExpr(tokenPtr, infoPtr, envPtr);
855        if (code != TCL_OK) {
856            goto done;
857        }
858        maxDepth = TclMax(envPtr->maxStackDepth, maxDepth);
859        tokenPtr += (tokenPtr->numComponents + 1);
860        if (!infoPtr->hasOperators) {
861            TclEmitOpcode(INST_TRY_CVT_TO_NUMERIC, envPtr);
862        }
863    
864        /*
865         * Fix up the second jump around the "else" expression.
866         */
867    
868        dist = (envPtr->codeNext - envPtr->codeStart)
869                - jumpAroundElseFixup.codeOffset;
870        if (TclFixupForwardJump(envPtr, &jumpAroundElseFixup, dist, 127)) {
871            /*
872             * Update the else expression's starting code offset since it
873             * moved down 3 bytes too.
874             */
875            
876            elseCodeOffset += 3;
877        }
878            
879        /*
880         * Fix up the first jump to the "else" expression if the test was false.
881         */
882        
883        dist = (elseCodeOffset - jumpAroundThenFixup.codeOffset);
884        TclFixupForwardJump(envPtr, &jumpAroundThenFixup, dist, 127);
885        *endPtrPtr = tokenPtr;
886    
887        done:
888        envPtr->maxStackDepth = maxDepth;
889        return code;
890    }
891    
892    /*
893     *----------------------------------------------------------------------
894     *
895     * CompileMathFuncCall --
896     *
897     *      This procedure compiles a call on a math function in an expression:
898     *      mathFuncCall ::= funcName '(' [condExpr {',' condExpr}] ')'
899     *
900     * Results:
901     *      The return value is TCL_OK on a successful compilation and TCL_ERROR
902     *      on failure. If TCL_OK is returned, a pointer to the token just after
903     *      the last one in the subexpression is stored at the address in
904     *      endPtrPtr. If TCL_ERROR is returned, then the interpreter's result
905     *      contains an error message.
906     *
907     *      envPtr->maxStackDepth is updated with the maximum number of stack
908     *      elements needed to execute the function.
909     *
910     * Side effects:
911     *      Adds instructions to envPtr to evaluate the math function at
912     *      runtime.
913     *
914     *----------------------------------------------------------------------
915     */
916    
917    static int
918    CompileMathFuncCall(exprTokenPtr, funcName, infoPtr, envPtr, endPtrPtr)
919        Tcl_Token *exprTokenPtr;    /* Points to TCL_TOKEN_SUB_EXPR token
920                                     * containing the math function call. */
921        char *funcName;             /* Name of the math function. */
922        ExprInfo *infoPtr;          /* Describes the compilation state for the
923                                     * expression being compiled. */
924        CompileEnv *envPtr;         /* Holds resulting instructions. */
925        Tcl_Token **endPtrPtr;      /* If successful, a pointer to the token
926                                     * just after the last token in the
927                                     * subexpression is stored here. */
928    {
929        Tcl_Interp *interp = infoPtr->interp;
930        Interp *iPtr = (Interp *) interp;
931        MathFunc *mathFuncPtr;
932        Tcl_HashEntry *hPtr;
933        Tcl_Token *tokenPtr, *afterSubexprPtr;
934        int maxDepth, code, i;
935    
936        /*
937         * Look up the MathFunc record for the function.
938         */
939    
940        code = TCL_OK;
941        maxDepth = 0;
942        hPtr = Tcl_FindHashEntry(&iPtr->mathFuncTable, funcName);
943        if (hPtr == NULL) {
944            Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
945                    "unknown math function \"", funcName, "\"", (char *) NULL);
946            code = TCL_ERROR;
947            goto done;
948        }
949        mathFuncPtr = (MathFunc *) Tcl_GetHashValue(hPtr);
950    
951        /*
952         * If not a builtin function, push an object with the function's name.
953         */
954    
955        if (mathFuncPtr->builtinFuncIndex < 0) {
956            TclEmitPush(TclRegisterLiteral(envPtr, funcName, -1, /*onHeap*/ 0),
957                    envPtr);
958            maxDepth = 1;
959        }
960    
961        /*
962         * Compile any arguments for the function.
963         */
964    
965        tokenPtr = exprTokenPtr+2;
966        afterSubexprPtr = exprTokenPtr + (exprTokenPtr->numComponents + 1);
967        if (mathFuncPtr->numArgs > 0) {
968            for (i = 0;  i < mathFuncPtr->numArgs;  i++) {
969                if (tokenPtr == afterSubexprPtr) {
970                    Tcl_ResetResult(interp);
971                    Tcl_AppendToObj(Tcl_GetObjResult(interp),
972                            "too few arguments for math function", -1);
973                    code = TCL_ERROR;
974                    goto done;
975                }
976                infoPtr->exprIsComparison = 0;
977                code = CompileSubExpr(tokenPtr, infoPtr, envPtr);
978                if (code != TCL_OK) {
979                    goto done;
980                }
981                tokenPtr += (tokenPtr->numComponents + 1);
982                maxDepth++;
983            }
984            if (tokenPtr != afterSubexprPtr) {
985                Tcl_ResetResult(interp);
986                Tcl_AppendToObj(Tcl_GetObjResult(interp),
987                        "too many arguments for math function", -1);
988                code = TCL_ERROR;
989                goto done;
990            }
991        } else if (tokenPtr != afterSubexprPtr) {
992            Tcl_ResetResult(interp);
993            Tcl_AppendToObj(Tcl_GetObjResult(interp),
994                    "too many arguments for math function", -1);
995            code = TCL_ERROR;
996            goto done;
997        }
998        
999        /*
1000         * Compile the call on the math function. Note that the "objc" argument
1001         * count for non-builtin functions is incremented by 1 to include the
1002         * function name itself.
1003         */
1004    
1005        if (mathFuncPtr->builtinFuncIndex >= 0) { /* a builtin function */
1006            TclEmitInstInt1(INST_CALL_BUILTIN_FUNC1,
1007                    mathFuncPtr->builtinFuncIndex, envPtr);
1008        } else {
1009            TclEmitInstInt1(INST_CALL_FUNC1, (mathFuncPtr->numArgs+1), envPtr);
1010        }
1011        *endPtrPtr = afterSubexprPtr;
1012    
1013        done:
1014        envPtr->maxStackDepth = maxDepth;
1015        return code;
1016    }
1017    
1018    /*
1019     *----------------------------------------------------------------------
1020     *
1021     * LogSyntaxError --
1022     *
1023     *      This procedure is invoked after an error occurs when compiling an
1024     *      expression. It sets the interpreter result to an error message
1025     *      describing the error.
1026     *
1027     * Results:
1028     *      None.
1029     *
1030     * Side effects:
1031     *      Sets the interpreter result to an error message describing the
1032     *      expression that was being compiled when the error occurred.
1033     *
1034     *----------------------------------------------------------------------
1035     */
1036    
1037    static void
1038    LogSyntaxError(infoPtr)
1039        ExprInfo *infoPtr;          /* Describes the compilation state for the
1040                                     * expression being compiled. */
1041    {
1042        int numBytes = (infoPtr->lastChar - infoPtr->expr);
1043        char buffer[100];
1044    
1045        sprintf(buffer, "syntax error in expression \"%.*s\"",
1046                ((numBytes > 60)? 60 : numBytes), infoPtr->expr);
1047        Tcl_AppendStringsToObj(Tcl_GetObjResult(infoPtr->interp),
1048                buffer, (char *) NULL);
1049    }
1050    
1051    /* End of tclcompexpr.c */
Legend:
Removed from v.29  
changed lines
  Added in v.71
dashley@gmail.com
 ViewVC Help
Powered by ViewVC 1.1.25