home *** CD-ROM | disk | FTP | other *** search
/ APDL Public Domain 1 / APDL_PD1A.iso / program / language / icon / Source / Iconx / C / Fmath < prev    next >
Encoding:
Text File  |  1990-07-19  |  5.2 KB  |  288 lines
  1.  
  2. /*
  3.  * fmath.c -- sin, cos, tan, acos, asin, atan, dtor, rtod, exp, log, sqrt
  4.  */
  5.  
  6. #include <math.h>
  7. #include "../h/config.h"
  8. #include "../h/rt.h"
  9. #include "rproto.h"
  10.  
  11. #ifdef MathFncs
  12. /*
  13.  * The following code is operating-system dependent [@fmath.01].  Include
  14.  *  system-dependent files and declarations.
  15.  */
  16.  
  17. #if PORT
  18.    /* probably #include <errno.h> */
  19. #endif                    /* PORT */
  20.  
  21. #if AMIGA || ARM || HIGHC_386 || MACINTOSH || VMS
  22. #include <errno.h>
  23. #endif                    /* AMIGA || HIGHC_386 ... */
  24.  
  25. #if ATARI_ST
  26. #if LATTICE
  27. #include <error.h>
  28. #else                    /* LATTICE */
  29. #include <errno.h>
  30. #endif                    /* LATTICE */
  31. #endif                    /* ATARI_ST */
  32.  
  33. #if MSDOS
  34. #if !MWC
  35. #include <errno.h>
  36. #endif                    /* !MWC */
  37. #endif                    /* MSDOS */
  38.  
  39. #if OS2
  40. #if MICROSOFT
  41. int errno;
  42. #endif                    /* MICROSOFT */
  43. #endif                    /* OS2 */
  44.  
  45. #if MVS || VM
  46. #include <errno.h>
  47. #ifdef SASC
  48. #include <lcmath.h>
  49. #define PI M_PI
  50. #endif                    /* SASC */
  51. #endif                    /* MVS || VM */
  52.  
  53. #if UNIX
  54. #include <errno.h>
  55. int errno;
  56. #endif                    /* UNIX */
  57.  
  58. /*
  59.  * End of operating-system specific code.
  60.  */
  61.  
  62. #ifndef PI
  63. #define PI 3.14159
  64. #endif                    /* PI */
  65.  
  66.  
  67. /*
  68.  * sin(x), x in radians
  69.  */
  70.  
  71. FncDcl(sin,1)
  72.    {
  73.    int t;
  74.    double sin();
  75.  
  76.    if ((t = cvreal(&Arg1)) == CvtFail) 
  77.      RunErr(102, &Arg1);
  78.    if (makereal(sin(BlkLoc(Arg1)->realblk.realval), &Arg0) == Error) 
  79.       RunErr(0, NULL);
  80.    Return;
  81.    }
  82.  
  83. /*
  84.  * cos(x), x in radians
  85.  */
  86.  
  87. FncDcl(cos,1)
  88.    {
  89.    int t;
  90.  
  91.    if ((t = cvreal(&Arg1)) == CvtFail) 
  92.       RunErr(102, &Arg1);
  93.    if (makereal(cos(BlkLoc(Arg1)->realblk.realval), &Arg0) == Error) 
  94.       RunErr(0, NULL);
  95.    Return;
  96.    }
  97.  
  98. /*
  99.  * tan(x), x in radians
  100.  */
  101.  
  102. FncDcl(tan,1)
  103.    {
  104.    int t;
  105.    double y;
  106.  
  107.    if ((t = cvreal(&Arg1)) == CvtFail) 
  108.       RunErr(102, &Arg1);
  109.    errno = 0;
  110.    y = tan(BlkLoc(Arg1)->realblk.realval);
  111.    if (errno == ERANGE) 
  112.       RunErr(-204, NULL);
  113.    if (makereal(y, &Arg0) == Error) 
  114.       RunErr(0, NULL);
  115.    Return;
  116.    }
  117.  
  118. /*
  119.  * acos(x), x in radians
  120.  */
  121. FncDcl(acos,1)
  122.    {
  123.    int t;
  124.    double r, y;
  125.  
  126.    if ((t = cvreal(&Arg1)) == CvtFail) 
  127.       RunErr(102, &Arg1);
  128.    r = BlkLoc(Arg1)->realblk.realval;
  129.    if (r < -1.0 || r > 1.0)        /* can't count on library */
  130.       RunErr(205,&Arg1);
  131.    errno = 0;
  132.    y = acos(r);
  133.    if (errno == EDOM) 
  134.       RunErr(-205, NULL);
  135.    if (makereal(y, &Arg0) == Error) 
  136.       RunErr(0, NULL);
  137.    Return;
  138.    }
  139.  
  140. /*
  141.  * asin(x), x in radians
  142.  */
  143. FncDcl(asin,1)
  144.    {
  145.    int t;
  146.    double r, y;
  147.  
  148.    if ((t = cvreal(&Arg1)) == CvtFail) 
  149.       RunErr(102, &Arg1);
  150.    r = BlkLoc(Arg1)->realblk.realval;
  151.    if (r < -1.0 || r > 1.0)        /* can't count on library */
  152.       RunErr(205,&Arg1);
  153.    errno = 0;
  154.    y = asin(r);
  155.    if (errno == EDOM) 
  156.       RunErr(-205, NULL);
  157.    if (makereal(y, &Arg0) == Error) 
  158.       RunErr(0, NULL);
  159.    Return;
  160.    }
  161.  
  162. /*
  163.  * atan(x,y) -- x,y  in radians; if y is present, produces atan2(x,y).
  164.  */
  165. FncDcl(atan,2)
  166.    {
  167.    int t;
  168.  
  169.    if ((t = cvreal(&Arg1)) == CvtFail) 
  170.       RunErr(102, &Arg1);
  171.    if (ChkNull(Arg2)) {
  172.       if (makereal(atan(BlkLoc(Arg1)->realblk.realval), &Arg0) == Error) 
  173.          RunErr(0, NULL);
  174.       }
  175.    else {
  176.       if ((t = cvreal(&Arg2)) == CvtFail) 
  177.          RunErr(102, &Arg2);
  178.       if (makereal(atan2(BlkLoc(Arg1)->realblk.realval,
  179.                BlkLoc(Arg2)->realblk.realval), &Arg0) == Error) 
  180.          RunErr(0, NULL);
  181.       }
  182.    Return;
  183.    }
  184.  
  185. /*
  186.  * dtor(x), x in degrees
  187.  */
  188.  
  189. FncDcl(dtor,1)
  190.    {
  191.  
  192.    if (cvreal(&Arg1) == CvtFail) 
  193.       RunErr(102, &Arg1);
  194.    if (makereal(BlkLoc(Arg1)->realblk.realval * PI / 180, &Arg0) == Error) 
  195.       RunErr(0, NULL);
  196.    Return;
  197.    }
  198.  
  199. /*
  200.  * rtod(x), x in radians
  201.  */
  202. FncDcl(rtod,1)
  203.    {
  204.  
  205.    if (cvreal(&Arg1) == CvtFail) 
  206.       RunErr(102, &Arg1);
  207.    if (makereal(BlkLoc(Arg1)->realblk.realval * 180 / PI, &Arg0) == Error) 
  208.       RunErr(0, NULL);
  209.    Return;
  210.    }
  211.  
  212. /*
  213.  * exp(x)
  214.  */
  215.  
  216. FncDcl(exp,1)
  217.    {
  218.    int t;
  219.    double y;
  220.  
  221.    if ((t = cvreal(&Arg1)) == CvtFail) 
  222.       RunErr(102, &Arg1);
  223.    errno = 0;
  224.    y = exp(BlkLoc(Arg1)->realblk.realval);
  225.    if (errno == ERANGE) 
  226.       RunErr(-204, NULL);
  227.    if (makereal(y, &Arg0) == Error) 
  228.       RunErr(0, NULL);
  229.    Return;
  230.    }
  231.  
  232. /*
  233.  * log(x,b) - logarithm of x to base b.
  234.  */
  235. FncDcl(log,2)
  236.    {
  237.    static double lastbase = 0.0;
  238.    static double divisor;
  239.    double x;
  240.  
  241.    if (cvreal(&Arg1) != T_Real)
  242.       RunErr(102, &Arg1);
  243.    if (BlkLoc(Arg1)->realblk.realval <= 0.0)
  244.       RunErr(205, &Arg1);
  245.    x = log(BlkLoc(Arg1)->realblk.realval);
  246.    if (! ChkNull(Arg2))  {
  247.       if (cvreal(&Arg2) != T_Real)
  248.          RunErr(102, &Arg2);
  249.       if (BlkLoc(Arg2)->realblk.realval <= 1.0)
  250.          RunErr(205, &Arg2);
  251.       if (BlkLoc(Arg2)->realblk.realval != lastbase) {
  252.          divisor = log(BlkLoc(Arg2)->realblk.realval);
  253.          lastbase = BlkLoc(Arg2)->realblk.realval;
  254.          }
  255.       x = x / divisor;
  256.       }  
  257.    if (makereal(x, &Arg0) == Error)
  258.       RunErr(0, NULL);
  259.    Return;
  260.    }
  261.  
  262.  
  263. /*
  264.  * sqrt(x)
  265.  */
  266.  
  267. FncDcl(sqrt,1)
  268.    {
  269.    int t;
  270.    double r, y;
  271.  
  272.    if ((t = cvreal(&Arg1)) == CvtFail) 
  273.       RunErr(102, &Arg1);
  274.    r = BlkLoc(Arg1)->realblk.realval;
  275.    if (r < 0)
  276.       RunErr(205, &Arg1);
  277.    y = sqrt(r);
  278.    errno = 0;
  279.    if (errno == EDOM) 
  280.       RunErr(-205, NULL);
  281.    if (makereal(y, &Arg0) == Error) 
  282.       RunErr(0, NULL);
  283.    Return;
  284.    }
  285. #else                    /* MathFncs */
  286. static char x;            /* prevent empty module */
  287. #endif                    /* MathFncs */
  288.