summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--erts/emulator/beam/beam_bif_load.c320
-rw-r--r--erts/emulator/beam/bif.tab6
-rw-r--r--erts/emulator/beam/erl_proc_sig_queue.c379
-rw-r--r--erts/emulator/beam/erl_proc_sig_queue.h28
-rw-r--r--erts/emulator/beam/erl_process.c65
-rw-r--r--erts/emulator/beam/erl_process.h1
-rw-r--r--erts/emulator/beam/global.h6
-rw-r--r--erts/preloaded/ebin/erts_internal.beambin26512 -> 26432 bytes
-rw-r--r--erts/preloaded/ebin/erts_literal_area_collector.beambin3596 -> 3820 bytes
-rw-r--r--erts/preloaded/src/erts_internal.erl9
-rw-r--r--erts/preloaded/src/erts_literal_area_collector.erl27
11 files changed, 580 insertions, 261 deletions
diff --git a/erts/emulator/beam/beam_bif_load.c b/erts/emulator/beam/beam_bif_load.c
index ca47ad0735..ce0046c25a 100644
--- a/erts/emulator/beam/beam_bif_load.c
+++ b/erts/emulator/beam/beam_bif_load.c
@@ -939,184 +939,72 @@ set_default_trace_pattern(Eterm module)
}
}
-static Uint hfrag_literal_size(Eterm* start, Eterm* end,
- char* lit_start, Uint lit_size);
-static void hfrag_literal_copy(Eterm **hpp, ErlOffHeap *ohp,
- Eterm *start, Eterm *end,
- char *lit_start, Uint lit_size);
-
-static ERTS_INLINE void
-msg_copy_literal_area(ErtsMessage *msgp, int *redsp,
- char *literals, Uint lit_bsize)
+int
+erts_check_copy_literals_gc_need(Process *c_p, int *redsp,
+ char *literals, Uint lit_bsize)
{
- ErlHeapFragment *hfrag, *hf;
- Uint lit_sz = 0;
-
- *redsp += 1;
-
- if (!ERTS_SIG_IS_INTERNAL_MSG(msgp))
- return;
-
- if (msgp->data.attached == ERTS_MSG_COMBINED_HFRAG)
- hfrag = &msgp->hfrag;
- else
- hfrag = msgp->data.heap_frag;
-
/*
- * Literals should only be able to appear in the
- * first message reference, i.e., the message
- * itself...
+ * TODO: Implement yielding support!
*/
- if (ErtsInArea(msgp->m[0], literals, lit_bsize))
- lit_sz += size_object(msgp->m[0]);
-
-#ifdef DEBUG
- {
- int i;
- for (i = 1; i < ERL_MESSAGE_REF_ARRAY_SZ; i++) {
- ASSERT(!ErtsInArea(msgp->m[i], literals, lit_bsize));
- }
- }
-#endif
-
- for (hf = hfrag; hf; hf = hf->next) {
- lit_sz += hfrag_literal_size(&hf->mem[0],
- &hf->mem[hf->used_size],
- literals, lit_bsize);
- *redsp += 1;
- }
-
- *redsp += lit_sz / 16; /* Better value needed... */
- if (lit_sz > 0) {
- ErlHeapFragment *bp = new_message_buffer(lit_sz);
- Eterm *hp = bp->mem;
-
- if (ErtsInArea(msgp->m[0], literals, lit_bsize)) {
- Uint sz = size_object(msgp->m[0]);
- msgp->m[0] = copy_struct(msgp->m[0], sz, &hp, &bp->off_heap);
- }
-
- for (hf = hfrag; hf; hf = hf->next) {
- hfrag_literal_copy(&hp, &bp->off_heap,
- &hf->mem[0],
- &hf->mem[hf->used_size],
- literals, lit_bsize);
- hfrag = hf;
- }
-
- bp->next = NULL;
- /* link new hfrag last */
- if (!hfrag)
- msgp->data.heap_frag = bp;
- else {
- ASSERT(hfrag->next == NULL);
- hfrag->next = bp;
- }
- }
-}
-
-Eterm
-erts_proc_copy_literal_area(Process *c_p, int *redsp, int fcalls, int gc_allowed)
-{
- ErtsLiteralArea *la;
- struct erl_off_heap_header* oh;
- char *literals;
- Uint lit_bsize;
ErlHeapFragment *hfrag;
ErtsMessage *mfp;
-
- la = ERTS_COPY_LITERAL_AREA();
- if (!la)
- goto return_ok;
+ Uint64 scanned = 0;
+ int res = !0; /* need gc */
/* The heap may be in an inconsistent state when the GC is disabled, for
* example when we're in the middle of building a record in
* binary_to_term/1, so we have to delay scanning until the GC is enabled
* again. */
- if (c_p->flags & F_DISABLE_GC) {
- return THE_NON_VALUE;
- }
-
- oh = la->off_heap;
- literals = (char *) &la->start[0];
- lit_bsize = (char *) la->end - literals;
+ if (c_p->flags & F_DISABLE_GC)
+ goto done;
/*
- * If a literal is in the message queue we make an explicit copy of
- * it and attach it to the heap fragment. Each message needs to be
- * self contained, we cannot save the literal in the old_heap or
- * any other heap than the message it self.
+ * Signal queue has already been handled see
+ * handle_cla() in erl_proc_sig_queue.c
*/
- erts_proc_lock(c_p, ERTS_PROC_LOCK_MSGQ);
- erts_proc_sig_fetch(c_p);
- erts_proc_unlock(c_p, ERTS_PROC_LOCK_MSGQ);
-
- ERTS_FOREACH_SIG_PRIVQS(c_p, msgp, msg_copy_literal_area(msgp,
- redsp,
- literals,
- lit_bsize));
-
- if (gc_allowed) {
- /*
- * Current implementation first tests without
- * allowing GC, and then restarts the operation
- * allowing GC if it is needed. It is therfore
- * very likely that we will need the GC (although
- * this is not completely certain). We go for
- * the GC directly instead of scanning everything
- * one more time...
- *
- * Also note that calling functions expect a
- * major GC to be performed if gc_allowed is set
- * to true. If you change this, you need to fix
- * callers...
- */
- goto literal_gc;
- }
-
- *redsp += 2;
+ scanned++;
if (any_heap_ref_ptrs(&c_p->fvalue, &c_p->fvalue+1, literals, lit_bsize)) {
c_p->freason = EXC_NULL;
c_p->fvalue = NIL;
c_p->ftrace = NIL;
}
+ scanned += c_p->hend - c_p->stop;
if (any_heap_ref_ptrs(c_p->stop, c_p->hend, literals, lit_bsize))
- goto literal_gc;
- *redsp += 1;
+ goto done;
+ scanned += c_p->htop - c_p->heap;
if (any_heap_refs(c_p->heap, c_p->htop, literals, lit_bsize))
- goto literal_gc;
- *redsp += 1;
+ goto done;
if (c_p->abandoned_heap) {
+ scanned += c_p->heap_sz;
if (any_heap_refs(c_p->abandoned_heap, c_p->abandoned_heap + c_p->heap_sz,
literals, lit_bsize))
- goto literal_gc;
- *redsp += 1;
+ goto done;
}
+ scanned += c_p->old_htop - c_p->old_heap;
if (any_heap_refs(c_p->old_heap, c_p->old_htop, literals, lit_bsize))
- goto literal_gc;
+ goto done;
/* Check dictionary */
- *redsp += 1;
if (c_p->dictionary) {
Eterm* start = ERTS_PD_START(c_p->dictionary);
Eterm* end = start + ERTS_PD_SIZE(c_p->dictionary);
+ scanned += end - start;
if (any_heap_ref_ptrs(start, end, literals, lit_bsize))
- goto literal_gc;
+ goto done;
}
/* Check heap fragments */
for (hfrag = c_p->mbuf; hfrag; hfrag = hfrag->next) {
Eterm *hp, *hp_end;
- *redsp += 1;
-
+ scanned += hfrag->used_size;
hp = &hfrag->mem[0];
hp_end = &hfrag->mem[hfrag->used_size];
if (any_heap_refs(hp, hp_end, literals, lit_bsize))
- goto literal_gc;
+ goto done;
}
/*
@@ -1130,27 +1018,46 @@ erts_proc_copy_literal_area(Process *c_p, int *redsp, int fcalls, int gc_allowed
for (; hfrag; hfrag = hfrag->next) {
Eterm *hp, *hp_end;
- *redsp += 1;
-
+ scanned += hfrag->used_size;
hp = &hfrag->mem[0];
hp_end = &hfrag->mem[hfrag->used_size];
if (any_heap_refs(hp, hp_end, literals, lit_bsize))
- goto literal_gc;
+ goto done;
}
}
+
+ res = 0; /* no need for gc */
-return_ok:
-
- if (ERTS_SCHEDULER_IS_DIRTY(erts_proc_sched_data(c_p)))
- c_p->flags &= ~F_DIRTY_CLA;
+done: {
+ Uint64 reds = ((scanned - 1)/ERTS_CLA_SCAN_WORDS_PER_RED) + 1;
+ if (reds > CONTEXT_REDS)
+ reds = CONTEXT_REDS;
+ *redsp += (int) reds;
+ return res;
+ }
+}
- return am_ok;
+Eterm
+erts_copy_literals_gc(Process *c_p, int *redsp, int fcalls)
+{
+ ErtsLiteralArea *la;
+ struct erl_off_heap_header* oh;
+ char *literals;
+ Uint lit_bsize;
-literal_gc:
+ la = ERTS_COPY_LITERAL_AREA();
+ if (!la) {
+ ASSERT(0);
+ return am_ok;
+ }
- if (!gc_allowed)
- return am_need_gc;
+ oh = la->off_heap;
+ literals = (char *) &la->start[0];
+ lit_bsize = (char *) la->end - literals;
+
+ if (c_p->flags & F_DISABLE_GC)
+ return THE_NON_VALUE;
*redsp += erts_garbage_collect_literals(c_p, (Eterm *) literals, lit_bsize,
oh, fcalls);
@@ -1286,80 +1193,6 @@ any_heap_refs(Eterm* start, Eterm* end, char* mod_start, Uint mod_size)
return 0;
}
-static Uint
-hfrag_literal_size(Eterm* start, Eterm* end, char* lit_start, Uint lit_size)
-{
- Eterm* p;
- Eterm val;
- Uint sz = 0;
-
- for (p = start; p < end; p++) {
- val = *p;
- switch (primary_tag(val)) {
- case TAG_PRIMARY_BOXED:
- case TAG_PRIMARY_LIST:
- if (ErtsInArea(val, lit_start, lit_size)) {
- sz += size_object(val);
- }
- break;
- case TAG_PRIMARY_HEADER:
- if (!header_is_transparent(val)) {
- Eterm* new_p;
- if (header_is_bin_matchstate(val)) {
- ErlBinMatchState *ms = (ErlBinMatchState*) p;
- ErlBinMatchBuffer *mb = &(ms->mb);
- if (ErtsInArea(mb->orig, lit_start, lit_size)) {
- sz += size_object(mb->orig);
- }
- }
- new_p = p + thing_arityval(val);
- ASSERT(start <= new_p && new_p < end);
- p = new_p;
- }
- }
- }
- return sz;
-}
-
-static void
-hfrag_literal_copy(Eterm **hpp, ErlOffHeap *ohp,
- Eterm *start, Eterm *end,
- char *lit_start, Uint lit_size) {
- Eterm* p;
- Eterm val;
- Uint sz;
-
- for (p = start; p < end; p++) {
- val = *p;
- switch (primary_tag(val)) {
- case TAG_PRIMARY_BOXED:
- case TAG_PRIMARY_LIST:
- if (ErtsInArea(val, lit_start, lit_size)) {
- sz = size_object(val);
- val = copy_struct(val, sz, hpp, ohp);
- *p = val;
- }
- break;
- case TAG_PRIMARY_HEADER:
- if (!header_is_transparent(val)) {
- Eterm* new_p;
- /* matchstate in message, not possible. */
- if (header_is_bin_matchstate(val)) {
- ErlBinMatchState *ms = (ErlBinMatchState*) p;
- ErlBinMatchBuffer *mb = &(ms->mb);
- if (ErtsInArea(mb->orig, lit_start, lit_size)) {
- sz = size_object(mb->orig);
- mb->orig = copy_struct(mb->orig, sz, hpp, ohp);
- }
- }
- new_p = p + thing_arityval(val);
- ASSERT(start <= new_p && new_p < end);
- p = new_p;
- }
- }
- }
-}
-
/*
* Release of literal areas...
*
@@ -1644,14 +1477,55 @@ rla_switch_area(void)
}
}
-BIF_RETTYPE erts_internal_release_literal_area_switch_0(BIF_ALIST_0)
+BIF_RETTYPE
+erts_literal_area_collector_send_copy_request_3(BIF_ALIST_3)
+{
+ Eterm req_id, tmp_heap[4];
+
+ /*
+ * The literal-area-collector process orchestrates this and
+ * is the only process allowed here...
+ */
+ if (BIF_P != erts_literal_area_collector)
+ BIF_ERROR(BIF_P, EXC_NOTSUP);
+
+ if (is_not_internal_pid(BIF_ARG_1))
+ BIF_ERROR(BIF_P, BADARG);
+
+ req_id = TUPLE3(&tmp_heap[0], BIF_ARG_2, BIF_ARG_3, BIF_ARG_1);
+
+ if (BIF_ARG_3 == am_false) {
+ /*
+ * Will handle signal queue and check if GC if needed. If
+ * GC is needed operation will be continued by a GC (below).
+ */
+ erts_proc_sig_send_cla_request(BIF_P, BIF_ARG_1, req_id);
+ }
+ else if (BIF_ARG_3 == am_true) {
+ /*
+ * Will perform a literal GC. Note that this assumes that
+ * signal queue already has been handled...
+ */
+ erts_schedule_cla_gc(BIF_P, BIF_ARG_1, req_id);
+ }
+ else
+ BIF_ERROR(BIF_P, BADARG);
+
+ BIF_RET(am_ok);
+}
+
+BIF_RETTYPE erts_literal_area_collector_release_area_switch_0(BIF_ALIST_0)
{
ErtsLiteralArea *new_area, *old_area;
int wait_ix = 0;
int sched_ix = 0;
+ /*
+ * The literal-area-collector process orchestrates this and
+ * is the only process allowed here...
+ */
if (BIF_P != erts_literal_area_collector)
- BIF_ERROR(BIF_P, EXC_NOTSUP);
+ BIF_ERROR(BIF_P, EXC_NOTSUP);
while (1) {
int six;
@@ -1705,7 +1579,7 @@ BIF_RETTYPE erts_internal_release_literal_area_switch_0(BIF_ALIST_0)
ASSERT(old_area);
ERTS_VBUMP_ALL_REDS(BIF_P);
- BIF_TRAP0(BIF_TRAP_EXPORT(BIF_erts_internal_release_literal_area_switch_0),
+ BIF_TRAP0(BIF_TRAP_EXPORT(BIF_erts_literal_area_collector_release_area_switch_0),
BIF_P);
}
diff --git a/erts/emulator/beam/bif.tab b/erts/emulator/beam/bif.tab
index 9bd486b01c..9ba49376dd 100644
--- a/erts/emulator/beam/bif.tab
+++ b/erts/emulator/beam/bif.tab
@@ -189,8 +189,6 @@ bif erts_internal:is_system_process/1
bif erts_internal:system_check/1
-bif erts_internal:release_literal_area_switch/0
-
bif erts_internal:scheduler_wall_time/1
bif erts_internal:dirty_process_handle_signals/1
@@ -203,6 +201,10 @@ bif erts_internal:spawn_request/4
bif erts_internal:dist_spawn_request/4
bif erlang:spawn_request_abandon/1
+# Static native functions in erts_literal_area_collector
+bif erts_literal_area_collector:release_area_switch/0
+bif erts_literal_area_collector:send_copy_request/3
+
# inet_db support
bif erlang:port_set_data/2
bif erlang:port_get_data/1
diff --git a/erts/emulator/beam/erl_proc_sig_queue.c b/erts/emulator/beam/erl_proc_sig_queue.c
index 1a29be24b1..63f716dba9 100644
--- a/erts/emulator/beam/erl_proc_sig_queue.c
+++ b/erts/emulator/beam/erl_proc_sig_queue.c
@@ -56,6 +56,13 @@
#define ERTS_SIG_LNK_X_FLAG_NORMAL_KILLS (((Uint32) 1) << 0)
#define ERTS_SIG_LNK_X_FLAG_CONNECTION_LOST (((Uint32) 1) << 1)
+#define ERTS_PROC_SIG_CLA_SCAN_FACTOR \
+ (ERTS_CLA_SCAN_WORDS_PER_RED / ERTS_SIG_REDS_CNT_FACTOR)
+#define ERTS_PROC_SIG_CLA_COPY_FACTOR \
+ (ERTS_PROC_SIG_CLA_SCAN_FACTOR / 8)
+#define ERTS_PROC_SIG_CLA_MSGS_FACTOR \
+ 25
+
Process *ERTS_WRITE_UNLIKELY(erts_dirty_process_signal_handler);
Process *ERTS_WRITE_UNLIKELY(erts_dirty_process_signal_handler_high);
Process *ERTS_WRITE_UNLIKELY(erts_dirty_process_signal_handler_max);
@@ -208,6 +215,11 @@ typedef struct {
ErtsORefThing oref_thing;
} ErtsProcSigRPC;
+typedef struct {
+ Eterm requester;
+ Eterm request_id;
+} ErtsCLAData;
+
static int handle_msg_tracing(Process *c_p,
ErtsSigRecvTracing *tracing,
ErtsMessage ***next_nm_sig);
@@ -224,6 +236,14 @@ static void group_leader_reply(Process *c_p, Eterm to,
Eterm ref, int success);
static int stretch_limit(Process *c_p, ErtsSigRecvTracing *tp,
int abs_lim, int *limp, int save_in_msgq);
+static int
+handle_cla(Process *c_p,
+ ErtsMessage *sig,
+ ErtsMessage ***next_nm_sig,
+ int exiting);
+static void
+send_cla_reply(Process *c_p, ErtsMessage *sig, Eterm to,
+ Eterm req_id, Eterm result);
#ifdef ERTS_PROC_SIG_HARD_DEBUG
#define ERTS_PROC_SIG_HDBG_PRIV_CHKQ(P, T, NMN) \
@@ -342,6 +362,16 @@ get_dist_spawn_reply_data(ErtsMessage *sig)
+ sig->hfrag.used_size);
}
+static ERTS_INLINE ErtsCLAData *
+get_cla_data(ErtsMessage *sig)
+{
+ ASSERT(ERTS_SIG_IS_NON_MSG(sig));
+ ASSERT(ERTS_PROC_SIG_OP(((ErtsSignal *) sig)->common.tag)
+ == ERTS_SIG_Q_OP_CLA);
+ return (ErtsCLAData *) (char *) (&sig->hfrag.mem[0]
+ + sig->hfrag.used_size);
+}
+
static ERTS_INLINE void
destroy_trace_info(ErtsSigTraceInfo *ti)
{
@@ -2406,6 +2436,56 @@ erts_proc_sig_send_rpc_request(Process *c_p,
return res;
}
+
+void
+erts_proc_sig_send_cla_request(Process *c_p, Eterm to, Eterm req_id)
+{
+ ErtsMessage *sig;
+ ErlHeapFragment *hfrag;
+ ErlOffHeap *ohp;
+ Eterm req_id_cpy, *hp, *start_hp;
+ Uint hsz, req_id_sz;
+ ErtsCLAData *cla;
+
+ hsz = sizeof(ErtsCLAData)/sizeof(Uint);
+ if (hsz < 4) {
+ /*
+ * Need room to overwrite the ErtsCLAData part with a
+ * 3-tuple when reusing the signal for the reply...
+ */
+ hsz = 4;
+ }
+
+ req_id_sz = size_object(req_id);
+ hsz += req_id_sz;
+
+ sig = erts_alloc_message(hsz, &hp);
+ hfrag = &sig->hfrag;
+ sig->next = NULL;
+ ohp = &hfrag->off_heap;
+ start_hp = hp;
+
+ req_id_cpy = copy_struct(req_id, req_id_sz, &hp, ohp);
+
+ cla = (ErtsCLAData *) (char *) hp;
+ hfrag->used_size = hp - start_hp;
+
+ cla->requester = c_p->common.id;
+ cla->request_id = req_id_cpy;
+
+ ERL_MESSAGE_TERM(sig) = ERTS_PROC_SIG_MAKE_TAG(ERTS_SIG_Q_OP_CLA,
+ ERTS_SIG_Q_TYPE_UNDEFINED,
+ 0);
+ ERL_MESSAGE_FROM(sig) = c_p->common.id;
+ ERL_MESSAGE_TOKEN(sig) = am_undefined;
+#ifdef USE_VM_PROBES
+ ERL_MESSAGE_DT_UTAG(sig) = NIL;
+#endif
+
+ if (!proc_queue_signal(c_p, to, (ErtsSignal *) sig, ERTS_SIG_Q_OP_CLA))
+ send_cla_reply(c_p, sig, c_p->common.id, req_id_cpy, am_ok);
+}
+
static int
handle_rpc(Process *c_p, ErtsProcSigRPC *rpc, int cnt, int limit, int *yieldp)
{
@@ -5280,6 +5360,12 @@ erts_proc_sig_handle_incoming(Process *c_p, erts_aint32_t *statep,
ERTS_PROC_SIG_HDBG_PRIV_CHKQ(c_p, &tracing, next_nm_sig);
break;
+ case ERTS_SIG_Q_OP_CLA:
+ ERTS_PROC_SIG_HDBG_PRIV_CHKQ(c_p, &tracing, next_nm_sig);
+ cnt += handle_cla(c_p, sig, next_nm_sig, 0);
+ ERTS_PROC_SIG_HDBG_PRIV_CHKQ(c_p, &tracing, next_nm_sig);
+ break;
+
case ERTS_SIG_Q_OP_TRACE_CHANGE_STATE: {
Uint16 type = ERTS_PROC_SIG_TYPE(tag);
@@ -5751,6 +5837,10 @@ erts_proc_sig_handle_exit(Process *c_p, Sint *redsp,
break;
}
+ case ERTS_SIG_Q_OP_CLA:
+ handle_cla(c_p, sig, next_nm_sig, !0);
+ break;
+
case ERTS_SIG_Q_OP_TRACE_CHANGE_STATE:
destroy_trace_info((ErtsSigTraceInfo *) sig);
break;
@@ -5847,6 +5937,7 @@ clear_seq_trace_token(ErtsMessage *sig)
case ERTS_SIG_Q_OP_SYNC_SUSPEND:
case ERTS_SIG_Q_OP_RPC:
case ERTS_SIG_Q_OP_RECV_MARK:
+ case ERTS_SIG_Q_OP_CLA:
break;
default:
@@ -5908,6 +5999,7 @@ erts_proc_sig_signal_size(ErtsSignal *sig)
case ERTS_SIG_Q_OP_SYNC_SUSPEND:
case ERTS_SIG_Q_OP_PERSISTENT_MON_MSG:
case ERTS_SIG_Q_OP_IS_ALIVE:
+ case ERTS_SIG_Q_OP_CLA:
case ERTS_SIG_Q_OP_DIST_SPAWN_REPLY: {
ErlHeapFragment *hf;
size = sizeof(ErtsMessageRef);
@@ -6148,6 +6240,292 @@ erts_proc_sig_receive_helper(Process *c_p,
return consumed_reds;
}
+static Uint
+area_literal_size(Eterm* start, Eterm* end, char* lit_start, Uint lit_size)
+{
+ Eterm* p;
+ Eterm val;
+ Uint sz = 0;
+
+ for (p = start; p < end; p++) {
+ val = *p;
+ switch (primary_tag(val)) {
+ case TAG_PRIMARY_BOXED:
+ case TAG_PRIMARY_LIST:
+ if (ErtsInArea(val, lit_start, lit_size)) {
+ sz += size_object(val);
+ }
+ break;
+ case TAG_PRIMARY_HEADER:
+ if (!header_is_transparent(val)) {
+ Eterm* new_p;
+ if (header_is_bin_matchstate(val)) {
+ ErlBinMatchState *ms = (ErlBinMatchState*) p;
+ ErlBinMatchBuffer *mb = &(ms->mb);
+ if (ErtsInArea(mb->orig, lit_start, lit_size)) {
+ sz += size_object(mb->orig);
+ }
+ }
+ new_p = p + thing_arityval(val);
+ ASSERT(start <= new_p && new_p < end);
+ p = new_p;
+ }
+ }
+ }
+ return sz;
+}
+
+static ERTS_INLINE void
+area_literal_copy(Eterm **hpp, ErlOffHeap *ohp,
+ Eterm *start, Eterm *end,
+ char *lit_start, Uint lit_size) {
+ Eterm* p;
+ Eterm val;
+ Uint sz;
+
+ for (p = start; p < end; p++) {
+ val = *p;
+ switch (primary_tag(val)) {
+ case TAG_PRIMARY_BOXED:
+ case TAG_PRIMARY_LIST:
+ if (ErtsInArea(val, lit_start, lit_size)) {
+ sz = size_object(val);
+ val = copy_struct(val, sz, hpp, ohp);
+ *p = val;
+ }
+ break;
+ case TAG_PRIMARY_HEADER:
+ if (!header_is_transparent(val)) {
+ Eterm* new_p;
+ /* matchstate in message, not possible. */
+ if (header_is_bin_matchstate(val)) {
+ ErlBinMatchState *ms = (ErlBinMatchState*) p;
+ ErlBinMatchBuffer *mb = &(ms->mb);
+ if (ErtsInArea(mb->orig, lit_start, lit_size)) {
+ sz = size_object(mb->orig);
+ mb->orig = copy_struct(mb->orig, sz, hpp, ohp);
+ }
+ }
+ new_p = p + thing_arityval(val);
+ ASSERT(start <= new_p && new_p < end);
+ p = new_p;
+ }
+ }
+ }
+}
+
+static void
+send_cla_reply(Process *c_p, ErtsMessage *sig, Eterm to,
+ Eterm req_id, Eterm result)
+{
+ Process *rp;
+
+ /*
+ * The incoming signal is reused as reply message to
+ * the requester. It has already been partially prepared.
+ * Request id is already in place in the combined message
+ * heap fragment and do not need to be copied.
+ */
+
+ ASSERT(is_value(result) && is_immed(result));
+ ASSERT(is_internal_pid(to));
+ ASSERT(((Sint) sig->hfrag.alloc_size)
+ - ((Sint) sig->hfrag.used_size)
+ >= 4); /* Room for 3-tuple... */
+
+ sig->next = NULL;
+ sig->data.attached = ERTS_MSG_COMBINED_HFRAG;
+
+ rp = erts_proc_lookup(to);
+ if (!rp)
+ erts_cleanup_messages(sig);
+ else {
+ Eterm rp_locks;
+ Eterm *hp, reply_msg;
+
+ hp = &sig->hfrag.mem[0] + sig->hfrag.used_size;
+ reply_msg = TUPLE3(hp, am_copy_literals, req_id, result);
+ sig->hfrag.used_size += 4;
+
+ if (c_p == rp)
+ rp_locks = ERTS_PROC_LOCK_MAIN;
+ else
+ rp_locks = 0;
+
+ erts_queue_proc_message(c_p, rp, rp_locks,
+ sig, reply_msg);
+ }
+}
+
+static int
+handle_cla(Process *c_p,
+ ErtsMessage *sig,
+ ErtsMessage ***next_nm_sig,
+ int exiting)
+{
+ /*
+ * TODO: Implement yielding support!
+ */
+ ErtsCLAData *cla;
+ ErtsMessage *msg;
+ ErtsLiteralArea *la;
+ char *literals;
+ Uint lit_bsize;
+ int nmsgs, reds;
+ Eterm result = am_ok;
+ Uint64 cnt = 0;
+
+ cnt++;
+
+ cla = get_cla_data(sig);
+ if (exiting) {
+ /* signal already removed... */
+ goto done;
+ }
+
+ /*
+ * If we need to perform a literal GC, all signals *must* already
+ * have been handled before the GC. Note that only the message
+ * queue (signals before this signal) needs to be scanned since the
+ * request have been passed through the signal queue after we set up
+ * the literal area to copy. No literals in the area of interest
+ * can therefore occur behind this signal.
+ */
+
+ la = ERTS_COPY_LITERAL_AREA();
+ if (!la) {
+ ASSERT(0);
+ remove_nm_sig(c_p, sig, next_nm_sig);
+ goto done;
+ }
+
+ ASSERT(la);
+
+ literals = (char *) &la->start[0];
+ lit_bsize = (char *) la->end - literals;
+
+ msg = c_p->sig_qs.first;
+ if (!msg)
+ msg = c_p->sig_qs.cont;
+
+ nmsgs = 0;
+ while (msg != sig) {
+ ASSERT(!!msg);
+ nmsgs++;
+ if (nmsgs >= ERTS_PROC_SIG_CLA_MSGS_FACTOR) {
+ cnt++;
+ nmsgs = 0;
+ }
+ if (ERTS_SIG_IS_INTERNAL_MSG(msg)) {
+ ErlHeapFragment *first_hfrag, *hf, **last_hfrag;
+ int in_refs = 0, in_heap_frags = 0;
+ Uint scanned = 0, lit_sz = 0;
+
+ /*
+ * If a literal to copy is found in the message, we make
+ * an explicit copy of it in a heap fragment and attach
+ * that heap fragment to the messag. Each message needs
+ * to be self contained, we cannot save the literal at
+ * any other place than in the message itself.
+ */
+
+ /*
+ * Literals directly from message references should only
+ * be able to appear in the first message reference, i.e.,
+ * the message itself...
+ */
+ if (ErtsInArea(msg->m[0], literals, lit_bsize)) {
+ in_refs++;
+ lit_sz += size_object(msg->m[0]);
+ }
+
+#ifdef DEBUG
+ {
+ int i;
+ for (i = 1; i < ERL_MESSAGE_REF_ARRAY_SZ; i++) {
+ ASSERT(!ErtsInArea(msg->m[i], literals, lit_bsize));
+ }
+ }
+#endif
+
+ if (msg->data.attached == ERTS_MSG_COMBINED_HFRAG) {
+ first_hfrag = &msg->hfrag;
+ last_hfrag = &msg->hfrag.next;
+ }
+ else {
+ first_hfrag = msg->data.heap_frag;
+ last_hfrag = &msg->data.heap_frag;
+ }
+
+ for (hf = first_hfrag; hf; hf = hf->next) {
+ Uint sz = hf->used_size;
+ Uint lsz = area_literal_size(&hf->mem[0],
+ &hf->mem[sz],
+ literals, lit_bsize);
+ if (lsz)
+ in_heap_frags++;
+ lit_sz += lsz;
+ scanned += sz;
+ last_hfrag = &hf->next;
+ }
+
+ cnt += scanned/ERTS_PROC_SIG_CLA_SCAN_FACTOR;
+
+ if (lit_sz > 0) {
+ ErlHeapFragment *new_hfrag = new_message_buffer(lit_sz);
+ ErlOffHeap *ohp = &new_hfrag->off_heap;
+ Eterm *hp = new_hfrag->mem;
+
+ if (in_refs) {
+ if (ErtsInArea(msg->m[0], literals, lit_bsize)) {
+ Uint sz = size_object(msg->m[0]);
+ msg->m[0] = copy_struct(msg->m[0], sz, &hp, ohp);
+ }
+ }
+
+ if (in_heap_frags) {
+
+ for (hf = first_hfrag; hf; hf = hf->next) {
+ area_literal_copy(&hp, ohp, &hf->mem[0],
+ &hf->mem[hf->used_size],
+ literals, lit_bsize);
+ }
+
+ }
+
+ /* link new hfrag last */
+ ASSERT(new_hfrag->used_size == hp - &new_hfrag->mem[0]);
+ new_hfrag->next = NULL;
+ ASSERT(!*last_hfrag);
+ *last_hfrag = new_hfrag;
+
+ cnt += scanned/ERTS_PROC_SIG_CLA_SCAN_FACTOR;
+ cnt += lit_sz/ERTS_PROC_SIG_CLA_COPY_FACTOR;
+ }
+ }
+
+ msg = msg->next;
+ if (!msg)
+ msg = c_p->sig_qs.cont;
+ }
+
+ remove_nm_sig(c_p, sig, next_nm_sig);
+
+ reds = 0;
+ if (erts_check_copy_literals_gc_need(c_p, &reds, literals, lit_bsize))
+ result = am_need_gc;
+
+ cnt += reds * ERTS_SIG_REDS_CNT_FACTOR;
+
+done:
+
+ send_cla_reply(c_p, sig, cla->requester, cla->request_id, result);
+
+ if (cnt > CONTEXT_REDS)
+ return CONTEXT_REDS;
+ return cnt;
+}
+
static int
handle_trace_change_state(Process *c_p,
ErtsSigRecvTracing *tracing,
@@ -6663,6 +7041,7 @@ erts_proc_sig_debug_foreach_sig(Process *c_p,
case ERTS_SIG_Q_OP_PERSISTENT_MON_MSG:
case ERTS_SIG_Q_OP_ALIAS_MSG:
+ case ERTS_SIG_Q_OP_CLA:
debug_foreach_sig_heap_frags(&sig->hfrag, oh_func, arg);
break;
diff --git a/erts/emulator/beam/erl_proc_sig_queue.h b/erts/emulator/beam/erl_proc_sig_queue.h
index c76314e08d..ffd2617fd0 100644
--- a/erts/emulator/beam/erl_proc_sig_queue.h
+++ b/erts/emulator/beam/erl_proc_sig_queue.h
@@ -107,7 +107,7 @@ typedef struct {
* Note that not all signal are handled using this functionality!
*/
-#define ERTS_SIG_Q_OP_MAX 17
+#define ERTS_SIG_Q_OP_MAX 18
#define ERTS_SIG_Q_OP_EXIT 0 /* Exit signal due to bif call */
#define ERTS_SIG_Q_OP_EXIT_LINKED 1 /* Exit signal due to link break*/
@@ -126,7 +126,8 @@ typedef struct {
#define ERTS_SIG_Q_OP_DIST_SPAWN_REPLY 14
#define ERTS_SIG_Q_OP_ALIAS_MSG 15
#define ERTS_SIG_Q_OP_RECV_MARK 16
-#define ERTS_SIG_Q_OP_UNLINK_ACK ERTS_SIG_Q_OP_MAX
+#define ERTS_SIG_Q_OP_UNLINK_ACK 17
+#define ERTS_SIG_Q_OP_CLA ERTS_SIG_Q_OP_MAX
#define ERTS_SIG_Q_TYPE_MAX (ERTS_MON_LNK_TYPE_MAX + 9)
@@ -933,6 +934,29 @@ erts_proc_sig_send_dist_spawn_reply(Eterm node,
Eterm result,
Eterm token);
+/**
+ *
+ * @brief Send a 'copy literal area request' signal to
+ * a process.
+ *
+ * The receiver will scan its message queue and then the rest
+ * of the process. After the operation has bee performed it will
+ * reply with a '{copy_literals, ReqID, Res}' message to the
+ * sender where 'Res' equals 'ok' if the receiver is clean or
+ * 'need_gc' if a literal GC is needed.
+ *
+ * Should only be called by the literal-area-collector process!
+ *
+ * @param[in] c_p Pointer to process struct of
+ * currently executing process.
+ *
+ * @param[in] to Identifier of receiver.
+ *
+ * @param[in] req_id Request ID (RegID) term.
+ */
+void
+erts_proc_sig_send_cla_request(Process *c_p, Eterm to, Eterm req_id);
+
/*
* End of send operations of currently supported process signals.
*/
diff --git a/erts/emulator/beam/erl_process.c b/erts/emulator/beam/erl_process.c
index 6e5f50bae1..c42105ecc6 100644
--- a/erts/emulator/beam/erl_process.c
+++ b/erts/emulator/beam/erl_process.c
@@ -10097,6 +10097,7 @@ notify_sys_task_executed(Process *c_p, ErtsProcSysTask *st,
Eterm st_result, int normal_sched)
{
Process *rp;
+
if (!normal_sched)
rp = erts_pid2proc_opt(c_p, ERTS_PROC_LOCK_MAIN,
st->requester, 0,
@@ -10395,15 +10396,12 @@ execute_sys_tasks(Process *c_p, erts_aint32_t *statep, int in_reds)
case ERTS_PSTT_CLA: {
int fcalls;
int cla_reds = 0;
- int do_gc;
if (!ERTS_PROC_GET_SAVED_CALLS_BUF(c_p))
fcalls = reds;
else
fcalls = reds - CONTEXT_REDS;
- do_gc = st->arg[0] == am_true;
- st_res = erts_proc_copy_literal_area(c_p, &cla_reds,
- fcalls, do_gc);
+ st_res = erts_copy_literals_gc(c_p, &cla_reds, fcalls);
reds -= cla_reds;
if (is_non_value(st_res)) {
if (c_p->flags & F_DIRTY_CLA) {
@@ -10416,8 +10414,8 @@ execute_sys_tasks(Process *c_p, erts_aint32_t *statep, int in_reds)
st = NULL;
break;
}
- if (do_gc) /* We did a major gc */
- minor_gc = major_gc = 1;
+ /* We did a major gc */
+ minor_gc = major_gc = 1;
break;
}
case ERTS_PSTT_COHMQ:
@@ -10634,7 +10632,7 @@ erts_execute_dirty_system_task(Process *c_p)
if (c_p->flags & F_DIRTY_CLA) {
int cla_reds = 0;
- cla_res = erts_proc_copy_literal_area(c_p, &cla_reds, c_p->fcalls, 1);
+ cla_res = erts_copy_literals_gc(c_p, &cla_reds, c_p->fcalls);
ASSERT(is_value(cla_res));
}
@@ -10902,16 +10900,6 @@ request_system_task(Process *c_p, Eterm requester, Eterm target,
fail_state |= ERTS_PSFLG_DIRTY_RUNNING;
break;
- case am_copy_literals:
- if (st->arg[0] != am_true && st->arg[0] != am_false)
- goto badarg;
- st->type = ERTS_PSTT_CLA;
- noproc_res = am_ok;
- fail_state = ERTS_PSFLG_FREE;
- if (!rp)
- goto noproc;
- break;
-
default:
if (ERTS_IS_ATOM_STR("system_task_test", req_type)) {
st->type = ERTS_PSTT_TEST;
@@ -11054,6 +11042,49 @@ erts_internal_request_system_task_4(BIF_ALIST_4)
BIF_ARG_2, BIF_ARG_3, BIF_ARG_4);
}
+void
+erts_schedule_cla_gc(Process *c_p, Eterm to, Eterm req_id)
+{
+ Process *rp;
+ ErtsProcSysTask *st;
+ Uint req_id_sz;
+ Eterm *hp;
+ int i;
+ erts_aint32_t state, st_prio, fail_state = ERTS_PSFLG_FREE;
+
+ ASSERT(erts_get_scheduler_data());
+ ASSERT(!ERTS_SCHEDULER_IS_DIRTY(erts_get_scheduler_data()));
+
+ req_id_sz = is_immed(req_id) ? 0 : size_object(req_id);
+ st = erts_alloc(ERTS_ALC_T_PROC_SYS_TSK,
+ ERTS_PROC_SYS_TASK_SIZE(req_id_sz));
+ ERTS_INIT_OFF_HEAP(&st->off_heap);
+ hp = &st->heap[0];
+
+ st->type = ERTS_PSTT_CLA;
+ st->requester = c_p->common.id;
+ st->reply_tag = am_copy_literals;
+ st->req_id_sz = req_id_sz;
+ st->req_id = req_id_sz == 0 ? req_id : copy_struct(req_id,
+ req_id_sz,
+ &hp,
+ &st->off_heap);
+ for (i = 0; i < ERTS_MAX_PROC_SYS_TASK_ARGS; i++)
+ st->arg[i] = THE_NON_VALUE;
+
+ rp = erts_proc_lookup_raw(to);
+ if (!rp)
+ goto noproc;
+
+ state = erts_atomic32_read_nob(&rp->state);
+ st_prio = ERTS_PSFLGS_GET_USR_PRIO(state);
+
+ if (!schedule_process_sys_task(rp, st_prio, st, &fail_state)) {
+ noproc:
+ (void) notify_sys_task_executed(c_p, st, am_ok, 1);
+ }
+}
+
static int
schedule_generic_sys_task(Eterm pid, ErtsProcSysTaskType type,
int prio, Eterm arg0, Eterm arg1)
diff --git a/erts/emulator/beam/erl_process.h b/erts/emulator/beam/erl_process.h
index dfd3549391..447acc1974 100644
--- a/erts/emulator/beam/erl_process.h
+++ b/erts/emulator/beam/erl_process.h
@@ -1906,6 +1906,7 @@ void erts_schedule_thr_prgr_later_cleanup_op(void (*)(void *),
ErtsThrPrgrLaterOp *,
UWord);
void erts_schedule_complete_off_heap_message_queue_change(Eterm pid);
+void erts_schedule_cla_gc(Process *c_p, Eterm to, Eterm req_id);
struct db_fixation;
void erts_schedule_ets_free_fixation(Eterm pid, struct db_fixation*);
void erts_schedule_flush_trace_messages(Process *proc, int force_on_proc);
diff --git a/erts/emulator/beam/global.h b/erts/emulator/beam/global.h
index 956d1dc468..8e8835abb9 100644
--- a/erts/emulator/beam/global.h
+++ b/erts/emulator/beam/global.h
@@ -975,7 +975,11 @@ Eterm erl_is_function(Process* p, Eterm arg1, Eterm arg2);
/* beam_bif_load.c */
Eterm erts_check_process_code(Process *c_p, Eterm module, int *redsp, int fcalls);
-Eterm erts_proc_copy_literal_area(Process *c_p, int *redsp, int fcalls, int gc_allowed);
+#define ERTS_CLA_SCAN_WORDS_PER_RED 512
+
+int erts_check_copy_literals_gc_need(Process *c_p, int *redsp,
+ char *literals, Uint lit_bsize);
+Eterm erts_copy_literals_gc(Process *c_p, int *redsp, int fcalls);
Uint32 erts_block_release_literal_area(void);
void erts_unblock_release_literal_area(Uint32);
diff --git a/erts/preloaded/ebin/erts_internal.beam b/erts/preloaded/ebin/erts_internal.beam
index 19355afa71..540be7491e 100644
--- a/erts/preloaded/ebin/erts_internal.beam
+++ b/erts/preloaded/ebin/erts_internal.beam
Binary files differ
diff --git a/erts/preloaded/ebin/erts_literal_area_collector.beam b/erts/preloaded/ebin/erts_literal_area_collector.beam
index 3e63973c87..b7c9fb3a1a 100644
--- a/erts/preloaded/ebin/erts_literal_area_collector.beam
+++ b/erts/preloaded/ebin/erts_literal_area_collector.beam
Binary files differ
diff --git a/erts/preloaded/src/erts_internal.erl b/erts/preloaded/src/erts_internal.erl
index 361a5d42ef..9925dbd3f9 100644
--- a/erts/preloaded/src/erts_internal.erl
+++ b/erts/preloaded/src/erts_internal.erl
@@ -47,7 +47,7 @@
-export([is_process_executing_dirty/1]).
-export([dirty_process_handle_signals/1]).
--export([release_literal_area_switch/0, wait_release_literal_area_switch/1]).
+-export([wait_release_literal_area_switch/1]).
-export([purge_module/2]).
@@ -350,11 +350,6 @@ is_process_executing_dirty(_Pid) ->
dirty_process_handle_signals(_Pid) ->
erlang:nif_error(undefined).
--spec release_literal_area_switch() -> 'true' | 'false'.
-
-release_literal_area_switch() ->
- erlang:nif_error(undefined).
-
-spec wait_release_literal_area_switch(WaitMsg) -> 'true' | 'false' when
WaitMsg :: term().
@@ -362,7 +357,7 @@ wait_release_literal_area_switch(WaitMsg) ->
%% release_literal_area_switch() traps to here
%% when it needs to wait
receive WaitMsg -> ok end,
- erts_internal:release_literal_area_switch().
+ erts_literal_area_collector:release_area_switch().
-spec purge_module(Module, Op) -> boolean() when
Module :: module(),
diff --git a/erts/preloaded/src/erts_literal_area_collector.erl b/erts/preloaded/src/erts_literal_area_collector.erl
index 3befad8dfb..05566c4d04 100644
--- a/erts/preloaded/src/erts_literal_area_collector.erl
+++ b/erts/preloaded/src/erts_literal_area_collector.erl
@@ -19,7 +19,7 @@
%%
-module(erts_literal_area_collector).
--export([start/0]).
+-export([start/0, send_copy_request/3, release_area_switch/0]).
%% Currently we only allow two outstanding literal
%% copying jobs that garbage collect in order to
@@ -42,8 +42,7 @@ start() ->
%% The VM will send us a 'copy_literals' message
%% when it has a new literal area that needs to
%% be handled is added. We will also be informed
-%% about more areas when we call
-%% erts_internal:release_literal_area_switch().
+%% about more areas when we call release_area_switch().
%%
msg_loop(Area, Outstnd, GcOutstnd, NeedGC) ->
receive
@@ -60,14 +59,14 @@ msg_loop(Area, Outstnd, GcOutstnd, NeedGC) ->
{copy_literals, {Area, true, _Pid}, ok} when NeedGC == [] ->
msg_loop(Area, Outstnd-1, GcOutstnd-1, []);
{copy_literals, {Area, true, _Pid}, ok} ->
- send_copy_req(hd(NeedGC), Area, true),
+ erts_literal_area_collector:send_copy_request(hd(NeedGC), Area, true),
msg_loop(Area, Outstnd-1, GcOutstnd, tl(NeedGC));
%% Process (Pid) failed to complete the request
%% since it needs to garbage collect in order to
%% complete the request...
{copy_literals, {Area, false, Pid}, need_gc} when GcOutstnd < ?MAX_GC_OUTSTND ->
- send_copy_req(Pid, Area, true),
+ erts_literal_area_collector:send_copy_request(Pid, Area, true),
msg_loop(Area, Outstnd, GcOutstnd+1, NeedGC);
{copy_literals, {Area, false, Pid}, need_gc} ->
msg_loop(Area, Outstnd, GcOutstnd, [Pid|NeedGC]);
@@ -85,7 +84,7 @@ msg_loop(Area, Outstnd, GcOutstnd, NeedGC) ->
end.
switch_area() ->
- Res = erts_internal:release_literal_area_switch(),
+ Res = erts_literal_area_collector:release_area_switch(),
erlang:garbage_collect(), %% Almost no live data now...
case Res of
false ->
@@ -106,8 +105,18 @@ send_copy_reqs(Ps, Area, GC) ->
send_copy_reqs([], _Area, _GC, N) ->
N;
send_copy_reqs([P|Ps], Area, GC, N) ->
- send_copy_req(P, Area, GC),
+ erts_literal_area_collector:send_copy_request(P, Area, GC),
send_copy_reqs(Ps, Area, GC, N+1).
-send_copy_req(P, Area, GC) ->
- erts_internal:request_system_task(P, normal, {copy_literals, {Area, GC, P}, GC}).
+-spec release_area_switch() -> boolean().
+
+release_area_switch() ->
+ erlang:nif_error(undef). %% Implemented in beam_bif_load.c
+
+-spec send_copy_request(To, AreaId, GcAllowed) -> 'ok' when
+ To :: pid(),
+ AreaId :: term(),
+ GcAllowed :: boolean().
+
+send_copy_request(_To, _AreaId, _GcAllowed) ->
+ erlang:nif_error(undef). %% Implemented in beam_bif_load.c
View Lorry Controller Status