vm: simpler and more efficient code heap compaction; restructure a few things to get ready for runtime code heap compaction

vm/callstack.hpp

@@ -23,8 +23,11 @@ template<typename Iterator> void factor_vm::iterate_callstack_object(callstack *
 	}
 }
 
-template<typename Iterator> void factor_vm::iterate_callstack(cell top, cell bottom, Iterator &iterator)
+template<typename Iterator> void factor_vm::iterate_callstack(context *ctx, Iterator &iterator)
 {
+	cell top = (cell)ctx->callstack_top;
+	cell bottom = (cell)ctx->callstack_bottom;
+
 	stack_frame *frame = (stack_frame *)bottom - 1;
 
 	while((cell)frame >= top)

vm/code_block.cpp

@@ -444,7 +444,7 @@ code_block *factor_vm::allot_code_block(cell size, cell type)
 	/* If allocation failed, do a code GC */
 	if(block == NULL)
 	{
-		gc();
+		primitive_full_gc();
 		block = code->heap_allot(size + sizeof(code_block),type);
 
 		/* Insufficient room even after code GC, give up */

vm/code_heap.cpp

@@ -137,22 +137,24 @@ void factor_vm::primitive_code_room()
 	dpush(tag_fixnum(max_free / 1024));
 }
 
-code_block *factor_vm::forward_xt(code_block *compiled)
+code_block *code_heap::forward_code_block(code_block *compiled)
 {
-	return (code_block *)code->forwarding[compiled];
+	return (code_block *)forwarding[compiled];
 }
 
-struct xt_forwarder {
+struct callframe_forwarder {
 	factor_vm *myvm;
 
-	explicit xt_forwarder(factor_vm *myvm_) : myvm(myvm_) {}
+	explicit callframe_forwarder(factor_vm *myvm_) : myvm(myvm_) {}
 
 	void operator()(stack_frame *frame)
 	{
-		cell offset = (cell)FRAME_RETURN_ADDRESS(frame,myvm) - (cell)myvm->frame_code(frame);
+		cell offset = (cell)FRAME_RETURN_ADDRESS(frame,myvm) - (cell)frame->xt;
-		code_block *forwarded = myvm->forward_xt(myvm->frame_code(frame));
+
+		code_block *forwarded = myvm->code->forward_code_block(myvm->frame_code(frame));
 		frame->xt = forwarded->xt();
-		FRAME_RETURN_ADDRESS(frame,myvm) = (void *)((cell)forwarded + offset);
+
+		FRAME_RETURN_ADDRESS(frame,myvm) = (void *)((cell)frame->xt + offset);
 	}
 };
 
@@ -171,9 +173,11 @@ void factor_vm::forward_object_xts()
 				word *w = untag<word>(obj);
 
 				if(w->code)
-					w->code = forward_xt(w->code);
+					w->code = code->forward_code_block(w->code);
 				if(w->profiling)
-					w->profiling = forward_xt(w->profiling);
+					w->profiling = code->forward_code_block(w->profiling);
+
+				update_word_xt(obj);
 			}
 			break;
 		case QUOTATION_TYPE:
@@ -181,13 +185,16 @@ void factor_vm::forward_object_xts()
 				quotation *quot = untag<quotation>(obj);
 
 				if(quot->code)
-					quot->code = forward_xt(quot->code);
+				{
+					quot->code = code->forward_code_block(quot->code);
+					set_quot_xt(quot,quot->code);
+				}
 			}
 			break;
 		case CALLSTACK_TYPE:
 			{
 				callstack *stack = untag<callstack>(obj);
-				xt_forwarder forwarder(this);
+				callframe_forwarder forwarder(this);
 				iterate_callstack_object(stack,forwarder);
 			}
 			break;
@@ -199,59 +206,26 @@ void factor_vm::forward_object_xts()
 	end_scan();
 }
 
-/* Set the XT fields now that the heap has been compacted */
+void factor_vm::forward_context_xts()
-void factor_vm::fixup_object_xts()
 {
-	begin_scan();
+	context *ctx = stack_chain;
 
-	cell obj;
+	while(ctx)
-
-	while((obj = next_object()) != F)
 	{
-		switch(tagged<object>(obj).type())
+		callframe_forwarder forwarder(this);
-		{
+		iterate_callstack(ctx,forwarder);
-		case WORD_TYPE:
+		ctx = ctx->next;
-			update_word_xt(obj);
-			break;
-		case QUOTATION_TYPE:
-			{
-				quotation *quot = untag<quotation>(obj);
-				if(quot->code)
-					set_quot_xt(quot,quot->code);
-				break;
 	}
-		default:
-			break;
-		}
-	}
-
-	end_scan();
 }
 
