/*
 * Copyright (C) iX Corporation 1989-1994.  All rights reserved.
 *
 * Module =
 *
 *   demomath.c
 *
 * Abstract =
 *
 *   Make the following math functions available to Open-REXX
 *
 *   acos
 *   asin
 *   atan
 *   cbrt - not on all systems
 *   cos
 *   exp
 *   log
 *   sin
 *   sqrt
 *   tan
 *
 * History =
 *
 *   11-Mar-94 nfnm Initial implementation
 *   08-Aug-94 nfnm Added <stdlib.h> #include.
 *                  Added HAVECBRT #define.
 *
 */
/*
 * define HAVECBRT below to 0 if cbrt() isn't available on your system
 *
 * HP-UX sites *must* define HAVECBRT to 0
 *
 */
#define HAVECBRT 0
/*
 * If <stdlib.h> is missing, simply remove the #include below.  Note that it
 * may be necessary to declare strtod().  If the functions give garbage
 * answers, strtod() probably isn't declared.
 */
#include <math.h>
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include "irx.h"
/*
 * rxmath - perform the math function passed on the argument and set the
 * result in the evalblock.
 */
#ifdef ORXXPrototype
static int rxmath(ARGLIST *ag,
                  EVALBLOCK *ev,
                  double (*fn)(double))
#else
static int rxmath(ag,
                  ev,
                  fn)
ARGLIST *ag;
EVALBLOCK *ev;
double (*fn)();
#endif
{
/*
 * floating point string buffer
 */
  char fpsr[32];
/*
 * strtod scan pointer
 */
  char *fpsrpt = NULL;
/*
 * floating point value
 */
  double fp;
/*
 * function return code
 */
  int rc = 0;
/*
 * if there is 1 argument that will fit in the floating point string buffer ...
 */
  if (ag->argstring_ptr != NULL && 
      (ag + 1)->argstring_ptr == NULL &&
      ag->argstring_length < sizeof(fpsr))
  {
/*
 * ... convert the argument to a '\0' terminated string
 */
    (void) memcpy(fpsr,
                  ag->argstring_ptr,
                  ag->argstring_length);
    *(fpsr + ag->argstring_length) = '\0';
/*
 * convert the argument to a double float
 */
    fp = strtod(fpsr,
                &fpsrpt);
    if (*fpsrpt != '\0')
      rc = -1;
    else
    {
/*
 * perform the function and get the result in a the evalblock
 */
      sprintf(ev->evdata,
              "%g",
              (*fn)(fp));
      ev->evlen = strlen(ev->evdata);
    }
  }
  else
    rc = -1;
  return rc;
}
/*
 * acos - return acos of argument
 */
#ifdef ORXXPrototype
static int rxacos(ARGLIST *ag,
                  EVALBLOCK *ev)
#else
static int rxacos(ag,
                  ev)
ARGLIST *ag;
EVALBLOCK *ev;
#endif
{
  return rxmath(ag,
                ev,
                acos);
}
/*
 * asin - return asin of argument
 */
#ifdef ORXXPrototype
static int rxasin(ARGLIST *ag,
                  EVALBLOCK *ev)
#else
static int rxasin(ag,
                  ev)
ARGLIST *ag;
EVALBLOCK *ev;
#endif
{
  return rxmath(ag,
                ev,
                asin);
}
/*
 * atan - return atan of argument
 */
#ifdef ORXXPrototype
static int rxatan(ARGLIST *ag,
                  EVALBLOCK *ev)
#else
static int rxatan(ag,
                  ev)
ARGLIST *ag;
EVALBLOCK *ev;
#endif
{
  return rxmath(ag,
                ev,
                atan);
}
#if HAVECBRT == 1
/*
 * cbrt - return cbrt of argument
 */
#ifdef ORXXPrototype
static int rxcbrt(ARGLIST *ag,
                  EVALBLOCK *ev)
#else
static int rxcbrt(ag,
                  ev)
ARGLIST *ag;
EVALBLOCK *ev;
#endif
{
  return rxmath(ag,
                ev,
                cbrt);
}
#endif
/*
 * cos - return cos of argument
 */
#ifdef ORXXPrototype
static int rxcos(ARGLIST *ag,
                 EVALBLOCK *ev)
#else
static int rxcos(ag,
                 ev)
ARGLIST *ag;
EVALBLOCK *ev;
#endif
{
  return rxmath(ag,
                ev,
                cos);
}
/*
 * exp - return exp of argument
 */
#ifdef ORXXPrototype
static int rxexp(ARGLIST *ag,
                 EVALBLOCK *ev)
#else
static int rxexp(ag,
                 ev)
ARGLIST *ag;
EVALBLOCK *ev;
#endif
{
  return rxmath(ag,
                ev,
                exp);
}
/*
 * log - return log of argument
 */
#ifdef ORXXPrototype
static int rxlog(ARGLIST *ag,
                 EVALBLOCK *ev)
#else
static int rxlog(ag,
                 ev)
ARGLIST *ag;
EVALBLOCK *ev;
#endif
{
  return rxmath(ag,
                ev,
                log);
}
/*
 * sin - return sin of argument
 */
#ifdef ORXXPrototype
static int rxsin(ARGLIST *ag,
                 EVALBLOCK *ev)
#else
static int rxsin(ag,
                 ev)
ARGLIST *ag;
EVALBLOCK *ev;
#endif
{
  return rxmath(ag,
                ev,
                sin);
}
/*
 * sqrt - return sqrt of argument
 */
#ifdef ORXXPrototype
static int rxsqrt(ARGLIST *ag,
                  EVALBLOCK *ev)
#else
static int rxsqrt(ag,
                  ev)
ARGLIST *ag;
EVALBLOCK *ev;
#endif
{
  return rxmath(ag,
                ev,
                sqrt);
}
/*
 * tan - return tan of argument
 */
#ifdef ORXXPrototype
static int rxtan(ARGLIST *ag,
                 EVALBLOCK *ev)
#else
static int rxtan(ag,
                 ev)
ARGLIST *ag;
EVALBLOCK *ev;
#endif
{
  return rxmath(ag,
                ev,
                tan);
}
/*
 * function table
 */
FPCKDIR irxfloc[] =
{
  "_acos", rxacos,
  "_asin", rxasin,
  "_atan", rxatan,
#if HAVECBRT == 1
  "_cbrt", rxcbrt,
#endif
  "_cos", rxcos,
  "_exp", rxexp,
  "_log", rxlog,
  "_sin", rxsin,
  "_sqrt", rxsqrt,
  "_tan", rxtan,
  NULL, NULL
};