/*-
 * Copyright (c) 2012 Brendan Fabeny
 * All rights reserved.
 *
 * Redistribution and use in source and binary forms, with or without
 * modification, are permitted provided that the following conditions
 * are met:
 * 1. Redistributions of source code must retain the above copyright
 *    notice, this list of conditions and the following disclaimer.
 * 2. Redistributions in binary form must reproduce the above copyright
 *    notice, this list of conditions and the following disclaimer in the
 *    documentation and/or other materials provided with the distribution.
 *
 * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
 * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
 * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
 * ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
 * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
 * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
 * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
 * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
 * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
 * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
 * SUCH DAMAGE.
 *
 */

/*
 * Stopgap replacements for missing standard libm functions.  Slower than many 
 * other libm functions, but more accurate than many naive replacements. No
 * exception handling, and no use of the ternary values (yet).
 */

#pragma STDC FENV_ACCESS ON

#include <sys/param.h>

#include <complex.h>
#include <fenv.h>
#include <float.h>

#if DBL_MANT_DIG == LDBL_MANT_DIG && DBL_MAX_EXP == LDBL_MAX_EXP
#define	LDBL_IS_DBL
#endif

#ifdef LDBL_IS_DBL
#include <math.h>
#else
#include <stdint.h>
#endif

#if 0
#define MPFR_USE_FILE
#define MPFR_USE_VA_LIST
#endif
#include "mpc.h"

#define	FUNCP(lib, constprefix, tonearest, downward, upward, towardzero) \
	lib ## _rnd_t \
	getrnd_ ## lib(void) \
	{ \
		lib ## _rnd_t rnd; \
		int rndmode; \
\
		rndmode=fegetround(); \
\
		switch (rndmode) { \
		case FE_TONEAREST: \
			rnd = constprefix ## tonearest; \
		case FE_DOWNWARD: \
			rnd = constprefix ## downward; \
		case FE_UPWARD: \
			rnd = constprefix ## upward; \
		case FE_TOWARDZERO: \
			rnd = constprefix ## towardzero; \
		} \
\
		return(rnd); \
}

FUNCP(mpc, MPC_RND, NN, DD, UU, ZZ)
FUNCP(mpfr, MPFR_RND, N, D, U, Z)

#define	prec_flt	FLT_MANT_DIG
#define	prec_d		DBL_MANT_DIG
#define	prec_ld		LDBL_MANT_DIG

/* 
 * Because mpc_get/set_fc are missing from the API, we just cast to doubles
 * and back
 */
 
#define prec_f		prec_d
#define	mpc_set_fc(mx, x, rnd)	mpc_set_dc(mx, (double complex)x, rnd)
#define	mpc_get_fc(mx, rnd)	(float complex)mpc_get_dc(mx,rnd)

