home *** CD-ROM | disk | FTP | other *** search
/ ftp.cs.arizona.edu / ftp.cs.arizona.edu.tar / ftp.cs.arizona.edu / icon / historic / v941.tgz / icon.v941src.tar / icon.v941src / src / runtime / fmath.r < prev    next >
Text File  |  2001-12-12  |  3KB  |  122 lines
  1. /*
  2.  * fmath.r -- sin, cos, tan, acos, asin, atan, dtor, rtod, exp, log, sqrt
  3.  */
  4.  
  5. /*
  6.  * Most of the math ops are simple calls to underlying C functions,
  7.  * sometimes with additional error checking to avoid and/or detect
  8.  * various C runtime errors.
  9.  */
  10. #begdef MathOp(funcname,ccode,comment,pre,post)
  11. #funcname "(r)" comment
  12. function{1} funcname(x)
  13.  
  14.    if !cnv:C_double(x) then
  15.       runerr(102, x)
  16.  
  17.    abstract {
  18.       return real
  19.       }
  20.    inline {
  21.       double y;
  22.       pre        /* Pre math-operation range checking */
  23.       errno = 0;
  24.       y = ccode(x);
  25.       post        /* Post math-operation C library error detection */
  26.       return C_double y;
  27.       }
  28. end
  29. #enddef
  30.  
  31.  
  32. #define aroundone if (x < -1.0 || x > 1.0) {drunerr(205, x); errorfail;}
  33. #define positive  if (x < 0)               {drunerr(205, x); errorfail;}
  34.  
  35. #define erange    if (errno == ERANGE)     runerr(204);
  36. #define edom      if (errno == EDOM)       runerr(205);
  37.  
  38. MathOp(sin, sin,  ", x in radians.", ;, ;)
  39. MathOp(cos, cos,  ", x in radians.", ;, ;)
  40. MathOp(tan, tan,  ", x in radians.", ; , erange)
  41. MathOp(acos,acos, ", x in radians.", aroundone, edom)
  42. MathOp(asin,asin, ", x in radians.", aroundone, edom)
  43. MathOp(exp, exp,  " - e^x.", ; , erange)
  44. MathOp(sqrt,sqrt, " - square root of x.", positive, edom)
  45. #define DTOR(x) ((x) * Pi / 180)
  46. #define RTOD(x) ((x) * 180 / Pi)
  47. MathOp(dtor,DTOR, " - convert x from degrees to radians.", ; , ;)
  48. MathOp(rtod,RTOD, " - convert x from radians to degrees.", ; , ;)
  49.  
  50.  
  51.  
  52. "atan(r1,r2) -- r1, r2  in radians; if r2 is present, produces atan2(r1,r2)."
  53.  
  54. function{1} atan(x,y)
  55.  
  56.    if !cnv:C_double(x) then
  57.       runerr(102, x)
  58.  
  59.    abstract {
  60.       return real
  61.       }
  62.    if is:null(y) then
  63.       inline {
  64.          return C_double atan(x);
  65.          }
  66.    if !cnv:C_double(y) then
  67.       runerr(102, y)
  68.    inline {
  69.  
  70. #if AMIGA
  71. #if AZTEC_C
  72.    #define atan2(x,y) atan(x/y)
  73. #endif                    /* AZTEC_C */
  74. #endif                    /* AMIGA */
  75.  
  76.       return C_double atan2(x,y);
  77.       }
  78. end
  79.  
  80.  
  81. "log(r1,r2) - logarithm of r1 to base r2."
  82.  
  83. function{1} log(x,b)
  84.  
  85.    if !cnv:C_double(x) then
  86.       runerr(102, x)
  87.  
  88.    abstract {
  89.       return real
  90.       }
  91.    inline {
  92.       if (x <= 0.0) {
  93.          drunerr(205, x);
  94.          errorfail;
  95.          }
  96.       }
  97.    if is:null(b) then
  98.       inline {
  99.          return C_double log(x);
  100.          }
  101.    else {
  102.       if !cnv:C_double(b) then
  103.          runerr(102, b)
  104.       body {
  105.          static double lastbase = 0.0;
  106.          static double divisor;
  107.  
  108.          if (b <= 1.0) {
  109.             drunerr(205, b);
  110.             errorfail;
  111.             }
  112.          if (b != lastbase) {
  113.             divisor = log(b);
  114.             lastbase = b;
  115.             }
  116.      x = log(x) / divisor;
  117.          return C_double x;
  118.          }
  119.       }
  120. end
  121.  
  122.