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 } } }
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_vector(LispObj o, int depth) { LispObj header = header_of(o); if (immheader_tag_p(fulltag_of(header))) { sprint_ivector(o); } else { sprint_gvector(o, depth); } }
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 if (subtag == subtag_macptr) { char *class_name = foreign_class_name(deref(the_car,1)); if (class_name) { add_c_string(class_name); } else { sprint_lisp_object(the_car, depth); } } 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(')'); }
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_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 plsym(ExceptionInformation *xp, char *pname) { long address = 0; address = find_symbol(pname); if (address == 0) { Dprintf("Can't find symbol."); return; } if ((fulltag_of(address) == fulltag_misc) && (header_subtag(header_of(address)) == subtag_symbol)){ describe_symbol(address); } else { fprintf(stderr, "Not a symbol.\n"); } return; }
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); } }