From 14cfdc2e8026dde8adeb43b6efb05122d7ff7c59 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?John=20H=C3=B6gberg?= Date: Wed, 7 Nov 2018 15:34:07 +0100 Subject: Make '++'/2 trapping --- erts/emulator/beam/erl_bif_lists.c | 309 +++++++++++++++++++++++++++-------- erts/emulator/beam/erl_dirty_bif.tab | 2 - lib/stdlib/test/lists_SUITE.erl | 14 ++ 3 files changed, 253 insertions(+), 72 deletions(-) diff --git a/erts/emulator/beam/erl_bif_lists.c b/erts/emulator/beam/erl_bif_lists.c index a793b34852..735ad3cae3 100644 --- a/erts/emulator/beam/erl_bif_lists.c +++ b/erts/emulator/beam/erl_bif_lists.c @@ -35,101 +35,270 @@ static Eterm keyfind(int Bif, Process* p, Eterm Key, Eterm Pos, Eterm List); +/* erlang:'++'/2 + * + * Adds a list to another (LHS ++ RHS). For historical reasons this is + * implemented by copying LHS and setting its tail to RHS without checking + * that RHS is a proper list. [] ++ 'not_a_list' will therefore result in + * 'not_a_list', and [1,2] ++ 3 will result in [1,2|3], and this is a bug that + * we have to live with. */ -static BIF_RETTYPE append(Process* p, Eterm A, Eterm B) -{ - Eterm list; - Eterm copy; - Eterm last; - Eterm* hp = NULL; - Sint i; +typedef struct { + Eterm lhs_original; + Eterm rhs_original; - list = A; + Eterm iterator; - if (is_nil(list)) { - BIF_RET(B); - } + Eterm result; + Eterm *result_cdr; +} ErtsAppendContext; + +static int append_ctx_bin_dtor(Binary *context_bin) { + return 1; +} + +static Eterm append_create_trap_state(Process *p, + ErtsAppendContext *from_context) { + ErtsAppendContext *to_context; + Binary *state_bin; + Eterm *hp; + + state_bin = erts_create_magic_binary(sizeof(ErtsAppendContext), + append_ctx_bin_dtor); + + to_context = ERTS_MAGIC_BIN_DATA(state_bin); + *to_context = *from_context; - if (is_not_list(list)) { - BIF_ERROR(p, BADARG); + if (from_context->result_cdr == &from_context->result) { + to_context->result_cdr = &to_context->result; } - /* optimistic append on heap first */ + hp = HAlloc(p, ERTS_MAGIC_REF_THING_SIZE); + return erts_mk_magic_ref(&hp, &MSO(p), state_bin); +} + +static BIF_RETTYPE lists_append_alloc(Process *p, ErtsAppendContext *context) { + static const Uint CELLS_PER_RED = 40; + + Eterm *alloc_top, *alloc_end; + Uint cells_left, max_cells; + Eterm lookahead; + + cells_left = max_cells = CELLS_PER_RED * ERTS_BIF_REDS_LEFT(p); + lookahead = context->iterator; - if ((i = HeapWordsLeft(p) / 2) < 4) { - goto list_tail; +#ifdef DEBUG + cells_left = max_cells = max_cells / 10 + 1; +#endif + + while (cells_left != 0 && is_list(lookahead)) { + lookahead = CDR(list_val(lookahead)); + cells_left--; } - hp = HEAP_TOP(p); - copy = last = CONS(hp, CAR(list_val(list)), make_list(hp+2)); - list = CDR(list_val(list)); - hp += 2; - i -= 2; /* don't use the last 2 words (extra i--;) */ - - while(i-- && is_list(list)) { - Eterm* listp = list_val(list); - last = CONS(hp, CAR(listp), make_list(hp+2)); - list = CDR(listp); - hp += 2; + BUMP_REDS(p, (max_cells - cells_left) / CELLS_PER_RED); + + if (is_not_list(lookahead) && is_not_nil(lookahead)) { + /* It's possible that we're erroring out with an incomplete list, so it + * must be terminated or we'll leave a hole in the heap. */ + *context->result_cdr = NIL; + return -1; } - /* A is proper and B is NIL return A as-is, don't update HTOP */ + alloc_top = HAlloc(p, 2 * (max_cells - cells_left)); + alloc_end = alloc_top + 2 * (max_cells - cells_left); + + while (alloc_top < alloc_end) { + Eterm *cell = list_val(context->iterator); + + ASSERT(context->iterator != lookahead); + + *context->result_cdr = make_list(alloc_top); + context->result_cdr = &CDR(alloc_top); + CAR(alloc_top) = CAR(cell); - if (is_nil(list) && is_nil(B)) { - BIF_RET(A); + context->iterator = CDR(cell); + alloc_top += 2; } - if (is_nil(list)) { - HEAP_TOP(p) = hp; - CDR(list_val(last)) = B; - BIF_RET(copy); + if (is_list(context->iterator)) { + /* The result only has to be terminated when returning it to the user, + * but we're doing it when trapping as well to prevent headaches when + * debugging. */ + *context->result_cdr = NIL; + ASSERT(cells_left == 0); + return 0; } -list_tail: + *context->result_cdr = context->rhs_original; + ASSERT(is_nil(context->iterator)); + + if (is_nil(context->rhs_original)) { + /* The list we created was equal to the original, so we'll return that + * in the hopes that the garbage we created can be removed soon. */ + context->result = context->lhs_original; + } + + return 1; +} + +static BIF_RETTYPE lists_append_onheap(Process *p, ErtsAppendContext *context) { + static const Uint CELLS_PER_RED = 60; + + Eterm *alloc_start, *alloc_top, *alloc_end; + Uint cells_left, max_cells; + + cells_left = max_cells = CELLS_PER_RED * ERTS_BIF_REDS_LEFT(p); + +#ifdef DEBUG + cells_left = max_cells = max_cells / 10 + 1; +#endif + + ASSERT(HEAP_LIMIT(p) >= HEAP_TOP(p) + 2); + alloc_start = HEAP_TOP(p); + alloc_end = HEAP_LIMIT(p) - 2; + alloc_top = alloc_start; + + /* Don't process more cells than we have reductions for. */ + alloc_end = MIN(alloc_top + (cells_left * 2), alloc_end); + + while (alloc_top < alloc_end && is_list(context->iterator)) { + Eterm *cell = list_val(context->iterator); - if ((i = erts_list_length(list)) < 0) { - BIF_ERROR(p, BADARG); + *context->result_cdr = make_list(alloc_top); + context->result_cdr = &CDR(alloc_top); + CAR(alloc_top) = CAR(cell); + + context->iterator = CDR(cell); + alloc_top += 2; } - /* remaining list was proper and B is NIL */ - if (is_nil(B)) { - BIF_RET(A); + cells_left -= (alloc_top - alloc_start) / 2; + HEAP_TOP(p) = alloc_top; + + ASSERT(cells_left >= 0 && cells_left <= max_cells); + BUMP_REDS(p, (max_cells - cells_left) / CELLS_PER_RED); + + if (is_not_list(context->iterator) && is_not_nil(context->iterator)) { + *context->result_cdr = NIL; + return -1; } - if (hp) { - /* Note: fall through case, already written - * on the heap. - * The last 2 words of the heap is not written yet - */ - Eterm *hp_save = hp; - ASSERT(i != 0); - HEAP_TOP(p) = hp + 2; - if (i == 1) { - hp[0] = CAR(list_val(list)); - hp[1] = B; - BIF_RET(copy); + if (is_list(context->iterator)) { + if (cells_left > CELLS_PER_RED) { + return lists_append_alloc(p, context); } - hp = HAlloc(p, 2*(i - 1)); - last = CONS(hp_save, CAR(list_val(list)), make_list(hp)); - } else { - hp = HAlloc(p, 2*i); - copy = last = CONS(hp, CAR(list_val(list)), make_list(hp+2)); - hp += 2; + + *context->result_cdr = NIL; + return 0; + } + + *context->result_cdr = context->rhs_original; + ASSERT(is_nil(context->iterator)); + + if (is_nil(context->rhs_original)) { + context->result = context->lhs_original; } - list = CDR(list_val(list)); - i--; + return 1; +} - ASSERT(i > -1); - while(i--) { - Eterm* listp = list_val(list); - last = CONS(hp, CAR(listp), make_list(hp+2)); - list = CDR(listp); - hp += 2; +static int append_continue(Process *p, ErtsAppendContext *context) { + /* We build the result on the unused part of the heap if possible to save + * us the trouble of having to figure out the list size. We fall back to + * lists_append_alloc when we run out of space. */ + if (HeapWordsLeft(p) > 8) { + return lists_append_onheap(p, context); } - CDR(list_val(last)) = B; - BIF_RET(copy); + return lists_append_alloc(p, context); +} + +static int append_start(Process *p, Eterm lhs, Eterm rhs, + ErtsAppendContext *context) { + context->lhs_original = lhs; + context->rhs_original = rhs; + + context->result_cdr = &context->result; + context->result = NIL; + + context->iterator = lhs; + + return append_continue(p, context); +} + +/* erlang:'++'/2 */ +static Eterm append(Export *bif_entry, BIF_ALIST_2) { + Eterm lhs = BIF_ARG_1, rhs = BIF_ARG_2; + + if (is_nil(lhs)) { + /* This is buggy but expected, `[] ++ 'not_a_list'` has always resulted + * in 'not_a_list'. */ + return rhs; + } else if (is_list(lhs)) { + /* We start with the context on the stack in the hopes that we won't + * have to trap. */ + ErtsAppendContext context; + int res; + + res = append_start(BIF_P, lhs, rhs, &context); + + if (res == 0) { + Eterm state_mref; + + state_mref = append_create_trap_state(BIF_P, &context); + erts_set_gc_state(BIF_P, 0); + + BIF_TRAP2(bif_entry, BIF_P, state_mref, NIL); + } + + if (res < 0) { + ASSERT(is_nil(*context.result_cdr)); + BIF_ERROR(BIF_P, BADARG); + } + + ASSERT(*context.result_cdr == context.rhs_original); + BIF_RET(context.result); + } else if (is_internal_magic_ref(lhs)) { + ErtsAppendContext *context; + int (*dtor)(Binary*); + Binary *magic_bin; + + int res; + + magic_bin = erts_magic_ref2bin(lhs); + dtor = ERTS_MAGIC_BIN_DESTRUCTOR(magic_bin); + + if (dtor != append_ctx_bin_dtor) { + BIF_ERROR(BIF_P, BADARG); + } + + ASSERT(BIF_P->flags & F_DISABLE_GC); + ASSERT(rhs == NIL); + + context = ERTS_MAGIC_BIN_DATA(magic_bin); + res = append_continue(BIF_P, context); + + if (res == 0) { + BIF_TRAP2(bif_entry, BIF_P, lhs, NIL); + } + + erts_set_gc_state(BIF_P, 1); + + if (res < 0) { + ASSERT(is_nil(*context->result_cdr)); + ERTS_BIF_ERROR_TRAPPED2(BIF_P, BADARG, bif_entry, + context->lhs_original, + context->rhs_original); + } + + ASSERT(*context->result_cdr == context->rhs_original); + BIF_RET(context->result); + } + + ASSERT(!(BIF_P->flags & F_DISABLE_GC)); + + BIF_ERROR(BIF_P, BADARG); } /* @@ -139,12 +308,12 @@ list_tail: Eterm ebif_plusplus_2(BIF_ALIST_2) { - return append(BIF_P, BIF_ARG_1, BIF_ARG_2); + return append(bif_export[BIF_ebif_plusplus_2], BIF_CALL_ARGS); } BIF_RETTYPE append_2(BIF_ALIST_2) { - return append(BIF_P, BIF_ARG_1, BIF_ARG_2); + return append(bif_export[BIF_append_2], BIF_CALL_ARGS); } /* erlang:'--'/2 diff --git a/erts/emulator/beam/erl_dirty_bif.tab b/erts/emulator/beam/erl_dirty_bif.tab index 20299ff604..609869ad9f 100644 --- a/erts/emulator/beam/erl_dirty_bif.tab +++ b/erts/emulator/beam/erl_dirty_bif.tab @@ -57,8 +57,6 @@ dirty-cpu erts_debug:lcnt_clear/0 # and debug purposes only. We really do *not* want to execute these # on dirty schedulers on a real system. -dirty-cpu-test erlang:'++'/2 -dirty-cpu-test erlang:append/2 dirty-cpu-test erlang:iolist_size/1 dirty-cpu-test erlang:make_tuple/2 dirty-cpu-test erlang:make_tuple/3 diff --git a/lib/stdlib/test/lists_SUITE.erl b/lib/stdlib/test/lists_SUITE.erl index 17bb12e548..316b7a1ffa 100644 --- a/lib/stdlib/test/lists_SUITE.erl +++ b/lib/stdlib/test/lists_SUITE.erl @@ -158,6 +158,20 @@ append_2(Config) when is_list(Config) -> "abcdef"=lists:append("abc", "def"), [hej, du]=lists:append([hej], [du]), [10, [elem]]=lists:append([10], [[elem]]), + + %% Trapping, both crashing and otherwise. + [append_trapping_1(N) || N <- lists:seq(0, 20)], + + ok. + +append_trapping_1(N) -> + List = lists:duplicate(N + (1 bsl N), gurka), + ImproperList = List ++ crash, + + {'EXIT',_} = (catch (ImproperList ++ [])), + + [3, 2, 1 | List] = lists:reverse(List ++ [1, 2, 3]), + ok. %% Tests the lists:reverse() implementation. The function is -- cgit v1.2.3