#define	init_mpc(typesuffix, mx) \
	mpc_init3(mx, prec_ ## typesuffix, prec_ ## typesuffix)

#define	assign_mpc(typesuffix, mx, x, rnd) \
	mpc_set_ ## typesuffix ## c(mx, x, rnd)

#define	convert_mpc(typesuffix, mx, rnd) \
	mpc_get_ ## typesuffix ## c(mx,rnd)

#define	cleanup_mpc

#define	init_mpfr(typesuffix, mx) \
	mpfr_init2(mx, prec_ ## typesuffix)

#define	assign_mpfr(typesuffix, mx, x, rnd) \
	mpfr_set_ ## typesuffix(mx, x, rnd)

#define	convert_mpfr(typesuffix, mx, rnd) \
	mpfr_get_ ## typesuffix(mx,rnd)

#define	cleanup_mpfr	mpfr_free_cache()

/* 
 * 1 input and 1 output of similar types, using only one of the
 * auxiliary libraries
 */

#define	FUNC1A(libmfunc, libmtype, typesuffix, auxlib, auxfunc) \
	libmtype \
	libmfunc(libmtype x) \
	{ \
		int i, j; \
		libmtype y; \
		auxlib ## _rnd_t rnd; \
		auxlib ## _t mx; \
\
		rnd=getrnd_ ## auxlib(); \
		init_ ## auxlib(typesuffix, mx); \
		i=assign_ ## auxlib(typesuffix, mx, x, rnd); \
		j=auxlib ## _ ## auxfunc(mx, mx, rnd); \
		y=convert_ ## auxlib(typesuffix, mx, rnd); \
		auxlib ## _clear(mx); \
		cleanup_ ## auxlib; \
\
		return(y); \
	}

/* 1 complex input, 1 real or integer output */

#define	FUNC1B(libmfunc, libmintype, libmouttype, mpctypesuffix, \
	mpfrtypesuffix, mpcfunc) \
	libmouttype \
	libmfunc(libmintype x) \
	{ \
		int i, j; \
		libmouttype y; \
		mpc_rnd_t mpcrnd; \
		mpc_t mx; \
		mpfr_rnd_t mpfrrnd; \
		mpfr_t my; \
\
		mpcrnd=getrnd_mpc(); \
		mpfrrnd=MPC_RND_RE(mpcrnd); \
		init_mpc(mpctypesuffix, mx); \
		init_mpfr(mpfrtypesuffix, my); \
		i=assign_mpc(mpctypesuffix, mx, x, mpcrnd); \
		j=mpc ## _ ## mpcfunc(my, mx, mpfrrnd); \
		y=convert_mpfr(mpfrtypesuffix, my, mpfrrnd); \
		mpc_clear(mx); \
		mpfr_clear(my); \
		cleanup_mpfr; \
\
		return(y); \
	}

/* 
 * 1 input and 1 output of different types, using only one of the
 * auxiliary libraries
 */

#define	FUNC1C(libmfunc, libmintype, libmouttype, insuffix, outsuffix, \
	auxlib, auxfunc) \
	libmouttype \
	libmfunc(libmintype x) \
	{ \
		int i, j; \
		libmouttype y; \
		auxlib ## _rnd_t rnd; \
		auxlib ## _t mx; \
\
		rnd=getrnd_ ## auxlib(); \
		init_ ## auxlib(insuffix, mx); \
		i=assign_ ## auxlib(insuffix, mx, x, rnd); \
		j=auxlib ## _ ## auxfunc(mx, mx, rnd); \
		y=convert_ ## auxlib(outsuffix, mx, rnd); \
		auxlib ## _clear(mx); \
		cleanup_ ## auxlib; \
\
		return(y); \
	}

/* 
 * 2 inputs and 1 output of similar types, using only one of the 
 * auxiliary libraries
 */

#define	FUNC2(libmfunc, libmtype, typesuffix, auxlib, auxfunc) \
	libmtype \
	libmfunc(libmtype x, libmtype y) \
	{ \
		int i, j, k; \
		libmtype z; \
		auxlib ## _rnd_t rnd; \
		auxlib ## _t mx, my; \
\
		rnd=getrnd_ ## auxlib(); \
		init_ ## auxlib(typesuffix, mx); \
		i=assign_ ## auxlib(typesuffix, mx, x, rnd); \
		init_ ## auxlib(typesuffix, my); \
		j=assign_ ## auxlib(typesuffix, my, y, rnd); \
		k=auxlib ## _ ## auxfunc(mx, mx, my, rnd); \
		z=convert_ ## auxlib(typesuffix, mx, rnd); \
		auxlib ## _clear(mx); \
		auxlib ## _clear(my); \
		cleanup_ ## auxlib; \
\
		return(z); \
	}

/* 
 * cast a single input from a longer to a shorter type, use the existing
 * libm function for the shorter type to produce a single output of the
 * shorter type, and then cast the output back to the longer type
 */
 
#define CASTFUNC1A(libmfunc, outcast, auxfunc, incast) \
	outcast \
	libmfunc(outcast x) \
	{ \
		outcast y; \
\
		y=(outcast)auxfunc((incast)x); \
\
		return(y); \
	}

/* 
 * cast a single input from a longer to a shorter type, and then use the
 * existing libm function for the shorter type to produce a single
 * output of a third type
 */
 
#define CASTFUNC1B(libmfunc, intype, outtype, auxfunc, incast) \
	outtype \
	libmfunc(intype x) \
	{ \
		outtype y; \
\
		y=auxfunc((incast)x); \
\
		return(y); \
	}

/*
 * cast two inputs from the same longer type to the same shorter type,
 * use the existing libm function for these inputs to produce a single
 * output of the shorter type, and then cast the output back to the
 * longer type
 */
 