-/* Move all free space to the end of the code heap. This is not very efficient,
+/* Move all free space to the end of the code heap. Live blocks must be marked
-since it makes several passes over the code and data heaps, but we only ever
+on entry to this function. XTs in code blocks must be updated after this
-do this before saving a deployed image and exiting, so performance is not
+function returns. */
-critical here */
+void factor_vm::compact_code_heap(bool trace_contexts_p)
-void factor_vm::compact_code_heap()
 {
-	/* Free all unreachable code blocks, don't trace contexts */
-	garbage_collection(collect_full_op,false,0);
-
-	/* Figure out where the code heap blocks are going to end up */
-	cell size = code->compute_heap_forwarding();
-
-	/* Update word and quotation code pointers */
-	forward_object_xts();
-
-	/* Actually perform the compaction */
 	code->compact_heap();
-
+	forward_object_xts();
-	/* Update word and quotation XTs */
+	if(trace_contexts_p) forward_context_xts();
-	fixup_object_xts();
-
-	/* Now update the free list; there will be a single free block at
-	the end */
-	code->build_free_list(size);
 }
 
 struct stack_trace_stripper {

vm/code_heap.hpp

@@ -16,6 +16,7 @@ struct code_heap : heap {
 	void clear_remembered_set();
 	bool needs_fixup_p(code_block *compiled);
 	void code_heap_free(code_block *compiled);
+	code_block *forward_code_block(code_block *compiled);
 };
 
 }

vm/collector.hpp

@@ -132,17 +132,17 @@ template<typename TargetGeneration, typename Policy> struct collector {
 
 	void trace_contexts()
 	{
-		context *stacks = myvm->stack_chain;
+		context *ctx = myvm->stack_chain;
 
-		while(stacks)
+		while(ctx)
 		{
-			trace_stack_elements(stacks->datastack_region,(cell *)stacks->datastack);
+			trace_stack_elements(ctx->datastack_region,(cell *)ctx->datastack);
-			trace_stack_elements(stacks->retainstack_region,(cell *)stacks->retainstack);
+			trace_stack_elements(ctx->retainstack_region,(cell *)ctx->retainstack);
 
-			trace_handle(&stacks->catchstack_save);
+			trace_handle(&ctx->catchstack_save);
-			trace_handle(&stacks->current_callback_save);
+			trace_handle(&ctx->current_callback_save);
 
-			stacks = stacks->next;
+			ctx = ctx->next;
 		}
 	}
 };

vm/contexts.cpp

@@ -104,9 +104,9 @@ void factor_vm::unnest_stacks()
 	userenv[CURRENT_CALLBACK_ENV] = stack_chain->current_callback_save;
 	userenv[CATCHSTACK_ENV] = stack_chain->catchstack_save;
 
-	context *old_stacks = stack_chain;
+	context *old_ctx = stack_chain;
-	stack_chain = old_stacks->next;
+	stack_chain = old_ctx->next;
-	dealloc_context(old_stacks);
+	dealloc_context(old_ctx);
 }
 
 void unnest_stacks(factor_vm *myvm)

vm/debug.cpp

