LispObj find_symbol_in_range(LispObj *start, LispObj *end, char *name) { LispObj header, tag; int n = strlen(name); char *s = name; lisp_char_code *p; while (start < end) { header = *start; tag = fulltag_of(header); if (header_subtag(header) == subtag_symbol) { LispObj pname = deref(ptr_to_lispobj(start), 1), pname_header = header_of(pname); if ((header_subtag(pname_header) == subtag_simple_base_string) && (header_element_count(pname_header) == n)) { p = (lisp_char_code *) ptr_from_lispobj(pname + misc_data_offset); if (compare_lisp_string_to_c_string(p, s, n) == 0) { return (ptr_to_lispobj(start))+fulltag_misc; } } } if (nodeheader_tag_p(tag)) { start += (~1 & (2 + header_element_count(header))); } else if (immheader_tag_p(tag)) { start = (LispObj *) skip_over_ivector((natural)start, header); } else { start += 2; } } return (LispObj)NULL; }
void add_lisp_base_string(LispObj str) { lisp_char_code *src = (lisp_char_code *) (ptr_from_lispobj(str + misc_data_offset)); natural i, n = header_element_count(header_of(str)); for (i=0; i < n; i++) { add_char((char)(*src++)); } }
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 sprint_symbol(LispObj o) { lispsymbol *rawsym = (lispsymbol *) ptr_from_lispobj(untag(o)); LispObj pname = rawsym->pname, package = rawsym->package_predicate; if (fulltag_of(package) == fulltag_cons) { package = car(package); } if (package == nrs_KEYWORD_PACKAGE.vcell) { add_char(':'); } add_lisp_base_string(pname); }
void plbt_sp(LispObj currentSP) { area *cs_area; { TCR *tcr = (TCR *)get_tcr(true); char *ilevel = interrupt_level_description(tcr); cs_area = tcr->cs_area; if ((((LispObj) ptr_to_lispobj(cs_area->low)) > currentSP) || (((LispObj) ptr_to_lispobj(cs_area->high)) < currentSP)) { Dprintf("\nStack pointer [#x%lX] in unknown area.", currentSP); } else { fprintf(dbgout, "current thread: tcr = 0x%lx, native thread ID = 0x%lx, interrupts %s\n", tcr, tcr->native_thread_id, ilevel); walk_stack_frames((lisp_frame *) ptr_from_lispobj(currentSP), (lisp_frame *) (cs_area->high)); walk_other_areas(); } } }
LispObj find_symbol(char *name) { area *a = ((area *) (ptr_from_lispobj(lisp_global(ALL_AREAS))))->succ; area_code code; LispObj sym = 0; while ((code = a->code) != AREA_VOID) { if ((code == AREA_STATIC) || (code == AREA_DYNAMIC) || (code == AREA_MANAGED_STATIC)) { sym = find_symbol_in_range((LispObj *)(a->low), (LispObj *)(a->active), name); if (sym) { break; } } a = a->succ; } return sym; }
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 }