static void
dump_process_info(int to, void *to_arg, Process *p)
{
Eterm* sp;
ErlMessage* mp;
int yreg = -1;
ERTS_SMP_MSGQ_MV_INQ2PRIVQ(p);
if ((p->trace_flags & F_SENSITIVE) == 0 && p->msg.first) {
erts_print(to, to_arg, "=proc_messages:%T\n", p->id);
for (mp = p->msg.first; mp != NULL; mp = mp->next) {
Eterm mesg = ERL_MESSAGE_TERM(mp);
if (is_value(mesg))
dump_element(to, to_arg, mesg);
else
dump_dist_ext(to, to_arg, mp->data.dist_ext);
mesg = ERL_MESSAGE_TOKEN(mp);
erts_print(to, to_arg, ":");
dump_element(to, to_arg, mesg);
erts_print(to, to_arg, "\n");
}
}
if ((p->trace_flags & F_SENSITIVE) == 0) {
if (p->dictionary) {
erts_print(to, to_arg, "=proc_dictionary:%T\n", p->id);
erts_deep_dictionary_dump(to, to_arg,
p->dictionary, dump_element_nl);
}
}
if ((p->trace_flags & F_SENSITIVE) == 0) {
erts_print(to, to_arg, "=proc_stack:%T\n", p->id);
for (sp = p->stop; sp < STACK_START(p); sp++) {
yreg = stack_element_dump(to, to_arg, p, sp, yreg);
}
erts_print(to, to_arg, "=proc_heap:%T\n", p->id);
for (sp = p->stop; sp < STACK_START(p); sp++) {
Eterm term = *sp;
if (!is_catch(term) && !is_CP(term)) {
heap_dump(to, to_arg, term);
}
}
for (mp = p->msg.first; mp != NULL; mp = mp->next) {
Eterm mesg = ERL_MESSAGE_TERM(mp);
if (is_value(mesg))
heap_dump(to, to_arg, mesg);
mesg = ERL_MESSAGE_TOKEN(mp);
heap_dump(to, to_arg, mesg);
}
if (p->dictionary) {
erts_deep_dictionary_dump(to, to_arg, p->dictionary, heap_dump);
}
}
}
static void
stack_trace_dump(int to, void *to_arg, Eterm *sp) {
Eterm x = *sp;
if (is_CP(x)) {
erts_print(to, to_arg, "%p:", sp);
erts_print(to, to_arg, "SReturn addr 0x%X (", cp_val(x));
print_function_from_pc(to, to_arg, cp_val(x));
erts_print(to, to_arg, ")\n");
}
}
static int
stack_element_dump(int to, void *to_arg, Process* p, Eterm* sp, int yreg)
{
Eterm x = *sp;
if (yreg < 0 || is_CP(x)) {
erts_print(to, to_arg, "%p:", sp);
} else {
erts_print(to, to_arg, "y%d:", yreg);
yreg++;
}
if (is_CP(x)) {
erts_print(to, to_arg, "SReturn addr 0x%X (", (Eterm *) x);
print_function_from_pc(to, to_arg, cp_val(x));
erts_print(to, to_arg, ")\n");
yreg = 0;
} else if is_catch(x) {
erts_print(to, to_arg, "SCatch 0x%X (", catch_pc(x));
print_function_from_pc(to, to_arg, catch_pc(x));
erts_print(to, to_arg, ")\n");
} else {
void
dbg_bt(Process* p, Eterm* sp)
{
Eterm* stack = STACK_START(p);
while (sp < stack) {
if (is_CP(*sp)) {
BeamInstr* addr = find_function_from_pc(cp_val(*sp));
if (addr)
erts_fprintf(stderr,
HEXF ": %T:%T/%bpu\n",
addr, (Eterm) addr[0], (Eterm) addr[1], addr[2]);
}
sp++;
}
}
void
dbg_bt(Process* p, Eterm* sp)
{
Eterm* stack = STACK_START(p);
while (sp < stack) {
if (is_CP(*sp)) {
ErtsCodeMFA* cmfa = find_function_from_pc(cp_val(*sp));
if (cmfa)
erts_fprintf(stderr,
HEXF ": %T:%T/%bpu\n",
&cmfa->module, cmfa->module,
cmfa->function, cmfa->arity);
}
sp++;
}
}
static void print_stack(Eterm *sp, Eterm *end)
{
printf(" | %*s | %*s |\r\n",
2+2*(int)sizeof(long), "Address",
2+2*(int)sizeof(long), "Contents");
while (sp < end) {
Eterm val = sp[0];
if (is_CP(val))
print_beam_cp(sp, val);
else if (is_catch(val))
print_catch(sp, val);
else {
printf(" | 0x%0*lx | 0x%0*lx | ",
2*(int)sizeof(long), (unsigned long)sp,
2*(int)sizeof(long), (unsigned long)val);
erts_printf("%.30T", val);
printf("\r\n");
}
sp += 1;
}
printf(" |%s|%s|\r\n", dashes, dashes);
}
static int
pdisplay1(fmtfn_t to, void *to_arg, Process* p, Eterm obj)
{
int i, k;
Eterm* nobj;
if (dcount-- <= 0)
return(1);
if (is_CP(obj)) {
erts_print(to, to_arg, "<cp/header:%0*lX",PTR_SIZE,obj);
return 0;
}
switch (tag_val_def(obj)) {
case NIL_DEF:
erts_print(to, to_arg, "[]");
break;
case ATOM_DEF:
erts_print(to, to_arg, "%T", obj);
break;
case SMALL_DEF:
erts_print(to, to_arg, "%ld", signed_val(obj));
break;
case BIG_DEF:
nobj = big_val(obj);
if (!IN_HEAP(p, nobj)) {
erts_print(to, to_arg, "#<bad big %X>#", obj);
return 1;
}
i = BIG_SIZE(nobj);
if (BIG_SIGN(nobj))
erts_print(to, to_arg, "-#integer(%d) = {", i);
else
erts_print(to, to_arg, "#integer(%d) = {", i);
erts_print(to, to_arg, "%d", BIG_DIGIT(nobj, 0));
for (k = 1; k < i; k++)
erts_print(to, to_arg, ",%d", BIG_DIGIT(nobj, k));
erts_putc(to, to_arg, '}');
break;
case REF_DEF:
case EXTERNAL_REF_DEF: {
Uint32 *ref_num;
erts_print(to, to_arg, "#Ref<%lu", ref_channel_no(obj));
ref_num = ref_numbers(obj);
for (i = ref_no_numbers(obj)-1; i >= 0; i--)
erts_print(to, to_arg, ",%lu", ref_num[i]);
erts_print(to, to_arg, ">");
break;
}
case PID_DEF:
case EXTERNAL_PID_DEF:
erts_print(to, to_arg, "<%lu.%lu.%lu>",
pid_channel_no(obj),
pid_number(obj),
pid_serial(obj));
break;
case PORT_DEF:
case EXTERNAL_PORT_DEF:
erts_print(to, to_arg, "#Port<%lu.%lu>",
port_channel_no(obj),
port_number(obj));
break;
case LIST_DEF:
erts_putc(to, to_arg, '[');
nobj = list_val(obj);
while (1) {
if (!IN_HEAP(p, nobj)) {
erts_print(to, to_arg, "#<bad list %X>", obj);
return 1;
}
if (pdisplay1(to, to_arg, p, *nobj++) != 0)
return(1);
if (is_not_list(*nobj))
break;
erts_putc(to, to_arg, ',');
nobj = list_val(*nobj);
}
if (is_not_nil(*nobj)) {
erts_putc(to, to_arg, '|');
if (pdisplay1(to, to_arg, p, *nobj) != 0)
return(1);
}
erts_putc(to, to_arg, ']');
break;
case TUPLE_DEF:
nobj = tuple_val(obj); /* pointer to arity */
i = arityval(*nobj); /* arity */
erts_putc(to, to_arg, '{');
while (i--) {
if (pdisplay1(to, to_arg, p, *++nobj) != 0) return(1);
if (i >= 1) erts_putc(to, to_arg, ',');
}
erts_putc(to, to_arg, '}');
break;
case FLOAT_DEF: {
FloatDef ff;
GET_DOUBLE(obj, ff);
erts_print(to, to_arg, "%.20e", ff.fd);
}
break;
case BINARY_DEF:
erts_print(to, to_arg, "#Bin");
break;
case MATCHSTATE_DEF:
erts_print(to, to_arg, "#Matchstate");
break;
default:
erts_print(to, to_arg, "unknown object %x", obj);
}
return(0);
}
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__
}
static Eterm
check_process_code(Process* rp, Module* modp)
{
Eterm* start;
char* mod_start;
Uint mod_size;
Eterm* end;
Eterm* sp;
#ifndef HYBRID /* FIND ME! */
ErlFunThing* funp;
int done_gc = 0;
#endif
#define INSIDE(a) (start <= (a) && (a) < end)
if (modp == NULL) { /* Doesn't exist. */
return am_false;
} else if (modp->old_code == NULL) { /* No old code. */
return am_false;
}
/*
* Pick up limits for the module.
*/
start = modp->old_code;
end = (Eterm *)((char *)start + modp->old_code_length);
mod_start = (char *) start;
mod_size = modp->old_code_length;
/*
* Check if current instruction or continuation pointer points into module.
*/
if (INSIDE(rp->i) || INSIDE(rp->cp)) {
return am_true;
}
/*
* Check all continuation pointers stored on the stack.
*/
for (sp = rp->stop; sp < STACK_START(rp); sp++) {
if (is_CP(*sp) && INSIDE(cp_val(*sp))) {
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 && INSIDE(s->pc)) ||
(s->current && INSIDE(s->current))) {
rp->freason = EXC_NULL;
rp->fvalue = NIL;
rp->ftrace = NIL;
} else {
int i;
for (i = 0; i < s->depth; i++) {
if (INSIDE(s->trace[i])) {
rp->freason = EXC_NULL;
rp->fvalue = NIL;
rp->ftrace = NIL;
break;
}
}
}
}
/*
* See if there are funs that refer to the old version of the module.
*/
#ifndef HYBRID /* FIND ME! */
rescan:
for (funp = MSO(rp).funs; funp; funp = funp->next) {
Eterm* fun_code;
fun_code = funp->fe->address;
if (INSIDE((Eterm *) funp->fe->address)) {
if (done_gc) {
return am_true;
} else {
/*
* Try to get rid of this fun by garbage collecting.
* Clear both fvalue and ftrace to make sure they
* don't hold any funs.
*/
rp->freason = EXC_NULL;
rp->fvalue = NIL;
rp->ftrace = NIL;
done_gc = 1;
FLAGS(rp) |= F_NEED_FULLSWEEP;
(void) erts_garbage_collect(rp, 0, rp->arg_reg, rp->arity);
goto rescan;
}
}
}
#endif
/*
* See if there are constants inside the module referenced by the process.
*/
done_gc = 0;
for (;;) {
ErlMessage* mp;
if (any_heap_ref_ptrs(&rp->fvalue, &rp->fvalue+1, mod_start, mod_size)) {
rp->freason = EXC_NULL;
rp->fvalue = NIL;
rp->ftrace = NIL;
}
if (any_heap_ref_ptrs(rp->stop, rp->hend, mod_start, mod_size)) {
goto need_gc;
}
if (any_heap_refs(rp->heap, rp->htop, mod_start, mod_size)) {
goto need_gc;
}
if (any_heap_refs(rp->old_heap, rp->old_htop, mod_start, mod_size)) {
goto need_gc;
}
if (rp->dictionary != NULL) {
Eterm* start = rp->dictionary->data;
Eterm* end = start + rp->dictionary->used;
if (any_heap_ref_ptrs(start, end, mod_start, mod_size)) {
goto need_gc;
}
}
for (mp = rp->msg.first; mp != NULL; mp = mp->next) {
if (any_heap_ref_ptrs(mp->m, mp->m+2, mod_start, mod_size)) {
goto need_gc;
}
}
break;
need_gc:
if (done_gc) {
return am_true;
} else {
Eterm* literals;
Uint lit_size;
/*
* Try to get rid of constants by by garbage collecting.
* Clear both fvalue and ftrace.
*/
rp->freason = EXC_NULL;
rp->fvalue = NIL;
rp->ftrace = NIL;
done_gc = 1;
FLAGS(rp) |= F_NEED_FULLSWEEP;
(void) erts_garbage_collect(rp, 0, rp->arg_reg, rp->arity);
literals = (Eterm *) modp->old_code[MI_LITERALS_START];
lit_size = (Eterm *) modp->old_code[MI_LITERALS_END] - literals;
erts_garbage_collect_literals(rp, literals, lit_size);
}
}
return am_false;
#undef INSIDE
}
static Eterm
check_process_code(Process* rp, Module* modp, int *redsp, int fcalls)
{
BeamInstr* start;
char* mod_start;
Uint mod_size;
Eterm* sp;
#ifdef HIPE
void *nat_start = NULL;
Uint nat_size = 0;
#endif
*redsp += 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;
}
*redsp += (STACK_START(rp) - rp->stop) / 32;
/*
* 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;
}
}
#ifdef HIPE
/*
* Check all continuation pointers stored on the native stack if the module
* has native code.
*/
if (modp->old.hipe_code) {
nat_start = modp->old.hipe_code->text_segment;
nat_size = modp->old.hipe_code->text_segment_size;
if (nat_size && nstack_any_cps_in_segment(rp, nat_start, nat_size)) {
return am_true;
}
}
#endif
/*
* 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;
char *area_start = mod_start;
Uint area_size = mod_size;
#ifdef HIPE
if (rp->freason & EXF_NATIVE) {
area_start = nat_start;
area_size = nat_size;
}
#endif
for (i = 0; i < s->depth; i++) {
if (ErtsInArea(s->trace[i], area_start, area_size)) {
rp->freason = EXC_NULL;
rp->fvalue = NIL;
rp->ftrace = NIL;
break;
}
}
}
}
return am_false;
}
