void
show_lisp_register(ExceptionInformation *xp, char *label, int r)
{
extern char* print_lisp_object(LispObj);
LispObj val = xpGPR(xp, r);
#ifdef PPC
fprintf(dbgout, "r%02d (%s) = %s\n", r, label, print_lisp_object(val));
#endif
#ifdef X8664
fprintf(dbgout, "%%%s (%s) = %s\n",Iregnames[r], label, print_lisp_object(val));
#endif
#ifdef X8632
{
TCR *tcr = get_tcr(false);
char *s;
if (r == REG_EDX && (xpGPR(xp, REG_EFL) & EFL_DF))
s = "marked as unboxed (DF set)";
else if (tcr && (tcr->node_regs_mask & bit_for_regnum(r)) == 0)
s = "marked as unboxed (node_regs_mask)";
else
s = print_lisp_object(val);
fprintf(dbgout, "%%%s (%s) = %s\n", Iregnames[r], label, s);
}
#endif
#ifdef ARM
fprintf(dbgout, "r%02d (%s) = %s\n", r, label, print_lisp_object(val));
#endif
}
void
describe_symbol(LispObj sym)
{
lispsymbol *rawsym = (lispsymbol *)(untag(sym));
LispObj function = rawsym->fcell;
Dprintf("Symbol %s at #x%08X", print_lisp_object(sym), sym);
Dprintf(" value : %s", print_lisp_object(rawsym->vcell));
if (function != nrs_UDF.vcell) {
Dprintf(" function : %s", print_lisp_object(function));
}
}
void
describe_symbol(LispObj sym)
{
lispsymbol *rawsym = (lispsymbol *)ptr_from_lispobj(untag(sym));
LispObj function = rawsym->fcell;
#ifdef fulltag_symbol
sym += (fulltag_symbol-fulltag_misc);
#endif
Dprintf("Symbol %s at #x%llX", print_lisp_object(sym), (long long)sym);
Dprintf(" value : %s", print_lisp_object(rawsym->vcell));
if (function != nrs_UDF.vcell) {
Dprintf(" function : %s", print_lisp_object(function));
}
}
void
print_lisp_frame(lisp_frame *frame)
{
LispObj fun = frame->savefn, pc = frame->savelr;
int delta = 0;
Dl_info info;
char *spname;
if ((fun == 0) || (fun == fulltag_misc)) {
spname = "unknown ?";
#ifndef STATIC
if (dladdr((void *)ptr_from_lispobj(pc), &info)) {
spname = (char *)(info.dli_sname);
#ifdef DARWIN
if (spname[-1] != '_') {
--spname;
}
#endif
}
#endif
#ifdef PPC64
Dprintf("(#x%016lX) #x%016lX : (subprimitive %s)", frame, pc, spname);
#else
Dprintf("(#x%08X) #x%08X : (subprimitive %s)", frame, pc, spname);
#endif
} else {
if ((fulltag_of(fun) != fulltag_misc) ||
(header_subtag(header_of(fun)) != subtag_function)) {
#ifdef PPC64
Dprintf("(#x%016lX) #x%016lX : (not a function!)", frame, pc);
#else
Dprintf("(#x%08X) #x%08X : (not a function!)", frame, pc);
#endif
} else {
LispObj code_vector = deref(fun, 1);
if ((pc >= (code_vector+misc_data_offset)) &&
(pc < ((code_vector+misc_data_offset)+(header_element_count(header_of(code_vector))<<2)))) {
delta = (pc - (code_vector+misc_data_offset));
}
#ifdef PPC64
Dprintf("(#x%016lX) #x%016lX : %s + %d", frame, pc, print_lisp_object(fun), delta);
#else
Dprintf("(#x%08X) #x%08X : %s + %d", frame, pc, print_lisp_object(fun), delta);
#endif
}
}
}
void
plprint(ExceptionInformation *xp, LispObj obj)
{
if (lisp_nil == (LispObj) NULL) {
fprintf(dbgout,"can't find lisp NIL; lisp process not active process ?\n");
} else {
Dprintf("\n%s", print_lisp_object(obj));
}
}
void
describe_arm_uuo(ExceptionInformation *xp)
{
pc program_counter = xpPC(xp);
opcode instruction = *program_counter;
if (IS_UUO(instruction)) {
unsigned format = UUO_FORMAT(instruction);
switch(format) {
case uuo_format_nullary:
case uuo_format_nullary_error:
switch UUOA_field(instruction) {
case 0:
fprintf(dbgout,"alloc_trap\n");
break;
case 1:
fprintf(dbgout,"wrong number of args (%d) to %s\n",xpGPR(xp,nargs)>>node_shift,
print_lisp_object(xpGPR(xp,nfn)));
break;
case 2:
fprintf(dbgout,"gc trap\n");
break;
case 3:
fprintf(dbgout,"debug trap\n");
break;
case 4:
fprintf(dbgout,"deferred interrupt\n");
break;
case 5:
fprintf(dbgout,"deferred suspend\n");
break;
default:
break;
}
break;
case uuo_format_unary_error:
switch (UUO_UNARY_field(instruction)) {
case 0:
case 1:
fprintf(dbgout,"%s is unbound\n", print_lisp_object(xpGPR(xp,UUOA_field(instruction))));
break;
default:
break;
}
default:
break;
}
}
}
void
describe_ppc_illegal(ExceptionInformation *xp)
{
pc where = xpPC(xp);
opcode the_uuo = *where;
Boolean described = false;
if (IS_UUO(the_uuo)) {
unsigned
minor = UUO_MINOR(the_uuo),
errnum = 0x3ff & (the_uuo >> 16);
switch(minor) {
case UUO_INTERR:
switch (errnum) {
case error_udf_call:
fprintf(dbgout, "ERROR: undefined function call: %s\n",
print_lisp_object(xpGPR(xp,fname)));
described = true;
break;
default:
fprintf(dbgout, "ERROR: lisp error %d\n", errnum);
described = true;
break;
}
break;
default:
break;
}
}
if (!described) {
fprintf(dbgout, "Illegal instruction (0x%08x) at 0x%lx\n",
the_uuo, where);
}
}
void
describe_ppc_trap(ExceptionInformation *xp)
{
pc where = xpPC(xp);
opcode the_trap = *where, instr;
int err_arg2, ra, rs;
Boolean identified = false;
if ((the_trap & OP_MASK) == OP(major_opcode_TRI)) {
/* TWI/TDI. If the RA field is "nargs", that means that the
instruction is either a number-of-args check or an
event-poll. Otherwise, the trap is some sort of
typecheck. */
if (RA_field(the_trap) == nargs) {
switch (TO_field(the_trap)) {
case TO_NE:
if (xpGPR(xp, nargs) < D_field(the_trap)) {
fprintf(dbgout, "Too few arguments (no opt/rest)\n");
} else {
fprintf(dbgout, "Too many arguments (no opt/rest)\n");
}
identified = true;
break;
case TO_GT:
fprintf(dbgout, "Event poll !\n");
identified = true;
break;
case TO_HI:
fprintf(dbgout, "Too many arguments (with opt)\n");
identified = true;
break;
case TO_LT:
fprintf(dbgout, "Too few arguments (with opt/rest/key)\n");
identified = true;
break;
default: /* some weird trap, not ours. */
identified = false;
break;
}
} else {
/* A type or boundp trap of some sort. */
switch (TO_field(the_trap)) {
case TO_EQ:
/* Boundp traps are of the form:
treqi rX,unbound
where some preceding instruction is of the form:
lwz/ld rX,symbol.value(rY).
The error message should try to say that rY is unbound. */
if (D_field(the_trap) == unbound) {
#ifdef PPC64
instr = scan_for_instr(LD_instruction(RA_field(the_trap),
unmasked_register,
offsetof(lispsymbol,vcell)-fulltag_misc),
D_RT_IMM_MASK,
where);
#else
instr = scan_for_instr(LWZ_instruction(RA_field(the_trap),
unmasked_register,
offsetof(lispsymbol,vcell)-fulltag_misc),
D_RT_IMM_MASK,
where);
#endif
if (instr) {
ra = RA_field(instr);
if (lisp_reg_p(ra)) {
fprintf(dbgout, "Unbound variable: %s\n",
print_lisp_object(xpGPR(xp,ra)));
identified = true;
}
}
}
break;
case TO_NE:
/* A type check. If the type (the immediate field of the trap
instruction) is a header type, an "lbz
rX,misc_header_offset(rY)" should precede it, in which case
we say that "rY is not of header type <type>." If the type
is not a header type, then rX should have been set by a
preceding "clrlwi rX,rY,29/30". In that case, scan
backwards for an RLWINM instruction that set rX and report
that rY isn't of the indicated type. */
err_arg2 = D_field(the_trap);
if (nodeheader_tag_p(err_arg2) ||
immheader_tag_p(err_arg2)) {
instr = scan_for_instr(LBZ_instruction(RA_field(the_trap),
unmasked_register,
misc_subtag_offset),
D_RT_IMM_MASK,
where);
if (instr) {
ra = RA_field(instr);
if (lisp_reg_p(ra)) {
fprintf(dbgout, "value 0x%lX is not of the expected header type 0x%02X\n", xpGPR(xp, ra), err_arg2);
identified = true;
}
}
} else {
/* Not a header type, look for rlwinm whose RA field matches the_trap's */
instr = scan_for_instr((OP(major_opcode_RLWINM) | (the_trap & RA_MASK)),
(OP_MASK | RA_MASK),
where);
if (instr) {
rs = RS_field(instr);
if (lisp_reg_p(rs)) {
fprintf(dbgout, "value 0x%lX is not of the expected type 0x%02X\n",
xpGPR(xp, rs), err_arg2);
identified = true;
}
}
}
break;
}
}
} else {
/* a "TW <to>,ra,rb" instruction."
twltu sp,rN is stack-overflow on SP.
twgeu rX,rY is subscript out-of-bounds, which was preceded
by an "lwz rM,misc_header_offset(rN)" instruction.
rM may or may not be the same as rY, but no other header
would have been loaded before the trap. */
switch (TO_field(the_trap)) {
case TO_LO:
if (RA_field(the_trap) == sp) {
fprintf(dbgout, "Stack overflow! Run away! Run away!\n");
identified = true;
}
break;
case (TO_HI|TO_EQ):
instr = scan_for_instr(OP(major_opcode_LWZ) | (D_MASK & misc_header_offset),
(OP_MASK | D_MASK),
where);
if (instr) {
ra = RA_field(instr);
if (lisp_reg_p(ra)) {
fprintf(dbgout, "Bad index %d for vector %lX length %d\n",
unbox_fixnum(xpGPR(xp, RA_field(the_trap))),
xpGPR(xp, ra),
unbox_fixnum(xpGPR(xp, RB_field(the_trap))));
identified = true;
}
}
break;
}
}
if (!identified) {
fprintf(dbgout, "Unknown trap: 0x%08x\n", the_trap);
}
}
