void
sprint_list(LispObj o, int depth)
{
LispObj the_cdr;
add_char('(');
while(1) {
if (o != lisp_nil) {
sprint_lisp_object(ptr_to_lispobj(car(o)), depth);
the_cdr = ptr_to_lispobj(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(')');
}
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
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();
}
}
}