#define CASTFUNC2(libmfunc, outcast, auxfunc, incast) \
	outcast \
	libmfunc(outcast x, outcast y) \
	{ \
		outcast z; \
\
		z=(outcast)auxfunc((incast)x, (incast)y); \
\
		return(z); \
	}

#if __FreeBSD_version < 704102 || \
(__FreeBSD_version >= 800000 && __FreeBSD_version < 802502) || \
(__FreeBSD_version >= 900000 && __FreeBSD_version < 900027)

FUNC1A(log2, double, d, mpfr, log2)
FUNC1A(log2f, float, flt, mpfr, log2)

#endif
#if __FreeBSD_version < 800007

/* nan* will require explicit definitions:
 * nan
 * nanf
 * nanl
 */

#ifdef LDBL_IS_DBL

CASTFUNC1A(logbl, long double, logb, double)

#else

long double
logbl(long double x)
{
	int i;
	long *exp=0;
	long double y;
	mpfr_rnd_t rnd;
	mpfr_t mx;

	rnd=getrnd_mpfr();
	mpfr_init2(mx, prec_ld);
	i=mpfr_set_ld(mx, x, rnd);
	y=mpfr_get_ld_2exp(exp, mx, rnd);
	mpfr_clear(mx);
	mpfr_free_cache();
	
	return((long double)*exp);
}

#endif

FUNC1B(carg, double complex, double, d, d, arg)
FUNC1B(cargf, float complex, float, f, flt, arg)

FUNC1A(csqrt, double complex, d, mpc, sqrt)
FUNC1A(csqrtf, float complex, f, mpc, sqrt)

#endif
#if __FreeBSD_version < 800012
#ifdef LDBL_IS_DBL 

CASTFUNC1B(llrintl, long double, long long, llrint, double)
CASTFUNC1B(lrintl, long double, long, lrint, double)

CASTFUNC1A(nearbyintl, long double, nearbyint, double)
CASTFUNC1A(rintl, long double, rint, double)
CASTFUNC1A(exp2l, long double, exp2, double)

#else

/* 
 * Since we cannot assume intmax_t is long long, and there is
 * no long long analogue of mpfr_get_sj, use a cast for llrintl
 */

FUNC1C(imrintl, long double, intmax_t, ld, sj, mpfr, rint)

long long
llrintl (long double x)
{
	long long y;

	y=(long long)imrintl(x);

	return(y);
}

FUNC1C(lrintl, long double, long, ld, si, mpfr, rint)

/* 
 * rint* and nearbyint* are conflated: to be strictly
 * correct, they should be distinguished by different handling
 * of the inexact flag.
 */

FUNC1A(nearbyintl, long double, ld, mpfr, rint)
FUNC1A(rintl, long double, ld, mpfr, rint)
FUNC1A(exp2l, long double, ld, mpfr, exp2)

#endif
#endif
#if __FreeBSD_version < 800022
#ifdef LDBL_IS_DBL

CASTFUNC1A(sinl, long double, sin, double)
CASTFUNC1A(cosl, long double, cos, double)
CASTFUNC1A(tanl, long double, tan, double)

#else

FUNC1A(sinl, long double, ld, mpfr, sin)
FUNC1A(cosl, long double, ld, mpfr, cos)
FUNC1A(tanl, long double, ld, mpfr, tan)

#endif

FUNC1A(tgammaf, float, flt, mpfr, gamma)

#endif
#if __FreeBSD_version < 800025
#ifdef LDBL_IS_DBL

CASTFUNC1A(sqrtl, long double, sqrt, double)

#else

FUNC1A(sqrtl, long double, ld, mpfr, sqrt)

#endif
#endif
#if __FreeBSD_version < 800030
#ifdef LDBL_IS_DBL

CASTFUNC2(hypotl, long double, hypot, double)
CASTFUNC2(remainderl, long double, remainder, double)

long double
remquol(long double x, long double y, int *quo)
{
	long double z;

	z=(long double)remquo((double)x,(double)y, quo);

	return(z);
}

CASTFUNC1B(cabsl, long double complex, long double, cabs, double complex)

CASTFUNC1A(csqrtl, long double complex, csqrt, double complex)

#else

