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