LispObj
find_symbol_in_range(LispObj *start, LispObj *end, char *name)
{
LispObj header;
int n = strlen(name);
char *s = name, *p;
while (start < end) {
header = *start;
if (header_subtag(header) == subtag_symbol) {
LispObj
pname = deref(start, 1),
pname_header = header_of(pname);
if ((header_subtag(pname_header) == subtag_simple_base_string) &&
(header_element_count(pname_header) == n)) {
p = (char *) (pname + misc_data_offset);
if (strncmp(p, s, n) == 0) {
return ((LispObj)start)+fulltag_misc;
}
}
}
if (fulltag_of(header) == fulltag_nodeheader) {
start += (~1 & (2 + header_element_count(header)));
} else if (fulltag_of(header) == fulltag_immheader) {
start = (LispObj *) skip_over_ivector((unsigned)start, header);
} else {
start += 2;
}
}
return (LispObj)NULL;
}
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
sprint_function(LispObj o, int depth)
{
LispObj lfbits, header, name = lisp_nil;
natural elements;
header = header_of(o);
elements = header_element_count(header);
lfbits = deref(o, elements);
if ((lfbits & lfbits_noname_mask) == 0) {
name = deref(o, elements-1);
}
add_c_string("#<");
if (name == lisp_nil) {
add_c_string("Anonymous Function ");
} else {
if (lfbits & lfbits_method_mask) {
LispObj
slot_vector = deref(name,3),
method_name = deref(slot_vector, 6),
method_qualifiers = deref(slot_vector, 2),
method_specializers = deref(slot_vector, 3);
add_c_string("Method-Function ");
sprint_lisp_object(method_name, depth);
add_char(' ');
if (method_qualifiers != lisp_nil) {
if (cdr(method_qualifiers) == lisp_nil) {
sprint_lisp_object(car(method_qualifiers), depth);
} else {
sprint_lisp_object(method_qualifiers, depth);
}
add_char(' ');
}
sprint_specializers_list(method_specializers, depth);
add_char(' ');
} else if (lfbits & lfbits_gfn_mask) {
add_c_string("Generic Function ");
#ifdef X8632
{
LispObj gf_slots = nth_immediate(o, 2);
LispObj gf_name = deref(gf_slots, 2);
sprint_lisp_object(gf_name, depth);
add_char(' ');
}
#endif
} else {
add_c_string("Function ");
sprint_lisp_object(name, depth);
add_char(' ');
}
}
sprint_unsigned_hex(o);
add_char('>');
}
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
sprint_function(LispObj o, int depth)
{
LispObj lfbits, header, name = lisp_nil;
natural elements;
header = header_of(o);
elements = header_element_count(header);
lfbits = deref(o, elements);
if ((lfbits & lfbits_noname_mask) == 0) {
name = deref(o, elements-1);
}
add_c_string("#<");
if (name == lisp_nil) {
add_c_string("Anonymous Function ");
} else {
if (lfbits & lfbits_method_mask) {
if (header_subtag(header_of(name)) == subtag_instance) {
LispObj
slot_vector = deref(name,3),
method_name = deref(slot_vector, 6),
method_qualifiers = deref(slot_vector, 2),
method_specializers = deref(slot_vector, 3);
add_c_string("Method-Function ");
sprint_lisp_object(method_name, depth);
add_char(' ');
if (method_qualifiers != lisp_nil) {
if (cdr(method_qualifiers) == lisp_nil) {
sprint_lisp_object(car(method_qualifiers), depth);
} else {
sprint_lisp_object(method_qualifiers, depth);
}
add_char(' ');
}
sprint_specializers_list(method_specializers, depth);
} else {
sprint_lisp_object(name, depth);
}
add_char(' ');
} else {
add_c_string("Function ");
sprint_lisp_object(name, depth);
add_char(' ');
}
}
sprint_unsigned_hex(o);
add_char('>');
}
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_gvector(LispObj o, int depth)
{
LispObj header = header_of(o);
unsigned
elements = header_element_count(header),
subtag = header_subtag(header);
switch(subtag) {
case subtag_function:
sprint_function(o, depth);
break;
case subtag_symbol:
sprint_symbol(o);
break;
case subtag_struct:
case subtag_istruct:
add_c_string("#<");
sprint_lisp_object(deref(o,1), depth);
add_c_string(" @");
sprint_unsigned_hex(o);
add_c_string(">");
break;
case subtag_simple_vector:
{
int i;
add_c_string("#(");
for(i = 1; i <= elements; i++) {
if (i > 1) {
add_char(' ');
}
sprint_lisp_object(deref(o, i), depth);
}
add_char(')');
break;
}
default:
sprint_random_vector(o, subtag, elements);
break;
}
}
void
sprint_ivector(LispObj o)
{
LispObj header = header_of(o);
unsigned
elements = header_element_count(header),
subtag = header_subtag(header);
switch(subtag) {
case subtag_simple_base_string:
add_char('"');
add_lisp_base_string(o);
add_char('"');
return;
case subtag_bignum:
if (elements == 1) {
sprint_signed_decimal((signed_natural)(deref(o, 1)));
return;
}
if ((elements == 2) && (deref(o, 2) == 0)) {
sprint_unsigned_decimal(deref(o, 1));
return;
}
break;
case subtag_double_float:
break;
case subtag_macptr:
add_c_string("#<MACPTR ");
sprint_unsigned_hex(deref(o,1));
add_c_string(">");
break;
default:
sprint_random_vector(o, subtag, elements);
}
}