FUNC2(hypotl, long double, ld, mpfr, hypot)
FUNC2(remainderl, long double, ld, mpfr, remainder)

long double
remquol(long double x, long double y, int *quo)
{
	int i, j, k;
	long *q=0;
	long double z;
	mpfr_rnd_t rnd;
	mpfr_t mx, my;

	rnd=getrnd_mpfr();
	mpfr_inits2(prec_ld, mx, my, (mpfr_ptr)0);
	i=mpfr_set_ld(mx, x, rnd);
	j=mpfr_set_ld(my, y, rnd);
	k=mpfr_remquo(my, q, mx, my, rnd);
	z=mpfr_get_ld(my, rnd);
	*quo=(int)*q;
	mpfr_clears(mx, my, (mpfr_ptr)0);
	mpfr_free_cache();
	
	return(z);
}

FUNC1B(cabsl, long double complex, long double, ld, ld, abs)

FUNC1A(csqrtl, long double complex, ld, mpc, sqrt)

#endif
#endif
#if __FreeBSD_version < 800040

#ifdef LDBL_IS_DBL

CASTFUNC2(fmodl, long double, fmod, double)

#else

FUNC2(fmodl, long double, ld, mpfr, fmod)

#endif
#endif
#if __FreeBSD_version < 800042
#ifdef LDBL_IS_DBL

CASTFUNC1A(acosl, long double, acos, double)
CASTFUNC1A(asinl, long double, asin, double)
CASTFUNC1A(atanl, long double, atan, double)

CASTFUNC2(atan2l, long double, atan2, double)

CASTFUNC1B(cargl, long double complex, long double, carg, double complex)

#else

FUNC1A(acosl, long double, ld, mpfr, acos)
FUNC1A(asinl, long double, ld, mpfr, asin)
FUNC1A(atanl, long double, ld, mpfr, atan)

FUNC2(atan2l, long double, ld, mpfr, atan2)

FUNC1B(cargl, long double complex, long double, ld, ld, arg)

#endif

FUNC1A(cproj, double complex, d, mpc, proj)
FUNC1A(cprojf, float complex, f, mpc, proj)
FUNC1A(cprojl, long double complex, ld, mpc, proj)

#endif
#if __FreeBSD_version < 900034

FUNC1A(cexp, double complex, d, mpc, exp)
FUNC1A(cexpf, float complex, f, mpc, exp)

#endif
#if __FreeBSD_version < 900035
#ifdef LDBL_IS_DBL

CASTFUNC1A(cbrtl, long double, cbrt, double)

#else

FUNC1A(cbrtl, long double, ld, mpfr, cbrt)

#endif
#endif
#if __FreeBSD_version < 900045 || \
(__FreeBSD_version >= 1000000 && __FreeBSD_version < 1000001)

FUNC1A(csin, double complex, d, mpc, sin)
FUNC1A(csinf, float complex, f, mpc, sin)
FUNC1A(csinh, double complex, d, mpc, sinh)
FUNC1A(csinhf, float complex, f, mpc, sinh)
FUNC1A(ccos, double complex, d, mpc, cos)
FUNC1A(ccosf, float complex, f, mpc, cos)
FUNC1A(ccosh, double complex, d, mpc, cosh)
FUNC1A(ccoshf, float complex, f, mpc, cosh)
FUNC1A(ctan, double complex, d, mpc, tan)
FUNC1A(ctanf, float complex, f, mpc, tan)
FUNC1A(ctanh, double complex, d, mpc, tanh)
FUNC1A(ctanhf, float complex, f, mpc, tanh)

#endif
#if __FreeBSD_version < 1000016
#ifdef LDBL_IS_DBL

CASTFUNC1A(expl, long double, exp, double)

#else

FUNC1A(expl, long double, ld, mpfr, exp)

#endif
#endif

FUNC1A(cacos, double complex, d, mpc, acos)
FUNC1A(cacosf, float complex, f, mpc, acos)
FUNC1A(cacosl, long double complex, ld, mpc, acos)

FUNC1A(cacosh, double complex, d, mpc, acosh)
FUNC1A(cacoshf, float complex, f, mpc, acosh)
FUNC1A(cacoshl, long double complex, ld, mpc, acosh)

