--- ray/src/common/calfunc.c 1990/09/29 11:18:34 1.3 +++ ray/src/common/calfunc.c 1992/10/02 15:58:31 2.5 @@ -1,4 +1,4 @@ -/* Copyright (c) 1986 Regents of the University of California */ +/* Copyright (c) 1991 Regents of the University of California */ #ifndef lint static char SCCSid[] = "$SunId$ LBL"; @@ -20,9 +20,12 @@ static char SCCSid[] = "$SunId$ LBL"; #include +#include + #include "calcomp.h" - + /* bits in argument flag (better be right!) */ +#define AFLAGSIZ (8*sizeof(unsigned long)) #define ALISTSIZ 6 /* maximum saved argument list */ typedef struct activation { @@ -51,22 +54,22 @@ static double l_exp(), l_log(), l_log10(); #ifdef BIGLIB /* functions must be listed alphabetically */ static LIBR library[MAXLIB] = { - { "acos", 1, l_acos }, - { "asin", 1, l_asin }, - { "atan", 1, l_atan }, - { "atan2", 2, l_atan2 }, - { "ceil", 1, l_ceil }, - { "cos", 1, l_cos }, - { "exp", 1, l_exp }, - { "floor", 1, l_floor }, - { "if", 3, l_if }, - { "log", 1, l_log }, - { "log10", 1, l_log10 }, - { "rand", 1, l_rand }, - { "select", 1, l_select }, - { "sin", 1, l_sin }, - { "sqrt", 1, l_sqrt }, - { "tan", 1, l_tan }, + { "acos", 1, ':', l_acos }, + { "asin", 1, ':', l_asin }, + { "atan", 1, ':', l_atan }, + { "atan2", 2, ':', l_atan2 }, + { "ceil", 1, ':', l_ceil }, + { "cos", 1, ':', l_cos }, + { "exp", 1, ':', l_exp }, + { "floor", 1, ':', l_floor }, + { "if", 3, ':', l_if }, + { "log", 1, ':', l_log }, + { "log10", 1, ':', l_log10 }, + { "rand", 1, ':', l_rand }, + { "select", 1, ':', l_select }, + { "sin", 1, ':', l_sin }, + { "sqrt", 1, ':', l_sqrt }, + { "tan", 1, ':', l_tan }, }; static int libsize = 16; @@ -74,11 +77,11 @@ static int libsize = 16; #else /* functions must be listed alphabetically */ static LIBR library[MAXLIB] = { - { "ceil", 1, l_ceil }, - { "floor", 1, l_floor }, - { "if", 3, l_if }, - { "rand", 1, l_rand }, - { "select", 1, l_select }, + { "ceil", 1, ':', l_ceil }, + { "floor", 1, ':', l_floor }, + { "if", 3, ':', l_if }, + { "rand", 1, ':', l_rand }, + { "select", 1, ':', l_select }, }; static int libsize = 5; @@ -87,8 +90,6 @@ static int libsize = 5; extern char *savestr(), *emalloc(); -extern LIBR *liblookup(); - extern VARDEF *argf(); #ifdef VARIABLE @@ -130,7 +131,10 @@ double *a; act.name = fname; act.prev = curact; act.ap = a; - act.an = (1L<= AFLAGSIZ) + act.an = ~0; + else + act.an = (1L<= MAXLIB) { eputs("Too many library functons!\n"); quit(1); @@ -161,14 +166,28 @@ double (*fptr)(); if (strcmp(lp[-1].fname, fname) > 0) { lp[0].fname = lp[-1].fname; lp[0].nargs = lp[-1].nargs; + lp[0].atyp = lp[-1].atyp; lp[0].f = lp[-1].f; } else break; libsize++; } - lp[0].fname = savestr(fname); - lp[0].nargs = nargs; - lp[0].f = fptr; + if (fptr == NULL) { /* delete */ + while (lp < &library[libsize-1]) { + lp[0].fname = lp[1].fname; + lp[0].nargs = lp[1].nargs; + lp[0].atyp = lp[1].atyp; + lp[0].f = lp[1].f; + lp++; + } + libsize--; + } else { /* or assign */ + lp[0].fname = fname; /* string must be static! */ + lp[0].nargs = nargs; + lp[0].atyp = assign; + lp[0].f = fptr; + } + libupdate(fname); /* relink library */ } @@ -193,7 +212,7 @@ argument(n) /* return nth argument for active functi register int n; { register ACTIVATION *actp = curact; - EPNODE *ep; + register EPNODE *ep; double aval; if (actp == NULL || --n < 0) { @@ -201,7 +220,7 @@ register int n; quit(1); } /* already computed? */ - if (1L<an) + if (n < AFLAGSIZ && 1L<an) return(actp->ap[n]); if (actp->fun == NULL || (ep = ekid(actp->fun, n+1)) == NULL) { @@ -320,6 +339,9 @@ char *fname; #ifndef VARIABLE +static VARDEF *varlist = NULL; /* our list of dummy variables */ + + VARDEF * varinsert(vname) /* dummy variable insert */ char *vname; @@ -330,8 +352,9 @@ char *vname; vp->name = savestr(vname); vp->nlinks = 1; vp->def = NULL; - vp->lib = NULL; - vp->next = NULL; + vp->lib = liblookup(vname); + vp->next = varlist; + varlist = vp; return(vp); } @@ -339,9 +362,28 @@ char *vname; varfree(vp) /* free dummy variable */ register VARDEF *vp; { + register VARDEF *vp2; + + if (vp == varlist) + varlist = vp->next; + else { + for (vp2 = varlist; vp2->next != vp; vp2 = vp2->next) + ; + vp2->next = vp->next; + } freestr(vp->name); efree((char *)vp); } + + +libupdate(nm) /* update library */ +char *nm; +{ + register VARDEF *vp; + + for (vp = varlist; vp != NULL; vp = vp->next) + vp->lib = liblookup(vp->name); +} #endif @@ -354,33 +396,39 @@ register VARDEF *vp; static double libfunc(fname, vp) /* execute library function */ char *fname; -register VARDEF *vp; +VARDEF *vp; { - VARDEF dumdef; + register LIBR *lp; double d; int lasterrno; - if (vp == NULL) { - vp = &dumdef; - vp->lib = NULL; - } - if (((vp->lib == NULL || strcmp(fname, vp->lib->fname)) && - (vp->lib = liblookup(fname)) == NULL) || - vp->lib->f == NULL) { + if (vp != NULL) + lp = vp->lib; + else + lp = liblookup(fname); + if (lp == NULL) { eputs(fname); eputs(": undefined function\n"); quit(1); } lasterrno = errno; errno = 0; - d = (*vp->lib->f)(); + d = (*lp->f)(lp->fname); #ifdef IEEE - if (!finite(d)) - errno = EDOM; + if (errno == 0) + if (isnan(d)) + errno = EDOM; + else if (isinf(d)) + errno = ERANGE; #endif if (errno) { wputs(fname); - wputs(": bad call\n"); + if (errno == EDOM) + wputs(": domain error\n"); + else if (errno == ERANGE) + wputs(": range error\n"); + else + wputs(": error in call\n"); return(0.0); } errno = lasterrno; @@ -423,7 +471,6 @@ l_select() /* return argument #(A1+1) */ static double l_rand() /* random function between 0 and 1 */ { - extern double floor(); double x; x = argument(1); @@ -437,8 +484,6 @@ l_rand() /* random function between 0 and 1 */ static double l_floor() /* return largest integer not greater than arg1 */ { - extern double floor(); - return(floor(argument(1))); } @@ -446,8 +491,6 @@ l_floor() /* return largest integer not greater than static double l_ceil() /* return smallest integer not less than arg1 */ { - extern double ceil(); - return(ceil(argument(1))); } @@ -456,8 +499,6 @@ l_ceil() /* return smallest integer not less than arg static double l_sqrt() { - extern double sqrt(); - return(sqrt(argument(1))); } @@ -465,8 +506,6 @@ l_sqrt() static double l_sin() { - extern double sin(); - return(sin(argument(1))); } @@ -474,8 +513,6 @@ l_sin() static double l_cos() { - extern double cos(); - return(cos(argument(1))); } @@ -483,8 +520,6 @@ l_cos() static double l_tan() { - extern double tan(); - return(tan(argument(1))); } @@ -492,8 +527,6 @@ l_tan() static double l_asin() { - extern double asin(); - return(asin(argument(1))); } @@ -501,8 +534,6 @@ l_asin() static double l_acos() { - extern double acos(); - return(acos(argument(1))); } @@ -510,8 +541,6 @@ l_acos() static double l_atan() { - extern double atan(); - return(atan(argument(1))); } @@ -519,8 +548,6 @@ l_atan() static double l_atan2() { - extern double atan2(); - return(atan2(argument(1), argument(2))); } @@ -528,8 +555,6 @@ l_atan2() static double l_exp() { - extern double exp(); - return(exp(argument(1))); } @@ -537,8 +562,6 @@ l_exp() static double l_log() { - extern double log(); - return(log(argument(1))); } @@ -546,8 +569,6 @@ l_log() static double l_log10() { - extern double log10(); - return(log10(argument(1))); } #endif