ViewVC Help
View File | Revision Log | Show Annotations | Download File | Root Listing
root/radiance/ray/src/common/calfunc.c
Revision: 1.4
Committed: Tue Apr 23 15:44:39 1991 UTC (33 years ago) by greg
Content type: text/plain
Branch: MAIN
Changes since 1.3: +25 -22 lines
Log Message:
changed setfunc() call to include assignment type

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