aboutsummaryrefslogtreecommitdiffstats
path: root/erts/emulator
diff options
context:
space:
mode:
Diffstat (limited to 'erts/emulator')
-rw-r--r--erts/emulator/beam/erl_bif_lists.c313
-rw-r--r--erts/emulator/beam/erl_dirty_bif.tab2
2 files changed, 241 insertions, 74 deletions
diff --git a/erts/emulator/beam/erl_bif_lists.c b/erts/emulator/beam/erl_bif_lists.c
index a793b34852..9b6b84d000 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
@@ -913,7 +1082,7 @@ static BIF_RETTYPE lists_reverse_alloc(Process *c_p,
list = list_in;
tail = tail_in;
- cells_left = max_cells = CELLS_PER_RED * (1 + ERTS_BIF_REDS_LEFT(c_p));
+ cells_left = max_cells = CELLS_PER_RED * ERTS_BIF_REDS_LEFT(c_p);
lookahead = list;
while (cells_left != 0 && is_list(lookahead)) {
@@ -962,7 +1131,7 @@ static BIF_RETTYPE lists_reverse_onheap(Process *c_p,
list = list_in;
tail = tail_in;
- cells_left = max_cells = CELLS_PER_RED * (1 + ERTS_BIF_REDS_LEFT(c_p));
+ cells_left = max_cells = CELLS_PER_RED * ERTS_BIF_REDS_LEFT(c_p);
ASSERT(HEAP_LIMIT(c_p) >= HEAP_TOP(c_p) + 2);
alloc_start = HEAP_TOP(c_p);
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
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-19 22:06:04 +0000