(lispobj *)pointer));
}
-#if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64)
-
/* Helper for valid_lisp_pointer_p and
* possibly_valid_dynamic_space_pointer.
*
}
break;
case OTHER_POINTER_LOWTAG:
+
+#if !defined(LISP_FEATURE_X86) && !defined(LISP_FEATURE_X86_64)
+ /* The all-architecture test below is good as far as it goes,
+ * but an LRA object is similar to a FUN-POINTER: It is
+ * embedded within a CODE-OBJECT pointed to by start_addr, and
+ * cannot be found by simply walking the heap, therefore we
+ * need to check for it. -- AB, 2010-Jun-04 */
+ if ((widetag_of(start_addr[0]) == CODE_HEADER_WIDETAG)) {
+ lispobj *potential_lra =
+ (lispobj *)(((unsigned long)pointer) - OTHER_POINTER_LOWTAG);
+ if ((widetag_of(potential_lra[0]) == RETURN_PC_HEADER_WIDETAG) &&
+ ((potential_lra - HeaderValue(potential_lra[0])) == start_addr)) {
+ return 1; /* It's as good as we can verify. */
+ }
+ }
+#endif
+
if ((unsigned long)pointer !=
((unsigned long)start_addr+OTHER_POINTER_LOWTAG)) {
if (gencgc_verbose) {
return 0;
}
+#if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64)
+
/* Is there any possibility that pointer is a valid Lisp object
* reference, and/or something else (e.g. subroutine call return
* address) which should prevent us from moving the referred-to thing?
}
#if !defined(LISP_FEATURE_X86) && !defined(LISP_FEATURE_X86_64)
-
static void
-scavenge_control_stack()
+scavenge_control_stack(struct thread *th)
{
unsigned long control_stack_size;
/* This is going to be a big problem when we try to port threads
* to PPC... CLH */
- struct thread *th = arch_os_get_current_thread();
lispobj *control_stack =
(lispobj *)(th->control_stack_start);
control_stack_size = current_control_stack_pointer - control_stack;
scavenge(control_stack, control_stack_size);
}
-
-/* Scavenging Interrupt Contexts */
-
-static int boxed_registers[] = BOXED_REGISTERS;
-
-static void
-scavenge_interrupt_context(os_context_t * context)
-{
- int i;
-
-#ifdef reg_LIP
- unsigned long lip;
- unsigned long lip_offset;
- int lip_register_pair;
-#endif
- unsigned long pc_code_offset;
-
-#ifdef ARCH_HAS_LINK_REGISTER
- unsigned long lr_code_offset;
-#endif
-#ifdef ARCH_HAS_NPC_REGISTER
- unsigned long npc_code_offset;
#endif
-#ifdef reg_LIP
- /* Find the LIP's register pair and calculate it's offset */
- /* before we scavenge the context. */
-
- /*
- * I (RLT) think this is trying to find the boxed register that is
- * closest to the LIP address, without going past it. Usually, it's
- * reg_CODE or reg_LRA. But sometimes, nothing can be found.
- */
- lip = *os_context_register_addr(context, reg_LIP);
- lip_offset = 0x7FFFFFFF;
- lip_register_pair = -1;
- for (i = 0; i < (sizeof(boxed_registers) / sizeof(int)); i++) {
- unsigned long reg;
- long offset;
- int index;
-
- index = boxed_registers[i];
- reg = *os_context_register_addr(context, index);
- if ((reg & ~((1L<<N_LOWTAG_BITS)-1)) <= lip) {
- offset = lip - reg;
- if (offset < lip_offset) {
- lip_offset = offset;
- lip_register_pair = index;
- }
- }
- }
-#endif /* reg_LIP */
-
- /* Compute the PC's offset from the start of the CODE */
- /* register. */
- pc_code_offset = *os_context_pc_addr(context)
- - *os_context_register_addr(context, reg_CODE);
-#ifdef ARCH_HAS_NPC_REGISTER
- npc_code_offset = *os_context_npc_addr(context)
- - *os_context_register_addr(context, reg_CODE);
-#endif /* ARCH_HAS_NPC_REGISTER */
-
-#ifdef ARCH_HAS_LINK_REGISTER
- lr_code_offset =
- *os_context_lr_addr(context) -
- *os_context_register_addr(context, reg_CODE);
-#endif
-
- /* Scanvenge all boxed registers in the context. */
- for (i = 0; i < (sizeof(boxed_registers) / sizeof(int)); i++) {
- int index;
- lispobj foo;
-
- index = boxed_registers[i];
- foo = *os_context_register_addr(context, index);
- scavenge(&foo, 1);
- *os_context_register_addr(context, index) = foo;
-
- scavenge((lispobj*) &(*os_context_register_addr(context, index)), 1);
- }
-
-#ifdef reg_LIP
- /* Fix the LIP */
-
- /*
- * But what happens if lip_register_pair is -1?
- * *os_context_register_addr on Solaris (see
- * solaris_register_address in solaris-os.c) will return
- * &context->uc_mcontext.gregs[2]. But gregs[2] is REG_nPC. Is
- * that what we really want? My guess is that that is not what we
- * want, so if lip_register_pair is -1, we don't touch reg_LIP at
- * all. But maybe it doesn't really matter if LIP is trashed?
- */
- if (lip_register_pair >= 0) {
- *os_context_register_addr(context, reg_LIP) =
- *os_context_register_addr(context, lip_register_pair)
- + lip_offset;
- }
-#endif /* reg_LIP */
-
- /* Fix the PC if it was in from space */
- if (from_space_p(*os_context_pc_addr(context)))
- *os_context_pc_addr(context) =
- *os_context_register_addr(context, reg_CODE) + pc_code_offset;
-
-#ifdef ARCH_HAS_LINK_REGISTER
- /* Fix the LR ditto; important if we're being called from
- * an assembly routine that expects to return using blr, otherwise
- * harmless */
- if (from_space_p(*os_context_lr_addr(context)))
- *os_context_lr_addr(context) =
- *os_context_register_addr(context, reg_CODE) + lr_code_offset;
-#endif
-
-#ifdef ARCH_HAS_NPC_REGISTER
- if (from_space_p(*os_context_npc_addr(context)))
- *os_context_npc_addr(context) =
- *os_context_register_addr(context, reg_CODE) + npc_code_offset;
-#endif /* ARCH_HAS_NPC_REGISTER */
-}
-
-void
-scavenge_interrupt_contexts(void)
-{
- int i, index;
- os_context_t *context;
-
- struct thread *th=arch_os_get_current_thread();
-
- index = fixnum_value(SymbolValue(FREE_INTERRUPT_CONTEXT_INDEX,0));
-
-#if defined(DEBUG_PRINT_CONTEXT_INDEX)
- printf("Number of active contexts: %d\n", index);
-#endif
-
- for (i = 0; i < index; i++) {
- context = th->interrupt_contexts[i];
- scavenge_interrupt_context(context);
- }
-}
-
-#endif
-
-#if defined(LISP_FEATURE_SB_THREAD)
+#if defined(LISP_FEATURE_SB_THREAD) && (defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64))
static void
preserve_context_registers (os_context_t *c)
{
* If not x86, we need to scavenge the interrupt context(s) and the
* control stack.
*/
- scavenge_interrupt_contexts();
- scavenge_control_stack();
+ {
+ struct thread *th;
+ for_each_thread(th) {
+ scavenge_interrupt_contexts(th);
+ scavenge_control_stack(th);
+ }
+
+ /* Scrub the unscavenged control stack space, so that we can't run
+ * into any stale pointers in a later GC (this is done by the
+ * stop-for-gc handler in the other threads). */
+ scrub_control_stack();
+ }
#endif
/* Scavenge the Lisp functions of the interrupt handlers, taking