ViewVC Help
View File | Revision Log | Show Annotations | Download File | Root Listing
root/radiance/ray/src/common/calfunc.c
Revision: 2.2
Committed: Fri May 15 16:38:47 1992 UTC (31 years, 11 months ago) by greg
Content type: text/plain
Branch: MAIN
Changes since 2.1: +19 -11 lines
Log Message:
changed library links to be reliable to avoid strcmp() call

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