The R13B03 release.OTP_R13B03

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