diff options
author | Erlang/OTP <[email protected]> | 2009-11-20 14:54:40 +0000 |
---|---|---|
committer | Erlang/OTP <[email protected]> | 2009-11-20 14:54:40 +0000 |
commit | 84adefa331c4159d432d22840663c38f155cd4c1 (patch) | |
tree | bff9a9c66adda4df2106dfd0e5c053ab182a12bd /erts/emulator/beam/erl_bif_lists.c | |
download | otp-84adefa331c4159d432d22840663c38f155cd4c1.tar.gz otp-84adefa331c4159d432d22840663c38f155cd4c1.tar.bz2 otp-84adefa331c4159d432d22840663c38f155cd4c1.zip |
The R13B03 release.OTP_R13B03
Diffstat (limited to 'erts/emulator/beam/erl_bif_lists.c')
-rw-r--r-- | erts/emulator/beam/erl_bif_lists.c | 392 |
1 files changed, 392 insertions, 0 deletions
diff --git a/erts/emulator/beam/erl_bif_lists.c b/erts/emulator/beam/erl_bif_lists.c new file mode 100644 index 0000000000..a9e8dd86f7 --- /dev/null +++ b/erts/emulator/beam/erl_bif_lists.c @@ -0,0 +1,392 @@ +/* + * %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% + */ + +/* + * BIFs logically belonging to the lists module. + */ + +#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" + +static Eterm keyfind(int Bif, Process* p, Eterm Key, Eterm Pos, Eterm List); + +/* + * erlang:'++'/2 + */ + +Eterm +ebif_plusplus_2(Process* p, Eterm A, Eterm B) +{ + return append_2(p, A, B); +} + +/* + * erlang:'--'/2 + */ + +Eterm +ebif_minusminus_2(Process* p, Eterm A, Eterm B) +{ + return subtract_2(p, A, B); +} + +BIF_RETTYPE append_2(BIF_ALIST_2) +{ + Eterm list; + Eterm copy; + Eterm last; + size_t need; + Eterm* hp; + int i; + + if ((i = list_length(BIF_ARG_1)) < 0) { + BIF_ERROR(BIF_P, BADARG); + } + if (i == 0) { + BIF_RET(BIF_ARG_2); + } else if (is_nil(BIF_ARG_2)) { + BIF_RET(BIF_ARG_1); + } + + need = 2*i; + hp = HAlloc(BIF_P, need); + list = BIF_ARG_1; + copy = last = CONS(hp, CAR(list_val(list)), make_list(hp+2)); + list = CDR(list_val(list)); + hp += 2; + i--; + while(i--) { + Eterm* listp = list_val(list); + last = CONS(hp, CAR(listp), make_list(hp+2)); + list = CDR(listp); + hp += 2; + } + CDR(list_val(last)) = BIF_ARG_2; + BIF_RET(copy); +} + +BIF_RETTYPE subtract_2(BIF_ALIST_2) +{ + Eterm list; + Eterm* hp; + Uint need; + Eterm res; + Eterm small_vec[10]; /* Preallocated memory for small lists */ + Eterm* vec_p; + Eterm* vp; + int i; + int n; + int m; + + if ((n = list_length(BIF_ARG_1)) < 0) { + BIF_ERROR(BIF_P, BADARG); + } + if ((m = list_length(BIF_ARG_2)) < 0) { + BIF_ERROR(BIF_P, BADARG); + } + + if (n == 0) + BIF_RET(NIL); + if (m == 0) + BIF_RET(BIF_ARG_1); + + /* allocate element vector */ + if (n <= sizeof(small_vec)/sizeof(small_vec[0])) + vec_p = small_vec; + else + vec_p = (Eterm*) erts_alloc(ERTS_ALC_T_TMP, n * sizeof(Eterm)); + + /* PUT ALL ELEMENTS IN VP */ + vp = vec_p; + list = BIF_ARG_1; + i = n; + while(i--) { + Eterm* listp = list_val(list); + *vp++ = CAR(listp); + list = CDR(listp); + } + + /* UNMARK ALL DELETED CELLS */ + list = BIF_ARG_2; + m = 0; /* number of deleted elements */ + while(is_list(list)) { + Eterm* listp = list_val(list); + Eterm elem = CAR(listp); + i = n; + vp = vec_p; + while(i--) { + if (is_value(*vp) && eq(*vp, elem)) { + *vp = THE_NON_VALUE; + m++; + break; + } + vp++; + } + list = CDR(listp); + } + + if (m == n) /* All deleted ? */ + res = NIL; + else if (m == 0) /* None deleted ? */ + res = BIF_ARG_1; + else { /* REBUILD LIST */ + res = NIL; + need = 2*(n - m); + hp = HAlloc(BIF_P, need); + vp = vec_p + n - 1; + while(vp >= vec_p) { + if (is_value(*vp)) { + res = CONS(hp, *vp, res); + hp += 2; + } + vp--; + } + } + if (vec_p != small_vec) + erts_free(ERTS_ALC_T_TMP, (void *) vec_p); + BIF_RET(res); +} + +BIF_RETTYPE lists_member_2(BIF_ALIST_2) +{ + Eterm term; + Eterm list; + Eterm item; + int non_immed_key; + int max_iter = 10 * CONTEXT_REDS; + + if (is_nil(BIF_ARG_2)) { + BIF_RET(am_false); + } else if (is_not_list(BIF_ARG_2)) { + BIF_ERROR(BIF_P, BADARG); + } + + term = BIF_ARG_1; + non_immed_key = is_not_immed(term); + list = BIF_ARG_2; + while (is_list(list)) { + if (--max_iter < 0) { + BUMP_ALL_REDS(BIF_P); + BIF_TRAP2(bif_export[BIF_lists_member_2], BIF_P, term, list); + } + item = CAR(list_val(list)); + if ((item == term) || (non_immed_key && eq(item, term))) { + BIF_RET2(am_true, CONTEXT_REDS - max_iter/10); + } + list = CDR(list_val(list)); + } + if (is_not_nil(list)) { + BIF_ERROR(BIF_P, BADARG); + } + BIF_RET2(am_false, CONTEXT_REDS - max_iter/10); +} + +BIF_RETTYPE lists_reverse_2(BIF_ALIST_2) +{ + Eterm list; + Eterm tmp_list; + Eterm result; + Eterm* hp; + Uint n; + int max_iter; + + /* + * Handle legal and illegal non-lists quickly. + */ + if (is_nil(BIF_ARG_1)) { + BIF_RET(BIF_ARG_2); + } else if (is_not_list(BIF_ARG_1)) { + error: + BIF_ERROR(BIF_P, BADARG); + } + + /* + * First use the rest of the remaning heap space. + */ + list = BIF_ARG_1; + result = BIF_ARG_2; + hp = HEAP_TOP(BIF_P); + n = HeapWordsLeft(BIF_P) / 2; + while (n != 0 && is_list(list)) { + Eterm* pair = list_val(list); + result = CONS(hp, CAR(pair), result); + list = CDR(pair); + hp += 2; + n--; + } + HEAP_TOP(BIF_P) = hp; + if (is_nil(list)) { + BIF_RET(result); + } + + /* + * Calculate length of remaining list (up to a suitable limit). + */ + max_iter = CONTEXT_REDS * 40; + n = 0; + tmp_list = list; + while (max_iter-- > 0 && is_list(tmp_list)) { + tmp_list = CDR(list_val(tmp_list)); + n++; + } + if (is_not_nil(tmp_list) && is_not_list(tmp_list)) { + goto error; + } + + /* + * Now do one HAlloc() and continue reversing. + */ + hp = HAlloc(BIF_P, 2*n); + while (n != 0 && is_list(list)) { + Eterm* pair = list_val(list); + result = CONS(hp, CAR(pair), result); + list = CDR(pair); + hp += 2; + n--; + } + if (is_nil(list)) { + BIF_RET(result); + } else { + BUMP_ALL_REDS(BIF_P); + BIF_TRAP2(bif_export[BIF_lists_reverse_2], BIF_P, list, result); + } +} + +BIF_RETTYPE +lists_keymember_3(Process* p, Eterm Key, Eterm Pos, Eterm List) +{ + Eterm res; + + res = keyfind(BIF_lists_keymember_3, p, Key, Pos, List); + if (is_value(res) && is_tuple(res)) { + return am_true; + } else { + return res; + } +} + +BIF_RETTYPE +lists_keysearch_3(Process* p, Eterm Key, Eterm Pos, Eterm List) +{ + Eterm res; + + res = keyfind(BIF_lists_keysearch_3, p, Key, Pos, List); + if (is_non_value(res) || is_not_tuple(res)) { + return res; + } else { /* Tuple */ + Eterm* hp = HAlloc(p, 3); + return TUPLE2(hp, am_value, res); + } +} + +BIF_RETTYPE +lists_keyfind_3(Process* p, Eterm Key, Eterm Pos, Eterm List) +{ + return keyfind(BIF_lists_keyfind_3, p, Key, Pos, List); +} + +static Eterm +keyfind(int Bif, Process* p, Eterm Key, Eterm Pos, Eterm List) +{ + int max_iter = 10 * CONTEXT_REDS; + Sint pos; + Eterm term; + + if (!is_small(Pos) || (pos = signed_val(Pos)) < 1) { + BIF_ERROR(p, BADARG); + } + + if (is_small(Key)) { + double float_key = (double) signed_val(Key); + + while (is_list(List)) { + if (--max_iter < 0) { + BUMP_ALL_REDS(p); + BIF_TRAP3(bif_export[Bif], p, Key, Pos, List); + } + term = CAR(list_val(List)); + List = CDR(list_val(List)); + if (is_tuple(term)) { + Eterm *tuple_ptr = tuple_val(term); + if (pos <= arityval(*tuple_ptr)) { + Eterm element = tuple_ptr[pos]; + if (Key == element) { + return term; + } else if (is_float(element)) { + FloatDef f; + + GET_DOUBLE(element, f); + if (f.fd == float_key) { + return term; + } + } + } + } + } + } else if (is_immed(Key)) { + while (is_list(List)) { + if (--max_iter < 0) { + BUMP_ALL_REDS(p); + BIF_TRAP3(bif_export[Bif], p, Key, Pos, List); + } + term = CAR(list_val(List)); + List = CDR(list_val(List)); + if (is_tuple(term)) { + Eterm *tuple_ptr = tuple_val(term); + if (pos <= arityval(*tuple_ptr)) { + Eterm element = tuple_ptr[pos]; + if (Key == element) { + return term; + } + } + } + } + } else { + while (is_list(List)) { + if (--max_iter < 0) { + BUMP_ALL_REDS(p); + BIF_TRAP3(bif_export[Bif], p, Key, Pos, List); + } + term = CAR(list_val(List)); + List = CDR(list_val(List)); + if (is_tuple(term)) { + Eterm *tuple_ptr = tuple_val(term); + if (pos <= arityval(*tuple_ptr)) { + Eterm element = tuple_ptr[pos]; + if (cmp(Key, element) == 0) { + return term; + } + } + } + } + } + + if (is_not_nil(List)) { + BIF_ERROR(p, BADARG); + } + return am_false; +} |