/*
 * fmath.c -- sin, cos, tan, acos, asin, atan, dtor, rtod, exp, log, sqrt
 */

#include <math.h>
#include "..\h\config.h"
#include "..\h\rt.h"
#include "rproto.h"

#ifdef MathFncs
/*
 * The following code is operating-system dependent [@fmath.01].  Include
 *  system-dependent files and declarations.
 */

#if PORT
   /* probably #include <errno.h> */
#endif					/* PORT */

#if AMIGA || HIGHC_386 || MACINTOSH || VMS
#include <errno.h>
#endif					/* AMIGA || HIGHC_386 ... */

#if ATARI_ST
#if LATTICE
#include <error.h>
#else					/* LATTICE */
#include <errno.h>
#endif					/* LATTICE */
#endif					/* ATARI_ST */

#if MSDOS
#if !MWC
#include <errno.h>
#endif					/* !MWC */
#if MICROSOFT
int errno;
#endif					/* MICROSOFT */
#endif					/* MSDOS */

#if OS2
#if MICROSOFT
int errno;
#endif					/* MICROSOFT */
#endif					/* OS2 */

#if MVS || VM
#include <errno.h>
#ifdef SASC
#include <lcmath.h>
#define PI M_PI
#endif					/* SASC */
#endif					/* MVS || VM */

#if UNIX
#include <errno.h>
int errno;
#endif					/* UNIX */

/*
 * End of operating-system specific code.
 */

#ifndef PI
#define PI 3.14159
#endif					/* PI */


/*
 * sin(x), x in radians
 */

FncDcl(sin,1)
   {
   int t;
   double sin();

   if ((t = cvreal(&Arg1)) == CvtFail) 
     RunErr(102, &Arg1);
   if (makereal(sin(BlkLoc(Arg1)->realblk.realval), &Arg0) == Error) 
      RunErr(0, NULL);
   Return;
   }

/*
 * cos(x), x in radians
 */

FncDcl(cos,1)
   {
   int t;

   if ((t = cvreal(&Arg1)) == CvtFail) 
      RunErr(102, &Arg1);
   if (makereal(cos(BlkLoc(Arg1)->realblk.realval), &Arg0) == Error) 
      RunErr(0, NULL);
   Return;
   }

/*
 * tan(x), x in radians
 */

FncDcl(tan,1)
   {
   int t;
   double y;

   if ((t = cvreal(&Arg1)) == CvtFail) 
      RunErr(102, &Arg1);
   errno = 0;
   y = tan(BlkLoc(Arg1)->realblk.realval);
   if (errno == ERANGE) 
      RunErr(-204, NULL);
   if (makereal(y, &Arg0) == Error) 
      RunErr(0, NULL);
   Return;
   }

/*
 * acos(x), x in radians
 */
FncDcl(acos,1)
   {
   int t;
   double r, y;

   if ((t = cvreal(&Arg1)) == CvtFail) 
      RunErr(102, &Arg1);
   r = BlkLoc(Arg1)->realblk.realval;
   if (r < -1.0 || r > 1.0)		/* can't count on library */
      RunErr(205,&Arg1);
   errno = 0;
   y = acos(r);
   if (errno == EDOM) 
      RunErr(-205, NULL);
   if (makereal(y, &Arg0) == Error) 
      RunErr(0, NULL);
   Return;
   }

/*
 * asin(x), x in radians
 */
FncDcl(asin,1)
   {
   int t;
   double r, y;

   if ((t = cvreal(&Arg1)) == CvtFail) 
      RunErr(102, &Arg1);
   r = BlkLoc(Arg1)->realblk.realval;
   if (r < -1.0 || r > 1.0)		/* can't count on library */
      RunErr(205,&Arg1);
   errno = 0;
   y = asin(r);
   if (errno == EDOM) 
      RunErr(-205, NULL);
   if (makereal(y, &Arg0) == Error) 
      RunErr(0, NULL);
   Return;
   }

/*
 * atan(x,y) -- x,y  in radians; if y is present, produces atan2(x,y).
 */
FncDcl(atan,2)
   {
   int t;

   if ((t = cvreal(&Arg1)) == CvtFail) 
      RunErr(102, &Arg1);
   if (ChkNull(Arg2)) {
      if (makereal(atan(BlkLoc(Arg1)->realblk.realval), &Arg0) == Error) 
         RunErr(0, NULL);
      }
   else {
      if ((t = cvreal(&Arg2)) == CvtFail) 
         RunErr(102, &Arg2);
      if (makereal(atan2(BlkLoc(Arg1)->realblk.realval,
		       BlkLoc(Arg2)->realblk.realval), &Arg0) == Error) 
         RunErr(0, NULL);
      }
   Return;
   }

/*
 * dtor(x), x in degrees
 */

FncDcl(dtor,1)
   {

   if (cvreal(&Arg1) == CvtFail) 
      RunErr(102, &Arg1);
   if (makereal(BlkLoc(Arg1)->realblk.realval * PI / 180, &Arg0) == Error) 
      RunErr(0, NULL);
   Return;
   }

/*
 * rtod(x), x in radians
 */
FncDcl(rtod,1)
   {

   if (cvreal(&Arg1) == CvtFail) 
      RunErr(102, &Arg1);
   if (makereal(BlkLoc(Arg1)->realblk.realval * 180 / PI, &Arg0) == Error) 
      RunErr(0, NULL);
   Return;
   }

/*
 * exp(x)
 */

FncDcl(exp,1)
   {
   int t;
   double y;

   if ((t = cvreal(&Arg1)) == CvtFail) 
      RunErr(102, &Arg1);
   errno = 0;
   y = exp(BlkLoc(Arg1)->realblk.realval);
   if (errno == ERANGE) 
      RunErr(-204, NULL);
   if (makereal(y, &Arg0) == Error) 
      RunErr(0, NULL);
   Return;
   }

/*
 * log(x,b) - logarithm of x to base b.
 */
FncDcl(log,2)
   {
   static double lastbase = 0.0;
   static double divisor;
   double x;
 
   if (cvreal(&Arg1) != T_Real)
      RunErr(102, &Arg1);
   if (BlkLoc(Arg1)->realblk.realval <= 0.0)
      RunErr(205, &Arg1);
   x = log(BlkLoc(Arg1)->realblk.realval);
   if (! ChkNull(Arg2))  {
      if (cvreal(&Arg2) != T_Real)
         RunErr(102, &Arg2);
      if (BlkLoc(Arg2)->realblk.realval <= 1.0)
         RunErr(205, &Arg2);
      if (BlkLoc(Arg2)->realblk.realval != lastbase) {
         divisor = log(BlkLoc(Arg2)->realblk.realval);
         lastbase = BlkLoc(Arg2)->realblk.realval;
         }
      x = x / divisor;
      }  
   if (makereal(x, &Arg0) == Error)
      RunErr(0, NULL);
   Return;
   }


/*
 * sqrt(x)
 */

FncDcl(sqrt,1)
   {
   int t;
   double r, y;

   if ((t = cvreal(&Arg1)) == CvtFail) 
      RunErr(102, &Arg1);
   r = BlkLoc(Arg1)->realblk.realval;
   if (r < 0)
      RunErr(205, &Arg1);
   y = sqrt(r);
   errno = 0;
   if (errno == EDOM) 
      RunErr(-205, NULL);
   if (makereal(y, &Arg0) == Error) 
      RunErr(0, NULL);
   Return;
   }
#else					/* MathFncs */
static char x;			/* prevent empty module */
#endif					/* MathFncs */