/*
 * %CopyrightBegin%
 *
 * SPDX-License-Identifier: Apache-2.0
 *
 * Copyright Ericsson AB 1997-2025. All Rights Reserved.
 *
 * Licensed under the Apache License, Version 2.0 (the "License");
 * you may not use this file except in compliance with the License.
 * You may obtain a copy of the License at
 *
 *     http://www.apache.org/licenses/LICENSE-2.0
 *
 * Unless required by applicable law or agreed to in writing, software
 * distributed under the License is distributed on an "AS IS" BASIS,
 * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
 * See the License for the specific language governing permissions and
 * limitations under the License.
 *
 * %CopyrightEnd%
 */

#ifdef HAVE_CONFIG_H
#  include "config.h"
#endif

#include "sys.h"
#include "erl_vm.h"
#include "global.h"
#include "erl_process.h"
#include "error.h"
#include "bif.h"
#include "big.h"

static Eterm
math_call_1(Process* p, double (*func)(double), Eterm arg1)
{
    FloatDef a1;
    Eterm res;
    Eterm* hp;

    ERTS_FP_CHECK_INIT(p);
    if (is_float(arg1)) {
	GET_DOUBLE(arg1, a1);
    } else if (is_small(arg1)) {
	a1.fd = signed_val(arg1);
    } else if (is_big(arg1)) {
	if (big_to_double(arg1, &a1.fd) < 0) {
	badarith:
	    p->freason = BADARITH;
	    return THE_NON_VALUE;
	}
    } else {
	p->freason = BADARG;
	return THE_NON_VALUE;
    }
    a1.fd = (*func)(a1.fd);
    ERTS_FP_ERROR_THOROUGH(p, a1.fd, goto badarith);
    hp = HAlloc(p, FLOAT_SIZE_OBJECT);
    res = make_float(hp);
    PUT_DOUBLE(a1, hp);
    return res;
}

/*
 * Execute a math function and also test errno for errors.
 * Called for math:acos/1 and math:asin/1.
 */
static Eterm
math_call_errno_1(Process* p, double (*func)(double), Eterm arg1)
{
    Eterm res;

    errno = 0;
    res = math_call_1(p, func, arg1);

    /*
     * We require a C compiler that supports C99, but on Solaris
     * it could happen that even though the C compiler (gcc) supports
     * C99, the runtime libraries could still behave as a previous
     * version (X/Open or C90).
     *
     * Specifically, the acos() and asin() function in C90 return 0.0
     * on a domain error, but sets the errno to EDOM. To ensure that
     * we raise an exception, we will need to check errno. (Testing
     * errno for all math functions would be wrong, because when pow()
     * underflows, 0.0 is returned but errno is set to ERANGE on
     * Solaris. Undeflow is not considered an error for the functions
     * in the math module.)
     */
    if (is_value(res) && errno != 0) {
        p->freason = BADARITH;
        return THE_NON_VALUE;
    }
    return res;
}

static Eterm
math_call_2(Process* p, double (*func)(double, double), Eterm arg1, Eterm arg2)
{
    FloatDef a1;
    FloatDef a2;
    Eterm res;
    Eterm* hp;

    ERTS_FP_CHECK_INIT(p);
    if (is_float(arg1)) {
	GET_DOUBLE(arg1, a1);
    } else if (is_small(arg1)) {
	a1.fd = signed_val(arg1);
    } else if (is_big(arg1)) {
	if (big_to_double(arg1, &a1.fd) < 0) {
	badarith:
	    p->freason = BADARITH;
	    return THE_NON_VALUE;
	}
    } else {
	p->freason = BADARG;
	return THE_NON_VALUE;
    }

    if (is_float(arg2)) {
	GET_DOUBLE(arg2, a2);
    } else if (is_small(arg2)) {
	a2.fd = signed_val(arg2);
    } else if (is_big(arg2)) {
	if (big_to_double(arg2, &a2.fd) < 0) {
	    goto badarith;
	}
    } else {
	p->freason = BADARG;
	return THE_NON_VALUE;
    }

    a1.fd = (*func)(a1.fd, a2.fd);
    ERTS_FP_ERROR_THOROUGH(p, a1.fd, goto badarith);
    hp = HAlloc(p, FLOAT_SIZE_OBJECT);
    res = make_float(hp);
    PUT_DOUBLE(a1, hp);
    return res;
}

BIF_RETTYPE math_cos_1(BIF_ALIST_1)
{
    return math_call_1(BIF_P, cos, BIF_ARG_1);
}

