X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fruntime%2Fgencgc.c;h=37b8b8ecc9467c7887572a2f96cb00ec4ba56587;hb=2cb068e245e00505076e9c325424df2a1260bfb1;hp=c8c6919f23178281dec432d4fd052e99d2f497c8;hpb=88cc2f72774202503588331fddd1592ae8546de1;p=sbcl.git diff --git a/src/runtime/gencgc.c b/src/runtime/gencgc.c index c8c6919..37b8b8e 100644 --- a/src/runtime/gencgc.c +++ b/src/runtime/gencgc.c @@ -1,5 +1,5 @@ /* - * GENerational Conservative Garbage Collector for SBCL x86 + * GENerational Conservative Garbage Collector for SBCL */ /* @@ -24,6 +24,7 @@ * . */ +#include #include #include #include @@ -159,21 +160,16 @@ boolean gc_active_p = 0; * saving a core), don't scan the stack / mark pages dont_move. */ static boolean conservative_stack = 1; -/* An array of page structures is statically allocated. +/* An array of page structures is allocated on gc initialization. * This helps quickly map between an address its page structure. - * NUM_PAGES is set from the size of the dynamic space. */ -struct page page_table[NUM_PAGES]; + * page_table_pages is set from the size of the dynamic space. */ +unsigned page_table_pages; +struct page *page_table; /* To map addresses to page structures the address of the first page * is needed. */ static void *heap_base = NULL; -#if N_WORD_BITS == 32 - #define SIMPLE_ARRAY_WORD_WIDETAG SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG -#elif N_WORD_BITS == 64 - #define SIMPLE_ARRAY_WORD_WIDETAG SIMPLE_ARRAY_UNSIGNED_BYTE_64_WIDETAG -#endif - /* Calculate the start address for the given page number. */ inline void * page_address(page_index_t page_num) @@ -190,7 +186,7 @@ find_page_index(void *addr) if (index >= 0) { index = ((unsigned long)index)/PAGE_BYTES; - if (index < NUM_PAGES) + if (index < page_table_pages) return (index); } @@ -1121,11 +1117,11 @@ gc_find_freeish_pages(page_index_t *restart_page_ptr, long nbytes, int unboxed) do { first_page = restart_page; if (large_p) - while ((first_page < NUM_PAGES) + while ((first_page < page_table_pages) && (page_table[first_page].allocated != FREE_PAGE_FLAG)) first_page++; else - while (first_page < NUM_PAGES) { + while (first_page < page_table_pages) { if(page_table[first_page].allocated == FREE_PAGE_FLAG) break; if((page_table[first_page].allocated == @@ -1140,7 +1136,7 @@ gc_find_freeish_pages(page_index_t *restart_page_ptr, long nbytes, int unboxed) first_page++; } - if (first_page >= NUM_PAGES) + if (first_page >= page_table_pages) gc_heap_exhausted_error_or_lose(0, nbytes); gc_assert(page_table[first_page].write_protected == 0); @@ -1150,7 +1146,7 @@ gc_find_freeish_pages(page_index_t *restart_page_ptr, long nbytes, int unboxed) num_pages = 1; while (((bytes_found < nbytes) || (!large_p && (num_pages < 2))) - && (last_page < (NUM_PAGES-1)) + && (last_page < (page_table_pages-1)) && (page_table[last_page+1].allocated == FREE_PAGE_FLAG)) { last_page++; num_pages++; @@ -1163,10 +1159,10 @@ gc_find_freeish_pages(page_index_t *restart_page_ptr, long nbytes, int unboxed) gc_assert(bytes_found == region_size); restart_page = last_page + 1; - } while ((restart_page < NUM_PAGES) && (bytes_found < nbytes)); + } while ((restart_page < page_table_pages) && (bytes_found < nbytes)); /* Check for a failure */ - if ((restart_page >= NUM_PAGES) && (bytes_found < nbytes)) + if ((restart_page >= page_table_pages) && (bytes_found < nbytes)) gc_heap_exhausted_error_or_lose(bytes_found, nbytes); *restart_page_ptr=first_page; @@ -1858,237 +1854,6 @@ trans_unboxed_large(lispobj object) /* - * vector-like objects - */ - - -/* FIXME: What does this mean? */ -int gencgc_hash = 1; - -#if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64) - -static long -scav_vector(lispobj *where, lispobj object) -{ - unsigned long kv_length; - lispobj *kv_vector; - unsigned long length = 0; /* (0 = dummy to stop GCC warning) */ - struct hash_table *hash_table; - lispobj empty_symbol; - unsigned long *index_vector = NULL; /* (NULL = dummy to stop GCC warning) */ - unsigned long *next_vector = NULL; /* (NULL = dummy to stop GCC warning) */ - unsigned long *hash_vector = NULL; /* (NULL = dummy to stop GCC warning) */ - lispobj weak_p_obj; - unsigned long next_vector_length = 0; - - /* FIXME: A comment explaining this would be nice. It looks as - * though SB-VM:VECTOR-VALID-HASHING-SUBTYPE is set for EQ-based - * hash tables in the Lisp HASH-TABLE code, and nowhere else. */ - if (HeaderValue(object) != subtype_VectorValidHashing) - return 1; - - if (!gencgc_hash) { - /* This is set for backward compatibility. FIXME: Do we need - * this any more? */ - *where = - (subtype_VectorMustRehash<header) != INSTANCE_HEADER_WIDETAG) { - lose("hash table not instance (%x at %x)\n", - hash_table->header, - hash_table); - } - - /* Scavenge element 1, which should be some internal symbol that - * the hash table code reserves for marking empty slots. */ - scavenge(where+3, 1); - if (!is_lisp_pointer(where[3])) { - lose("not empty-hash-table-slot symbol pointer: %x\n", where[3]); - } - empty_symbol = where[3]; - /* fprintf(stderr,"* empty_symbol = %x\n", empty_symbol);*/ - if (widetag_of(*(lispobj *)native_pointer(empty_symbol)) != - SYMBOL_HEADER_WIDETAG) { - lose("not a symbol where empty-hash-table-slot symbol expected: %x\n", - *(lispobj *)native_pointer(empty_symbol)); - } - - /* Scavenge hash table, which will fix the positions of the other - * needed objects. */ - scavenge((lispobj *)hash_table, - sizeof(struct hash_table) / sizeof(lispobj)); - - /* Cross-check the kv_vector. */ - if (where != (lispobj *)native_pointer(hash_table->table)) { - lose("hash_table table!=this table %x\n", hash_table->table); - } - - /* WEAK-P */ - weak_p_obj = hash_table->weak_p; - - /* index vector */ - { - lispobj index_vector_obj = hash_table->index_vector; - - if (is_lisp_pointer(index_vector_obj) && - (widetag_of(*(lispobj *)native_pointer(index_vector_obj)) == - SIMPLE_ARRAY_WORD_WIDETAG)) { - index_vector = - ((unsigned long *)native_pointer(index_vector_obj)) + 2; - /*FSHOW((stderr, "/index_vector = %x\n",index_vector));*/ - length = fixnum_value(((lispobj *)native_pointer(index_vector_obj))[1]); - /*FSHOW((stderr, "/length = %d\n", length));*/ - } else { - lose("invalid index_vector %x\n", index_vector_obj); - } - } - - /* next vector */ - { - lispobj next_vector_obj = hash_table->next_vector; - - if (is_lisp_pointer(next_vector_obj) && - (widetag_of(*(lispobj *)native_pointer(next_vector_obj)) == - SIMPLE_ARRAY_WORD_WIDETAG)) { - next_vector = ((unsigned long *)native_pointer(next_vector_obj)) + 2; - /*FSHOW((stderr, "/next_vector = %x\n", next_vector));*/ - next_vector_length = fixnum_value(((lispobj *)native_pointer(next_vector_obj))[1]); - /*FSHOW((stderr, "/next_vector_length = %d\n", next_vector_length));*/ - } else { - lose("invalid next_vector %x\n", next_vector_obj); - } - } - - /* maybe hash vector */ - { - lispobj hash_vector_obj = hash_table->hash_vector; - - if (is_lisp_pointer(hash_vector_obj) && - (widetag_of(*(lispobj *)native_pointer(hash_vector_obj)) == - SIMPLE_ARRAY_WORD_WIDETAG)){ - hash_vector = - ((unsigned long *)native_pointer(hash_vector_obj)) + 2; - /*FSHOW((stderr, "/hash_vector = %x\n", hash_vector));*/ - gc_assert(fixnum_value(((lispobj *)native_pointer(hash_vector_obj))[1]) - == next_vector_length); - } else { - hash_vector = NULL; - /*FSHOW((stderr, "/no hash_vector: %x\n", hash_vector_obj));*/ - } - } - - /* These lengths could be different as the index_vector can be a - * different length from the others, a larger index_vector could help - * reduce collisions. */ - gc_assert(next_vector_length*2 == kv_length); - - /* now all set up.. */ - - /* Work through the KV vector. */ - { - long i; - for (i = 1; i < next_vector_length; i++) { - lispobj old_key = kv_vector[2*i]; - -#if N_WORD_BITS == 32 - unsigned long old_index = (old_key & 0x1fffffff)%length; -#elif N_WORD_BITS == 64 - unsigned long old_index = (old_key & 0x1fffffffffffffff)%length; -#endif - - /* Scavenge the key and value. */ - scavenge(&kv_vector[2*i],2); - - /* Check whether the key has moved and is EQ based. */ - { - lispobj new_key = kv_vector[2*i]; -#if N_WORD_BITS == 32 - unsigned long new_index = (new_key & 0x1fffffff)%length; -#elif N_WORD_BITS == 64 - unsigned long new_index = (new_key & 0x1fffffffffffffff)%length; -#endif - - if ((old_index != new_index) && - ((!hash_vector) || - (hash_vector[i] == MAGIC_HASH_VECTOR_VALUE)) && - ((new_key != empty_symbol) || - (kv_vector[2*i] != empty_symbol))) { - - /*FSHOW((stderr, - "* EQ key %d moved from %x to %x; index %d to %d\n", - i, old_key, new_key, old_index, new_index));*/ - - if (index_vector[old_index] != 0) { - /*FSHOW((stderr, "/P1 %d\n", index_vector[old_index]));*/ - - /* Unlink the key from the old_index chain. */ - if (index_vector[old_index] == i) { - /*FSHOW((stderr, "/P2a %d\n", next_vector[i]));*/ - index_vector[old_index] = next_vector[i]; - /* Link it into the needing rehash chain. */ - next_vector[i] = fixnum_value(hash_table->needing_rehash); - hash_table->needing_rehash = make_fixnum(i); - /*SHOW("P2");*/ - } else { - unsigned long prior = index_vector[old_index]; - unsigned long next = next_vector[prior]; - - /*FSHOW((stderr, "/P3a %d %d\n", prior, next));*/ - - while (next != 0) { - /*FSHOW((stderr, "/P3b %d %d\n", prior, next));*/ - if (next == i) { - /* Unlink it. */ - next_vector[prior] = next_vector[next]; - /* Link it into the needing rehash - * chain. */ - next_vector[next] = - fixnum_value(hash_table->needing_rehash); - hash_table->needing_rehash = make_fixnum(next); - /*SHOW("/P3");*/ - break; - } - prior = next; - next = next_vector[next]; - } - } - } - } - } - } - } - return (CEILING(kv_length + 2, 2)); -} - -#else - -static long -scav_vector(lispobj *where, lispobj object) -{ - if (HeaderValue(object) == subtype_VectorValidHashing) { - *where = - (subtype_VectorMustRehash<=(void **)c; ptr--) { + for(ptr = ((void **)(c+1))-1; ptr>=(void **)c; ptr--) { preserve_pointer(*ptr); } } +#endif /* Garbage collect a generation. If raise is 0 then the remains of the * generation are not raised to the next generation. */ @@ -4082,6 +3847,9 @@ garbage_collect_generation(generation_index_t generation, int raise) /* The oldest generation can't be raised. */ gc_assert((generation != HIGHEST_NORMAL_GENERATION) || (raise == 0)); + /* Check if weak hash tables were processed in the previous GC. */ + gc_assert(weak_hash_tables == NULL); + /* Initialize the weak pointer list. */ weak_pointers = NULL; @@ -4168,7 +3936,7 @@ garbage_collect_generation(generation_index_t generation, int raise) #else esp = (void **)((void *)&raise); #endif - for (ptr = (void **)th->control_stack_end; ptr > esp; ptr--) { + for (ptr = ((void **)th->control_stack_end)-1; ptr > esp; ptr--) { preserve_pointer(*ptr); } } @@ -4289,6 +4057,7 @@ garbage_collect_generation(generation_index_t generation, int raise) } #endif + scan_weak_hash_tables(); scan_weak_pointers(); /* Flush the current regions, updating the tables. */ @@ -4550,7 +4319,7 @@ gc_free_heap(void) if (gencgc_verbose > 1) SHOW("entering gc_free_heap"); - for (page = 0; page < NUM_PAGES; page++) { + for (page = 0; page < page_table_pages; page++) { /* Skip free pages which should already be zero filled. */ if (page_table[page].allocated != FREE_PAGE_FLAG) { void *page_start, *addr; @@ -4636,8 +4405,15 @@ gc_init(void) { page_index_t i; + /* Compute the number of pages needed for the dynamic space. + * Dynamic space size should be aligned on page size. */ + page_table_pages = dynamic_space_size/PAGE_BYTES; + gc_assert(dynamic_space_size == (size_t) page_table_pages*PAGE_BYTES); + + page_table = calloc(page_table_pages, sizeof(struct page)); + gc_assert(page_table); + gc_init_tables(); - scavtab[SIMPLE_VECTOR_WIDETAG] = scav_vector; scavtab[WEAK_POINTER_WIDETAG] = scav_weak_pointer; transother[SIMPLE_ARRAY_WIDETAG] = trans_boxed_large; @@ -4650,7 +4426,7 @@ gc_init(void) heap_base = (void*)DYNAMIC_SPACE_START; /* Initialize each page structure. */ - for (i = 0; i < NUM_PAGES; i++) { + for (i = 0; i < page_table_pages; i++) { /* Initialize all pages as free. */ page_table[i].allocated = FREE_PAGE_FLAG; page_table[i].bytes_used = 0; @@ -4768,8 +4544,12 @@ alloc(long nbytes) #else &boxed_region; #endif +#ifndef LISP_FEATURE_WIN32 + lispobj alloc_signal; +#endif void *new_obj; void *new_free_pointer; + gc_assert(nbytes>0); /* Check for alignment allocation problems. */ @@ -4821,6 +4601,24 @@ alloc(long nbytes) } } new_obj = gc_alloc_with_region(nbytes,0,region,0); + +#ifndef LISP_FEATURE_WIN32 + alloc_signal = SymbolValue(ALLOC_SIGNAL,thread); + if ((alloc_signal & FIXNUM_TAG_MASK) == 0) { + if ((signed long) alloc_signal <= 0) { +#ifdef LISP_FEATURE_SB_THREAD + kill_thread_safely(thread->os_thread, SIGPROF); +#else + raise(SIGPROF); +#endif + } else { + SetSymbolValue(ALLOC_SIGNAL, + alloc_signal - (1 << N_FIXNUM_TAG_BITS), + thread); + } + } +#endif + return (new_obj); } @@ -4962,7 +4760,8 @@ gc_and_save(char *filename, int prepend_runtime) void *runtime_bytes = NULL; size_t runtime_size; - file = prepare_to_save(filename, prepend_runtime, &runtime_bytes, &runtime_size); + file = prepare_to_save(filename, prepend_runtime, &runtime_bytes, + &runtime_size); if (file == NULL) return;