ViewVC Help
View File | Revision Log | Show Annotations | Download File | Root Listing
root/radiance/ray/src/common/calfunc.c
Revision: 1.9
Committed: Fri Aug 2 14:11:17 1991 UTC (32 years, 9 months ago) by greg
Content type: text/plain
Branch: MAIN
Changes since 1.8: +5 -2 lines
Log Message:
improved IEEE error reporting slightly

File Contents

# User Rev Content
1 greg 1.5 /* Copyright (c) 1991 Regents of the University of California */
2 greg 1.1
3     #ifndef lint
4     static char SCCSid[] = "$SunId$ LBL";
5     #endif
6    
7     /*
8     * calfunc.c - routines for calcomp using functions.
9     *
10     * The define BIGLIB pulls in a large number of the
11     * available math routines.
12     *
13     * If VARIABLE is not defined, only library functions
14     * can be accessed.
15     *
16     * 4/2/86
17     */
18    
19     #include <stdio.h>
20    
21     #include <errno.h>
22    
23     #include "calcomp.h"
24    
25 greg 1.5 /* bits in argument flag (better be right!) */
26     #define AFLAGSIZ (8*sizeof(unsigned long))
27 greg 1.1 #define ALISTSIZ 6 /* maximum saved argument list */
28    
29     typedef struct activation {
30     char *name; /* function name */
31     struct activation *prev; /* previous activation */
32     double *ap; /* argument list */
33     unsigned long an; /* computed argument flags */
34     EPNODE *fun; /* argument function */
35     } ACTIVATION; /* an activation record */
36    
37     static ACTIVATION *curact = NULL;
38    
39 greg 1.2 static double libfunc();
40 greg 1.1
41     #define MAXLIB 64 /* maximum number of library functions */
42    
43 greg 1.2 static double l_if(), l_select(), l_rand();
44     static double l_floor(), l_ceil();
45 greg 1.1 #ifdef BIGLIB
46 greg 1.2 static double l_sqrt();
47     static double l_sin(), l_cos(), l_tan();
48     static double l_asin(), l_acos(), l_atan(), l_atan2();
49     static double l_exp(), l_log(), l_log10();
50 greg 1.1 #endif
51    
52     #ifdef BIGLIB
53     /* functions must be listed alphabetically */
54     static LIBR library[MAXLIB] = {
55 greg 1.4 { "acos", 1, ':', l_acos },
56     { "asin", 1, ':', l_asin },
57     { "atan", 1, ':', l_atan },
58     { "atan2", 2, ':', l_atan2 },
59     { "ceil", 1, ':', l_ceil },
60     { "cos", 1, ':', l_cos },
61     { "exp", 1, ':', l_exp },
62     { "floor", 1, ':', l_floor },
63     { "if", 3, ':', l_if },
64     { "log", 1, ':', l_log },
65     { "log10", 1, ':', l_log10 },
66     { "rand", 1, ':', l_rand },
67     { "select", 1, ':', l_select },
68     { "sin", 1, ':', l_sin },
69     { "sqrt", 1, ':', l_sqrt },
70     { "tan", 1, ':', l_tan },
71 greg 1.1 };
72    
73     static int libsize = 16;
74    
75     #else
76     /* functions must be listed alphabetically */
77     static LIBR library[MAXLIB] = {
78 greg 1.4 { "ceil", 1, ':', l_ceil },
79     { "floor", 1, ':', l_floor },
80     { "if", 3, ':', l_if },
81     { "rand", 1, ':', l_rand },
82     { "select", 1, ':', l_select },
83 greg 1.1 };
84    
85     static int libsize = 5;
86    
87     #endif
88    
89     extern char *savestr(), *emalloc();
90    
91     extern LIBR *liblookup();
92    
93     extern VARDEF *argf();
94    
95     #ifdef VARIABLE
96     #define resolve(ep) ((ep)->type==VAR?(ep)->v.ln:argf((ep)->v.chan))
97     #else
98     #define resolve(ep) ((ep)->v.ln)
99     #define varlookup(name) NULL
100     #endif
101    
102    
103     int
104     fundefined(fname) /* return # of arguments for function */
105     char *fname;
106     {
107     LIBR *lp;
108     register VARDEF *vp;
109    
110     if ((vp = varlookup(fname)) == NULL || vp->def == NULL
111     || vp->def->v.kid->type != FUNC)
112     if ((lp = liblookup(fname)) == NULL)
113     return(0);
114     else
115     return(lp->nargs);
116     else
117     return(nekids(vp->def->v.kid) - 1);
118     }
119    
120    
121     double
122     funvalue(fname, n, a) /* return a function value to the user */
123     char *fname;
124     int n;
125     double *a;
126     {
127     ACTIVATION act;
128     register VARDEF *vp;
129     double rval;
130     /* push environment */
131     act.name = fname;
132     act.prev = curact;
133     act.ap = a;
134 greg 1.5 if (n >= AFLAGSIZ)
135     act.an = ~0;
136     else
137     act.an = (1L<<n)-1;
138 greg 1.1 act.fun = NULL;
139     curact = &act;
140    
141     if ((vp = varlookup(fname)) == NULL || vp->def == NULL
142     || vp->def->v.kid->type != FUNC)
143     rval = libfunc(fname, vp);
144     else
145     rval = evalue(vp->def->v.kid->sibling);
146    
147     curact = act.prev; /* pop environment */
148     return(rval);
149     }
150    
151    
152 greg 1.4 funset(fname, nargs, assign, fptr) /* set a library function */
153 greg 1.1 char *fname;
154     int nargs;
155 greg 1.4 int assign;
156 greg 1.1 double (*fptr)();
157     {
158     register LIBR *lp;
159    
160     if ((lp = liblookup(fname)) == NULL) {
161     if (libsize >= MAXLIB) {
162     eputs("Too many library functons!\n");
163     quit(1);
164     }
165     for (lp = &library[libsize]; lp > library; lp--)
166     if (strcmp(lp[-1].fname, fname) > 0) {
167     lp[0].fname = lp[-1].fname;
168     lp[0].nargs = lp[-1].nargs;
169 greg 1.4 lp[0].atyp = lp[-1].atyp;
170 greg 1.1 lp[0].f = lp[-1].f;
171     } else
172     break;
173     libsize++;
174     }
175 greg 1.6 lp[0].fname = fname; /* must be static! */
176 greg 1.1 lp[0].nargs = nargs;
177 greg 1.4 lp[0].atyp = assign;
178 greg 1.1 lp[0].f = fptr;
179     }
180    
181    
182     int
183     nargum() /* return number of available arguments */
184     {
185     register int n;
186    
187     if (curact == NULL)
188     return(0);
189     if (curact->fun == NULL) {
190     for (n = 0; (1L<<n) & curact->an; n++)
191     ;
192     return(n);
193     }
194     return(nekids(curact->fun) - 1);
195     }
196    
197    
198     double
199     argument(n) /* return nth argument for active function */
200     register int n;
201     {
202     register ACTIVATION *actp = curact;
203 greg 1.7 register EPNODE *ep;
204 greg 1.1 double aval;
205    
206     if (actp == NULL || --n < 0) {
207     eputs("Bad call to argument!\n");
208     quit(1);
209     }
210     /* already computed? */
211 greg 1.5 if (n < AFLAGSIZ && 1L<<n & actp->an)
212 greg 1.1 return(actp->ap[n]);
213    
214     if (actp->fun == NULL || (ep = ekid(actp->fun, n+1)) == NULL) {
215     eputs(actp->name);
216     eputs(": too few arguments\n");
217     quit(1);
218     }
219     curact = actp->prev; /* pop environment */
220     aval = evalue(ep); /* compute argument */
221     curact = actp; /* push back environment */
222     if (n < ALISTSIZ) { /* save value */
223     actp->ap[n] = aval;
224     actp->an |= 1L<<n;
225     }
226     return(aval);
227     }
228    
229    
230     #ifdef VARIABLE
231     VARDEF *
232     argf(n) /* return function def for nth argument */
233     int n;
234     {
235     register ACTIVATION *actp;
236     register EPNODE *ep;
237    
238     for (actp = curact; actp != NULL; actp = actp->prev) {
239    
240     if (n <= 0)
241     break;
242    
243     if (actp->fun == NULL)
244     goto badarg;
245    
246     if ((ep = ekid(actp->fun, n)) == NULL) {
247     eputs(actp->name);
248     eputs(": too few arguments\n");
249     quit(1);
250     }
251     if (ep->type == VAR)
252     return(ep->v.ln); /* found it */
253    
254     if (ep->type != ARG)
255     goto badarg;
256    
257     n = ep->v.chan; /* try previous context */
258     }
259     eputs("Bad call to argf!\n");
260     quit(1);
261    
262     badarg:
263     eputs(actp->name);
264     eputs(": argument not a function\n");
265     quit(1);
266     }
267    
268    
269     char *
270     argfun(n) /* return function name for nth argument */
271     int n;
272     {
273     return(argf(n)->name);
274     }
275     #endif
276    
277    
278     double
279     efunc(ep) /* evaluate a function */
280     register EPNODE *ep;
281     {
282     ACTIVATION act;
283     double alist[ALISTSIZ];
284     double rval;
285     register VARDEF *dp;
286     /* push environment */
287     dp = resolve(ep->v.kid);
288     act.name = dp->name;
289     act.prev = curact;
290     act.ap = alist;
291     act.an = 0;
292     act.fun = ep;
293     curact = &act;
294    
295     if (dp->def == NULL || dp->def->v.kid->type != FUNC)
296     rval = libfunc(act.name, dp);
297     else
298     rval = evalue(dp->def->v.kid->sibling);
299    
300     curact = act.prev; /* pop environment */
301     return(rval);
302     }
303    
304    
305     LIBR *
306     liblookup(fname) /* look up a library function */
307     char *fname;
308     {
309     int upper, lower;
310     register int cm, i;
311    
312     lower = 0;
313     upper = cm = libsize;
314    
315     while ((i = (lower + upper) >> 1) != cm) {
316     cm = strcmp(fname, library[i].fname);
317     if (cm > 0)
318     lower = i;
319     else if (cm < 0)
320     upper = i;
321     else
322     return(&library[i]);
323     cm = i;
324     }
325     return(NULL);
326     }
327    
328    
329     #ifndef VARIABLE
330     VARDEF *
331     varinsert(vname) /* dummy variable insert */
332     char *vname;
333     {
334     register VARDEF *vp;
335    
336     vp = (VARDEF *)emalloc(sizeof(VARDEF));
337     vp->name = savestr(vname);
338     vp->nlinks = 1;
339     vp->def = NULL;
340     vp->lib = NULL;
341     vp->next = NULL;
342     return(vp);
343     }
344    
345    
346     varfree(vp) /* free dummy variable */
347     register VARDEF *vp;
348     {
349     freestr(vp->name);
350     efree((char *)vp);
351     }
352     #endif
353    
354    
355    
356     /*
357     * The following routines are for internal use:
358     */
359    
360    
361     static double
362     libfunc(fname, vp) /* execute library function */
363     char *fname;
364     register VARDEF *vp;
365     {
366     VARDEF dumdef;
367     double d;
368     int lasterrno;
369    
370     if (vp == NULL) {
371     vp = &dumdef;
372     vp->lib = NULL;
373     }
374     if (((vp->lib == NULL || strcmp(fname, vp->lib->fname)) &&
375     (vp->lib = liblookup(fname)) == NULL) ||
376     vp->lib->f == NULL) {
377     eputs(fname);
378     eputs(": undefined function\n");
379     quit(1);
380     }
381     lasterrno = errno;
382     errno = 0;
383 greg 1.6 d = (*vp->lib->f)(vp->lib->fname);
384 greg 1.1 #ifdef IEEE
385 greg 1.9 if (errno == 0)
386     if (isnan(d))
387     errno = EDOM;
388     else if (isinf(d))
389     errno = ERANGE;
390 greg 1.1 #endif
391     if (errno) {
392     wputs(fname);
393 greg 1.8 if (errno == EDOM)
394     wputs(": domain error\n");
395     else if (errno == ERANGE)
396     wputs(": range error\n");
397     else
398     wputs(": error in call\n");
399 greg 1.1 return(0.0);
400     }
401     errno = lasterrno;
402     return(d);
403     }
404    
405    
406     /*
407     * Library functions:
408     */
409    
410    
411     static double
412     l_if() /* if(cond, then, else) conditional expression */
413     /* cond evaluates true if greater than zero */
414     {
415     if (argument(1) > 0.0)
416     return(argument(2));
417     else
418     return(argument(3));
419     }
420    
421    
422     static double
423     l_select() /* return argument #(A1+1) */
424     {
425     register int n;
426    
427     n = argument(1) + .5;
428     if (n == 0)
429     return(nargum()-1);
430     if (n < 1 || n > nargum()-1) {
431     errno = EDOM;
432     return(0.0);
433     }
434     return(argument(n+1));
435     }
436    
437    
438     static double
439     l_rand() /* random function between 0 and 1 */
440     {
441     extern double floor();
442     double x;
443    
444     x = argument(1);
445     x *= 1.0/(1.0 + x*x) + 2.71828182845904;
446     x += .785398163397447 - floor(x);
447     x = 1e5 / x;
448     return(x - floor(x));
449     }
450    
451    
452     static double
453     l_floor() /* return largest integer not greater than arg1 */
454     {
455     extern double floor();
456    
457     return(floor(argument(1)));
458     }
459    
460    
461     static double
462     l_ceil() /* return smallest integer not less than arg1 */
463     {
464     extern double ceil();
465    
466     return(ceil(argument(1)));
467     }
468    
469    
470     #ifdef BIGLIB
471     static double
472     l_sqrt()
473     {
474     extern double sqrt();
475    
476     return(sqrt(argument(1)));
477     }
478    
479    
480     static double
481     l_sin()
482     {
483     extern double sin();
484    
485     return(sin(argument(1)));
486     }
487    
488    
489     static double
490     l_cos()
491     {
492     extern double cos();
493    
494     return(cos(argument(1)));
495     }
496    
497    
498     static double
499     l_tan()
500     {
501     extern double tan();
502    
503     return(tan(argument(1)));
504     }
505    
506    
507     static double
508     l_asin()
509     {
510     extern double asin();
511    
512     return(asin(argument(1)));
513     }
514    
515    
516     static double
517     l_acos()
518     {
519     extern double acos();
520    
521     return(acos(argument(1)));
522     }
523    
524    
525     static double
526     l_atan()
527     {
528     extern double atan();
529    
530     return(atan(argument(1)));
531     }
532    
533    
534     static double
535     l_atan2()
536     {
537     extern double atan2();
538    
539     return(atan2(argument(1), argument(2)));
540     }
541    
542    
543     static double
544     l_exp()
545     {
546     extern double exp();
547    
548     return(exp(argument(1)));
549     }
550    
551    
552     static double
553     l_log()
554     {
555     extern double log();
556    
557     return(log(argument(1)));
558     }
559    
560    
561     static double
562     l_log10()
563     {
564     extern double log10();
565    
566     return(log10(argument(1)));
567     }
568     #endif