void
sprint_lisp_object(LispObj o, int depth)
{
if (--depth < 0) {
add_char('#');
} else {
switch (fulltag_of(o)) {
case fulltag_even_fixnum:
case fulltag_odd_fixnum:
sprint_signed_decimal(unbox_fixnum(o));
break;
#ifdef PPC64
case fulltag_immheader_0:
case fulltag_immheader_1:
case fulltag_immheader_2:
case fulltag_immheader_3:
case fulltag_nodeheader_0:
case fulltag_nodeheader_1:
case fulltag_nodeheader_2:
case fulltag_nodeheader_3:
#else
case fulltag_immheader:
case fulltag_nodeheader:
#endif
add_c_string("#<header ? ");
sprint_unsigned_hex(o);
add_c_string(">");
break;
#ifdef PPC64
case fulltag_imm_0:
case fulltag_imm_1:
case fulltag_imm_2:
case fulltag_imm_3:
#else
case fulltag_imm:
#endif
if (o == unbound) {
add_c_string("#<Unbound>");
} else {
if (header_subtag(o) == subtag_character) {
unsigned c = (o >> charcode_shift);
add_c_string("#\\");
if ((c >= ' ') && (c < 0x7f)) {
add_char(c);
} else {
sprintf(numbuf, "%o", c);
add_c_string(numbuf);
}
#ifdef PPC64
} else if (header_subtag(o) == subtag_single_float) {
sprintf(numbuf, "%f", o>>32);
add_c_string(numbuf);
#endif
} else {
void
sprint_specializers_list(LispObj o, int depth)
{
LispObj the_cdr, the_car;
add_char('(');
while(1) {
if (o != lisp_nil) {
the_car = car(o);
if (fulltag_of(the_car) == fulltag_misc) {
LispObj header = header_of(the_car);
unsigned subtag = header_subtag(header);
if (subtag == subtag_instance) {
if (unbox_fixnum(deref(the_car,1)) < (1<<20)) {
sprint_lisp_object(deref(deref(the_car,3), 4), depth);
} else {
/* An EQL specializer */
add_c_string("(EQL ");
sprint_lisp_object(deref(deref(the_car,3), 3), depth);
add_char(')');
}
} else if (subtag == subtag_macptr) {
char *class_name = foreign_class_name(deref(the_car,1));
if (class_name) {
add_c_string(class_name);
} else {
sprint_lisp_object(the_car, depth);
}
} else {
sprint_lisp_object(the_car, depth);
}
} else {
sprint_lisp_object(the_car, depth);
}
the_cdr = cdr(o);
if (the_cdr != lisp_nil) {
add_char(' ');
if (fulltag_of(the_cdr) == fulltag_cons) {
o = the_cdr;
continue;
}
add_c_string(". ");
sprint_lisp_object(the_cdr, depth);
break;
}
}
break;
}
add_char(')');
}
debug_command_return
debug_lisp_registers(ExceptionInformation *xp, siginfo_t *info, int arg)
{
if (lisp_debugger_in_foreign_code == false) {
#ifdef PPC
TCR *xpcontext = (TCR *)ptr_from_lispobj(xpGPR(xp, rcontext));
fprintf(dbgout, "rcontext = 0x%lX ", xpcontext);
if (!active_tcr_p(xpcontext)) {
fprintf(dbgout, "(INVALID)\n");
} else {
fprintf(dbgout, "\nnargs = %d\n", xpGPR(xp, nargs) >> fixnumshift);
show_lisp_register(xp, "fn", fn);
show_lisp_register(xp, "arg_z", arg_z);
show_lisp_register(xp, "arg_y", arg_y);
show_lisp_register(xp, "arg_x", arg_x);
show_lisp_register(xp, "temp0", temp0);
show_lisp_register(xp, "temp1/next_method_context", temp1);
show_lisp_register(xp, "temp2/nfn", temp2);
show_lisp_register(xp, "temp3/fname", temp3);
/* show_lisp_register(xp, "new_fn", new_fn); */
show_lisp_register(xp, "save0", save0);
show_lisp_register(xp, "save1", save1);
show_lisp_register(xp, "save2", save2);
show_lisp_register(xp, "save3", save3);
show_lisp_register(xp, "save4", save4);
show_lisp_register(xp, "save5", save5);
show_lisp_register(xp, "save6", save6);
show_lisp_register(xp, "save7", save7);
}
#endif
#ifdef X8664
show_lisp_register(xp, "arg_z", Iarg_z);
show_lisp_register(xp, "arg_y", Iarg_y);
show_lisp_register(xp, "arg_x", Iarg_x);
fprintf(dbgout,"------\n");
show_lisp_register(xp, "fn", Ifn);
fprintf(dbgout,"------\n");
show_lisp_register(xp, "save0", Isave0);
show_lisp_register(xp, "save1", Isave1);
show_lisp_register(xp, "save2", Isave2);
show_lisp_register(xp, "save3", Isave3);
fprintf(dbgout,"------\n");
show_lisp_register(xp, "temp0", Itemp0);
show_lisp_register(xp, "temp1", Itemp1);
show_lisp_register(xp, "temp2", Itemp2);
fprintf(dbgout,"------\n");
if (tag_of(xpGPR(xp,Inargs)) == tag_fixnum) {
fprintf(dbgout,"%%rcx (nargs) = %ld (maybe)\n", unbox_fixnum(xpGPR(xp,Inargs)&0xffff));
}
#endif
#ifdef X8632
show_lisp_register(xp, "arg_z", Iarg_z);
show_lisp_register(xp, "arg_y", Iarg_y);
fprintf(dbgout,"------\n");
show_lisp_register(xp, "fn", Ifn);
fprintf(dbgout,"------\n");
show_lisp_register(xp, "temp0", Itemp0);
show_lisp_register(xp, "temp1", Itemp1);
fprintf(dbgout,"------\n");
if (tag_of(xpGPR(xp,Inargs)) == tag_fixnum) {
fprintf(dbgout,"%%edx (nargs) = %d (maybe)\n", unbox_fixnum(xpGPR(xp,Inargs)));
}
#endif
#ifdef ARM
TCR *xpcontext = (TCR *)ptr_from_lispobj(xpGPR(xp, rcontext));
fprintf(dbgout, "rcontext = 0x%lX ", xpcontext);
if (!active_tcr_p(xpcontext)) {
fprintf(dbgout, "(INVALID)\n");
} else {
fprintf(dbgout, "\nnargs = %d\n", xpGPR(xp, nargs) >> fixnumshift);
show_lisp_register(xp, "fn", Rfn);
show_lisp_register(xp, "arg_z", arg_z);
show_lisp_register(xp, "arg_y", arg_y);
show_lisp_register(xp, "arg_x", arg_x);
show_lisp_register(xp, "temp0", temp0);
show_lisp_register(xp, "temp1/fname/next_method_context", temp1);
show_lisp_register(xp, "temp2/nfn", temp2);
}
#endif
}
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);
}
}
void
sprint_lisp_object(LispObj o, int depth)
{
if (--depth < 0) {
add_char('#');
} else {
switch (fulltag_of(o)) {
case fulltag_even_fixnum:
case fulltag_odd_fixnum:
sprint_signed_decimal(unbox_fixnum(o));
break;
#ifdef X8664
case fulltag_immheader_0:
case fulltag_immheader_1:
case fulltag_immheader_2:
case fulltag_nodeheader_0:
case fulltag_nodeheader_1:
#else
case fulltag_immheader:
case fulltag_nodeheader:
#endif
add_c_string("#<header ? ");
sprint_unsigned_hex(o);
add_c_string(">");
break;
#ifdef X8664
case fulltag_imm_0:
case fulltag_imm_1:
#else
case fulltag_imm:
#endif
if (o == unbound) {
add_c_string("#<Unbound>");
} else {
if (header_subtag(o) == subtag_character) {
unsigned c = (o >> charcode_shift);
add_c_string("#\\");
if ((c >= ' ') && (c < 0x7f)) {
add_char(c);
} else {
sprintf(numbuf, "%#o", c);
add_c_string(numbuf);
}
#ifdef X8664
} else if (header_subtag(o) == subtag_single_float) {
LispObj xx = o;
float f = ((float *)&xx)[1];
sprintf(numbuf, "%f", f);
add_c_string(numbuf);
#endif
} else {
add_c_string("#<imm ");
sprint_unsigned_hex(o);
add_c_string(">");
}
}
break;
#ifdef X8664
case fulltag_nil:
#endif
case fulltag_cons:
sprint_list(o, depth);
break;
case fulltag_misc:
sprint_vector(o, depth);
break;
#ifdef X8664
case fulltag_symbol:
sprint_symbol(o);
break;
case fulltag_function:
sprint_function(o, depth);
break;
#endif
#ifdef X8664
case fulltag_tra_0:
case fulltag_tra_1:
#else
case fulltag_tra:
#endif
sprint_tra(o,depth);
break;
}
