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(')'); }
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; }
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_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 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_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 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_symbol(LispObj o) { lispsymbol *rawsym = (lispsymbol *) ptr_from_lispobj(untag(o)); LispObj pname = rawsym->pname, package = rawsym->package_predicate; 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 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_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; }