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