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); } }