ViewVC Help
View File | Revision Log | Show Annotations | Download File | Root Listing
root/radiance/ray/src/common/calfunc.c
Revision: 2.18
Committed: Sat Aug 1 23:27:04 2015 UTC (8 years, 9 months ago) by greg
Content type: text/plain
Branch: MAIN
CVS Tags: rad5R2, rad5R0, rad5R1
Changes since 2.17: +3 -2 lines
Log Message:
Fixed various compiler warnings (mostly harmless)

File Contents

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