@@ -189,10 +189,8 @@ struct stack_frame_printer {
 void factor_vm::print_callstack()
 {
 	print_string("==== CALL STACK:\n");
-	cell bottom = (cell)stack_chain->callstack_bottom;
-	cell top = (cell)stack_chain->callstack_top;
 	stack_frame_printer printer(this);
-	iterate_callstack(top,bottom,printer);
+	iterate_callstack(stack_chain,printer);
 }
 
 void factor_vm::dump_cell(cell x)
@@ -234,7 +232,7 @@ void factor_vm::dump_generations()
 
 void factor_vm::dump_objects(cell type)
 {
-	gc();
+	primitive_full_gc();
 	begin_scan();
 
 	cell obj;

vm/full_collector.cpp

@@ -26,17 +26,13 @@ struct stack_frame_marker {
 /* Mark code blocks executing in currently active stack frames. */
 void full_collector::mark_active_blocks()
 {
-	context *stacks = this->myvm->stack_chain;
+	context *ctx = this->myvm->stack_chain;
 
-	while(stacks)
+	while(ctx)
 	{
-		cell top = (cell)stacks->callstack_top;
-		cell bottom = (cell)stacks->callstack_bottom;
-
 		stack_frame_marker marker(this);
-		myvm->iterate_callstack(top,bottom,marker);
+		myvm->iterate_callstack(ctx,marker);
-
+		ctx = ctx->next;
-		stacks = stacks->next;
 	}
 }
 
@@ -140,7 +136,12 @@ void factor_vm::collect_full_impl(bool trace_contexts_p)
 	nursery.here = nursery.start;
 }
 
-void factor_vm::collect_growing_heap(cell requested_bytes, bool trace_contexts_p)
+/* In both cases, compact code heap before updating code blocks so that
+XTs are correct after */
+
+void factor_vm::collect_growing_heap(cell requested_bytes,
+	bool trace_contexts_p,
+	bool compact_code_heap_p)
 {
 	/* Grow the data heap and copy all live objects to the new heap. */
 	data_heap *old = data;
@@ -148,18 +149,22 @@ void factor_vm::collect_growing_heap(cell requested_bytes, bool trace_contexts_p
 	collect_full_impl(trace_contexts_p);
 	delete old;
 
+	if(compact_code_heap_p) compact_code_heap(trace_contexts_p);
+
 	after_growing_heap_updater updater(this);
 	code->free_unmarked(updater);
 	code->clear_remembered_set();
 }
 
-void factor_vm::collect_full(bool trace_contexts_p)
+void factor_vm::collect_full(bool trace_contexts_p, bool compact_code_heap_p)
 {
 	/* Copy all live objects to the tenured semispace. */
 	std::swap(data->tenured,data->tenured_semispace);
 	reset_generation(data->tenured);
 	collect_full_impl(trace_contexts_p);
 
+	if(compact_code_heap_p) compact_code_heap(trace_contexts_p);
+
 	after_full_updater updater(this);
 	code->free_unmarked(updater);
 	code->clear_remembered_set();

vm/gc.cpp

@@ -25,10 +25,10 @@ void factor_vm::record_gc_stats(generation_statistics *stats)
 		stats->max_gc_time = gc_elapsed;
 }
 
-/* Collect gen and all younger generations.
+void factor_vm::gc(gc_op op,
-If growing_data_heap_ is true, we must grow the data heap to such a size that
+	cell requested_bytes,
-an allocation of requested_bytes won't fail */
+	bool trace_contexts_p,
-void factor_vm::garbage_collection(gc_op op, bool trace_contexts_p, cell requested_bytes)
+	bool compact_code_heap_p)
 {
 	assert(!gc_off);
 	assert(!current_gc);
@@ -80,11 +80,11 @@ void factor_vm::garbage_collection(gc_op op, bool trace_contexts_p, cell request
 		record_gc_stats(&gc_stats.aging_stats);
 		break;
 	case collect_full_op:
-		collect_full(trace_contexts_p);
+		collect_full(trace_contexts_p,compact_code_heap_p);
 		record_gc_stats(&gc_stats.full_stats);
 		break;
 	case collect_growing_heap_op:
-		collect_growing_heap(requested_bytes,trace_contexts_p);
+		collect_growing_heap(requested_bytes,trace_contexts_p,compact_code_heap_p);
 		record_gc_stats(&gc_stats.full_stats);
 		break;
 	default:
@@ -96,14 +96,28 @@ void factor_vm::garbage_collection(gc_op op, bool trace_contexts_p, cell request
 	current_gc = NULL;
 }
 
-void factor_vm::gc()
+void factor_vm::primitive_full_gc()
 {
-	garbage_collection(collect_full_op,true,0);
+	gc(collect_full_op,
+		0, /* requested size */
+		true, /* trace contexts? */
+		false /* compact code heap? */);
 }
 
-void factor_vm::primitive_gc()
+void factor_vm::primitive_minor_gc()
 {
-	gc();
+	gc(collect_nursery_op,
+		0, /* requested size */
+		true, /* trace contexts? */
+		false /* compact code heap? */);
+}
+
+void factor_vm::primitive_compact_gc()
+{
+	gc(collect_full_op,
+		0, /* requested size */
+		true, /* trace contexts? */
+		true /* compact code heap? */);
 }
 
 void factor_vm::add_gc_stats(generation_statistics *stats, growable_array *result)
@@ -171,7 +185,7 @@ void factor_vm::primitive_become()
 			old_obj->h.forward_to(new_obj.untagged());
 	}
 
-	gc();
+	primitive_full_gc();
 
 	/* If a word's definition quotation was in old_objects and the
 	   quotation in new_objects is not compiled, we might leak memory
@@ -185,7 +199,7 @@ void factor_vm::inline_gc(cell *gc_roots_base, cell gc_roots_size)
 	for(cell i = 0; i < gc_roots_size; i++)
 		gc_locals.push_back((cell)&gc_roots_base[i]);
 
-	garbage_collection(collect_nursery_op,true,0);
+	primitive_minor_gc();
 
 	for(cell i = 0; i < gc_roots_size; i++)
 		gc_locals.pop_back();
@@ -204,16 +218,18 @@ object *factor_vm::allot_object(header header, cell size)
 {
 #ifdef GC_DEBUG
 	if(!gc_off)
-		gc();
+		primitive_full_gc();
 #endif
 
 	object *obj;
 
+	/* If the object is smaller than the nursery, allocate it in the nursery,
+	after a GC if needed */
 	if(nursery.size > size)
 	{
 		/* If there is insufficient room, collect the nursery */
 		if(nursery.here + size > nursery.end)
-			garbage_collection(collect_nursery_op,true,0);
+			primitive_minor_gc();
 
 		obj = nursery.allot(size);
 	}
@@ -223,11 +239,16 @@ object *factor_vm::allot_object(header header, cell size)
 	{
 		/* If tenured space does not have enough room, collect */
 		if(data->tenured->here + size > data->tenured->end)
-			gc();
+			primitive_full_gc();
 
 		/* If it still won't fit, grow the heap */
 		if(data->tenured->here + size > data->tenured->end)
-			garbage_collection(collect_growing_heap_op,true,size);
+		{
+			gc(collect_growing_heap_op,
+				size, /* requested size */
+				true, /* trace contexts? */
+				false /* compact code heap? */);
+		}
 
 		obj = data->tenured->allot(size);
 

vm/heap.cpp

@@ -226,37 +226,32 @@ cell heap::heap_size()
 		return seg->size;
 }
 
-/* Compute where each block is going to go, after compaction */
-cell heap::compute_heap_forwarding()
-{
-	heap_block *scan = first_block();
-	char *address = (char *)first_block();
-
-	while(scan)
-	{
-		if(scan->type() != FREE_BLOCK_TYPE)
-		{
-			forwarding[scan] = address;
-			address += scan->size();
-		}
-		scan = next_block(scan);
-	}
-
-	return (cell)address - seg->start;
-}
-
 void heap::compact_heap()
 {
-	heap_block *scan = first_block();
+	forwarding.clear();
 
+	heap_block *scan = first_block();
+	char *address = (char *)scan;
+
+	/* Slide blocks up while building the forwarding hashtable. */
 	while(scan)
 	{
 		heap_block *next = next_block(scan);
  
-		if(scan->type() != FREE_BLOCK_TYPE)
+		if(scan->type() != FREE_BLOCK_TYPE && scan->marked_p())
-			memmove(forwarding[scan],scan,scan->size());
+		{
+			cell size = scan->size();
+			memmove(address,scan,size);
+			forwarding[scan] = address;
+			address += size;
+		}
+
 		scan = next;
 	}
+
+	/* Now update the free list; there will be a single free block at
+	the end */
+	build_free_list((cell)address - seg->start);
 }
 
 heap_block *heap::free_allocated(heap_block *prev, heap_block *scan)

vm/heap.hpp

@@ -49,7 +49,6 @@ struct heap {
 	void clear_mark_bits();
 	void heap_usage(cell *used, cell *total_free, cell *max_free);
 	cell heap_size();
-	cell compute_heap_forwarding();
 	void compact_heap();
 
 	heap_block *free_allocated(heap_block *prev, heap_block *scan);

vm/image.cpp

@@ -114,7 +114,7 @@ bool factor_vm::save_image(const vm_char *filename)
 void factor_vm::primitive_save_image()
 {
 	/* do a full GC to push everything into tenured space */
-	gc();
+	primitive_full_gc();
 
 	gc_root<byte_array> path(dpop(),this);
 	path.untag_check(this);
@@ -135,8 +135,10 @@ void factor_vm::primitive_save_image_and_exit()
 		if(!save_env_p(i)) userenv[i] = F;
 	}
 
-	/* do a full GC + code heap compaction */
+	gc(collect_full_op,
-	compact_code_heap();
+		0, /* requested size */
+		false, /* discard objects only reachable from stacks */
+		true /* compact the code heap */);
 
 	/* Save the image */
 	if(save_image((vm_char *)(path.untagged() + 1)))

vm/primitives.cpp

@@ -3,6 +3,131 @@
 namespace factor
 {
 
+PRIMITIVE_FORWARD(bignum_to_fixnum)
+PRIMITIVE_FORWARD(float_to_fixnum)
+PRIMITIVE_FORWARD(fixnum_to_bignum)
+PRIMITIVE_FORWARD(float_to_bignum)
+PRIMITIVE_FORWARD(fixnum_to_float)
+PRIMITIVE_FORWARD(bignum_to_float)
+PRIMITIVE_FORWARD(str_to_float)
+PRIMITIVE_FORWARD(float_to_str)
+PRIMITIVE_FORWARD(float_bits)
+PRIMITIVE_FORWARD(double_bits)
+PRIMITIVE_FORWARD(bits_float)
+PRIMITIVE_FORWARD(bits_double)
+PRIMITIVE_FORWARD(fixnum_divint)
+PRIMITIVE_FORWARD(fixnum_divmod)
+PRIMITIVE_FORWARD(fixnum_shift)
+PRIMITIVE_FORWARD(bignum_eq)
+PRIMITIVE_FORWARD(bignum_add)
+PRIMITIVE_FORWARD(bignum_subtract)
+PRIMITIVE_FORWARD(bignum_multiply)
+PRIMITIVE_FORWARD(bignum_divint)
+PRIMITIVE_FORWARD(bignum_mod)
+PRIMITIVE_FORWARD(bignum_divmod)
+PRIMITIVE_FORWARD(bignum_and)
+PRIMITIVE_FORWARD(bignum_or)
+PRIMITIVE_FORWARD(bignum_xor)
+PRIMITIVE_FORWARD(bignum_not)
+PRIMITIVE_FORWARD(bignum_shift)
+PRIMITIVE_FORWARD(bignum_less)
+PRIMITIVE_FORWARD(bignum_lesseq)
+PRIMITIVE_FORWARD(bignum_greater)
+PRIMITIVE_FORWARD(bignum_greatereq)
+PRIMITIVE_FORWARD(bignum_bitp)
+PRIMITIVE_FORWARD(bignum_log2)
+PRIMITIVE_FORWARD(byte_array_to_bignum)
+PRIMITIVE_FORWARD(float_eq)
+PRIMITIVE_FORWARD(float_add)
+PRIMITIVE_FORWARD(float_subtract)
+PRIMITIVE_FORWARD(float_multiply)
+PRIMITIVE_FORWARD(float_divfloat)
+PRIMITIVE_FORWARD(float_mod)
+PRIMITIVE_FORWARD(float_less)
+PRIMITIVE_FORWARD(float_lesseq)
+PRIMITIVE_FORWARD(float_greater)
+PRIMITIVE_FORWARD(float_greatereq)
+PRIMITIVE_FORWARD(word)
+PRIMITIVE_FORWARD(word_xt)
+PRIMITIVE_FORWARD(getenv)
+PRIMITIVE_FORWARD(setenv)
+PRIMITIVE_FORWARD(existsp)
+PRIMITIVE_FORWARD(full_gc)
+PRIMITIVE_FORWARD(gc_stats)
+PRIMITIVE_FORWARD(save_image)
+PRIMITIVE_FORWARD(save_image_and_exit)
+PRIMITIVE_FORWARD(datastack)
+PRIMITIVE_FORWARD(retainstack)
+PRIMITIVE_FORWARD(callstack)
+PRIMITIVE_FORWARD(set_datastack)
+PRIMITIVE_FORWARD(set_retainstack)
+PRIMITIVE_FORWARD(set_callstack)
+PRIMITIVE_FORWARD(exit)
+PRIMITIVE_FORWARD(data_room)
+PRIMITIVE_FORWARD(code_room)
+PRIMITIVE_FORWARD(micros)
+PRIMITIVE_FORWARD(modify_code_heap)
+PRIMITIVE_FORWARD(dlopen)
+PRIMITIVE_FORWARD(dlsym)
+PRIMITIVE_FORWARD(dlclose)
+PRIMITIVE_FORWARD(byte_array)
+PRIMITIVE_FORWARD(uninitialized_byte_array)
+PRIMITIVE_FORWARD(displaced_alien)
+PRIMITIVE_FORWARD(alien_address)
+PRIMITIVE_FORWARD(set_slot)
+PRIMITIVE_FORWARD(string_nth)
+PRIMITIVE_FORWARD(set_string_nth_fast)
+PRIMITIVE_FORWARD(set_string_nth_slow)
+PRIMITIVE_FORWARD(resize_array)
+PRIMITIVE_FORWARD(resize_string)
+PRIMITIVE_FORWARD(array)
+PRIMITIVE_FORWARD(begin_scan)
+PRIMITIVE_FORWARD(next_object)
+PRIMITIVE_FORWARD(end_scan)
+PRIMITIVE_FORWARD(size)
+PRIMITIVE_FORWARD(die)
+PRIMITIVE_FORWARD(fopen)
+PRIMITIVE_FORWARD(fgetc)
+PRIMITIVE_FORWARD(fread)
+PRIMITIVE_FORWARD(fputc)
+PRIMITIVE_FORWARD(fwrite)
+PRIMITIVE_FORWARD(fflush)
+PRIMITIVE_FORWARD(ftell)
+PRIMITIVE_FORWARD(fseek)
+PRIMITIVE_FORWARD(fclose)
+PRIMITIVE_FORWARD(wrapper)
+PRIMITIVE_FORWARD(clone)
+PRIMITIVE_FORWARD(string)
+PRIMITIVE_FORWARD(array_to_quotation)
+PRIMITIVE_FORWARD(quotation_xt)
+PRIMITIVE_FORWARD(tuple)
+PRIMITIVE_FORWARD(profiling)
+PRIMITIVE_FORWARD(become)
+PRIMITIVE_FORWARD(sleep)
+PRIMITIVE_FORWARD(tuple_boa)
+PRIMITIVE_FORWARD(callstack_to_array)
+PRIMITIVE_FORWARD(innermost_stack_frame_executing)
+PRIMITIVE_FORWARD(innermost_stack_frame_scan)
+PRIMITIVE_FORWARD(set_innermost_stack_frame_quot)
+PRIMITIVE_FORWARD(call_clear)
+PRIMITIVE_FORWARD(resize_byte_array)
+PRIMITIVE_FORWARD(dll_validp)
+PRIMITIVE_FORWARD(unimplemented)
+PRIMITIVE_FORWARD(clear_gc_stats)
+PRIMITIVE_FORWARD(jit_compile)
+PRIMITIVE_FORWARD(load_locals)
+PRIMITIVE_FORWARD(check_datastack)
+PRIMITIVE_FORWARD(mega_cache_miss)
+PRIMITIVE_FORWARD(lookup_method)
+PRIMITIVE_FORWARD(reset_dispatch_stats)
+PRIMITIVE_FORWARD(dispatch_stats)
+PRIMITIVE_FORWARD(reset_inline_cache_stats)
+PRIMITIVE_FORWARD(inline_cache_stats)
+PRIMITIVE_FORWARD(optimized_p)
+PRIMITIVE_FORWARD(quot_compiled_p)
+PRIMITIVE_FORWARD(vm_ptr)
+PRIMITIVE_FORWARD(strip_stack_traces)
+
 const primitive_type primitives[] = {
 	primitive_bignum_to_fixnum,
 	primitive_float_to_fixnum,
@@ -62,7 +187,7 @@ const primitive_type primitives[] = {
 	primitive_getenv,
 	primitive_setenv,
 	primitive_existsp,
-	primitive_gc,
+	primitive_full_gc,
 	primitive_gc_stats,
 	primitive_save_image,
 	primitive_save_image_and_exit,
@@ -167,129 +292,4 @@ const primitive_type primitives[] = {
 	primitive_strip_stack_traces,
 };
 
-PRIMITIVE_FORWARD(bignum_to_fixnum)
-PRIMITIVE_FORWARD(float_to_fixnum)
-PRIMITIVE_FORWARD(fixnum_to_bignum)
-PRIMITIVE_FORWARD(float_to_bignum)
-PRIMITIVE_FORWARD(fixnum_to_float)
-PRIMITIVE_FORWARD(bignum_to_float)
-PRIMITIVE_FORWARD(str_to_float)
-PRIMITIVE_FORWARD(float_to_str)
-PRIMITIVE_FORWARD(float_bits)
-PRIMITIVE_FORWARD(double_bits)
-PRIMITIVE_FORWARD(bits_float)
-PRIMITIVE_FORWARD(bits_double)
-PRIMITIVE_FORWARD(fixnum_divint)
-PRIMITIVE_FORWARD(fixnum_divmod)
-PRIMITIVE_FORWARD(fixnum_shift)
-PRIMITIVE_FORWARD(bignum_eq)
-PRIMITIVE_FORWARD(bignum_add)
-PRIMITIVE_FORWARD(bignum_subtract)
-PRIMITIVE_FORWARD(bignum_multiply)
-PRIMITIVE_FORWARD(bignum_divint)
-PRIMITIVE_FORWARD(bignum_mod)
-PRIMITIVE_FORWARD(bignum_divmod)
-PRIMITIVE_FORWARD(bignum_and)
-PRIMITIVE_FORWARD(bignum_or)
-PRIMITIVE_FORWARD(bignum_xor)
-PRIMITIVE_FORWARD(bignum_not)
-PRIMITIVE_FORWARD(bignum_shift)
-PRIMITIVE_FORWARD(bignum_less)
-PRIMITIVE_FORWARD(bignum_lesseq)
-PRIMITIVE_FORWARD(bignum_greater)
-PRIMITIVE_FORWARD(bignum_greatereq)
-PRIMITIVE_FORWARD(bignum_bitp)
-PRIMITIVE_FORWARD(bignum_log2)
-PRIMITIVE_FORWARD(byte_array_to_bignum)
-PRIMITIVE_FORWARD(float_eq)
-PRIMITIVE_FORWARD(float_add)
-PRIMITIVE_FORWARD(float_subtract)
-PRIMITIVE_FORWARD(float_multiply)
-PRIMITIVE_FORWARD(float_divfloat)
-PRIMITIVE_FORWARD(float_mod)
-PRIMITIVE_FORWARD(float_less)
-PRIMITIVE_FORWARD(float_lesseq)
-PRIMITIVE_FORWARD(float_greater)
-PRIMITIVE_FORWARD(float_greatereq)
-PRIMITIVE_FORWARD(word)
-PRIMITIVE_FORWARD(word_xt)
-PRIMITIVE_FORWARD(getenv)
-PRIMITIVE_FORWARD(setenv)
-PRIMITIVE_FORWARD(existsp)
-PRIMITIVE_FORWARD(gc)
-PRIMITIVE_FORWARD(gc_stats)
-PRIMITIVE_FORWARD(save_image)
-PRIMITIVE_FORWARD(save_image_and_exit)
-PRIMITIVE_FORWARD(datastack)
-PRIMITIVE_FORWARD(retainstack)
-PRIMITIVE_FORWARD(callstack)
-PRIMITIVE_FORWARD(set_datastack)
-PRIMITIVE_FORWARD(set_retainstack)
-PRIMITIVE_FORWARD(set_callstack)
-PRIMITIVE_FORWARD(exit)
-PRIMITIVE_FORWARD(data_room)
-PRIMITIVE_FORWARD(code_room)
-PRIMITIVE_FORWARD(micros)
-PRIMITIVE_FORWARD(modify_code_heap)
-PRIMITIVE_FORWARD(dlopen)
-PRIMITIVE_FORWARD(dlsym)
-PRIMITIVE_FORWARD(dlclose)
-PRIMITIVE_FORWARD(byte_array)
-PRIMITIVE_FORWARD(uninitialized_byte_array)
-PRIMITIVE_FORWARD(displaced_alien)
-PRIMITIVE_FORWARD(alien_address)
-PRIMITIVE_FORWARD(set_slot)
-PRIMITIVE_FORWARD(string_nth)
-PRIMITIVE_FORWARD(set_string_nth_fast)
-PRIMITIVE_FORWARD(set_string_nth_slow)
-PRIMITIVE_FORWARD(resize_array)
-PRIMITIVE_FORWARD(resize_string)
-PRIMITIVE_FORWARD(array)
-PRIMITIVE_FORWARD(begin_scan)
-PRIMITIVE_FORWARD(next_object)
-PRIMITIVE_FORWARD(end_scan)
-PRIMITIVE_FORWARD(size)
-PRIMITIVE_FORWARD(die)
-PRIMITIVE_FORWARD(fopen)
-PRIMITIVE_FORWARD(fgetc)
-PRIMITIVE_FORWARD(fread)
-PRIMITIVE_FORWARD(fputc)
-PRIMITIVE_FORWARD(fwrite)
-PRIMITIVE_FORWARD(fflush)
-PRIMITIVE_FORWARD(ftell)
-PRIMITIVE_FORWARD(fseek)
-PRIMITIVE_FORWARD(fclose)
-PRIMITIVE_FORWARD(wrapper)
-PRIMITIVE_FORWARD(clone)
-PRIMITIVE_FORWARD(string)
-PRIMITIVE_FORWARD(array_to_quotation)
-PRIMITIVE_FORWARD(quotation_xt)
-PRIMITIVE_FORWARD(tuple)
-PRIMITIVE_FORWARD(profiling)
-PRIMITIVE_FORWARD(become)
-PRIMITIVE_FORWARD(sleep)
-PRIMITIVE_FORWARD(tuple_boa)
-PRIMITIVE_FORWARD(callstack_to_array)
-PRIMITIVE_FORWARD(innermost_stack_frame_executing)
-PRIMITIVE_FORWARD(innermost_stack_frame_scan)
-PRIMITIVE_FORWARD(set_innermost_stack_frame_quot)
-PRIMITIVE_FORWARD(call_clear)
-PRIMITIVE_FORWARD(resize_byte_array)
-PRIMITIVE_FORWARD(dll_validp)
-PRIMITIVE_FORWARD(unimplemented)
-PRIMITIVE_FORWARD(clear_gc_stats)
-PRIMITIVE_FORWARD(jit_compile)
-PRIMITIVE_FORWARD(load_locals)
-PRIMITIVE_FORWARD(check_datastack)
-PRIMITIVE_FORWARD(mega_cache_miss)
-PRIMITIVE_FORWARD(lookup_method)
-PRIMITIVE_FORWARD(reset_dispatch_stats)
-PRIMITIVE_FORWARD(dispatch_stats)
-PRIMITIVE_FORWARD(reset_inline_cache_stats)
-PRIMITIVE_FORWARD(inline_cache_stats)
-PRIMITIVE_FORWARD(optimized_p)
-PRIMITIVE_FORWARD(quot_compiled_p)
-PRIMITIVE_FORWARD(vm_ptr)
-PRIMITIVE_FORWARD(strip_stack_traces)
-
 }

vm/primitives.hpp

@@ -18,79 +18,14 @@ namespace factor
 #endif
 extern const primitive_type primitives[];
 
-PRIMITIVE(bignum_to_fixnum);
+/* These are defined in assembly */
-PRIMITIVE(float_to_fixnum);
-PRIMITIVE(fixnum_to_bignum);
-PRIMITIVE(float_to_bignum);
-PRIMITIVE(fixnum_to_float);
-PRIMITIVE(bignum_to_float);
-PRIMITIVE(str_to_float);
-PRIMITIVE(float_to_str);
-PRIMITIVE(float_bits);
-PRIMITIVE(double_bits);
-PRIMITIVE(bits_float);
-PRIMITIVE(bits_double);
 PRIMITIVE(fixnum_add);
 PRIMITIVE(fixnum_subtract);
 PRIMITIVE(fixnum_multiply);
-PRIMITIVE(fixnum_divint);
+PRIMITIVE(inline_cache_miss);
-PRIMITIVE(fixnum_divmod);
+PRIMITIVE(inline_cache_miss_tail);
-PRIMITIVE(fixnum_shift);
+
-PRIMITIVE(bignum_eq);
+/* These are generated with macros in alien.c */
-PRIMITIVE(bignum_add);
-PRIMITIVE(bignum_subtract);
-PRIMITIVE(bignum_multiply);
-PRIMITIVE(bignum_divint);
-PRIMITIVE(bignum_mod);
-PRIMITIVE(bignum_divmod);
-PRIMITIVE(bignum_and);
-PRIMITIVE(bignum_or);
-PRIMITIVE(bignum_xor);
-PRIMITIVE(bignum_not);
-PRIMITIVE(bignum_shift);
-PRIMITIVE(bignum_less);
-PRIMITIVE(bignum_lesseq);
-PRIMITIVE(bignum_greater);
-PRIMITIVE(bignum_greatereq);
-PRIMITIVE(bignum_bitp);
-PRIMITIVE(bignum_log2);
-PRIMITIVE(byte_array_to_bignum);
-PRIMITIVE(float_eq);
-PRIMITIVE(float_add);
-PRIMITIVE(float_subtract);
-PRIMITIVE(float_multiply);
-PRIMITIVE(float_divfloat);
-PRIMITIVE(float_mod);
-PRIMITIVE(float_less);
-PRIMITIVE(float_lesseq);
-PRIMITIVE(float_greater);
-PRIMITIVE(float_greatereq);
-PRIMITIVE(word);
-PRIMITIVE(word_xt);
-PRIMITIVE(getenv);
-PRIMITIVE(setenv);
-PRIMITIVE(existsp);
-PRIMITIVE(gc);
-PRIMITIVE(gc_stats);
-PRIMITIVE(save_image);
-PRIMITIVE(save_image_and_exit);
-PRIMITIVE(datastack);
-PRIMITIVE(retainstack);
-PRIMITIVE(callstack);
-PRIMITIVE(set_datastack);
-PRIMITIVE(set_retainstack);
-PRIMITIVE(set_callstack);
-PRIMITIVE(exit);
-PRIMITIVE(data_room);
-PRIMITIVE(code_room);
-PRIMITIVE(micros);
-PRIMITIVE(modify_code_heap);
-PRIMITIVE(dlopen);
-PRIMITIVE(dlsym);
-PRIMITIVE(dlclose);
-PRIMITIVE(byte_array);
-PRIMITIVE(uninitialized_byte_array);
-PRIMITIVE(displaced_alien);
 PRIMITIVE(alien_signed_cell);
 PRIMITIVE(set_alien_signed_cell);
 PRIMITIVE(alien_unsigned_cell);
@@ -117,61 +52,5 @@ PRIMITIVE(alien_double);
 PRIMITIVE(set_alien_double);
 PRIMITIVE(alien_cell);
 PRIMITIVE(set_alien_cell);
-PRIMITIVE(alien_address);
-PRIMITIVE(set_slot);
-PRIMITIVE(string_nth);
-PRIMITIVE(set_string_nth_fast);
-PRIMITIVE(set_string_nth_slow);
-PRIMITIVE(resize_array);
-PRIMITIVE(resize_string);
-PRIMITIVE(array);
-PRIMITIVE(begin_scan);
-PRIMITIVE(next_object);
-PRIMITIVE(end_scan);
-PRIMITIVE(size);
-PRIMITIVE(die);
-PRIMITIVE(fopen);
-PRIMITIVE(fgetc);
-PRIMITIVE(fread);
-PRIMITIVE(fputc);
-PRIMITIVE(fwrite);
-PRIMITIVE(fflush);
-PRIMITIVE(ftell);
-PRIMITIVE(fseek);
-PRIMITIVE(fclose);
-PRIMITIVE(wrapper);
-PRIMITIVE(clone);
-PRIMITIVE(string);
-PRIMITIVE(array_to_quotation);
-PRIMITIVE(quotation_xt);
-PRIMITIVE(tuple);
-PRIMITIVE(profiling);
-PRIMITIVE(become);
-PRIMITIVE(sleep);
-PRIMITIVE(tuple_boa);
-PRIMITIVE(callstack_to_array);
-PRIMITIVE(innermost_stack_frame_executing);
-PRIMITIVE(innermost_stack_frame_scan);
-PRIMITIVE(set_innermost_stack_frame_quot);
-PRIMITIVE(call_clear);
-PRIMITIVE(resize_byte_array);
-PRIMITIVE(dll_validp);
-PRIMITIVE(unimplemented);
-PRIMITIVE(clear_gc_stats);
-PRIMITIVE(jit_compile);
-PRIMITIVE(load_locals);
-PRIMITIVE(check_datastack);
-PRIMITIVE(inline_cache_miss);
-PRIMITIVE(inline_cache_miss_tail);
-PRIMITIVE(mega_cache_miss);
-PRIMITIVE(lookup_method);
-PRIMITIVE(reset_dispatch_stats);
-PRIMITIVE(dispatch_stats);
-PRIMITIVE(reset_inline_cache_stats);
-PRIMITIVE(inline_cache_stats);
-PRIMITIVE(optimized_p);
-PRIMITIVE(quot_compiled_p);
-PRIMITIVE(vm_ptr);
-PRIMITIVE(strip_stack_traces);
 
 }

vm/profiler.cpp

@@ -29,7 +29,7 @@ void factor_vm::set_profiling(bool profiling)
 
 	/* Push everything to tenured space so that we can heap scan
 	and allocate profiling blocks if necessary */
-	gc();
+	primitive_full_gc();
 
 	gc_root<array> words(find_all_words(),this);
 

vm/quotations.cpp

@@ -283,9 +283,7 @@ void quotation_jit::iterate_quotation()
 
 void factor_vm::set_quot_xt(quotation *quot, code_block *code)
 {
-	if(code->type() != QUOTATION_TYPE)
+	assert(code->type() == QUOTATION_TYPE);
-		critical_error("Bad param to set_quot_xt",(cell)code);
-
 	quot->code = code;
 	quot->xt = code->xt();
 }

vm/vm.hpp

@@ -239,12 +239,13 @@ struct factor_vm
 	void collect_aging();
 	void collect_to_tenured();
 	void collect_full_impl(bool trace_contexts_p);
-	void collect_growing_heap(cell requested_bytes, bool trace_contexts_p);
+	void collect_growing_heap(cell requested_bytes, bool trace_contexts_p, bool compact_code_heap_p);
-	void collect_full(bool trace_contexts_p);
+	void collect_full(bool trace_contexts_p, bool compact_code_heap_p);
 	void record_gc_stats(generation_statistics *stats);
-	void garbage_collection(gc_op op, bool trace_contexts_p, cell requested_bytes);
+	void gc(gc_op op, cell requested_bytes, bool trace_contexts_p, bool compact_code_heap_p);
-	void gc();
+	void primitive_full_gc();
-	void primitive_gc();
+	void primitive_minor_gc();
+	void primitive_compact_gc();
 	void primitive_gc_stats();
 	void clear_gc_stats();
 	void primitive_become();
@@ -499,10 +500,9 @@ struct factor_vm
 	void update_code_heap_words();
 	void primitive_modify_code_heap();
 	void primitive_code_room();
-	code_block *forward_xt(code_block *compiled);
 	void forward_object_xts();
-	void fixup_object_xts();
+	void forward_context_xts();
-	void compact_code_heap();
+	void compact_code_heap(bool trace_contexts_p);
 	void primitive_strip_stack_traces();
 
 	/* Apply a function to every code block */
@@ -557,7 +557,7 @@ struct factor_vm
 	void primitive_innermost_stack_frame_scan();
 	void primitive_set_innermost_stack_frame_quot();
 	void save_callstack_bottom(stack_frame *callstack_bottom);
-	template<typename Iterator> void iterate_callstack(cell top, cell bottom, Iterator &iterator);
+	template<typename Iterator> void iterate_callstack(context *ctx, Iterator &iterator);
 
 	/* Every object has a regular representation in the runtime, which makes GC
 	much simpler. Every slot of the object until binary_payload_start is a pointer