static lispobj
trans_sap(lispobj object)
{
gc_assert(is_lisp_pointer(object));
enqueue_sap_pointer(((struct sap *)native_pointer(object))->pointer);
return copy_unboxed_object(object, 2);
}
static inline
int process_pointer_alloc_pair_p (foreign_ref_t foreign, struct foreign_allocation * alloc)
{
#if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64)
lispobj * enclosing;
#endif
if (alloc->type & 1) { // any pointer counts!
// SAP's low bit is cleared, so either it's a preserved pointer
// (and we're scanning roots), or it's not a lisp pointer.
if (scanning_roots_p || !is_lisp_pointer((lispobj)foreign.ptr))
return 1;
}
if (alloc->type & 4) { // pointer to head counts
if (scanning_roots_p) { // we're scanning roots, it's preserved
if (alloc->start == foreign.ptr) return 1;
} else if (!is_lisp_pointer((lispobj)foreign.ptr)) {
// otherwise low bit cleared on SAP addresses
if (((lispobj)alloc->start & (~1UL)) == (lispobj)foreign.ptr)
return 1;
}
}
if (!(alloc->type & 2)) return 0;
/* Lisp-like heap: */
if (!(is_lisp_pointer((lispobj)foreign.ptr)||scanning_roots_p)) return 0;
#if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64)
if (!(enclosing
= gc_search_space(alloc->start, alloc->end - alloc->start, foreign.ptr)))
return 0;
if (!looks_like_valid_lisp_pointer_p(foreign.ptr, enclosing)) return 0;
#endif
return 1;
}
static void
dump_cmd(char **ptr)
{
static char *lastaddr = 0;
static int lastcount = 20;
char *addr = lastaddr;
int count = lastcount, displacement;
int force = 0, decode = 0;
if (more_p(ptr)) {
// you can't both "force" and "decode" - only one or the other,
// or neither
if (!strncmp(*ptr, "-f ", 3)) {
force = 1;
*ptr += 3;
} else if (!strncmp(*ptr, "-d ", 3)) {
decode = 1;
*ptr += 3;
}
addr = parse_addr(ptr, !force);
if (more_p(ptr))
count = parse_number(ptr);
}
if (count == 0) {
printf("COUNT must be non-zero.\n");
return;
}
lastcount = count;
if (count > 0)
displacement = N_WORD_BYTES;
else {
displacement = -N_WORD_BYTES;
count = -count;
}
boolean aligned = ((uword_t)addr & LOWTAG_MASK) == 0;
if (decode && (!aligned || displacement < 0)) {
printf("Sorry, can only decode if aligned and stepping forward\n");
decode = 0;
}
lispobj* next_object = decode ? (lispobj*)addr : 0;
while (count-- > 0) {
#ifndef LISP_FEATURE_ALPHA
printf("%p: ", (os_vm_address_t) addr);
#else
printf("0x%08X: ", (u32) addr);
#endif
if (force || gc_managed_addr_p((lispobj)addr)) {
#ifndef LISP_FEATURE_ALPHA
unsigned long *lptr = (unsigned long *)addr;
#else
u32 *lptr = (u32 *)addr;
#endif
unsigned char *cptr = (unsigned char *)addr;
#if N_WORD_BYTES == 8
printf("0x%016lx | %c%c%c%c%c%c%c%c",
lptr[0],
visible(cptr[0]), visible(cptr[1]),
visible(cptr[2]), visible(cptr[3]),
visible(cptr[4]), visible(cptr[5]),
visible(cptr[6]), visible(cptr[7]));
#else
unsigned short *sptr = (unsigned short *)addr;
printf("0x%08lx 0x%04x 0x%04x "
"0x%02x 0x%02x 0x%02x 0x%02x "
"%c%c"
"%c%c",
lptr[0], sptr[0], sptr[1],
cptr[0], cptr[1], cptr[2], cptr[3],
visible(cptr[0]), visible(cptr[1]),
visible(cptr[2]), visible(cptr[3]));
#endif
#ifdef LISP_FEATURE_GENCGC
if (aligned) {
lispobj ptr = *(lispobj*)addr;
int gen;
if (is_lisp_pointer(ptr) && gc_managed_heap_space_p(ptr)
&& (gen = gc_gen_of(ptr, 99)) != 99) // say that static is 99
if (gen != 99) printf(" | %d", gen);
}
#endif
if (decode && addr == (char*)next_object) {
lispobj word = *addr;
// ensure validity of widetag because crashing with
// "no size function" would be worse than doing nothing
if (word != 0 && !is_lisp_pointer(word)
&& valid_widetag_p(header_widetag(word))) {
printf(" %s", widetag_names[header_widetag(word)>>2]);
next_object += sizetab[header_widetag(word)](next_object);
} else if (is_cons_half(word)) {
