path: root/erts/emulator/beam/erl_math.c

/*
 * %CopyrightBegin%
 * 
 * Copyright Ericsson AB 1997-2016. 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;
}


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_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_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);
}