X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fruntime%2Fgc-common.c;h=68167601b6211d78b5e6b912ee4e67bea71ff40a;hb=661bcd7d3e0bdc1966f3878fa71d322ffd5927a4;hp=7eb89aec6b6fd5c95d8f9c831fdad1bad294dcfe;hpb=1eb303172df6650de51ad12b993a392681f50c50;p=sbcl.git diff --git a/src/runtime/gc-common.c b/src/runtime/gc-common.c index 7eb89ae..6816760 100644 --- a/src/runtime/gc-common.c +++ b/src/runtime/gc-common.c @@ -52,8 +52,8 @@ #endif #endif -size_t dynamic_space_size = DEFAULT_DYNAMIC_SPACE_SIZE; -size_t thread_control_stack_size = DEFAULT_CONTROL_STACK_SIZE; +os_vm_size_t dynamic_space_size = DEFAULT_DYNAMIC_SPACE_SIZE; +os_vm_size_t thread_control_stack_size = DEFAULT_CONTROL_STACK_SIZE; inline static boolean forwarding_pointer_p(lispobj *pointer) { @@ -90,33 +90,25 @@ lispobj (*transother[256])(lispobj object); long (*sizetab[256])(lispobj *where); struct weak_pointer *weak_pointers; -unsigned long bytes_consed_between_gcs = 12*1024*1024; - +os_vm_size_t bytes_consed_between_gcs = 12*1024*1024; /* * copying objects */ +/* gc_general_copy_object is inline from gc-internal.h */ + /* to copy a boxed object */ lispobj copy_object(lispobj object, long nwords) { - int tag; - lispobj *new; - - gc_assert(is_lisp_pointer(object)); - gc_assert(from_space_p(object)); - gc_assert((nwords & 0x01) == 0); - - /* Get tag of object. */ - tag = lowtag_of(object); - - /* Allocate space. */ - new = gc_general_alloc(nwords*N_WORD_BYTES,ALLOC_BOXED,ALLOC_QUICK); + return gc_general_copy_object(object, nwords, BOXED_PAGE_FLAG); +} - /* Copy the object. */ - memcpy(new,native_pointer(object),nwords*N_WORD_BYTES); - return make_lispobj(new,tag); +lispobj +copy_code_object(lispobj object, long nwords) +{ + return gc_general_copy_object(object, nwords, CODE_PAGE_FLAG); } static long scav_lose(lispobj *where, lispobj object); /* forward decl */ @@ -268,7 +260,7 @@ trans_code(struct code *code) nwords = ncode_words + nheader_words; nwords = CEILING(nwords, 2); - l_new_code = copy_object(l_code, nwords); + l_new_code = copy_code_object(l_code, nwords); new_code = (struct code *) native_pointer(l_new_code); #if defined(DEBUG_CODE_GC) @@ -370,7 +362,7 @@ scav_code_header(lispobj *where, lispobj object) scavenge(&function_ptr->name, 1); scavenge(&function_ptr->arglist, 1); scavenge(&function_ptr->type, 1); - scavenge(&function_ptr->xrefs, 1); + scavenge(&function_ptr->info, 1); } return n_words; @@ -552,7 +544,7 @@ trans_list(lispobj object) /* Copy 'object'. */ new_cons = (struct cons *) - gc_general_alloc(sizeof(struct cons),ALLOC_BOXED,ALLOC_QUICK); + gc_general_alloc(sizeof(struct cons), BOXED_PAGE_FLAG, ALLOC_QUICK); new_cons->car = cons->car; new_cons->cdr = cons->cdr; /* updated later */ new_list_pointer = make_lispobj(new_cons,lowtag_of(object)); @@ -577,7 +569,7 @@ trans_list(lispobj object) /* Copy 'cdr'. */ new_cdr_cons = (struct cons*) - gc_general_alloc(sizeof(struct cons),ALLOC_BOXED,ALLOC_QUICK); + gc_general_alloc(sizeof(struct cons), BOXED_PAGE_FLAG, ALLOC_QUICK); new_cdr_cons->car = cdr_cons->car; new_cdr_cons->cdr = cdr_cons->cdr; new_cdr = make_lispobj(new_cdr_cons, lowtag_of(cdr)); @@ -1873,7 +1865,7 @@ scav_lose(lispobj *where, lispobj object) { lose("no scavenge function for object 0x%08x (widetag 0x%x)\n", (unsigned long)object, - widetag_of(*(lispobj*)native_pointer(object))); + widetag_of(*where)); return 0; /* bogus return value to satisfy static type checking */ } @@ -1892,7 +1884,7 @@ size_lose(lispobj *where) { lose("no size function for object at 0x%08x (widetag 0x%x)\n", (unsigned long)where, - widetag_of(LOW_WORD(where))); + widetag_of(*where)); return 1; /* bogus return value to satisfy static type checking */ } @@ -1904,7 +1896,7 @@ size_lose(lispobj *where) void gc_init_tables(void) { - unsigned long i; + unsigned long i, j; /* Set default value in all slots of scavenge table. FIXME * replace this gnarly sizeof with something based on @@ -1919,11 +1911,14 @@ gc_init_tables(void) */ for (i = 0; i < (1<<(N_WIDETAG_BITS-N_LOWTAG_BITS)); i++) { - scavtab[EVEN_FIXNUM_LOWTAG|(i<= hard_guard_page_address)) || + (((os_vm_address_t)sp < (guard_page_address + os_vm_page_size)) && + ((os_vm_address_t)sp >= guard_page_address) && + (th->control_stack_guard_page_protected != NIL))) + return; +#ifdef LISP_FEATURE_STACK_GROWS_DOWNWARD_NOT_UPWARD + do { + *sp = 0; + } while (((unsigned long)sp--) & (BYTES_ZERO_BEFORE_END - 1)); + if ((os_vm_address_t)sp < (hard_guard_page_address + os_vm_page_size)) + return; + do { + if (*sp) + goto scrub; + } while (((unsigned long)sp--) & (BYTES_ZERO_BEFORE_END - 1)); +#else + do { + *sp = 0; + } while (((unsigned long)++sp) & (BYTES_ZERO_BEFORE_END - 1)); + if ((os_vm_address_t)sp >= hard_guard_page_address) + return; + do { + if (*sp) + goto scrub; + } while (((unsigned long)++sp) & (BYTES_ZERO_BEFORE_END - 1)); +#endif +#endif /* LISP_FEATURE_C_STACK_IS_CONTROL_STACK */ +} + +#if !defined(LISP_FEATURE_X86) && !defined(LISP_FEATURE_X86_64) + +void +scavenge_control_stack(struct thread *th) +{ + lispobj *object_ptr; + + /* In order to properly support dynamic-extent allocation of + * non-CONS objects, the control stack requires special handling. + * Rather than calling scavenge() directly, grovel over it fixing + * broken hearts, scavenging pointers to oldspace, and pitching a + * fit when encountering unboxed data. This prevents stray object + * headers from causing the scavenger to blow past the end of the + * stack (an error case checked in scavenge()). We don't worry + * about treating unboxed words as boxed or vice versa, because + * the compiler isn't allowed to store unboxed objects on the + * control stack. -- AB, 2011-Dec-02 */ + + for (object_ptr = th->control_stack_start; + object_ptr < access_control_stack_pointer(th); + object_ptr++) { + + lispobj object = *object_ptr; +#ifdef LISP_FEATURE_GENCGC + if (forwarding_pointer_p(object_ptr)) + lose("unexpected forwarding pointer in scavenge_control_stack: %p, start=%p, end=%p\n", + object_ptr, th->control_stack_start, access_control_stack_pointer(th)); +#endif + if (is_lisp_pointer(object) && from_space_p(object)) { + /* It currently points to old space. Check for a + * forwarding pointer. */ + lispobj *ptr = native_pointer(object); + if (forwarding_pointer_p(ptr)) { + /* Yes, there's a forwarding pointer. */ + *object_ptr = LOW_WORD(forwarding_pointer_value(ptr)); + } else { + /* Scavenge that pointer. */ + long n_words_scavenged = + (scavtab[widetag_of(object)])(object_ptr, object); + gc_assert(n_words_scavenged == 1); + } + } else if (scavtab[widetag_of(object)] == scav_lose) { + lose("unboxed object in scavenge_control_stack: %p->%x, start=%p, end=%p\n", + object_ptr, object, th->control_stack_start, access_control_stack_pointer(th)); + } + } +} + +/* Scavenging Interrupt Contexts */ + +static int boxed_registers[] = BOXED_REGISTERS; + +/* The GC has a notion of an "interior pointer" register, an unboxed + * register that typically contains a pointer to inside an object + * referenced by another pointer. The most obvious of these is the + * program counter, although many compiler backends define a "Lisp + * Interior Pointer" register known to the runtime as reg_LIP, and + * various CPU architectures have other registers that also partake of + * the interior-pointer nature. As the code for pairing an interior + * pointer value up with its "base" register, and fixing it up after + * scavenging is complete is horribly repetitive, a few macros paper + * over the monotony. --AB, 2010-Jul-14 */ + +/* These macros are only ever used over a lexical environment which + * defines a pointer to an os_context_t called context, thus we don't + * bother to pass that context in as a parameter. */ + +/* Define how to access a given interior pointer. */ +#define ACCESS_INTERIOR_POINTER_pc \ + *os_context_pc_addr(context) +#define ACCESS_INTERIOR_POINTER_lip \ + *os_context_register_addr(context, reg_LIP) +#define ACCESS_INTERIOR_POINTER_lr \ + *os_context_lr_addr(context) +#define ACCESS_INTERIOR_POINTER_npc \ + *os_context_npc_addr(context) +#define ACCESS_INTERIOR_POINTER_ctr \ + *os_context_ctr_addr(context) + +#define INTERIOR_POINTER_VARS(name) \ + unsigned long name##_offset; \ + int name##_register_pair + +#define PAIR_INTERIOR_POINTER(name) \ + pair_interior_pointer(context, \ + ACCESS_INTERIOR_POINTER_##name, \ + &name##_offset, \ + &name##_register_pair) + +/* One complexity here is that if a paired register is not found for + * an interior pointer, then that pointer does not get updated. + * Originally, there was some commentary about using an index of -1 + * when calling os_context_register_addr() on SPARC referring to the + * program counter, but the real reason is to allow an interior + * pointer register to point to the runtime, read-only space, or + * static space without problems. */ +#define FIXUP_INTERIOR_POINTER(name) \ + do { \ + if (name##_register_pair >= 0) { \ + ACCESS_INTERIOR_POINTER_##name = \ + (*os_context_register_addr(context, \ + name##_register_pair) \ + & ~LOWTAG_MASK) \ + + name##_offset; \ + } \ + } while (0) + + +static void +pair_interior_pointer(os_context_t *context, unsigned long pointer, + unsigned long *saved_offset, int *register_pair) +{ + int i; + + /* + * 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. + */ + /* 0x7FFFFFFF on 32-bit platforms; + 0x7FFFFFFFFFFFFFFF on 64-bit platforms */ + *saved_offset = (((unsigned long)1) << (N_WORD_BITS - 1)) - 1; + *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); + + /* An interior pointer is never relative to a non-pointer + * register (an oversight in the original implementation). + * The simplest argument for why this is true is to consider + * the fixnum that happens by coincide to be the word-index in + * memory of the header for some object plus two. This is + * happenstance would cause the register containing the fixnum + * to be selected as the register_pair if the interior pointer + * is to anywhere after the first two words of the object. + * The fixnum won't be changed during GC, but the object might + * move, thus destroying the interior pointer. --AB, + * 2010-Jul-14 */ + + if (is_lisp_pointer(reg) && + ((reg & ~LOWTAG_MASK) <= pointer)) { + offset = pointer - (reg & ~LOWTAG_MASK); + if (offset < *saved_offset) { + *saved_offset = offset; + *register_pair = index; + } + } + } +} + +static void +scavenge_interrupt_context(os_context_t * context) +{ + int i; + + /* FIXME: The various #ifdef noise here is precisely that: noise. + * Is it possible to fold it into the macrology so that we have + * one set of #ifdefs and then INTERIOR_POINTER_VARS /et alia/ + * compile out for the registers that don't exist on a given + * platform? */ + + INTERIOR_POINTER_VARS(pc); +#ifdef reg_LIP + INTERIOR_POINTER_VARS(lip); +#endif +#ifdef ARCH_HAS_LINK_REGISTER + INTERIOR_POINTER_VARS(lr); +#endif +#ifdef ARCH_HAS_NPC_REGISTER + INTERIOR_POINTER_VARS(npc); +#endif +#ifdef LISP_FEATURE_PPC + INTERIOR_POINTER_VARS(ctr); +#endif + + PAIR_INTERIOR_POINTER(pc); +#ifdef reg_LIP + PAIR_INTERIOR_POINTER(lip); +#endif +#ifdef ARCH_HAS_LINK_REGISTER + PAIR_INTERIOR_POINTER(lr); +#endif +#ifdef ARCH_HAS_NPC_REGISTER + PAIR_INTERIOR_POINTER(npc); +#endif +#ifdef LISP_FEATURE_PPC + PAIR_INTERIOR_POINTER(ctr); +#endif + + /* Scavenge 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; + + /* this is unlikely to work as intended on bigendian + * 64 bit platforms */ + + scavenge((lispobj *) os_context_register_addr(context, index), 1); + } + + /* Now that the scavenging is done, repair the various interior + * pointers. */ + FIXUP_INTERIOR_POINTER(pc); +#ifdef reg_LIP + FIXUP_INTERIOR_POINTER(lip); +#endif +#ifdef ARCH_HAS_LINK_REGISTER + FIXUP_INTERIOR_POINTER(lr); +#endif +#ifdef ARCH_HAS_NPC_REGISTER + FIXUP_INTERIOR_POINTER(npc); +#endif +#ifdef LISP_FEATURE_PPC + FIXUP_INTERIOR_POINTER(ctr); +#endif +} + +void +scavenge_interrupt_contexts(struct thread *th) +{ + int i, index; + os_context_t *context; + + index = fixnum_value(SymbolValue(FREE_INTERRUPT_CONTEXT_INDEX,th)); + +#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 /* x86oid targets */