ViewVC Help
View File | Revision Log | Show Annotations | Download File | Root Listing
root/radiance/ray/src/common/calfunc.c
Revision: 2.8
Committed: Sat Feb 22 02:07:21 2003 UTC (21 years, 2 months ago) by greg
Content type: text/plain
Branch: MAIN
Changes since 2.7: +71 -90 lines
Log Message: 
Changes and check-in for 3.5 release
Includes new source files and modifications not recorded for many years
See ray/doc/notes/ReleaseNotes for notes between 3.1 and 3.5 release

File Contents

# Content
1 #ifndef lint
2 static const char RCSid[] = "$Id$";
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 /* ====================================================================
14 * The Radiance Software License, Version 1.0
15 *
16 * Copyright (c) 1990 - 2002 The Regents of the University of California,
17 * through Lawrence Berkeley National Laboratory. All rights reserved.
18 *
19 * Redistribution and use in source and binary forms, with or without
20 * modification, are permitted provided that the following conditions
21 * are met:
22 *
23 * 1. Redistributions of source code must retain the above copyright
24 * notice, this list of conditions and the following disclaimer.
25 *
26 * 2. Redistributions in binary form must reproduce the above copyright
27 * notice, this list of conditions and the following disclaimer in
28 * the documentation and/or other materials provided with the
29 * distribution.
30 *
31 * 3. The end-user documentation included with the redistribution,
32 * if any, must include the following acknowledgment:
33 * "This product includes Radiance software
34 * (http://radsite.lbl.gov/)
35 * developed by the Lawrence Berkeley National Laboratory
36 * (http://www.lbl.gov/)."
37 * Alternately, this acknowledgment may appear in the software itself,
38 * if and wherever such third-party acknowledgments normally appear.
39 *
40 * 4. The names "Radiance," "Lawrence Berkeley National Laboratory"
41 * and "The Regents of the University of California" must
42 * not be used to endorse or promote products derived from this
43 * software without prior written permission. For written
44 * permission, please contact [email protected].
45 *
46 * 5. Products derived from this software may not be called "Radiance",
47 * nor may "Radiance" appear in their name, without prior written
48 * permission of Lawrence Berkeley National Laboratory.
49 *
50 * THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESSED OR IMPLIED
51 * WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
52 * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
53 * DISCLAIMED. IN NO EVENT SHALL Lawrence Berkeley National Laboratory OR
54 * ITS CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
55 * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
56 * LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF
57 * USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
58 * ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
59 * OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT
60 * OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
61 * SUCH DAMAGE.
62 * ====================================================================
63 *
64 * This software consists of voluntary contributions made by many
65 * individuals on behalf of Lawrence Berkeley National Laboratory. For more
66 * information on Lawrence Berkeley National Laboratory, please see
67 * <http://www.lbl.gov/>.
68 */
69
70 #include <stdio.h>
71
72 #include <errno.h>
73
74 #include <math.h>
75
76 #include "calcomp.h"
77
78 /* bits in argument flag (better be right!) */
79 #define AFLAGSIZ (8*sizeof(unsigned long))
80 #define ALISTSIZ 6 /* maximum saved argument list */
81
82 typedef struct activation {
83 char *name; /* function name */
84 struct activation *prev; /* previous activation */
85 double *ap; /* argument list */
86 unsigned long an; /* computed argument flags */
87 EPNODE *fun; /* argument function */
88 } ACTIVATION; /* an activation record */
89
90 static ACTIVATION *curact = NULL;
91
92 static double libfunc();
93
94 #ifndef MAXLIB
95 #define MAXLIB 64 /* maximum number of library functions */
96 #endif
97
98 static double l_if(), l_select(), l_rand();
99 static double l_floor(), l_ceil();
100 static double l_sqrt();
101 static double l_sin(), l_cos(), l_tan();
102 static double l_asin(), l_acos(), l_atan(), l_atan2();
103 static double l_exp(), l_log(), l_log10();
104
105 /* functions must be listed alphabetically */
106 static LIBR library[MAXLIB] = {
107 { "acos", 1, ':', l_acos },
108 { "asin", 1, ':', l_asin },
109 { "atan", 1, ':', l_atan },
110 { "atan2", 2, ':', l_atan2 },
111 { "ceil", 1, ':', l_ceil },
112 { "cos", 1, ':', l_cos },
113 { "exp", 1, ':', l_exp },
114 { "floor", 1, ':', l_floor },
115 { "if", 3, ':', l_if },
116 { "log", 1, ':', l_log },
117 { "log10", 1, ':', l_log10 },
118 { "rand", 1, ':', l_rand },
119 { "select", 1, ':', l_select },
120 { "sin", 1, ':', l_sin },
121 { "sqrt", 1, ':', l_sqrt },
122 { "tan", 1, ':', l_tan },
123 };
124
125 static int libsize = 16;
126
127 #define resolve(ep) ((ep)->type==VAR?(ep)->v.ln:argf((ep)->v.chan))
128
129
130 int
131 fundefined(fname) /* return # of arguments for function */
132 char *fname;
133 {
134 register LIBR *lp;
135 register VARDEF *vp;
136
137 if ((vp = varlookup(fname)) != NULL && vp->def != NULL
138 && vp->def->v.kid->type == FUNC)
139 return(nekids(vp->def->v.kid) - 1);
140 lp = vp != NULL ? vp->lib : liblookup(fname);
141 if (lp == NULL)
142 return(0);
143 return(lp->nargs);
144 }
145
146
147 double
148 funvalue(fname, n, a) /* return a function value to the user */
149 char *fname;
150 int n;
151 double *a;
152 {
153 ACTIVATION act;
154 register VARDEF *vp;
155 double rval;
156 /* push environment */
157 act.name = fname;
158 act.prev = curact;
159 act.ap = a;
160 if (n >= AFLAGSIZ)
161 act.an = ~0;
162 else
163 act.an = (1L<<n)-1;
164 act.fun = NULL;
165 curact = &act;
166
167 if ((vp = varlookup(fname)) == NULL || vp->def == NULL
168 || vp->def->v.kid->type != FUNC)
169 rval = libfunc(fname, vp);
170 else
171 rval = evalue(vp->def->v.kid->sibling);
172
173 curact = act.prev; /* pop environment */
174 return(rval);
175 }
176
177
178 void
179 funset(fname, nargs, assign, fptr) /* set a library function */
180 char *fname;
181 int nargs;
182 int assign;
183 double (*fptr)();
184 {
185 int oldlibsize = libsize;
186 char *cp;
187 register LIBR *lp;
188 /* check for context */
189 for (cp = fname; *cp; cp++)
190 ;
191 if (cp == fname)
192 return;
193 if (cp[-1] == CNTXMARK)
194 *--cp = '\0';
195 if ((lp = liblookup(fname)) == NULL) { /* insert */
196 if (libsize >= MAXLIB) {
197 eputs("Too many library functons!\n");
198 quit(1);
199 }
200 for (lp = &library[libsize]; lp > library; lp--)
201 if (strcmp(lp[-1].fname, fname) > 0) {
202 lp[0].fname = lp[-1].fname;
203 lp[0].nargs = lp[-1].nargs;
204 lp[0].atyp = lp[-1].atyp;
205 lp[0].f = lp[-1].f;
206 } else
207 break;
208 libsize++;
209 }
210 if (fptr == NULL) { /* delete */
211 while (lp < &library[libsize-1]) {
212 lp[0].fname = lp[1].fname;
213 lp[0].nargs = lp[1].nargs;
214 lp[0].atyp = lp[1].atyp;
215 lp[0].f = lp[1].f;
216 lp++;
217 }
218 libsize--;
219 } else { /* or assign */
220 lp[0].fname = fname; /* string must be static! */
221 lp[0].nargs = nargs;
222 lp[0].atyp = assign;
223 lp[0].f = fptr;
224 }
225 if (libsize != oldlibsize)
226 libupdate(fname); /* relink library */
227 }
228
229
230 int
231 nargum() /* return number of available arguments */
232 {
233 register int n;
234
235 if (curact == NULL)
236 return(0);
237 if (curact->fun == NULL) {
238 for (n = 0; (1L<<n) & curact->an; n++)
239 ;
240 return(n);
241 }
242 return(nekids(curact->fun) - 1);
243 }
244
245
246 double
247 argument(n) /* return nth argument for active function */
248 register int n;
249 {
250 register ACTIVATION *actp = curact;
251 register EPNODE *ep;
252 double aval;
253
254 if (actp == NULL || --n < 0) {
255 eputs("Bad call to argument!\n");
256 quit(1);
257 }
258 /* already computed? */
259 if (n < AFLAGSIZ && 1L<<n & actp->an)
260 return(actp->ap[n]);
261
262 if (actp->fun == NULL || (ep = ekid(actp->fun, n+1)) == NULL) {
263 eputs(actp->name);
264 eputs(": too few arguments\n");
265 quit(1);
266 }
267 curact = actp->prev; /* pop environment */
268 aval = evalue(ep); /* compute argument */
269 curact = actp; /* push back environment */
270 if (n < ALISTSIZ) { /* save value */
271 actp->ap[n] = aval;
272 actp->an |= 1L<<n;
273 }
274 return(aval);
275 }
276
277
278 VARDEF *
279 argf(n) /* return function def for nth argument */
280 int n;
281 {
282 register ACTIVATION *actp;
283 register EPNODE *ep;
284
285 for (actp = curact; actp != NULL; actp = actp->prev) {
286
287 if (n <= 0)
288 break;
289
290 if (actp->fun == NULL)
291 goto badarg;
292
293 if ((ep = ekid(actp->fun, n)) == NULL) {
294 eputs(actp->name);
295 eputs(": too few arguments\n");
296 quit(1);
297 }
298 if (ep->type == VAR)
299 return(ep->v.ln); /* found it */
300
301 if (ep->type != ARG)
302 goto badarg;
303
304 n = ep->v.chan; /* try previous context */
305 }
306 eputs("Bad call to argf!\n");
307 quit(1);
308
309 badarg:
310 eputs(actp->name);
311 eputs(": argument not a function\n");
312 quit(1);
313 }
314
315
316 char *
317 argfun(n) /* return function name for nth argument */
318 int n;
319 {
320 return(argf(n)->name);
321 }
322
323
324 double
325 efunc(ep) /* evaluate a function */
326 register EPNODE *ep;
327 {
328 ACTIVATION act;
329 double alist[ALISTSIZ];
330 double rval;
331 register VARDEF *dp;
332 /* push environment */
333 dp = resolve(ep->v.kid);
334 act.name = dp->name;
335 act.prev = curact;
336 act.ap = alist;
337 act.an = 0;
338 act.fun = ep;
339 curact = &act;
340
341 if (dp->def == NULL || dp->def->v.kid->type != FUNC)
342 rval = libfunc(act.name, dp);
343 else
344 rval = evalue(dp->def->v.kid->sibling);
345
346 curact = act.prev; /* pop environment */
347 return(rval);
348 }
349
350
351 LIBR *
352 liblookup(fname) /* look up a library function */
353 char *fname;
354 {
355 int upper, lower;
356 register int cm, i;
357
358 lower = 0;
359 upper = cm = libsize;
360
361 while ((i = (lower + upper) >> 1) != cm) {
362 cm = strcmp(fname, library[i].fname);
363 if (cm > 0)
364 lower = i;
365 else if (cm < 0)
366 upper = i;
367 else
368 return(&library[i]);
369 cm = i;
370 }
371 return(NULL);
372 }
373
374
375 /*
376 * The following routines are for internal use:
377 */
378
379
380 static double
381 libfunc(fname, vp) /* execute library function */
382 char *fname;
383 VARDEF *vp;
384 {
385 register LIBR *lp;
386 double d;
387 int lasterrno;
388
389 if (vp != NULL)
390 lp = vp->lib;
391 else
392 lp = liblookup(fname);
393 if (lp == NULL) {
394 eputs(fname);
395 eputs(": undefined function\n");
396 quit(1);
397 }
398 lasterrno = errno;
399 errno = 0;
400 d = (*lp->f)(lp->fname);
401 #ifdef IEEE
402 if (errno == 0)
403 if (isnan(d))
404 errno = EDOM;
405 else if (isinf(d))
406 errno = ERANGE;
407 #endif
408 if (errno) {
409 wputs(fname);
410 if (errno == EDOM)
411 wputs(": domain error\n");
412 else if (errno == ERANGE)
413 wputs(": range error\n");
414 else
415 wputs(": error in call\n");
416 return(0.0);
417 }
418 errno = lasterrno;
419 return(d);
420 }
421
422
423 /*
424 * Library functions:
425 */
426
427
428 static double
429 l_if() /* if(cond, then, else) conditional expression */
430 /* cond evaluates true if greater than zero */
431 {
432 if (argument(1) > 0.0)
433 return(argument(2));
434 else
435 return(argument(3));
436 }
437
438
439 static double
440 l_select() /* return argument #(A1+1) */
441 {
442 register int n;
443
444 n = argument(1) + .5;
445 if (n == 0)
446 return(nargum()-1);
447 if (n < 1 || n > nargum()-1) {
448 errno = EDOM;
449 return(0.0);
450 }
451 return(argument(n+1));
452 }
453
454
455 static double
456 l_rand() /* random function between 0 and 1 */
457 {
458 double x;
459
460 x = argument(1);
461 x *= 1.0/(1.0 + x*x) + 2.71828182845904;
462 x += .785398163397447 - floor(x);
463 x = 1e5 / x;
464 return(x - floor(x));
465 }
466
467
468 static double
469 l_floor() /* return largest integer not greater than arg1 */
470 {
471 return(floor(argument(1)));
472 }
473
474
475 static double
476 l_ceil() /* return smallest integer not less than arg1 */
477 {
478 return(ceil(argument(1)));
479 }
480
481
482 static double
483 l_sqrt()
484 {
485 return(sqrt(argument(1)));
486 }
487
488
489 static double
490 l_sin()
491 {
492 return(sin(argument(1)));
493 }
494
495
496 static double
497 l_cos()
498 {
499 return(cos(argument(1)));
500 }
501
502
503 static double
504 l_tan()
505 {
506 return(tan(argument(1)));
507 }
508
509
510 static double
511 l_asin()
512 {
513 return(asin(argument(1)));
514 }
515
516
517 static double
518 l_acos()
519 {
520 return(acos(argument(1)));
521 }
522
523
524 static double
525 l_atan()
526 {
527 return(atan(argument(1)));
528 }
529
530
531 static double
532 l_atan2()
533 {
534 return(atan2(argument(1), argument(2)));
535 }
536
537
538 static double
539 l_exp()
540 {
541 return(exp(argument(1)));
542 }
543
544
545 static double
546 l_log()
547 {
548 return(log(argument(1)));
549 }
550
551
552 static double
553 l_log10()
554 {
555 return(log10(argument(1)));
556 }