X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=src%2Fruntime%2Fgencgc.c;h=37b8b8ecc9467c7887572a2f96cb00ec4ba56587;hb=2cb068e245e00505076e9c325424df2a1260bfb1;hp=76beaa1014b31c3cd01db65e4ba4739e4d2a4717;hpb=8f7210321a2abb703ceeb3f203e86d5e0d9412b0;p=sbcl.git diff --git a/src/runtime/gencgc.c b/src/runtime/gencgc.c index 76beaa1..37b8b8e 100644 --- a/src/runtime/gencgc.c +++ b/src/runtime/gencgc.c @@ -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,225 +1854,6 @@ trans_unboxed_large(lispobj object) /* - * vector-like objects - */ - -#if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64) - -#if N_WORD_BITS == 32 -#define EQ_HASH_MASK 0x1fffffff -#elif N_WORD_BITS == 64 -#define EQ_HASH_MASK 0x1fffffffffffffff -#endif - -/* Compute the EQ-hash of KEY. This must match POINTER-HASH in - * target-hash-table.lisp. */ -#define EQ_HASH(key) ((key) & EQ_HASH_MASK) - -/* Return the beginning of data in ARRAY (skipping the header and the - * length) or NULL if it isn't an array of the specified widetag after - * all. */ -static inline lispobj * -get_array_data (lispobj array, int widetag, unsigned long *length) -{ - if (is_lisp_pointer(array) && - (widetag_of(*(lispobj *)native_pointer(array)) == widetag)) { - if (length != NULL) - *length = fixnum_value(((lispobj *)native_pointer(array))[1]); - return ((lispobj *)native_pointer(array)) + 2; - } else { - return NULL; - } -} - -/* Only need to worry about scavenging the _real_ entries in the - * table. Phantom entries such as the hash table itself at index 0 and - * the empty marker at index 1 were scavenged by scav_vector that - * either called this function directly or arranged for it to be - * called later by pushing the hash table onto weak_hash_tables. */ -static void -scav_hash_table_entries (struct hash_table *hash_table) -{ - lispobj *kv_vector; - unsigned long kv_length; - lispobj *index_vector; - unsigned long length; - lispobj *next_vector; - unsigned long next_vector_length; - lispobj *hash_vector; - unsigned long hash_vector_length; - lispobj empty_symbol; - long i; - - kv_vector = get_array_data(hash_table->table, - SIMPLE_VECTOR_WIDETAG, &kv_length); - if (kv_vector == NULL) - lose("invalid kv_vector %x\n", hash_table->table); - - index_vector = get_array_data(hash_table->index_vector, - SIMPLE_ARRAY_WORD_WIDETAG, &length); - if (index_vector == NULL) - lose("invalid index_vector %x\n", hash_table->index_vector); - - next_vector = get_array_data(hash_table->next_vector, - SIMPLE_ARRAY_WORD_WIDETAG, - &next_vector_length); - if (next_vector == NULL) - lose("invalid next_vector %x\n", hash_table->next_vector); - - hash_vector = get_array_data(hash_table->hash_vector, - SIMPLE_ARRAY_WORD_WIDETAG, - &hash_vector_length); - if (hash_vector != NULL) - gc_assert(hash_vector_length == next_vector_length); - - /* 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); - - empty_symbol = kv_vector[1]; - /* 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)); - } - - /* Work through the KV vector. */ - for (i = 1; i < next_vector_length; i++) { - lispobj old_key = kv_vector[2*i]; - { - unsigned long old_index = EQ_HASH(old_key)%length; - lispobj new_key; - unsigned long new_index; - - /* Scavenge the key and value. */ - scavenge(&kv_vector[2*i],2); - - /* Check whether the key has moved and is EQ based. */ - new_key = kv_vector[2*i]; - new_index = EQ_HASH(new_key)%length; - - if ((old_index != new_index) && - ((!hash_vector) || - (hash_vector[i] == MAGIC_HASH_VECTOR_VALUE)) && - ((new_key != empty_symbol) || - (kv_vector[2*i+1] != 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]; - } - } - } - } - } - } -} - -static long -scav_vector(lispobj *where, lispobj object) -{ - unsigned long kv_length; - lispobj *kv_vector; - struct hash_table *hash_table; - - /* 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; - - kv_length = fixnum_value(where[1]); - kv_vector = where + 2; /* Skip the header and length. */ - /*FSHOW((stderr,"/kv_length = %d\n", kv_length));*/ - - /* Scavenge element 0, which may be a hash-table structure. */ - scavenge(where+2, 1); - if (!is_lisp_pointer(where[2])) { - lose("no pointer at %x in hash table\n", where[2]); - } - hash_table = (struct hash_table *)native_pointer(where[2]); - /*FSHOW((stderr,"/hash_table = %x\n", hash_table));*/ - if (widetag_of(hash_table->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]); - } - - /* 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); - } - - scav_hash_table_entries(hash_table); - - 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); } } @@ -4073,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; @@ -4159,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); } } @@ -4280,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. */ @@ -4541,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; @@ -4627,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; @@ -4641,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; @@ -4759,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. */ @@ -4812,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); }