BIF_RETTYPE math_cosh_1(BIF_ALIST_1)
{
    return math_call_1(BIF_P, cosh, BIF_ARG_1);
}

BIF_RETTYPE math_sin_1(BIF_ALIST_1)
{
    return math_call_1(BIF_P, sin, BIF_ARG_1);
}

BIF_RETTYPE math_sinh_1(BIF_ALIST_1)
{
    return math_call_1(BIF_P, sinh, BIF_ARG_1);
}

BIF_RETTYPE math_tan_1(BIF_ALIST_1)
{
    return math_call_1(BIF_P, tan, BIF_ARG_1);
}


BIF_RETTYPE math_tanh_1(BIF_ALIST_1)
{
    return math_call_1(BIF_P, tanh, BIF_ARG_1);
}


BIF_RETTYPE math_acos_1(BIF_ALIST_1)
{
    return math_call_errno_1(BIF_P, acos, BIF_ARG_1);
}

BIF_RETTYPE math_acosh_1(BIF_ALIST_1)
{
#ifdef NO_ACOSH
    BIF_ERROR(BIF_P, EXC_UNDEF);
#else
    return math_call_1(BIF_P, acosh, BIF_ARG_1);
#endif
}

BIF_RETTYPE math_asin_1(BIF_ALIST_1)
{
    return math_call_errno_1(BIF_P, asin, BIF_ARG_1);
}

BIF_RETTYPE math_asinh_1(BIF_ALIST_1)
{
#ifdef NO_ASINH
    BIF_ERROR(BIF_P, EXC_UNDEF);
#else
    return math_call_1(BIF_P, asinh, BIF_ARG_1);
#endif
}

BIF_RETTYPE math_atan_1(BIF_ALIST_1)
{
    return math_call_1(BIF_P, atan, BIF_ARG_1);
}

BIF_RETTYPE math_atanh_1(BIF_ALIST_1)
{
#ifdef NO_ATANH
    BIF_ERROR(BIF_P, EXC_UNDEF);
#else
    return math_call_1(BIF_P, atanh, BIF_ARG_1);
#endif
}

BIF_RETTYPE math_erf_1(BIF_ALIST_1)
{
#ifdef NO_ERF
    BIF_ERROR(BIF_P, EXC_UNDEF);
#else
    return math_call_1(BIF_P, erf, BIF_ARG_1);
#endif
}

BIF_RETTYPE math_erfc_1(BIF_ALIST_1)
{
#ifdef NO_ERFC
    BIF_ERROR(BIF_P, EXC_UNDEF);
#else
    return math_call_1(BIF_P, erfc, BIF_ARG_1);
#endif
}

BIF_RETTYPE math_exp_1(BIF_ALIST_1)
{
    return math_call_1(BIF_P, exp, BIF_ARG_1);
}

BIF_RETTYPE math_log_1(BIF_ALIST_1)
{
    return math_call_1(BIF_P, log, BIF_ARG_1);
}

#ifdef HAVE_LOG2
static double
log2_wrapper(double x)
{
    return log2(x);
}
#else
static double
log2_wrapper(double x)
{
    return log(x) / 0.6931471805599453; /* log(2.0); */
}
#endif

BIF_RETTYPE math_log2_1(BIF_ALIST_1)
{
    return math_call_1(BIF_P, log2_wrapper, BIF_ARG_1);
}

BIF_RETTYPE math_log10_1(BIF_ALIST_1)
{
    return math_call_1(BIF_P, log10, BIF_ARG_1);
}

BIF_RETTYPE math_sqrt_1(BIF_ALIST_1)
{
    return math_call_1(BIF_P, sqrt, BIF_ARG_1);
}

BIF_RETTYPE math_atan2_2(BIF_ALIST_2)
{
    return math_call_2(BIF_P, atan2, BIF_ARG_1, BIF_ARG_2);
}

BIF_RETTYPE math_pow_2(BIF_ALIST_2)
{
    return math_call_2(BIF_P, pow, BIF_ARG_1, BIF_ARG_2);
}

BIF_RETTYPE math_ceil_1(BIF_ALIST_1)
{
    return math_call_1(BIF_P, ceil, BIF_ARG_1);
}

BIF_RETTYPE math_floor_1(BIF_ALIST_1)
{
    return math_call_1(BIF_P, floor, BIF_ARG_1);
}

BIF_RETTYPE math_fmod_2(BIF_ALIST_2)
{
    return math_call_2(BIF_P, fmod, BIF_ARG_1, BIF_ARG_2);
}