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 __inline__ void hipe_pop_beam_trap_frame(Process *p)
{
ASSERT(p->stop[1] == hipe_beam_catch_throw);
p->cp = cp_val(p->stop[0]);
--p->catches;
p->stop += 2;
}
static void print_beam_cp(Eterm *pos, Eterm val)
{
printf(" |%s|%s| BEAM ACTIVATION RECORD\r\n", dashes, dashes);
printf(" | 0x%0*lx | 0x%0*lx | BEAM PC ",
2*(int)sizeof(long), (unsigned long)pos,
2*(int)sizeof(long), (unsigned long)val);
print_beam_pc(cp_val(val));
printf("\r\n");
}
static int
stack_element_dump(int to, void *to_arg, 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 (", cp_val(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 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
}
/*
* Entry point called by the trace wrap functions in erl_bif_wrap.c
*
* The trace wrap functions are themselves called through the export
* entries instead of the original BIF functions.
*/
Eterm
erts_bif_trace(int bif_index, Process* p, Eterm* args, BeamInstr* I)
{
Eterm result;
Eterm (*func)(Process*, Eterm*, BeamInstr*);
Export* ep = bif_export[bif_index];
Uint32 flags = 0, flags_meta = 0;
ErtsTracer meta_tracer = erts_tracer_nil;
int applying = (I == &(ep->code[3])); /* Yup, the apply code for a bif
* is actually in the
* export entry */
BeamInstr *cp = p->cp;
GenericBp* g;
GenericBpData* bp = NULL;
Uint bp_flags = 0;
ERTS_SMP_CHK_HAVE_ONLY_MAIN_PROC_LOCK(p);
g = (GenericBp *) ep->fake_op_func_info_for_hipe[1];
if (g) {
bp = &g->data[erts_active_bp_ix()];
bp_flags = bp->flags;
}
/*
* Make continuation pointer OK, it is not during direct BIF calls,
* but it is correct during apply of bif.
*/
if (!applying) {
p->cp = I;
}
if (bp_flags & (ERTS_BPF_LOCAL_TRACE|ERTS_BPF_GLOBAL_TRACE) &&
IS_TRACED_FL(p, F_TRACE_CALLS)) {
int local = !!(bp_flags & ERTS_BPF_LOCAL_TRACE);
flags = erts_call_trace(p, ep->code, bp->local_ms, args,
local, &ERTS_TRACER(p));
}
if (bp_flags & ERTS_BPF_META_TRACE) {
ErtsTracer old_tracer;
meta_tracer = erts_smp_atomic_read_nob(&bp->meta_tracer->tracer);
old_tracer = meta_tracer;
flags_meta = erts_call_trace(p, ep->code, bp->meta_ms, args,
0, &meta_tracer);
if (!ERTS_TRACER_COMPARE(old_tracer, meta_tracer)) {
ErtsTracer new_tracer = erts_tracer_nil;
erts_tracer_update(&new_tracer, meta_tracer);
if (old_tracer == erts_smp_atomic_cmpxchg_acqb(
&bp->meta_tracer->tracer,
(erts_aint_t)new_tracer,
(erts_aint_t)old_tracer)) {
ERTS_TRACER_CLEAR(&old_tracer);
} else {
ERTS_TRACER_CLEAR(&new_tracer);
}
}
}
if (bp_flags & ERTS_BPF_TIME_TRACE_ACTIVE &&
IS_TRACED_FL(p, F_TRACE_CALLS)) {
BeamInstr *pc = (BeamInstr *)ep->code+3;
erts_trace_time_call(p, pc, bp->time);
}
/* Restore original continuation pointer (if changed). */
p->cp = cp;
func = bif_table[bif_index].f;
result = func(p, args, I);
if (applying && (flags & MATCH_SET_RETURN_TO_TRACE)) {
BeamInstr i_return_trace = beam_return_trace[0];
BeamInstr i_return_to_trace = beam_return_to_trace[0];
BeamInstr i_return_time_trace = beam_return_time_trace[0];
Eterm *cpp;
/* Maybe advance cp to skip trace stack frames */
for (cpp = p->stop; ; cp = cp_val(*cpp++)) {
if (*cp == i_return_trace) {
/* Skip stack frame variables */
while (is_not_CP(*cpp)) cpp++;
cpp += 2; /* Skip return_trace parameters */
} else if (*cp == i_return_time_trace) {
/* Skip stack frame variables */
while (is_not_CP(*cpp)) cpp++;
cpp += 1; /* Skip return_time_trace parameters */
} else if (*cp == i_return_to_trace) {
/* A return_to trace message is going to be generated
* by normal means, so we do not have to.
*/
cp = NULL;
break;
} else break;
}
}
/* Try to get these in the order
* they usually appear in normal code... */
if (is_non_value(result)) {
Uint reason = p->freason;
if (reason != TRAP) {
Eterm class;
Eterm value = p->fvalue;
/* Expand error value like in handle_error() */
if (reason & EXF_ARGLIST) {
Eterm *tp;
ASSERT(is_tuple(value));
tp = tuple_val(value);
value = tp[1];
}
if ((reason & EXF_THROWN) && (p->catches <= 0)) {
Eterm *hp = HAlloc(p, 3);
value = TUPLE2(hp, am_nocatch, value);
reason = EXC_ERROR;
}
/* Note: expand_error_value() could theoretically
* allocate on the heap, but not for any error
* returned by a BIF, and it would do no harm,
* just be annoying.
*/
value = expand_error_value(p, reason, value);
class = exception_tag[GET_EXC_CLASS(reason)];
if (flags_meta & MATCH_SET_EXCEPTION_TRACE) {
erts_trace_exception(p, ep->code, class, value,
&meta_tracer);
}
if (flags & MATCH_SET_EXCEPTION_TRACE) {
erts_trace_exception(p, ep->code, class, value,
&ERTS_TRACER(p));
}
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;
}
static __inline__ void hipe_pop_beam_trap_frame(Process *p)
{
p->cp = cp_val(p->stop[0]);
--p->catches;
p->stop += 2;
}
static int
getentry(tcconf_section_t *ts, tcc_entry *te, char *fmt,
va_list args, char **tail)
{
char *f = fmt, *p;
int n = 0;
tclist_item_t *li = NULL;
tcc_value *tv;
va_list ac;
while((p = strchr(f, '%')) != NULL){
void *dest;
int type = 0;
if((tv = tclist_next(te->value.values, &li)) == NULL)
break;
f = p;
if(tv->type == TCC_REF && strcmp(tv->value.string, "NULL")){
tcconf_section_t *rs = tcref(ts);
tcc_entry *re;
int r;
if(!(re = getvalue(rs->sec, tv->value.string, &rs))){
n = -n;
break;
}
#ifdef __va_copy
__va_copy(ac, args);
#else
ac = args;
#endif
r = getentry(ts, re, f, ac, &f);
tcfree(rs);
if(r < 0){
n += -r;
break;
}
n += r;
while(r--)
va_arg(args, void *);
continue;
}
dest = va_arg(args, void *);
f++;
while(!(type & TCC_TYPEMASK) && *f){
switch(*f){
case 's':
type |= TCC_STRING;
break;
case 'd':
case 'i':
type |= TCC_INTEGER;
break;
case 'f':
type |= TCC_FLOAT;
break;
case 'l':
type |= TCC_LONG;
break;
case 'u':
type |= TCC_UNSIGNED;
break;
case 'z':
type |= TCC_IGNORE;
break;
}
f++;
}
if(cp_val(ts, tv, type, dest) < 0){
fprintf(stderr, "Type mismatch in '%s'.\n", te->value.key);
n = -n;
break;
} else {
n++;
}
}
if(tail)
*tail = f;
if(li)
tclist_unlock(te->value.values, li);
return n;
}
static char *
vtostr(char *name, void *_ts)
{
tcconf_section_t *ts = _ts;
tclist_item_t *li = NULL;
tcc_value *tv;
tcc_entry *te;
int l = 0;
char *s = NULL;
char *p = s;
int sp = 0;
#define ext(n) do { \
int o = p - s; \
s = realloc(s, l += n); \
p = s + o; \
} while(0)
tcref(ts);
if(!(te = getvalue(ts->sec, name, &ts)))
return NULL;
while((tv = tclist_next(te->value.values, &li))){
union {
uint64_t i;
double d;
char *s;
} v;
int sl;
cp_val(ts, tv, tv->type | TCC_LONG, &v);
if(sp)
*p++ = ' ';
switch(tv->type & TCC_TYPEMASK){
case TCC_INTEGER:
ext(22);
p += snprintf(p, 22, "%lli", v.i);
break;
case TCC_FLOAT:
ext(40);
p += snprintf(p, 40, "%lf", v.d);
break;
case TCC_REF:
v.s = vtostr(tv->value.string, ts);
case TCC_STRING:
sl = strlen(v.s);
ext(sl + 1);
strcpy(p, v.s);
free(v.s);
p += sl;
break;
}
sp = 1;
}
*p = 0;
#undef ext
tcfree(ts);
return s;
}
Eterm
erts_bif_trace_epilogue(Process *p, Eterm result, int applying,
Export* ep, BeamInstr *cp, Uint32 flags,
Uint32 flags_meta, BeamInstr* I,
ErtsTracer meta_tracer)
{
if (applying && (flags & MATCH_SET_RETURN_TO_TRACE)) {
BeamInstr i_return_trace = beam_return_trace[0];
BeamInstr i_return_to_trace = beam_return_to_trace[0];
BeamInstr i_return_time_trace = beam_return_time_trace[0];
Eterm *cpp;
/* Maybe advance cp to skip trace stack frames */
for (cpp = p->stop; ; cp = cp_val(*cpp++)) {
if (*cp == i_return_trace) {
/* Skip stack frame variables */
while (is_not_CP(*cpp)) cpp++;
cpp += 2; /* Skip return_trace parameters */
} else if (*cp == i_return_time_trace) {
/* Skip stack frame variables */
while (is_not_CP(*cpp)) cpp++;
cpp += 1; /* Skip return_time_trace parameters */
} else if (*cp == i_return_to_trace) {
/* A return_to trace message is going to be generated
* by normal means, so we do not have to.
*/
cp = NULL;
break;
} else break;
}
}
/* Try to get these in the order
* they usually appear in normal code... */
if (is_non_value(result)) {
Uint reason = p->freason;
if (reason != TRAP) {
Eterm class;
Eterm value = p->fvalue;
/* Expand error value like in handle_error() */
if (reason & EXF_ARGLIST) {
Eterm *tp;
ASSERT(is_tuple(value));
tp = tuple_val(value);
value = tp[1];
}
if ((reason & EXF_THROWN) && (p->catches <= 0)) {
Eterm *hp = HAlloc(p, 3);
value = TUPLE2(hp, am_nocatch, value);
reason = EXC_ERROR;
}
/* Note: expand_error_value() could theoretically
* allocate on the heap, but not for any error
* returned by a BIF, and it would do no harm,
* just be annoying.
*/
value = expand_error_value(p, reason, value);
class = exception_tag[GET_EXC_CLASS(reason)];
if (flags_meta & MATCH_SET_EXCEPTION_TRACE) {
erts_trace_exception(p, &ep->info.mfa, class, value,
&meta_tracer);
}
if (flags & MATCH_SET_EXCEPTION_TRACE) {
erts_trace_exception(p, &ep->info.mfa, class, value,
&ERTS_TRACER(p));
}
