At the end of a compilation unit, all PICs become dead so add them to the free list immediately instead of having them waste space until the next GC.

Similarly, when a PIC transition occurs, add the old PIC to the free list immediately. 
Remove an unused function update_code_heap_roots()

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)
+	if(TAG(obj) == QUOTATION_TYPE)
-	{
-		F_WORD *word = untag_object(obj);
-		return (CELL)word->xt;
-	}
-	else
 	{
 		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);

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 */

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);

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)

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);

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);
 }

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);

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);