void verify_process(Process *p)
{
#define VERIFY_AREA(name,ptr,sz) { \
int n = (sz); \
while (n--) if(!verify_eterm(p,*(ptr+n))) \
erts_exit(ERTS_ERROR_EXIT,"Wild pointer found in " name " of %T!\n",p->common.id); }
#define VERIFY_ETERM(name,eterm) { \
if(!verify_eterm(p,eterm)) \
erts_exit(ERTS_ERROR_EXIT,"Wild pointer found in " name " of %T!\n",p->common.id); }
ErtsMessage* mp = p->msg.first;
VERBOSE(DEBUG_MEMORY,("Verify process: %T...\n",p->common.id));
while (mp != NULL) {
VERIFY_ETERM("message term",ERL_MESSAGE_TERM(mp));
VERIFY_ETERM("message token",ERL_MESSAGE_TOKEN(mp));
mp = mp->next;
}
erts_check_stack(p);
erts_check_heap(p);
if (p->dictionary)
VERIFY_AREA("dictionary", ERTS_PD_START(p->dictionary), ERTS_PD_SIZE(p->dictionary));
VERIFY_ETERM("seq trace token",p->seq_trace_token);
VERIFY_ETERM("group leader",p->group_leader);
VERIFY_ETERM("fvalue",p->fvalue);
VERIFY_ETERM("ftrace",p->ftrace);
VERBOSE(DEBUG_MEMORY,("...done\n"));
#undef VERIFY_AREA
#undef VERIFY_ETERM
}
static void print_process_memory(Process *p)
{
ErlHeapFragment* bp = MBUF(p);
erts_printf("==============================\n");
erts_printf("|| Memory info for %T ||\n",p->common.id);
erts_printf("==============================\n");
erts_printf("-- %-*s ---%s-%s-%s-%s--\n",
PTR_SIZE, "PCB", dashes, dashes, dashes, dashes);
if (p->msg.first != NULL) {
ErtsMessage* mp;
erts_printf(" Message Queue:\n");
mp = p->msg.first;
while (mp != NULL) {
erts_printf("| 0x%0*lx | 0x%0*lx |\n",PTR_SIZE,
ERL_MESSAGE_TERM(mp),PTR_SIZE,ERL_MESSAGE_TOKEN(mp));
mp = mp->next;
}
}
if (p->dictionary != NULL) {
int n = ERTS_PD_SIZE(p->dictionary);
Eterm *ptr = ERTS_PD_START(p->dictionary);
erts_printf(" Dictionary: ");
while (n--) erts_printf("0x%0*lx ",PTR_SIZE,(unsigned long)ptr++);
erts_printf("\n");
}
if (p->arity > 0) {
int n = p->arity;
Eterm *ptr = p->arg_reg;
erts_printf(" Argument Registers: ");
while (n--) erts_printf("0x%0*lx ",PTR_SIZE,(unsigned long)*ptr++);
erts_printf("\n");
}
erts_printf(" Trace Token: 0x%0*lx\n",PTR_SIZE,p->seq_trace_token);
erts_printf(" Group Leader: 0x%0*lx\n",PTR_SIZE,p->group_leader);
erts_printf(" Fvalue: 0x%0*lx\n",PTR_SIZE,p->fvalue);
erts_printf(" Ftrace: 0x%0*lx\n",PTR_SIZE,p->ftrace);
erts_printf("+- %-*s -+ 0x%0*lx 0x%0*lx %s-%s-+\n",
PTR_SIZE, "Stack",
PTR_SIZE, (unsigned long)STACK_TOP(p),
PTR_SIZE, (unsigned long)STACK_START(p),
dashes, dashes);
print_untagged_memory(STACK_TOP(p),STACK_START(p));
erts_printf("+- %-*s -+ 0x%0*lx 0x%0*lx 0x%0*lx 0x%0*lx +\n",
PTR_SIZE, "Heap",
PTR_SIZE, (unsigned long)HEAP_START(p),
PTR_SIZE, (unsigned long)HIGH_WATER(p),
PTR_SIZE, (unsigned long)HEAP_TOP(p),
PTR_SIZE, (unsigned long)HEAP_END(p));
print_untagged_memory(HEAP_START(p),HEAP_TOP(p));
if (OLD_HEAP(p)) {
erts_printf("+- %-*s -+ 0x%0*lx 0x%0*lx 0x%0*lx %s-+\n",
PTR_SIZE, "Old Heap",
PTR_SIZE, (unsigned long)OLD_HEAP(p),
PTR_SIZE, (unsigned long)OLD_HTOP(p),
PTR_SIZE, (unsigned long)OLD_HEND(p),
dashes);
print_untagged_memory(OLD_HEAP(p),OLD_HTOP(p));
}
if (bp)
erts_printf("+- %-*s -+-%s-%s-%s-%s-+\n",
PTR_SIZE, "heap fragments",
dashes, dashes, dashes, dashes);
while (bp) {
print_untagged_memory(bp->mem,bp->mem + bp->used_size);
bp = bp->next;
}
}
static Eterm
check_process_code(Process* rp, Module* modp, Uint flags, int *redsp, int fcalls)
{
BeamInstr* start;
char* literals;
Uint lit_bsize;
char* mod_start;
Uint mod_size;
Eterm* sp;
int done_gc = 0;
int need_gc = 0;
ErtsMessage *msgp;
ErlHeapFragment *hfrag;
#define ERTS_ORDINARY_GC__ (1 << 0)
#define ERTS_LITERAL_GC__ (1 << 1)
/*
* Pick up limits for the module.
*/
start = (BeamInstr*) modp->old.code_hdr;
mod_start = (char *) start;
mod_size = modp->old.code_length;
/*
* Check if current instruction or continuation pointer points into module.
*/
if (ErtsInArea(rp->i, mod_start, mod_size)
|| ErtsInArea(rp->cp, mod_start, mod_size)) {
return am_true;
}
/*
* Check all continuation pointers stored on the stack.
*/
for (sp = rp->stop; sp < STACK_START(rp); sp++) {
if (is_CP(*sp) && ErtsInArea(cp_val(*sp), mod_start, mod_size)) {
return am_true;
}
}
/*
* Check all continuation pointers stored in stackdump
* and clear exception stackdump if there is a pointer
* to the module.
*/
if (rp->ftrace != NIL) {
struct StackTrace *s;
ASSERT(is_list(rp->ftrace));
s = (struct StackTrace *) big_val(CDR(list_val(rp->ftrace)));
if ((s->pc && ErtsInArea(s->pc, mod_start, mod_size)) ||
(s->current && ErtsInArea(s->current, mod_start, mod_size))) {
rp->freason = EXC_NULL;
rp->fvalue = NIL;
rp->ftrace = NIL;
} else {
int i;
for (i = 0; i < s->depth; i++) {
if (ErtsInArea(s->trace[i], mod_start, mod_size)) {
rp->freason = EXC_NULL;
rp->fvalue = NIL;
rp->ftrace = NIL;
break;
}
}
}
}
if (rp->flags & F_DISABLE_GC) {
/*
* Cannot proceed. Process has disabled gc in order to
* safely leave inconsistent data on the heap and/or
* off heap lists. Need to wait for gc to be enabled
* again.
*/
return THE_NON_VALUE;
}
/*
* Message queue can contains funs, but (at least currently) no
* literals. If we got references to this module from the message
* queue, a GC cannot remove these...
*/
erts_smp_proc_lock(rp, ERTS_PROC_LOCK_MSGQ);
ERTS_SMP_MSGQ_MV_INQ2PRIVQ(rp);
erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_MSGQ);
literals = (char*) modp->old.code_hdr->literals_start;
lit_bsize = (char*) modp->old.code_hdr->literals_end - literals;
for (msgp = rp->msg.first; msgp; msgp = msgp->next) {
if (msgp->data.attached == ERTS_MSG_COMBINED_HFRAG)
hfrag = &msgp->hfrag;
else if (is_value(ERL_MESSAGE_TERM(msgp)) && msgp->data.heap_frag)
hfrag = msgp->data.heap_frag;
else
continue;
for (; hfrag; hfrag = hfrag->next) {
if (check_mod_funs(rp, &hfrag->off_heap, mod_start, mod_size))
return am_true;
/* Should not contain any literals... */
ASSERT(!any_heap_refs(&hfrag->mem[0],
&hfrag->mem[hfrag->used_size],
literals,
lit_bsize));
}
}
while (1) {
/* Check heap, stack etc... */
if (check_mod_funs(rp, &rp->off_heap, mod_start, mod_size))
goto try_gc;
if (!(flags & ERTS_CPC_COPY_LITERALS)) {
/* Process ok. May contain old literals but we will be called
* again before module is purged.
*/
return am_false;
}
if (any_heap_ref_ptrs(&rp->fvalue, &rp->fvalue+1, literals, lit_bsize)) {
rp->freason = EXC_NULL;
rp->fvalue = NIL;
rp->ftrace = NIL;
}
if (any_heap_ref_ptrs(rp->stop, rp->hend, literals, lit_bsize))
goto try_literal_gc;
if (any_heap_refs(rp->heap, rp->htop, literals, lit_bsize))
goto try_literal_gc;
if (any_heap_refs(rp->old_heap, rp->old_htop, literals, lit_bsize))
goto try_literal_gc;
/* Check dictionary */
if (rp->dictionary) {
Eterm* start = ERTS_PD_START(rp->dictionary);
Eterm* end = start + ERTS_PD_SIZE(rp->dictionary);
if (any_heap_ref_ptrs(start, end, literals, lit_bsize))
goto try_literal_gc;
}
/* Check heap fragments */
for (hfrag = rp->mbuf; hfrag; hfrag = hfrag->next) {
Eterm *hp, *hp_end;
/* Off heap lists should already have been moved into process */
ASSERT(!check_mod_funs(rp, &hfrag->off_heap, mod_start, mod_size));
hp = &hfrag->mem[0];
hp_end = &hfrag->mem[hfrag->used_size];
if (any_heap_refs(hp, hp_end, literals, lit_bsize))
goto try_literal_gc;
}
#ifdef DEBUG
/*
* Message buffer fragments should not have any references
* to literals, and off heap lists should already have
* been moved into process off heap structure.
*/
for (msgp = rp->msg_frag; msgp; msgp = msgp->next) {
if (msgp->data.attached == ERTS_MSG_COMBINED_HFRAG)
hfrag = &msgp->hfrag;
else
hfrag = msgp->data.heap_frag;
for (; hfrag; hfrag = hfrag->next) {
Eterm *hp, *hp_end;
ASSERT(!check_mod_funs(rp, &hfrag->off_heap, mod_start, mod_size));
hp = &hfrag->mem[0];
hp_end = &hfrag->mem[hfrag->used_size];
ASSERT(!any_heap_refs(hp, hp_end, literals, lit_bsize));
}
}
#endif
return am_false;
try_literal_gc:
need_gc |= ERTS_LITERAL_GC__;
try_gc:
need_gc |= ERTS_ORDINARY_GC__;
if ((done_gc & need_gc) == need_gc)
return am_true;
if (!(flags & ERTS_CPC_ALLOW_GC))
return am_aborted;
need_gc &= ~done_gc;
/*
* Try to get rid of literals by by garbage collecting.
* Clear both fvalue and ftrace.
*/
rp->freason = EXC_NULL;
rp->fvalue = NIL;
rp->ftrace = NIL;
if (need_gc & ERTS_ORDINARY_GC__) {
FLAGS(rp) |= F_NEED_FULLSWEEP;
*redsp += erts_garbage_collect_nobump(rp, 0, rp->arg_reg, rp->arity, fcalls);
done_gc |= ERTS_ORDINARY_GC__;
}
if (need_gc & ERTS_LITERAL_GC__) {
struct erl_off_heap_header* oh;
oh = modp->old.code_hdr->literals_off_heap;
*redsp += lit_bsize / 64; /* Need, better value... */
erts_garbage_collect_literals(rp, (Eterm*)literals, lit_bsize, oh);
done_gc |= ERTS_LITERAL_GC__;
}
need_gc = 0;
}
#undef ERTS_ORDINARY_GC__
#undef ERTS_LITERAL_GC__
}
Eterm
erts_proc_copy_literal_area(Process *c_p, int *redsp, int fcalls, int gc_allowed)
{
ErtsLiteralArea *la;
ErtsMessage *msgp;
struct erl_off_heap_header* oh;
char *literals;
Uint lit_bsize;
ErlHeapFragment *hfrag;
la = ERTS_COPY_LITERAL_AREA();
if (!la)
return am_ok;
oh = la->off_heap;
literals = (char *) &la->start[0];
lit_bsize = (char *) la->end - literals;
/*
* 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.
*/
erts_smp_proc_lock(c_p, ERTS_PROC_LOCK_MSGQ);
ERTS_SMP_MSGQ_MV_INQ2PRIVQ(c_p);
erts_smp_proc_unlock(c_p, ERTS_PROC_LOCK_MSGQ);
for (msgp = c_p->msg.first; msgp; msgp = msgp->next) {
ErlHeapFragment *hf;
Uint lit_sz = 0;
*redsp += 1;
if (msgp->data.attached == ERTS_MSG_COMBINED_HFRAG)
hfrag = &msgp->hfrag;
else if (is_value(ERL_MESSAGE_TERM(msgp)) && msgp->data.heap_frag)
hfrag = msgp->data.heap_frag;
else
continue; /* Content on heap or in external term format... */
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;
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;
}
/* link new hfrag last */
ASSERT(hfrag->next == NULL);
hfrag->next = bp;
bp->next = NULL;
}
}
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...
*/
goto literal_gc;
}
*redsp += 2;
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;
}
if (any_heap_ref_ptrs(c_p->stop, c_p->hend, literals, lit_bsize))
goto literal_gc;
*redsp += 1;
#ifdef HIPE
if (nstack_any_heap_ref_ptrs(c_p, literals, lit_bsize))
goto literal_gc;
*redsp += 1;
#endif
if (any_heap_refs(c_p->heap, c_p->htop, literals, lit_bsize))
goto literal_gc;
*redsp += 1;
if (any_heap_refs(c_p->old_heap, c_p->old_htop, literals, lit_bsize))
goto literal_gc;
/* 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);
if (any_heap_ref_ptrs(start, end, literals, lit_bsize))
goto literal_gc;
}
/* Check heap fragments */
for (hfrag = c_p->mbuf; hfrag; hfrag = hfrag->next) {
Eterm *hp, *hp_end;
*redsp += 1;
hp = &hfrag->mem[0];
hp_end = &hfrag->mem[hfrag->used_size];
if (any_heap_refs(hp, hp_end, literals, lit_bsize))
goto literal_gc;
}
/*
* Message buffer fragments (matched messages)
* - off heap lists should already have been moved into
* process off heap structure.
* - Check for literals
*/
for (msgp = c_p->msg_frag; msgp; msgp = msgp->next) {
hfrag = erts_message_to_heap_frag(msgp);
for (; hfrag; hfrag = hfrag->next) {
Eterm *hp, *hp_end;
*redsp += 1;
hp = &hfrag->mem[0];
hp_end = &hfrag->mem[hfrag->used_size];
if (any_heap_refs(hp, hp_end, literals, lit_bsize))
goto literal_gc;
}
}
return am_ok;
literal_gc:
if (!gc_allowed)
return am_need_gc;
if (c_p->flags & F_DISABLE_GC)
return THE_NON_VALUE;
FLAGS(c_p) |= F_NEED_FULLSWEEP;
*redsp += erts_garbage_collect_nobump(c_p, 0, c_p->arg_reg, c_p->arity, fcalls);
erts_garbage_collect_literals(c_p, (Eterm *) literals, lit_bsize, oh);
*redsp += lit_bsize / 64; /* Need, better value... */
return am_ok;
}