/* Copyright (C) 1991-99 Free Software Foundation, Inc.

   This file is part of GNU Pascal Library.

   Transcendental functions. Uses libm.a.

The GNU Pascal Library is free software; you can redistribute it and/or
modify it under the terms of the GNU Library General Public License as
published by the Free Software Foundation; either version 2 of the
License, or (at your option) any later version.

The GNU Pascal Library is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
Library General Public License for more details.

You should have received a copy of the GNU Library General Public
License along with the GNU Pascal Library; see the file COPYING.LIB.  If
not, write to the Free Software Foundation, Inc., 675 Mass Ave,
Cambridge, MA 02139, USA.  */

/*
 * Authors: Jukka Virtanen <jtv@hut.fi>
 *          Peter Gerwinski <peter@gerwinski.de>
 */

#include "rts.h"
#include <math.h>

static void
check_errno ()
{
  switch (errno)
  {
    case 0 :
      break;
    case ERANGE :
      _p_error (700); /* Overflow in exponentiation */
    case EDOM :
      _p_error (701); /* In `x pow y', x must be >= 0 if y < 0 and y is not an integer */
    default :
      _p_internal_error_integer (922, (long int) errno); /* undocumented errno value %d in exponentiation */
  }
}

double
_p_arctan(x)
double x;
{
  return (double) atan (x);
}

double
_p_arctan2(y, x)
double y, x;
{
  return (double) atan2 (y, x);
}

double
_p_sqrt(x)
double x;
{
  if (x < 0.0) _p_error (708); /* argument of `Sqrt' is < 0 */
  return sqrt(x);
}

double
_p_ln(x)
double x;
{
  if (x <= 0.0) _p_error (707); /* argument of `Ln' is <= 0 */
  return log(x);
}

double
_p_exp(x)
double x;
{
  double ret;
  errno = 0;
  ret = exp (x);
  check_errno ();
  return ret;
}

double
_p_sin(x)
double x;
{
  return sin(x);
}

double
_p_sinh(x)
double x;
{
  return sinh(x);
}

double
_p_cos(x)
double x;
{
  return cos(x);
}

double
_p_cosh(x)
double x;
{
  return cosh(x);
}

double
_p_expon (x,y)
double x, y;
{
  double rval;
  errno = 0;
  rval = pow (x, y);
  check_errno ();
  return rval;
}

#ifndef HAVE_SINL
#define sinl sin
#endif

#ifndef HAVE_COSL
#define cosl cos
#endif

#ifndef HAVE_SQRTL
#define sqrtl sqrt
#endif

#ifndef HAVE_LOGL
#define logl log
#endif

#ifndef HAVE_EXPL
#define expl exp
#endif

#ifndef HAVE_POWL
#define powl pow
#endif

#ifndef HAVE_ATANL
#define atanl atan
#endif

long double
_pp_arctan(x)
long double x;
{
  long double val = atanl(x);
  return val;
}

long double
_pp_sqrt(x)
long double x;
{
  if (x < 0.0) _p_error (708); /* argument of `Sqrt' is < 0 */
  return sqrtl(x);
}

long double
_pp_ln(x)
long double x;
{
  if (x <= 0.0) _p_error (707); /* argument of `Ln' is <= 0 */
  return logl(x);
}

long double
_pp_exp(x)
long double x;
{
  long double ret;
  errno = 0;
  ret = expl (x);
  check_errno ();
  return ret;
}

long double
_pp_sin(x)
long double x;
{
  return sinl(x);
}

long double
_pp_cos(x)
long double x;
{
  return cosl(x);
}

long double
_pp_expon (x,y)
long double x, y;
{
  long double rval;
  errno = 0;
  rval = powl (x, y);
  check_errno ();
  return rval;
}
