X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fruntime%2Fgencgc.c;h=8f6012918048a72553d2bbd6ae17c85f6571cb08;hb=4c09711eca1c33e60ff30a8f47f9c03b429d5994;hp=136e23ea7784ddee04bdb5aeb72f108d1a864d8c;hpb=3be1ab042ab74e008e40626cc6bd5190b27da033;p=sbcl.git diff --git a/src/runtime/gencgc.c b/src/runtime/gencgc.c index 136e23e..8f60129 100644 --- a/src/runtime/gencgc.c +++ b/src/runtime/gencgc.c @@ -50,9 +50,9 @@ #include "genesis/hash-table.h" #include "genesis/instance.h" #include "genesis/layout.h" - -#ifdef LUTEX_WIDETAG -#include "genesis/lutex.h" +#include "gencgc.h" +#if defined(LUTEX_WIDETAG) +#include "pthread-lutex.h" #endif /* forward declarations */ @@ -1071,9 +1071,9 @@ void gc_heap_exhausted_error_or_lose (long available, long requested) { /* Write basic information before doing anything else: if we don't - * call to lisp this is a must, and even if we do there is always the - * danger that we bounce back here before the error has been handled, - * or indeed even printed. + * call to lisp this is a must, and even if we do there is always + * the danger that we bounce back here before the error has been + * handled, or indeed even printed. */ fprintf(stderr, "Heap exhausted during %s: %ld bytes available, %ld requested.\n", gc_active_p ? "garbage collection" : "allocation", available, requested); @@ -1081,14 +1081,23 @@ gc_heap_exhausted_error_or_lose (long available, long requested) /* If we are in GC, or totally out of memory there is no way * to sanely transfer control to the lisp-side of things. */ + struct thread *thread = arch_os_get_current_thread(); print_generation_stats(1); + fprintf(stderr, "GC control variables:\n"); + fprintf(stderr, " *GC-INHIBIT* = %s\n *GC-PENDING* = %s\n", + SymbolValue(GC_INHIBIT,thread)==NIL ? "false" : "true", + SymbolValue(GC_PENDING,thread)==NIL ? "false" : "true"); +#ifdef LISP_FEATURE_SB_THREAD + fprintf(stderr, " *STOP-FOR-GC-PENDING* = %s\n", + SymbolValue(STOP_FOR_GC_PENDING,thread)==NIL ? "false" : "true"); +#endif lose("Heap exhausted, game over."); } else { /* FIXME: assert free_pages_lock held */ thread_mutex_unlock(&free_pages_lock); funcall2(SymbolFunction(HEAP_EXHAUSTED_ERROR), - make_fixnum(available), make_fixnum(requested)); + alloc_number(available), alloc_number(requested)); lose("HEAP-EXHAUSTED-ERROR fell through"); } } @@ -1938,7 +1947,7 @@ reap_lutexes (generation_index_t gen) { while (lutex) { struct lutex *next = lutex->next; if (!lutex->live) { - lutex_destroy(lutex); + lutex_destroy((tagged_lutex_t) lutex); gencgc_unregister_lutex(lutex); } lutex = next; @@ -1997,7 +2006,7 @@ scav_lutex(lispobj *where, lispobj object) static lispobj trans_lutex(lispobj object) { - struct lutex *lutex = native_pointer(object); + struct lutex *lutex = (struct lutex *) native_pointer(object); lispobj copied; size_t words = CEILING(sizeof(struct lutex)/sizeof(lispobj), 2); gc_assert(is_lisp_pointer(object)); @@ -2005,13 +2014,14 @@ trans_lutex(lispobj object) /* Update the links, since the lutex moved in memory. */ if (lutex->next) { - lutex->next->prev = native_pointer(copied); + lutex->next->prev = (struct lutex *) native_pointer(copied); } if (lutex->prev) { - lutex->prev->next = native_pointer(copied); + lutex->prev->next = (struct lutex *) native_pointer(copied); } else { - generations[lutex->gen].lutexes = native_pointer(copied); + generations[lutex->gen].lutexes = + (struct lutex *) native_pointer(copied); } return copied; @@ -2115,37 +2125,30 @@ search_dynamic_space(void *pointer) (lispobj *)pointer)); } -/* 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? - * This is called from preserve_pointers() */ +#if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64) + +/* Helper for valid_lisp_pointer_p and + * possibly_valid_dynamic_space_pointer. + * + * pointer is the pointer to validate, and start_addr is the address + * of the enclosing object. + */ static int -possibly_valid_dynamic_space_pointer(lispobj *pointer) +looks_like_valid_lisp_pointer_p(lispobj *pointer, lispobj *start_addr) { - lispobj *start_addr; - - /* Find the object start address. */ - if ((start_addr = search_dynamic_space(pointer)) == NULL) { - return 0; - } - /* We need to allow raw pointers into Code objects for return * addresses. This will also pick up pointers to functions in code * objects. */ - if (widetag_of(*start_addr) == CODE_HEADER_WIDETAG) { + if (widetag_of(*start_addr) == CODE_HEADER_WIDETAG) /* XXX could do some further checks here */ return 1; - } - /* If it's not a return address then it needs to be a valid Lisp - * pointer. */ if (!is_lisp_pointer((lispobj)pointer)) { return 0; } /* Check that the object pointed to is consistent with the pointer - * low tag. - */ + * low tag. */ switch (lowtag_of((lispobj)pointer)) { case FUN_POINTER_LOWTAG: /* Start_addr should be the enclosing code object, or a closure @@ -2387,7 +2390,46 @@ possibly_valid_dynamic_space_pointer(lispobj *pointer) return 1; } -#if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64) +/* Used by the debugger to validate possibly bogus pointers before + * calling MAKE-LISP-OBJ on them. + * + * FIXME: We would like to make this perfect, because if the debugger + * constructs a reference to a bugs lisp object, and it ends up in a + * location scavenged by the GC all hell breaks loose. + * + * Whereas possibly_valid_dynamic_space_pointer has to be conservative + * and return true for all valid pointers, this could actually be eager + * and lie about a few pointers without bad results... but that should + * be reflected in the name. + */ +int +valid_lisp_pointer_p(lispobj *pointer) +{ + lispobj *start; + if (((start=search_dynamic_space(pointer))!=NULL) || + ((start=search_static_space(pointer))!=NULL) || + ((start=search_read_only_space(pointer))!=NULL)) + return looks_like_valid_lisp_pointer_p(pointer, start); + else + return 0; +} + +/* 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? + * This is called from preserve_pointers() */ +static int +possibly_valid_dynamic_space_pointer(lispobj *pointer) +{ + lispobj *start_addr; + + /* Find the object start address. */ + if ((start_addr = search_dynamic_space(pointer)) == NULL) { + return 0; + } + + return looks_like_valid_lisp_pointer_p(pointer, start_addr); +} /* Adjust large bignum and vector objects. This will adjust the * allocated region if the size has shrunk, and move unboxed objects @@ -2563,8 +2605,6 @@ maybe_adjust_large_object(lispobj *where) return; } -#endif - /* Take a possible pointer to a Lisp object and mark its page in the * page_table so that it will not be relocated during a GC. * @@ -2578,8 +2618,6 @@ maybe_adjust_large_object(lispobj *where) * It is also assumed that the current gc_alloc() region has been * flushed and the tables updated. */ -#if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64) - static void preserve_pointer(void *addr) { @@ -2696,7 +2734,7 @@ preserve_pointer(void *addr) gc_assert(page_table[addr_page_index].dont_move != 0); } -#endif +#endif // defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64) /* If the given page is not write-protected, then scan it for pointers @@ -3822,6 +3860,22 @@ preserve_context_registers (os_context_t *c) preserve_pointer((void*)*os_context_register_addr(c,reg_ESI)); preserve_pointer((void*)*os_context_register_addr(c,reg_EDI)); preserve_pointer((void*)*os_context_pc_addr(c)); +#elif defined LISP_FEATURE_X86_64 + preserve_pointer((void*)*os_context_register_addr(c,reg_RAX)); + preserve_pointer((void*)*os_context_register_addr(c,reg_RCX)); + preserve_pointer((void*)*os_context_register_addr(c,reg_RDX)); + preserve_pointer((void*)*os_context_register_addr(c,reg_RBX)); + preserve_pointer((void*)*os_context_register_addr(c,reg_RSI)); + preserve_pointer((void*)*os_context_register_addr(c,reg_RDI)); + preserve_pointer((void*)*os_context_register_addr(c,reg_R8)); + preserve_pointer((void*)*os_context_register_addr(c,reg_R9)); + preserve_pointer((void*)*os_context_register_addr(c,reg_R10)); + preserve_pointer((void*)*os_context_register_addr(c,reg_R11)); + preserve_pointer((void*)*os_context_register_addr(c,reg_R12)); + preserve_pointer((void*)*os_context_register_addr(c,reg_R13)); + preserve_pointer((void*)*os_context_register_addr(c,reg_R14)); + preserve_pointer((void*)*os_context_register_addr(c,reg_R15)); + preserve_pointer((void*)*os_context_pc_addr(c)); #else #error "preserve_context_registers needs to be tweaked for non-x86 Darwin" #endif @@ -3840,7 +3894,9 @@ garbage_collect_generation(generation_index_t generation, int raise) unsigned long bytes_freed; page_index_t i; unsigned long static_space_size; +#if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64) struct thread *th; +#endif gc_assert(generation <= HIGHEST_NORMAL_GENERATION); /* The oldest generation can't be raised. */