void
sprint_lisp_object(LispObj o, int depth)
{
if (--depth < 0) {
add_char('#');
} else {
switch (fulltag_of(o)) {
case fulltag_even_fixnum:
case fulltag_odd_fixnum:
sprint_signed_decimal(unbox_fixnum(o));
break;
#ifdef PPC64
case fulltag_immheader_0:
case fulltag_immheader_1:
case fulltag_immheader_2:
case fulltag_immheader_3:
case fulltag_nodeheader_0:
case fulltag_nodeheader_1:
case fulltag_nodeheader_2:
case fulltag_nodeheader_3:
#else
case fulltag_immheader:
case fulltag_nodeheader:
#endif
add_c_string("#<header ? ");
sprint_unsigned_hex(o);
add_c_string(">");
break;
#ifdef PPC64
case fulltag_imm_0:
case fulltag_imm_1:
case fulltag_imm_2:
case fulltag_imm_3:
#else
case fulltag_imm:
#endif
if (o == unbound) {
add_c_string("#<Unbound>");
} else {
if (header_subtag(o) == subtag_character) {
unsigned c = (o >> charcode_shift);
add_c_string("#\\");
if ((c >= ' ') && (c < 0x7f)) {
add_char(c);
} else {
sprintf(numbuf, "%o", c);
add_c_string(numbuf);
}
#ifdef PPC64
} else if (header_subtag(o) == subtag_single_float) {
sprintf(numbuf, "%f", o>>32);
add_c_string(numbuf);
#endif
} else {
void
sprint_unsigned_hex(natural n)
{
int i,
ndigits =
#if WORD_SIZE == 64
16
#else
8
#endif
;
add_c_string("#x");
for (i = 0; i < ndigits; i++) {
add_char(digits[(n>>(4*(ndigits-(i+1))))&15]);
}
}
void
sprint_random_vector(LispObj o, unsigned subtag, natural elements)
{
add_c_string("#<");
sprint_unsigned_decimal(elements);
add_c_string("-element vector subtag = ");
sprintf(numbuf, "%02X @", subtag);
add_c_string(numbuf);
sprint_unsigned_hex(o);
add_c_string(" (");
add_c_string(vector_subtag_name(subtag));
add_c_string(")>");
}
void
sprint_random_vector(LispObj o, unsigned subtag, natural elements)
{
add_c_string("#<");
sprint_unsigned_decimal(elements);
add_c_string("-element vector subtag = #x");
add_char(digits[subtag>>4]);
add_char(digits[subtag&15]);
add_c_string(" @");
sprint_unsigned_hex(o);
add_c_string(" (");
add_c_string(vector_subtag_name(subtag));
add_c_string(")>");
}
void
sprint_symbol(LispObj o)
{
lispsymbol *rawsym = (lispsymbol *) ptr_from_lispobj(untag(o));
LispObj
pname = rawsym->pname,
package = rawsym->package_predicate;
#ifdef PPC64
if (o == lisp_nil) {
add_c_string("()");
return;
}
#endif
if (fulltag_of(package) == fulltag_cons) {
package = car(package);
}
if (package == nrs_KEYWORD_PACKAGE.vcell) {
add_char(':');
}
add_lisp_base_string(pname);
}
void
sprint_tra(LispObj o, int depth)
{
#ifdef X8664
signed sdisp;
unsigned disp = 0;
LispObj f = 0;
if ((*((unsigned short *)o) == RECOVER_FN_FROM_RIP_WORD0) &&
(*((unsigned char *)(o+2)) == RECOVER_FN_FROM_RIP_BYTE2)) {
sdisp = (*(int *) (o+3));
f = RECOVER_FN_FROM_RIP_LENGTH+o+sdisp;
disp = o-f;
}
if (fulltag_of(f) == fulltag_function) {
add_c_string("tagged return address: ");
sprint_function(f, depth);
add_c_string(" + ");
sprint_unsigned_decimal(disp);
} else {
add_c_string("(tra ?) : ");
sprint_unsigned_hex(o);
}
#else
LispObj f = 0;
unsigned disp = 0;
if (*(unsigned char *)o == RECOVER_FN_OPCODE) {
f = (LispObj)(*((natural *)(o + 1)));
disp = o - f;
}
if (f && header_subtag(header_of(f)) == subtag_function) {
add_c_string("tagged return address: ");
sprint_function(f, depth);
add_c_string(" + ");
sprint_unsigned_decimal(disp);
} else {
add_c_string("(tra ?) : ");
sprint_unsigned_hex(o);
}
#endif
}
void
sprint_unsigned_decimal(natural n)
{
sprintf(numbuf, "%lu", n);
add_c_string(numbuf);
}
void
sprint_signed_decimal(signed_natural n)
{
sprintf(numbuf, "%ld", n);
add_c_string(numbuf);
}
void
sprint_lisp_object(LispObj o, int depth)
{
if (--depth < 0) {
add_char('#');
} else {
switch (fulltag_of(o)) {
case fulltag_even_fixnum:
case fulltag_odd_fixnum:
sprint_signed_decimal(unbox_fixnum(o));
break;
#ifdef X8664
case fulltag_immheader_0:
case fulltag_immheader_1:
case fulltag_immheader_2:
case fulltag_nodeheader_0:
case fulltag_nodeheader_1:
#else
case fulltag_immheader:
case fulltag_nodeheader:
#endif
add_c_string("#<header ? ");
sprint_unsigned_hex(o);
add_c_string(">");
break;
#ifdef X8664
case fulltag_imm_0:
case fulltag_imm_1:
#else
case fulltag_imm:
#endif
if (o == unbound) {
add_c_string("#<Unbound>");
} else {
if (header_subtag(o) == subtag_character) {
unsigned c = (o >> charcode_shift);
add_c_string("#\\");
if ((c >= ' ') && (c < 0x7f)) {
add_char(c);
} else {
sprintf(numbuf, "%#o", c);
add_c_string(numbuf);
}
#ifdef X8664
} else if (header_subtag(o) == subtag_single_float) {
LispObj xx = o;
float f = ((float *)&xx)[1];
sprintf(numbuf, "%f", f);
add_c_string(numbuf);
#endif
} else {
add_c_string("#<imm ");
sprint_unsigned_hex(o);
add_c_string(">");
}
}
break;
#ifdef X8664
case fulltag_nil:
#endif
case fulltag_cons:
sprint_list(o, depth);
break;
case fulltag_misc:
sprint_vector(o, depth);
break;
#ifdef X8664
case fulltag_symbol:
sprint_symbol(o);
break;
case fulltag_function:
sprint_function(o, depth);
break;
#endif
#ifdef X8664
case fulltag_tra_0:
case fulltag_tra_1:
#else
case fulltag_tra:
#endif
sprint_tra(o,depth);
break;
}
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;
}
case subtag_instance:
{
LispObj class_or_hash = deref(o,1);
if (tag_of(class_or_hash) == tag_fixnum) {
sprint_random_vector(o, subtag, elements);
} else {
add_c_string("#<CLASS ");
sprint_lisp_object(class_or_hash, depth);
add_c_string(" @");
sprint_unsigned_hex(o);
add_c_string(">");
}
break;
}
default:
sprint_random_vector(o, subtag, elements);
break;
}
}
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 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('>');
}