ViewVC Help
View File | Revision Log | Show Annotations | Download File | Root Listing
root/radiance/ray/src/common/calfunc.c
Revision: 1.3
Committed: Sat Sep 29 11:18:34 1990 UTC (33 years, 7 months ago) by greg
Content type: text/plain
Branch: MAIN
Changes since 1.2: +1 -1 lines
Log Message:
removed static requirement for function name -- better anyway

File Contents

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