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; }