aboutsummaryrefslogtreecommitdiffstats
path: root/erts/emulator/beam/erl_bif_op.c
diff options
context:
space:
mode:
Diffstat (limited to 'erts/emulator/beam/erl_bif_op.c')
-rw-r--r--erts/emulator/beam/erl_bif_op.c327
1 files changed, 327 insertions, 0 deletions
diff --git a/erts/emulator/beam/erl_bif_op.c b/erts/emulator/beam/erl_bif_op.c
new file mode 100644
index 0000000000..6da72dcef9
--- /dev/null
+++ b/erts/emulator/beam/erl_bif_op.c
@@ -0,0 +1,327 @@
+/*
+ * %CopyrightBegin%
+ *
+ * Copyright Ericsson AB 1999-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%
+ */
+
+/*
+ * Operator BIFs.
+ */
+
+#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 "erl_driver.h"
+#include "bif.h"
+#include "big.h"
+#include "dist.h"
+#include "erl_version.h"
+#include "erl_binary.h"
+
+BIF_RETTYPE and_2(BIF_ALIST_2)
+{
+ if (BIF_ARG_1 == am_true && BIF_ARG_2 == am_true)
+ BIF_RET(am_true);
+ else if (BIF_ARG_1 == am_true && BIF_ARG_2 == am_false)
+ BIF_RET(am_false);
+ else if (BIF_ARG_1 == am_false && BIF_ARG_2 == am_true)
+ BIF_RET(am_false);
+ else if (BIF_ARG_1 == am_false && BIF_ARG_2 == am_false)
+ BIF_RET(am_false);
+ BIF_ERROR(BIF_P, BADARG);
+}
+
+BIF_RETTYPE or_2(BIF_ALIST_2)
+{
+ if (BIF_ARG_1 == am_true && BIF_ARG_2 == am_true)
+ BIF_RET(am_true);
+ else if (BIF_ARG_1 == am_true && BIF_ARG_2 == am_false)
+ BIF_RET(am_true);
+ else if (BIF_ARG_1 == am_false && BIF_ARG_2 == am_true)
+ BIF_RET(am_true);
+ else if (BIF_ARG_1 == am_false && BIF_ARG_2 == am_false)
+ BIF_RET(am_false);
+ BIF_ERROR(BIF_P, BADARG);
+}
+
+BIF_RETTYPE xor_2(BIF_ALIST_2)
+{
+ if (BIF_ARG_1 == am_true && BIF_ARG_2 == am_true)
+ BIF_RET(am_false);
+ else if (BIF_ARG_1 == am_true && BIF_ARG_2 == am_false)
+ BIF_RET(am_true);
+ else if (BIF_ARG_1 == am_false && BIF_ARG_2 == am_true)
+ BIF_RET(am_true);
+ else if (BIF_ARG_1 == am_false && BIF_ARG_2 == am_false)
+ BIF_RET(am_false);
+ BIF_ERROR(BIF_P, BADARG);
+}
+
+BIF_RETTYPE not_1(BIF_ALIST_1)
+{
+ if (BIF_ARG_1 == am_true)
+ BIF_RET(am_false);
+ else if (BIF_ARG_1 == am_false)
+ BIF_RET(am_true);
+ BIF_ERROR(BIF_P, BADARG);
+}
+
+BIF_RETTYPE sgt_2(BIF_ALIST_2)
+{
+ BIF_RET(cmp_gt(BIF_ARG_1, BIF_ARG_2) ? am_true : am_false);
+}
+
+BIF_RETTYPE sge_2(BIF_ALIST_2)
+{
+ BIF_RET(cmp_ge(BIF_ARG_1, BIF_ARG_2) ? am_true : am_false);
+}
+
+BIF_RETTYPE slt_2(BIF_ALIST_2)
+{
+ BIF_RET(cmp_lt(BIF_ARG_1, BIF_ARG_2) ? am_true : am_false);
+}
+
+BIF_RETTYPE sle_2(BIF_ALIST_2)
+{
+ BIF_RET(cmp_le(BIF_ARG_1, BIF_ARG_2) ? am_true : am_false);
+}
+
+BIF_RETTYPE seq_2(BIF_ALIST_2)
+{
+ BIF_RET(eq(BIF_ARG_1, BIF_ARG_2) ? am_true : am_false);
+}
+
+BIF_RETTYPE seqeq_2(BIF_ALIST_2)
+{
+ BIF_RET(cmp_eq(BIF_ARG_1, BIF_ARG_2) ? am_true : am_false);
+}
+
+BIF_RETTYPE sneq_2(BIF_ALIST_2)
+{
+ BIF_RET(eq(BIF_ARG_1, BIF_ARG_2) ? am_false : am_true);
+}
+
+BIF_RETTYPE sneqeq_2(BIF_ALIST_2)
+{
+ BIF_RET(cmp_ne(BIF_ARG_1, BIF_ARG_2) ? am_true : am_false);
+}
+
+BIF_RETTYPE is_atom_1(BIF_ALIST_1)
+{
+ if (is_atom(BIF_ARG_1)) {
+ BIF_RET(am_true);
+ }
+ BIF_RET(am_false);
+}
+
+BIF_RETTYPE is_float_1(BIF_ALIST_1)
+{
+ if (is_float(BIF_ARG_1)) {
+ BIF_RET(am_true);
+ }
+ BIF_RET(am_false);
+}
+
+BIF_RETTYPE is_integer_1(BIF_ALIST_1)
+{
+ if (is_integer(BIF_ARG_1)) {
+ BIF_RET(am_true);
+ }
+ BIF_RET(am_false);
+}
+
+BIF_RETTYPE is_list_1(BIF_ALIST_1)
+{
+ if (is_list(BIF_ARG_1) || is_nil(BIF_ARG_1)) {
+ BIF_RET(am_true);
+ }
+ BIF_RET(am_false);
+}
+
+BIF_RETTYPE is_number_1(BIF_ALIST_1)
+{
+ if (is_number(BIF_ARG_1)) {
+ BIF_RET(am_true);
+ }
+ BIF_RET(am_false);
+}
+
+
+BIF_RETTYPE is_pid_1(BIF_ALIST_1)
+{
+ if (is_pid(BIF_ARG_1)) {
+ BIF_RET(am_true);
+ }
+ BIF_RET(am_false);
+}
+
+BIF_RETTYPE is_port_1(BIF_ALIST_1)
+{
+ if (is_port(BIF_ARG_1)) {
+ BIF_RET(am_true);
+ }
+ BIF_RET(am_false);
+}
+
+BIF_RETTYPE is_reference_1(BIF_ALIST_1)
+{
+ if (is_ref(BIF_ARG_1)) {
+ BIF_RET(am_true);
+ }
+ BIF_RET(am_false);
+}
+
+BIF_RETTYPE is_tuple_1(BIF_ALIST_1)
+{
+ if (is_tuple(BIF_ARG_1)) {
+ BIF_RET(am_true);
+ }
+ BIF_RET(am_false);
+}
+
+BIF_RETTYPE is_binary_1(BIF_ALIST_1)
+{
+ if (is_binary(BIF_ARG_1) && binary_bitsize(BIF_ARG_1) == 0) {
+ BIF_RET(am_true);
+ }
+ BIF_RET(am_false);
+}
+
+BIF_RETTYPE is_bitstring_1(BIF_ALIST_1)
+{
+ if (is_binary(BIF_ARG_1)) {
+ BIF_RET(am_true);
+ }
+ BIF_RET(am_false);
+}
+
+BIF_RETTYPE is_function_1(BIF_ALIST_1)
+{
+ if (is_any_fun(BIF_ARG_1)) {
+ BIF_RET(am_true);
+ } else {
+ BIF_RET(am_false);
+ }
+}
+
+BIF_RETTYPE is_function_2(BIF_ALIST_2)
+{
+ Sint arity;
+
+ /*
+ * Verify argument 2 (arity); arity must be >= 0.
+ */
+ if (is_small(BIF_ARG_2)) {
+ arity = signed_val(BIF_ARG_2);
+ if (arity < 0) {
+ error:
+ BIF_ERROR(BIF_P, BADARG);
+ }
+ } else if (is_big(BIF_ARG_2) && !bignum_header_is_neg(*big_val(BIF_ARG_2))) {
+ /* A positive bignum is OK, but can't possibly match. */
+ arity = -1;
+ } else {
+ /* Everything else (including negative bignum) is an error. */
+ goto error;
+ }
+
+ if (is_fun(BIF_ARG_1)) {
+ ErlFunThing* funp = (ErlFunThing *) fun_val(BIF_ARG_1);
+
+ if (funp->arity == (Uint) arity) {
+ BIF_RET(am_true);
+ }
+ } else if (is_export(BIF_ARG_1)) {
+ Export* exp = (Export *) (export_val(BIF_ARG_1))[1];
+
+ if (exp->code[2] == (Uint) arity) {
+ BIF_RET(am_true);
+ }
+ } else if (is_tuple(BIF_ARG_1)) {
+ Eterm* tp = tuple_val(BIF_ARG_1);
+ if (tp[0] == make_arityval(2) && is_atom(tp[1]) && is_atom(tp[2])) {
+ BIF_RET(am_true);
+ }
+ }
+ BIF_RET(am_false);
+}
+
+BIF_RETTYPE is_boolean_1(BIF_ALIST_1)
+{
+ if (BIF_ARG_1 == am_true || BIF_ARG_1 == am_false) {
+ BIF_RET(am_true);
+ } else {
+ BIF_RET(am_false);
+ }
+}
+
+
+
+/*
+ * The compiler usually translates calls to is_record/2 to more primitive
+ * operations. In some cases this is not possible. We'll need to implement
+ * a weak version of is_record/2 as BIF (the size of the record cannot
+ * be verified).
+ */
+BIF_RETTYPE is_record_2(BIF_ALIST_2)
+{
+ Eterm *t;
+
+ if (is_not_atom(BIF_ARG_2)) {
+ BIF_ERROR(BIF_P, BADARG);
+ }
+
+ if (is_tuple(BIF_ARG_1) &&
+ arityval(*(t = tuple_val(BIF_ARG_1))) >= 1 &&
+ t[1] == BIF_ARG_2) {
+ BIF_RET(am_true);
+ }
+ BIF_RET(am_false);
+}
+
+
+/*
+ * Record test cannot actually be a bif. The epp processor is involved in
+ * the real guard test, we have to add one more parameter, the
+ * return value of record_info(size, Rec), which is the arity of the TUPLE.
+ * his may seem awkward when applied from the shell, where the plain
+ * tuple test is more understandable, I think...
+ */
+BIF_RETTYPE is_record_3(BIF_ALIST_3)
+{
+ Eterm *t;
+ if (is_not_atom(BIF_ARG_2) || is_not_small(BIF_ARG_3)) {
+ BIF_ERROR(BIF_P, BADARG);
+ }
+
+ if (is_tuple(BIF_ARG_1) &&
+ arityval(*(t = tuple_val(BIF_ARG_1))) == signed_val(BIF_ARG_3)
+ && t[1] == BIF_ARG_2) {
+ BIF_RET(am_true);
+ }
+ BIF_RET(am_false);
+}
+
+
+
+
+