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
}