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(')');
}
void
sprint_specializers_list(LispObj o, int depth)
{
LispObj the_cdr, the_car;
add_char('(');
while(1) {
if (o != lisp_nil) {
the_car = car(o);
if (fulltag_of(the_car) == fulltag_misc) {
sprint_lisp_object(deref(deref(the_car,3), 4), depth);
} else {
sprint_lisp_object(the_car, depth);
}
the_cdr = 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(')');
}
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
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
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_specializers_list(LispObj o, int depth)
{
LispObj the_cdr, the_car;
add_char('(');
while(1) {
if (o != lisp_nil) {
the_car = car(o);
if (fulltag_of(the_car) == fulltag_misc) {
LispObj header = header_of(the_car);
unsigned subtag = header_subtag(header);
if (subtag == subtag_instance) {
if (unbox_fixnum(deref(the_car,1)) < (1<<20)) {
sprint_lisp_object(deref(deref(the_car,3), 4), depth);
} else {
/* An EQL specializer */
add_c_string("(EQL ");
sprint_lisp_object(deref(deref(the_car,3), 3), depth);
add_char(')');
}
} else {
sprint_lisp_object(the_car, depth);
}
} else {
sprint_lisp_object(the_car, depth);
}
the_cdr = 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(')');
}
