diff options
Diffstat (limited to 'erts/emulator/beam/erl_math.c')
| -rw-r--r-- | erts/emulator/beam/erl_math.c | 233 |
1 files changed, 233 insertions, 0 deletions
diff --git a/erts/emulator/beam/erl_math.c b/erts/emulator/beam/erl_math.c new file mode 100644 index 0000000000..16d4fdc09c --- /dev/null +++ b/erts/emulator/beam/erl_math.c @@ -0,0 +1,233 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1997-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights 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); +} + + +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); +} + + + + |