From bloom-picayune.mit.edu!bloom-beacon!micro-heart-of-gold.mit.edu!wupost!zaphod.mps.ohio-state.edu!pacific.mps.ohio-state.edu!linac!att!cbnewsm!grenache!gah Wed Apr 15 17:56:50 EDT 1992 Article: 516 of comp.lang.tcl Path: bloom-picayune.mit.edu!bloom-beacon!micro-heart-of-gold.mit.edu!wupost!zaphod.mps.ohio-state.edu!pacific.mps.ohio-state.edu!linac!att!cbnewsm!grenache!gah From: gah@grenache (George A. Howlett) Newsgroups: comp.lang.tcl Subject: Patch to add libm.a functions to Tcl 6.2 (tclExpr.c) Message-ID: <1992Apr15.155503.19266@cbnewsm.cb.att.com> Date: 15 Apr 92 15:55:03 GMT Sender: news@cbnewsm.cb.att.com (NetNews Administrator) Reply-To: george.howlett@att.com Organization: AT&T Bell Laboratories Lines: 499 Nntp-Posting-Host: grenache.cnet.att.com Below is a patch which adds both exponentiation and some libm.a math library function support to the "expr" command. The following patch was done on a Sun SS2 and assumes the math functions specified are available in libm.a and have forward declarations in /usr/include/math.h. Obviously, some of the functions are not found in other system's libm.a (rint, exp10, etc.) and the patched file will have to be edited. Features: * Exponentiation operator **: set a [expr $x**$y] Since it's very easy to generate values which are out of the range of a signed/unsigned int, both operands are silently promoted to TYPE_DOUBLE. (It may be advisable to do this for multiplication also) * Math library functions: Absolute value: abs Roots: sqrt, cbrt Rounding: ceil, floor, rint Trigonometric: cos, sin, tan, asin, acos, atan, asinh Logarithm, exponential: log, log10, exp, exp10 Promotion, demotion: int, float All math functions require a single argument and functions have the same precedence as unary operators. Basically I treat the function name as a unary operator and require that a parenthesized expression follow it, using the value of that expression as the argument to the function. set a [ expr cos($x)**2+sin($x)**2 ] set a [ expr log($a-$b) ] The only math error checking done is by inspecting errno after invoking the function and setting errorCode if needed. The format of errorCode is "MATHERR ". I don't know if more extensive checking is possible or necessary (e.g. via matherr()). The int and float do the obvious casting of values. # a = 0.25 not 0 set b 1 ; set a [ expr float($b)/4 ] # a = -3 set a [ expr int(-3.3) ] Problems: * Some floating point values can be silently demoted to integers by the sprintf ("%g") call in the ExprMakeString routine. The biggest problem is that you don't expect it. (Promoting multiplication operands eliminates much of the problem but may break some existing code which may rely upon implicit demotion.) The following fragment demonstrates how one must track intermediate values to be sure they are not demoted. set a 100000.0 set b [ expr $a*1.0 ] set c [ expr $b*$b ] set d [ expr $a*$a ] wish: set a 100000.0 100000.0 wish: set b [ expr $a*1.0 ] 100000 wish: set c [ expr $b*$b ] 1410065408 wish: set d [ expr $a*$a ] 1e+10 A very quick and dirty solution would be to check and see if the resulting string (from sprintf) is not already in floating point format (i.e. has a 'E', 'e', or '.') and concatenate a ".0" on the end. ------------------- patch starts here --------------------- *** tclExpr.c-dist Sun Dec 15 20:30:50 1991 --- tclExpr.c Wed Apr 15 09:58:44 1992 *************** *** 22,27 **** --- 22,28 ---- #endif #include "tclInt.h" + #include /* * The stuff below is a bit of a hack so that this file can be used *************** *** 79,84 **** --- 80,86 ---- * expr. See below for definitions. * Corresponds to the characters just * before expr. */ + ClientData clientData; /* Place to stash the function index */ } ExprInfo; /* *************** *** 96,102 **** /* * Binary operators: */ ! #define MULT 8 #define DIVIDE 9 #define MOD 10 --- 98,104 ---- /* * Binary operators: */ ! #define EXPON 7 #define MULT 8 #define DIVIDE 9 #define MOD 10 *************** *** 126,137 **** #define NOT 29 #define BIT_NOT 30 /* * Precedence table. The values for non-operator token types are ignored. */ int precTable[] = { ! 0, 0, 0, 0, 0, 0, 0, 0, 11, 11, 11, /* MULT, DIVIDE, MOD */ 10, 10, /* PLUS, MINUS */ 9, 9, /* LEFT_SHIFT, RIGHT_SHIFT */ --- 128,180 ---- #define NOT 29 #define BIT_NOT 30 + #define FUNCT 31 /* Not really unary operators, but we'll + * treat them as such */ + struct MathLibraryFunctions { + char *name; + double (*ptr)_ANSI_ARGS_((double x)); + }; + + /* The following symbols represent indices of each function in the + math function table found below. */ + enum FunctionIndices { + F_ABS, F_ACOS, F_ASIN, F_ASINH, F_ATAN, F_CBRT, F_CEIL, F_COS, F_EXP, + F_EXP10, F_FLOAT, F_FLOOR, F_INT, F_LOG, F_LOG10, F_RINT, F_SIN, + F_SQRT, F_TAN + }; + + /* The data structure below contains the name and function pointer + of libm.a math routines. If you change this table, you must also + change the index table above. */ + static struct MathLibraryFunctions mathLib [] = { + "abs", fabs, + "acos", acos, + "asin", asin, + "asinh", asinh, + "atan", atan, + "cbrt", cbrt, + "ceil", ceil, + "cos", cos, + "exp", exp, + "exp10", exp10, + "float", NULL, + "floor", floor, + "int", NULL, + "log", log, + "log10", log10, + "rint", rint, + "sin", sin, + "sqrt", sqrt, + "tan", tan, + }; + /* * Precedence table. The values for non-operator token types are ignored. */ int precTable[] = { ! 0, 0, 0, 0, 0, 0, 0, ! 12, /* EXPON */ 11, 11, 11, /* MULT, DIVIDE, MOD */ 10, 10, /* PLUS, MINUS */ 9, 9, /* LEFT_SHIFT, RIGHT_SHIFT */ *************** *** 143,149 **** 3, /* AND */ 2, /* OR */ 1, 1, /* QUESTY, COLON */ ! 12, 12, 12 /* UNARY_MINUS, NOT, BIT_NOT */ }; /* --- 186,193 ---- 3, /* AND */ 2, /* OR */ 1, 1, /* QUESTY, COLON */ ! 13, 13, 13, /* UNARY_MINUS, NOT, BIT_NOT */ ! 13, /* FUNCT */ }; /* *************** *** 151,160 **** */ char *operatorStrings[] = { ! "VALUE", "(", ")", "END", "UNKNOWN", "5", "6", "7", "*", "/", "%", "+", "-", "<<", ">>", "<", ">", "<=", ">=", "==", "!=", "&", "^", "|", "&&", "||", "?", ":", ! "-", "!", "~" }; /* --- 195,204 ---- */ char *operatorStrings[] = { ! "VALUE", "(", ")", "END", "UNKNOWN", "5", "6", "**", "*", "/", "%", "+", "-", "<<", ">>", "<", ">", "<=", ">=", "==", "!=", "&", "^", "|", "&&", "||", "?", ":", ! "-", "!", "~", "FUNCT" }; /* *************** *** 424,430 **** return TCL_OK; case '*': ! infoPtr->token = MULT; return TCL_OK; case '/': --- 468,479 ---- return TCL_OK; case '*': ! if (p[1] == '*') { ! infoPtr->token = EXPON; ! infoPtr->expr = p+2; ! } else { ! infoPtr->token = MULT; ! } return TCL_OK; case '/': *************** *** 533,540 **** return TCL_OK; default: ! infoPtr->expr = p+1; ! infoPtr->token = UNKNOWN; return TCL_OK; } } --- 582,591 ---- return TCL_OK; default: ! if (ParseFunction (infoPtr, p) != TCL_OK) { ! infoPtr->expr = p+1; ! infoPtr->token = UNKNOWN; ! } return TCL_OK; } } *************** *** 626,635 **** } if (infoPtr->token >= UNARY_MINUS) { /* * Process unary operators. */ - operator = infoPtr->token; result = ExprGetValue(interp, infoPtr, precTable[infoPtr->token], valuePtr); --- 677,686 ---- } if (infoPtr->token >= UNARY_MINUS) { + int fnum = (int)infoPtr->clientData; /*Save the function index*/ /* * Process unary operators. */ operator = infoPtr->token; result = ExprGetValue(interp, infoPtr, precTable[infoPtr->token], valuePtr); *************** *** 675,680 **** --- 726,766 ---- goto illegalType; } break; + case FUNCT: + if (valuePtr->type == TYPE_STRING) { + badType = valuePtr->type; + goto illegalType; + } + switch (fnum) { + case F_INT: + if (valuePtr->type == TYPE_DOUBLE) { + valuePtr->intValue = valuePtr->doubleValue; + valuePtr->type = TYPE_INT; + } + break; + case F_FLOAT: + if (valuePtr->type == TYPE_INT) { + valuePtr->doubleValue = valuePtr->intValue; + valuePtr->type = TYPE_DOUBLE; + } + break; + default: + if (valuePtr->type == TYPE_INT) { + valuePtr->doubleValue = valuePtr->intValue; + valuePtr->type = TYPE_DOUBLE; + } + errno = 0; + valuePtr->doubleValue = + (*mathLib[fnum].ptr)(valuePtr->doubleValue); + if (errno == EDOM || errno == ERANGE) { + Tcl_SetErrorCode (interp, "MATHERR", + (errno == EDOM) ? "EDOM" : "ERANGE", + mathLib[fnum].name, NULL); + } + break; + } + break; + } gotOp = 1; } else if (infoPtr->token != VALUE) { *************** *** 695,701 **** while (1) { operator = infoPtr->token; value2.pv.next = value2.pv.buffer; ! if ((operator < MULT) || (operator >= UNARY_MINUS)) { if ((operator == END) || (operator == CLOSE_PAREN)) { result = TCL_OK; goto done; --- 781,787 ---- while (1) { operator = infoPtr->token; value2.pv.next = value2.pv.buffer; ! if ((operator < EXPON) || (operator >= UNARY_MINUS)) { if ((operator == END) || (operator == CLOSE_PAREN)) { result = TCL_OK; goto done; *************** *** 770,776 **** if (result != TCL_OK) { goto done; } ! if ((infoPtr->token < MULT) && (infoPtr->token != VALUE) && (infoPtr->token != END) && (infoPtr->token != CLOSE_PAREN)) { goto syntaxError; --- 856,862 ---- if (result != TCL_OK) { goto done; } ! if ((infoPtr->token < EXPON) && (infoPtr->token != VALUE) && (infoPtr->token != END) && (infoPtr->token != CLOSE_PAREN)) { goto syntaxError; *************** *** 786,791 **** --- 872,897 ---- switch (operator) { /* + * Unlike the binary operators below, force floating + * point arithemetic to be done for exponentiation. + */ + case EXPON: + if ((valuePtr->type == TYPE_STRING) + || (value2.type == TYPE_STRING)) { + badType = TYPE_STRING; + goto illegalType; + } + if (value2.type == TYPE_INT) { + value2.doubleValue = value2.intValue; + value2.type = TYPE_DOUBLE; + } + if (valuePtr->type == TYPE_INT) { + valuePtr->doubleValue = valuePtr->intValue; + valuePtr->type = TYPE_DOUBLE; + } + break; + + /* * For the operators below, no strings are allowed and * ints get converted to floats if necessary. */ *************** *** 808,814 **** } } break; - /* * For the operators below, only integers are allowed. */ --- 914,919 ---- *************** *** 895,900 **** --- 1000,1009 ---- */ switch (operator) { + case EXPON: + valuePtr->doubleValue = pow (valuePtr->doubleValue, + value2.doubleValue); + break; case MULT: if (valuePtr->type == TYPE_INT) { valuePtr->intValue *= value2.intValue; *************** *** 1334,1336 **** --- 1443,1505 ---- } return result; } + + /* + *-------------------------------------------------------------- + * + * ParseFunction -- + * + * Determine if the expression is a known math function + * (which we are treating as an unary operator), and save the + * the index to the math library function in the table. + * + * Results: + * A standard Tcl result. If the result is TCL_OK, infoPtr + * is set (token is FUNCT, clientData is the index to the + * math function entry). + * + * Side effects: + * None. + * + *-------------------------------------------------------------- + */ + + static int + ParseFunction (infoPtr, namePtr) + ExprInfo *infoPtr; /* Describes the state of the parse. */ + register char *namePtr; /* Pointer to the start of the function name */ + { + + register char *lastPtr = namePtr; /* Pointer to end of function name */ + static int numLibraryFunctions = + (sizeof (mathLib) / sizeof (struct MathLibraryFunctions)); + register struct MathLibraryFunctions *funcPtr = mathLib; + int nameLength; + register int i; + char c; + + /* Find the end of the identifier */ + while (isalnum(*lastPtr)) + lastPtr++; + nameLength = lastPtr - namePtr; + /* Skip whitespace to get to the opening parenthesis */ + while (isspace (*lastPtr)) + lastPtr++; + if (*lastPtr != '(') + return TCL_ERROR; /* Missing opening parenthesis */ + c = *namePtr; + for (i = 0; i < numLibraryFunctions; i++, funcPtr++) { + if ((c == *funcPtr->name) && (nameLength == strlen (funcPtr->name)) && + (strncmp (namePtr, funcPtr->name, nameLength) == 0)) { + + /* Save the index to the function entry */ + infoPtr->clientData = (ClientData) i; + infoPtr->expr = lastPtr; + infoPtr->token = FUNCT; + return (TCL_OK); + } + } + return (TCL_ERROR); + } + +