diff --git a/vm/code_block.c b/vm/code_block.c index 1d428e4fcd..f2ddc717f7 100644 --- a/vm/code_block.c +++ b/vm/code_block.c @@ -154,16 +154,16 @@ void copy_literal_references(F_CODE_BLOCK *compiled) CELL object_xt(CELL obj) { - if(type_of(obj) == WORD_TYPE) - { - F_WORD *word = untag_object(obj); - return (CELL)word->xt; - } - else + if(TAG(obj) == QUOTATION_TYPE) { F_QUOTATION *quot = untag_object(obj); return (CELL)quot->xt; } + else + { + F_WORD *word = untag_object(obj); + return (CELL)word->xt; + } } CELL word_direct_xt(CELL obj) @@ -215,6 +215,18 @@ void update_word_references(F_CODE_BLOCK *compiled) { if(compiled->block.needs_fixup) relocate_code_block(compiled); + /* update_word_references() is always applied to every block in + the code heap. Since it resets all call sites to point to + their canonical XT (cold entry point for non-tail calls, + standard entry point for tail calls), it means that no PICs + are referenced after this is done. So instead of polluting + the code heap with dead PICs that will be freed on the next + GC, we add them to the free list immediately. */ + else if(compiled->block.type == PIC_TYPE) + { + fflush(stdout); + heap_free(&code_heap,&compiled->block); + } else { iterate_relocations(compiled,update_word_references_step); diff --git a/vm/code_gc.c b/vm/code_gc.c index e72c159375..c7ab02c6e6 100755 --- a/vm/code_gc.c +++ b/vm/code_gc.c @@ -17,7 +17,7 @@ void new_heap(F_HEAP *heap, CELL size) clear_free_list(heap); } -void add_to_free_list(F_HEAP *heap, F_FREE_BLOCK *block) +static void add_to_free_list(F_HEAP *heap, F_FREE_BLOCK *block) { if(block->block.size < FREE_LIST_COUNT * BLOCK_SIZE_INCREMENT) { @@ -94,7 +94,7 @@ static void assert_free_block(F_FREE_BLOCK *block) critical_error("Invalid block in free list",(CELL)block); } -F_FREE_BLOCK *find_free_block(F_HEAP *heap, CELL size) +static F_FREE_BLOCK *find_free_block(F_HEAP *heap, CELL size) { CELL attempt = size; @@ -134,7 +134,7 @@ F_FREE_BLOCK *find_free_block(F_HEAP *heap, CELL size) return NULL; } -F_FREE_BLOCK *split_free_block(F_HEAP *heap, F_FREE_BLOCK *block, CELL size) +static F_FREE_BLOCK *split_free_block(F_HEAP *heap, F_FREE_BLOCK *block, CELL size) { if(block->block.size != size ) { @@ -167,6 +167,13 @@ F_BLOCK *heap_allot(F_HEAP *heap, CELL size) return NULL; } +/* Deallocates a block manually */ +void heap_free(F_HEAP *heap, F_BLOCK *block) +{ + block->status = B_FREE; + add_to_free_list(heap,(F_FREE_BLOCK *)block); +} + void mark_block(F_BLOCK *block) { /* If already marked, do nothing */ diff --git a/vm/code_gc.h b/vm/code_gc.h index d71dee29c5..35f8d66d90 100755 --- a/vm/code_gc.h +++ b/vm/code_gc.h @@ -16,6 +16,7 @@ typedef void (*HEAP_ITERATOR)(F_BLOCK *compiled); void new_heap(F_HEAP *heap, CELL size); void build_free_list(F_HEAP *heap, CELL size); F_BLOCK *heap_allot(F_HEAP *heap, CELL size); +void heap_free(F_HEAP *heap, F_BLOCK *block); void mark_block(F_BLOCK *block); void unmark_marked(F_HEAP *heap); void free_unmarked(F_HEAP *heap, HEAP_ITERATOR iter); diff --git a/vm/code_heap.c b/vm/code_heap.c index 6ba98dfa77..0a174903b6 100755 --- a/vm/code_heap.c +++ b/vm/code_heap.c @@ -47,13 +47,6 @@ void copy_code_heap_roots(void) iterate_code_heap(copy_literal_references); } -/* Update literals referenced from all code blocks. Only for tenured -collections, done at the end. */ -void update_code_heap_roots(void) -{ - iterate_code_heap(update_literal_and_word_references); -} - /* Update pointers to words referenced from all code blocks. Only after defining a new word. */ void update_code_heap_words(void) diff --git a/vm/code_heap.h b/vm/code_heap.h index b5e176d40c..01d282acfa 100755 --- a/vm/code_heap.h +++ b/vm/code_heap.h @@ -13,8 +13,6 @@ void iterate_code_heap(CODE_HEAP_ITERATOR iter); void copy_code_heap_roots(void); -void update_code_heap_roots(void); - void primitive_modify_code_heap(void); void primitive_code_room(void); diff --git a/vm/cpu-x86.h b/vm/cpu-x86.h index 9336b39de5..ab09893707 100755 --- a/vm/cpu-x86.h +++ b/vm/cpu-x86.h @@ -10,7 +10,7 @@ F_FASTCALL void lazy_jit_compile(CELL quot); void set_callstack(F_STACK_FRAME *to, F_STACK_FRAME *from, CELL length, void *memcpy); -INLINE void set_call_site(CELL return_address, CELL target) +INLINE void check_call_site(CELL return_address) { /* An x86 CALL instruction looks like so: |e8|..|..|..|..| @@ -20,5 +20,16 @@ INLINE void set_call_site(CELL return_address, CELL target) #ifdef FACTOR_DEBUG assert(*(unsigned char *)(return_address - 5) == 0xe8); #endif +} + +INLINE CELL get_call_target(CELL return_address) +{ + check_call_site(return_address); + return *(F_FIXNUM *)(return_address - 4) + return_address; +} + +INLINE void set_call_target(CELL return_address, CELL target) +{ + check_call_site(return_address); *(F_FIXNUM *)(return_address - 4) = (target - return_address); } diff --git a/vm/inline_cache.c b/vm/inline_cache.c index 8d1e16e01a..83981d2894 100644 --- a/vm/inline_cache.c +++ b/vm/inline_cache.c @@ -5,6 +5,23 @@ void init_inline_caching(int max_size) max_pic_size = max_size; } +void deallocate_inline_cache(CELL return_address) +{ + /* Find the call target. */ + XT old_xt = (XT)get_call_target(return_address); + F_CODE_BLOCK *old_block = (F_CODE_BLOCK *)old_xt - 1; + CELL old_type = old_block->block.type; + +#ifdef FACTOR_DEBUG + /* The call target was either another PIC, + or a compiled quotation (megamorphic stub) */ + assert(old_type == PIC_TYPE || old_type == QUOTATION_TYPE); +#endif + + if(old_type == PIC_TYPE) + heap_free(&code_heap,&old_block->block); +} + /* Figure out what kind of type check the PIC needs based on the methods it contains */ static CELL determine_inline_cache_type(CELL cache_entries) @@ -79,7 +96,7 @@ static F_CODE_BLOCK *compile_inline_cache(F_FIXNUM index, CELL generic_word, CEL update_pic_count(inline_cache_type); F_JIT jit; - jit_init(&jit,WORD_TYPE,generic_word); + jit_init(&jit,PIC_TYPE,generic_word); /* Generate machine code to determine the object's class. */ jit_emit_class_lookup(&jit,index,inline_cache_type); @@ -163,6 +180,11 @@ XT inline_cache_miss(CELL return_address) { check_code_pointer(return_address); + /* Since each PIC is only referenced from a single call site, + if the old call target was a PIC, we can deallocate it immediately, + instead of leaving dead PICs around until the next GC. */ + deallocate_inline_cache(return_address); + CELL cache_entries = dpop(); F_FIXNUM index = untag_fixnum_fast(dpop()); CELL methods = dpop(); @@ -195,7 +217,7 @@ XT inline_cache_miss(CELL return_address) } /* Install the new stub. */ - set_call_site(return_address,(CELL)xt); + set_call_target(return_address,(CELL)xt); #ifdef PIC_DEBUG printf("Updated call site 0x%lx with 0x%lx\n",return_address,(CELL)xt); diff --git a/vm/layouts.h b/vm/layouts.h index fd30f1bfa2..21a38165a7 100755 --- a/vm/layouts.h +++ b/vm/layouts.h @@ -60,6 +60,9 @@ typedef signed long long s64; #define TYPE_COUNT 15 +/* Not a real type, but F_CODE_BLOCK's type field can be set to this */ +#define PIC_TYPE 69 + INLINE bool immediate_p(CELL obj) { return (obj == F || TAG(obj) == FIXNUM_TYPE);