FUNC1A(casin, double complex, d, mpc, asin)
FUNC1A(casinf, float complex, f, mpc, asin)
FUNC1A(casinl, long double complex, ld, mpc, asin)

FUNC1A(casinh, double complex, d, mpc, asinh)
FUNC1A(casinhf, float complex, f, mpc, asinh)
FUNC1A(casinhl, long double complex, ld, mpc, asinh)

FUNC1A(catan, double complex, d, mpc, atan)
FUNC1A(catanf, float complex, f, mpc, atan)
FUNC1A(catanl, long double complex, ld, mpc, atan)

FUNC1A(catanh, double complex, d, mpc, atanh)
FUNC1A(catanhf, float complex, f, mpc, atanh)
FUNC1A(catanhl, long double complex, ld, mpc, atanh)

FUNC1A(clog, double complex, d, mpc, log)
FUNC1A(clogf, float complex, f, mpc, log)
FUNC1A(clogl, long double complex, ld, mpc, log)

FUNC2(cpow, double complex, d, mpc, pow)
FUNC2(cpowf, float complex, f, mpc, pow)
FUNC2(cpowl, long double complex, ld, mpc, pow)

#ifdef LDBL_IS_DBL

CASTFUNC1A(acoshl, long double, acosh, double)
CASTFUNC1A(asinhl, long double, asinh, double)
CASTFUNC1A(atanhl, long double, atanh, double)

CASTFUNC1A(ccoshl, long double complex, ccosh, double complex)
CASTFUNC1A(ccosl, long double complex, ccos, double complex)
CASTFUNC1A(cexpl, long double complex, cexp, double complex)

CASTFUNC1A(coshl, long double, cosh, double)

CASTFUNC1A(csinhl, long double complex, csinh, double complex)
CASTFUNC1A(csinl, long double complex, csin, double complex)
CASTFUNC1A(ctanhl, long double complex, ctanh, double complex)
CASTFUNC1A(ctanl, long double complex, ctan, double complex)

CASTFUNC1A(erfcl, long double, erfc, double)
CASTFUNC1A(erfl, long double, erf, double)
CASTFUNC1A(expm1l, long double, expm1, double)
CASTFUNC1A(lgammal, long double, lgamma, double)
CASTFUNC1A(log10l, long double, log10, double)
CASTFUNC1A(log1pl, long double, log1p, double)
CASTFUNC1A(log2l, long double, log2, double)
CASTFUNC1A(logl, long double, log, double)
CASTFUNC1A(sinhl, long double, sinh, double)
CASTFUNC1A(tanhl, long double, tanh, double)
CASTFUNC1A(tgammal, long double, tgamma, double)

CASTFUNC2(powl, long double, pow, double)

#else

FUNC1A(acoshl, long double, ld, mpfr, acosh)
FUNC1A(asinhl, long double, ld, mpfr, asinh)
FUNC1A(atanhl, long double, ld, mpfr, atanh)

FUNC1A(ccoshl, long double complex, ld, mpc, cosh)
FUNC1A(ccosl, long double complex, ld, mpc, cos)
FUNC1A(cexpl, long double complex, ld, mpc, exp)

FUNC1A(coshl, long double, ld, mpfr, cosh)

FUNC1A(csinhl, long double complex, ld, mpc, sinh)
FUNC1A(csinl, long double complex, ld, mpc, sin)
FUNC1A(ctanhl, long double complex, ld, mpc, tanh)
FUNC1A(ctanl, long double complex, ld, mpc, tan)

FUNC1A(erfcl, long double, ld, mpfr, erfc)
FUNC1A(erfl, long double, ld, mpfr, erf)
FUNC1A(expm1l, long double, ld, mpfr, expm1)
FUNC1A(lgammal, long double, ld, mpfr, lngamma)
FUNC1A(log10l, long double, ld, mpfr, log10)
FUNC1A(log1pl, long double, ld, mpfr, log1p)
FUNC1A(log2l, long double, ld, mpfr, log2)
FUNC1A(logl, long double, ld, mpfr, log)
FUNC1A(sinhl, long double, ld, mpfr, sinh)
FUNC1A(tanhl, long double, ld, mpfr, tanh)
FUNC1A(tgammal, long double, ld, mpfr, gamma)

FUNC2(powl, long double, ld, mpfr, pow)

#endif
