aboutsummaryrefslogtreecommitdiffstats
path: root/erts/emulator/beam/erl_math.c
diff options
context:
space:
mode:
authorErlang/OTP <[email protected]>2009-11-20 14:54:40 +0000
committerErlang/OTP <[email protected]>2009-11-20 14:54:40 +0000
commit84adefa331c4159d432d22840663c38f155cd4c1 (patch)
treebff9a9c66adda4df2106dfd0e5c053ab182a12bd /erts/emulator/beam/erl_math.c
downloadotp-84adefa331c4159d432d22840663c38f155cd4c1.tar.gz
otp-84adefa331c4159d432d22840663c38f155cd4c1.tar.bz2
otp-84adefa331c4159d432d22840663c38f155cd4c1.zip
The R13B03 release.OTP_R13B03
Diffstat (limited to 'erts/emulator/beam/erl_math.c')
-rw-r--r--erts/emulator/beam/erl_math.c233
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);
+}
+
+
+
+