ViewVC Help
View File | Revision Log | Show Annotations | Download File | Root Listing
root/radiance/ray/src/common/calfunc.c
Revision: 2.15
Committed: Wed May 10 15:21:20 2006 UTC (17 years, 10 months ago) by greg
Content type: text/plain
Branch: MAIN
CVS Tags: rad4R1, rad4R0, rad3R8, rad3R9
Changes since 2.14: +2 -2 lines
Log Message:
Changed from IEEE macro to checking for isnan macro

File Contents

# Content
1 #ifndef lint
2 static const char RCSid[] = "$Id: calfunc.c,v 2.14 2003/11/14 17:22:06 schorsch Exp $";
3 #endif
4 /*
5 * calfunc.c - routines for calcomp using functions.
6 *
7 * 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 #include "copyright.h"
14
15 #include <stdio.h>
16 #include <string.h>
17 #include <errno.h>
18 #include <math.h>
19
20 #include "rterror.h"
21 #include "calcomp.h"
22
23 /* bits in argument flag (better be right!) */
24 #define AFLAGSIZ (8*sizeof(unsigned long))
25 #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 static double libfunc(char *fname, VARDEF *vp);
38
39 #ifndef MAXLIB
40 #define MAXLIB 64 /* maximum number of library functions */
41 #endif
42
43 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
50 /* functions must be listed alphabetically */
51 static LIBR library[MAXLIB] = {
52 { "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 };
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 fundefined(fname) /* return # of arguments for function */
77 char *fname;
78 {
79 register LIBR *lp;
80 register VARDEF *vp;
81
82 if ((vp = varlookup(fname)) != NULL && vp->def != NULL
83 && vp->def->v.kid->type == FUNC)
84 return(nekids(vp->def->v.kid) - 1);
85 lp = vp != NULL ? vp->lib : liblookup(fname);
86 if (lp == NULL)
87 return(0);
88 return(lp->nargs);
89 }
90
91
92 double
93 funvalue(fname, n, a) /* return a function value to the user */
94 char *fname;
95 int n;
96 double *a;
97 {
98 ACTIVATION act;
99 register VARDEF *vp;
100 double rval;
101 /* push environment */
102 act.name = fname;
103 act.prev = curact;
104 act.ap = a;
105 if (n >= AFLAGSIZ)
106 act.an = ~0;
107 else
108 act.an = (1L<<n)-1;
109 act.fun = NULL;
110 curact = &act;
111
112 if ((vp = varlookup(fname)) == NULL || vp->def == NULL
113 || vp->def->v.kid->type != FUNC)
114 rval = libfunc(fname, vp);
115 else
116 rval = evalue(vp->def->v.kid->sibling);
117
118 curact = act.prev; /* pop environment */
119 return(rval);
120 }
121
122
123 void
124 funset(fname, nargs, assign, fptr) /* set a library function */
125 char *fname;
126 int nargs;
127 int assign;
128 double (*fptr)(char *);
129 {
130 int oldlibsize = libsize;
131 char *cp;
132 register LIBR *lp;
133 /* check for context */
134 for (cp = fname; *cp; cp++)
135 ;
136 if (cp == fname)
137 return;
138 if (cp[-1] == CNTXMARK)
139 *--cp = '\0';
140 if ((lp = liblookup(fname)) == NULL) { /* insert */
141 if (libsize >= MAXLIB) {
142 eputs("Too many library functons!\n");
143 quit(1);
144 }
145 for (lp = &library[libsize]; lp > library; lp--)
146 if (strcmp(lp[-1].fname, fname) > 0) {
147 lp[0].fname = lp[-1].fname;
148 lp[0].nargs = lp[-1].nargs;
149 lp[0].atyp = lp[-1].atyp;
150 lp[0].f = lp[-1].f;
151 } else
152 break;
153 libsize++;
154 }
155 if (fptr == NULL) { /* delete */
156 while (lp < &library[libsize-1]) {
157 lp[0].fname = lp[1].fname;
158 lp[0].nargs = lp[1].nargs;
159 lp[0].atyp = lp[1].atyp;
160 lp[0].f = lp[1].f;
161 lp++;
162 }
163 libsize--;
164 } else { /* or assign */
165 lp[0].fname = fname; /* string must be static! */
166 lp[0].nargs = nargs;
167 lp[0].atyp = assign;
168 lp[0].f = fptr;
169 }
170 if (libsize != oldlibsize)
171 libupdate(fname); /* relink library */
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 register EPNODE *ep = NULL;
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 (n < AFLAGSIZ && 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 VARDEF *
224 argf(n) /* return function def for nth argument */
225 int n;
226 {
227 register ACTIVATION *actp;
228 register EPNODE *ep;
229
230 for (actp = curact; actp != NULL; actp = actp->prev) {
231
232 if (n <= 0)
233 break;
234
235 if (actp->fun == NULL)
236 goto badarg;
237
238 if ((ep = ekid(actp->fun, n)) == NULL) {
239 eputs(actp->name);
240 eputs(": too few arguments\n");
241 quit(1);
242 }
243 if (ep->type == VAR)
244 return(ep->v.ln); /* found it */
245
246 if (ep->type != ARG)
247 goto badarg;
248
249 n = ep->v.chan; /* try previous context */
250 }
251 eputs("Bad call to argf!\n");
252 quit(1);
253
254 badarg:
255 eputs(actp->name);
256 eputs(": argument not a function\n");
257 quit(1);
258 return NULL; /* pro forma return */
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
269
270 double
271 efunc(ep) /* evaluate a function */
272 register EPNODE *ep;
273 {
274 ACTIVATION act;
275 double alist[ALISTSIZ];
276 double rval;
277 register VARDEF *dp;
278 /* push environment */
279 dp = resolve(ep->v.kid);
280 act.name = dp->name;
281 act.prev = curact;
282 act.ap = alist;
283 act.an = 0;
284 act.fun = ep;
285 curact = &act;
286
287 if (dp->def == NULL || dp->def->v.kid->type != FUNC)
288 rval = libfunc(act.name, dp);
289 else
290 rval = evalue(dp->def->v.kid->sibling);
291
292 curact = act.prev; /* pop environment */
293 return(rval);
294 }
295
296
297 LIBR *
298 liblookup(fname) /* look up a library function */
299 char *fname;
300 {
301 int upper, lower;
302 register int cm, i;
303
304 lower = 0;
305 upper = cm = libsize;
306
307 while ((i = (lower + upper) >> 1) != cm) {
308 cm = strcmp(fname, library[i].fname);
309 if (cm > 0)
310 lower = i;
311 else if (cm < 0)
312 upper = i;
313 else
314 return(&library[i]);
315 cm = i;
316 }
317 return(NULL);
318 }
319
320
321 /*
322 * The following routines are for internal use:
323 */
324
325
326 static double
327 libfunc(fname, vp) /* execute library function */
328 char *fname;
329 VARDEF *vp;
330 {
331 register LIBR *lp;
332 double d;
333 int lasterrno;
334
335 if (vp != NULL)
336 lp = vp->lib;
337 else
338 lp = liblookup(fname);
339 if (lp == NULL) {
340 eputs(fname);
341 eputs(": undefined function\n");
342 quit(1);
343 }
344 lasterrno = errno;
345 errno = 0;
346 d = (*lp->f)(lp->fname);
347 #ifdef isnan
348 if (errno == 0)
349 if (isnan(d))
350 errno = EDOM;
351 else if (isinf(d))
352 errno = ERANGE;
353 #endif
354 if (errno == EDOM || errno == ERANGE) {
355 wputs(fname);
356 if (errno == EDOM)
357 wputs(": domain error\n");
358 else if (errno == ERANGE)
359 wputs(": range error\n");
360 else
361 wputs(": error in call\n");
362 return(0.0);
363 }
364 errno = lasterrno;
365 return(d);
366 }
367
368
369 /*
370 * Library functions:
371 */
372
373
374 static double
375 l_if(char *nm) /* if(cond, then, else) conditional expression */
376 /* cond evaluates true if greater than zero */
377 {
378 if (argument(1) > 0.0)
379 return(argument(2));
380 else
381 return(argument(3));
382 }
383
384
385 static double
386 l_select(char *nm) /* return argument #(A1+1) */
387 {
388 register int n;
389
390 n = (int)(argument(1) + .5);
391 if (n == 0)
392 return(nargum()-1);
393 if (n < 1 || n > nargum()-1) {
394 errno = EDOM;
395 return(0.0);
396 }
397 return(argument(n+1));
398 }
399
400
401 static double
402 l_rand(char *nm) /* random function between 0 and 1 */
403 {
404 double x;
405
406 x = argument(1);
407 x *= 1.0/(1.0 + x*x) + 2.71828182845904;
408 x += .785398163397447 - floor(x);
409 x = 1e5 / x;
410 return(x - floor(x));
411 }
412
413
414 static double
415 l_floor(char *nm) /* return largest integer not greater than arg1 */
416 {
417 return(floor(argument(1)));
418 }
419
420
421 static double
422 l_ceil(char *nm) /* return smallest integer not less than arg1 */
423 {
424 return(ceil(argument(1)));
425 }
426
427
428 static double
429 l_sqrt(char *nm)
430 {
431 return(sqrt(argument(1)));
432 }
433
434
435 static double
436 l_sin(char *nm)
437 {
438 return(sin(argument(1)));
439 }
440
441
442 static double
443 l_cos(char *nm)
444 {
445 return(cos(argument(1)));
446 }
447
448
449 static double
450 l_tan(char *nm)
451 {
452 return(tan(argument(1)));
453 }
454
455
456 static double
457 l_asin(char *nm)
458 {
459 return(asin(argument(1)));
460 }
461
462
463 static double
464 l_acos(char *nm)
465 {
466 return(acos(argument(1)));
467 }
468
469
470 static double
471 l_atan(char *nm)
472 {
473 return(atan(argument(1)));
474 }
475
476
477 static double
478 l_atan2(char *nm)
479 {
480 return(atan2(argument(1), argument(2)));
481 }
482
483
484 static double
485 l_exp(char *nm)
486 {
487 return(exp(argument(1)));
488 }
489
490
491 static double
492 l_log(char *nm)
493 {
494 return(log(argument(1)));
495 }
496
497
498 static double
499 l_log10(char *nm)
500 {
501 return(log10(argument(1)));
502 }