diff options
Diffstat (limited to 'erts/emulator/beam/erl_bif_op.c')
| -rw-r--r-- | erts/emulator/beam/erl_bif_op.c | 327 |
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); +} + + + + + |