factor/vm/code_gc.c

#include "factor.h"

/* This malloc-style heap code is reasonably generic. Maybe in the future, it
will be used for the data heap too, if we ever get incremental
mark/sweep/compact GC. */
void new_heap(HEAP *heap, CELL size)
{
	heap->base = (CELL)(alloc_bounded_block(size)->start);
	if(heap->base == 0)
		fatal_error("Cannot allocate code heap",size);
	heap->limit = heap->base + size;
	heap->free_list = NULL;
}

void init_code_heap(CELL size)
{
	new_heap(&compiling,size);
}

INLINE void update_free_list(HEAP *heap, F_BLOCK *prev, F_BLOCK *next_free)
{
	if(prev)
		prev->next_free = next_free;
	else
		heap->free_list = next_free;
}

/* called after reading the code heap from the image file. we must build the
free list, and add a large free block from compiling.base + size to
compiling.limit. */
void build_free_list(HEAP *heap, CELL size)
{
	F_BLOCK *prev = NULL;
	F_BLOCK *scan = (F_BLOCK *)heap->base;
	F_BLOCK *end = (F_BLOCK *)(heap->base + size);

	while(scan && scan < end)
	{
		if(scan->status == B_FREE)
		{
			update_free_list(heap,prev,scan);
			prev = scan;
		}

		scan = next_block(heap,scan);
	}

	if((CELL)(end + 1) <= heap->limit)
	{
		end->status = B_FREE;
		end->next_free = NULL;
		end->size = heap->limit - (CELL)end;
	}
	else
	{
		end = NULL;

		if(prev)
			prev->size = heap->limit - (CELL)prev;
	}

	update_free_list(heap,prev,end);
}

CELL heap_allot(HEAP *heap, CELL size)
{
	F_BLOCK *prev = NULL;
	F_BLOCK *scan = heap->free_list;

	while(scan)
	{
		CELL this_size = scan->size - sizeof(F_BLOCK);

		if(this_size < size)
		{
			prev = scan;
			scan = scan->next_free;
			continue;
		}

		/* we found a candidate block */
		F_BLOCK *next_free;

		if(this_size - size <= sizeof(F_BLOCK))
		{
			/* too small to be split */
			next_free = scan->next_free;
		}
		else
		{
			/* split the block in two */
			CELL new_size = size + sizeof(F_BLOCK);
			F_BLOCK *split = (F_BLOCK *)((CELL)scan + new_size);
			split->status = B_FREE;
			split->size = scan->size - new_size;
			split->next_free = scan->next_free;
			scan->size = new_size;
			next_free = split;
		}

		/* update the free list */
		update_free_list(heap,prev,next_free);

		/* this is our new block */
		scan->status = B_ALLOCATED;

		return (CELL)(scan + 1);
	}

	if(heap->base == 0)
		critical_error("Code heap is full",size);

	return 0; /* can't happen */
}

/* free blocks which are allocated and not marked */
void free_unmarked(HEAP *heap)
{
	F_BLOCK *prev = NULL;
	F_BLOCK *scan = (F_BLOCK *)heap->base;

	while(scan)
	{
		if(scan->status == B_ALLOCATED)
		{
			/* merge blocks? */
			if(next_block(heap,prev) == scan)
				prev->size += scan->size;
			else
			{
				scan->status = B_FREE;
				update_free_list(heap,prev,scan);
				prev = scan;
			}
		}
		else if(scan->status == B_MARKED)
			scan->status = B_ALLOCATED;

		scan = next_block(heap,scan);
	}

	if(prev)
		prev->next_free = NULL;
}

CELL heap_free_space(HEAP *heap)
{
	CELL size = 0;
	F_BLOCK *scan = (F_BLOCK *)heap->base;

	while(scan)
	{
		if(scan->status == B_FREE)
			size += scan->size;
		scan = next_block(heap,scan);
	}

	return size;
}

CELL heap_size(HEAP *heap)
{
	CELL start = heap->base;
	F_BLOCK *scan = (F_BLOCK *)start;
	while(next_block(heap,scan))
		scan = next_block(heap,scan);
	return (CELL)scan - (CELL)start;
}

void iterate_code_heap(CODE_HEAP_ITERATOR iter)
{
	F_BLOCK *scan = (F_BLOCK *)compiling.base;

	while(scan)
	{
		if(scan->status != B_FREE)
			iterate_code_heap_step((F_COMPILED *)(scan + 1),iter);
		scan = next_block(&compiling,scan);
	}
}

void collect_literals_step(F_COMPILED *relocating, CELL code_start,
	CELL reloc_start, CELL literal_start, CELL words_start, CELL words_end)
{
	CELL scan;

	CELL literal_end = literal_start + relocating->literal_length;

	for(scan = literal_start; scan < literal_end; scan += CELLS)
		copy_handle((CELL*)scan);

	if(!relocating->finalized)
	{
		for(scan = words_start; scan < words_end; scan += CELLS)
			copy_handle((CELL*)scan);
	}
}

void collect_literals(void)
{
	iterate_code_heap(collect_literals_step);
}

void mark_sweep_step(F_COMPILED *compiled, CELL code_start,
	CELL reloc_start, CELL literal_start, CELL words_start, CELL words_end)
{
	CELL scan;

	if(compiled->finalized)
	{
		for(scan = words_start; scan < words_end; scan += CELLS)
			mark_and_sweep(get(scan));
	}
}

void mark_and_sweep(CELL xt)
{
	F_BLOCK *block = xt_to_block(xt);

	if(block->status == B_MARKED)
		return;
	else if(block->status == B_FREE)
		critical_error("Marking a free block",(CELL)block);

	block->status = B_MARKED;

	F_COMPILED *compiled = xt_to_compiled(xt);
	iterate_code_heap_step(compiled,collect_literals_step);
	iterate_code_heap_step(compiled,mark_sweep_step);
}

void primitive_code_room(void)
{
	box_unsigned_cell(heap_free_space(&compiling));
	box_unsigned_cell(compiling.limit - compiling.base);
}

void primitive_code_gc(void)
{
	garbage_collection(TENURED,true);
}