Starting mark sweep collector for code

Makefile

@@ -32,6 +32,7 @@ OBJS = $(PLAF_OBJS) \
 	vm/debug.o \
 	vm/factor.o \
 	vm/ffi_test.o \
+	vm/heap.o \
 	vm/image.o \
 	vm/io.o \
 	vm/math.o \

vm/compiler.c

@@ -1,22 +1,31 @@
 #include "factor.h"
 
-void iterate_code_heap(CELL start, CELL end, CODE_HEAP_ITERATOR iter)
+void init_compiler(CELL size)
 {
-	while(start < end)
+	new_heap(&compiling,size);
+}
+
+void iterate_code_heap(CODE_HEAP_ITERATOR iter)
+{
+	F_BLOCK *scan = (F_BLOCK *)compiling.base;
+
+	while(scan)
 	{
-		F_COMPILED *compiled = (F_COMPILED *)start;
+		if(scan->status != B_FREE)
+		{
+			F_COMPILED *compiled = (F_COMPILED *)(scan + 1);
 
-		CELL code_start = start + sizeof(F_COMPILED);
-		CELL reloc_start = code_start + compiled->code_length;
-		CELL literal_start = reloc_start + compiled->reloc_length;
-		CELL words_start = literal_start + compiled->literal_length;
-		CELL words_end = words_start + compiled->words_length;
+			CELL code_start = (CELL)(compiled + 1);
+			CELL reloc_start = code_start + compiled->code_length;
+			CELL literal_start = reloc_start + compiled->reloc_length;
+			CELL words_start = literal_start + compiled->literal_length;
 
-		iter(compiled,
-			code_start,reloc_start,
-			literal_start,words_start);
+			iter(compiled,
+				code_start,reloc_start,
+				literal_start,words_start);
+		}
 
-		start = words_end;
+		scan = scan->next;
 	}
 }
 
@@ -131,29 +140,34 @@ void apply_relocation(F_REL *rel,
 	}
 }
 
+void relocate_code_block(F_COMPILED *relocating, CELL code_start,
+	CELL reloc_start, CELL literal_start, CELL words_start)
+{
+	F_REL *rel = (F_REL *)reloc_start;
+	F_REL *rel_end = (F_REL *)literal_start;
+
+	/* apply relocations */
+	while(rel < rel_end)
+		apply_relocation(rel++,code_start,literal_start,words_start);
+}
+
 void finalize_code_block(F_COMPILED *relocating, CELL code_start,
 	CELL reloc_start, CELL literal_start, CELL words_start)
 {
 	CELL words_end = words_start + relocating->words_length;
 
-	F_REL *rel = (F_REL *)reloc_start;
-	F_REL *rel_end = (F_REL *)literal_start;
-
 	if(!relocating->finalized)
 	{
-		/* first time (ie, we just compiled, and are not simply loading
-		an image from disk). figure out word XTs. */
 		CELL scan;
 
 		for(scan = words_start; scan < words_end; scan += CELLS)
 			put(scan,untag_word(get(scan))->xt);
 
 		relocating->finalized = true;
-	}
 
-	/* apply relocations */
-	while(rel < rel_end)
-		apply_relocation(rel++,code_start,literal_start,words_start);
+		relocate_code_block(relocating,code_start,reloc_start,
+			literal_start,words_start);
+	}
 }
 
 void collect_literals_step(F_COMPILED *relocating, CELL code_start,
@@ -176,20 +190,10 @@ void collect_literals_step(F_COMPILED *relocating, CELL code_start,
 
 void collect_literals(void)
 {
-	iterate_code_heap(compiling.base,compiling.here,collect_literals_step);
+	iterate_code_heap(collect_literals_step);
 }
 
-void init_compiler(CELL size)
-{
-	compiling.base = compiling.here
-		= (CELL)(alloc_bounded_block(size)->start);
-	if(compiling.base == 0)
-		fatal_error("Cannot allocate code heap",size);
-	compiling.limit = compiling.base + size;
-	last_flush = compiling.base;
-}
-
-void deposit_integers(F_VECTOR *vector, CELL format)
+void deposit_integers(CELL here, F_VECTOR *vector, CELL format)
 {
 	CELL count = untag_fixnum_fast(vector->top);
 	F_ARRAY *array = untag_array_fast(vector->array);
@@ -198,38 +202,36 @@ void deposit_integers(F_VECTOR *vector, CELL format)
 	if(format == 1)
 	{
 		for(i = 0; i < count; i++)
-			cput(compiling.here + i,to_fixnum(get(AREF(array,i))));
+			cput(here + i,to_fixnum(get(AREF(array,i))));
 	}
 	else if(format == CELLS)
 	{
 		for(i = 0; i < count; i++)
-			put(CREF(compiling.here,i),to_fixnum(get(AREF(array,i))));
+			put(CREF(here,i),to_fixnum(get(AREF(array,i))));
 	}
 	else
 		critical_error("Bad format param to deposit_vector()",format);
 }
 
-void deposit_objects(F_VECTOR *vector, CELL literal_length)
+void deposit_objects(CELL here, F_VECTOR *vector, CELL literal_length)
 {
 	F_ARRAY *array = untag_array_fast(vector->array);
-	memcpy((void*)compiling.here,array + 1,literal_length);
+	memcpy((void*)here,array + 1,literal_length);
 }
 
 CELL add_compiled_block(CELL code_format, F_VECTOR *code,
 	F_VECTOR *literals, F_VECTOR *words, F_VECTOR *rel)
 {
-	CELL start = compiling.here;
-
 	CELL code_length = align8(untag_fixnum_fast(code->top) * code_format);
 	CELL rel_length = untag_fixnum_fast(rel->top) * CELLS;
 	CELL literal_length = untag_fixnum_fast(literals->top) * CELLS;
 	CELL words_length = untag_fixnum_fast(words->top) * CELLS;
 
-	CELL total_length = sizeof(F_COMPILED) + code_length + rel_length
+	CELL total_length = code_length + rel_length
 		+ literal_length + words_length;
 
-	if(compiling.here + total_length >= compiling.limit)
-		critical_error("Code heap exhausted",compiling.limit);
+	CELL start = heap_allot(&compiling,total_length);
+	CELL here = start;
 
 	/* compiled header */
 	F_COMPILED header;
@@ -239,24 +241,24 @@ CELL add_compiled_block(CELL code_format, F_VECTOR *code,
 	header.words_length = words_length;
 	header.finalized = false;
 
-	memcpy((void*)compiling.here,&header,sizeof(F_COMPILED));
-	compiling.here += sizeof(F_COMPILED);
+	memcpy((void*)here,&header,sizeof(F_COMPILED));
+	here += sizeof(F_COMPILED);
 
 	/* code */
-	deposit_integers(code,code_format);
-	compiling.here += code_length;
+	deposit_integers(here,code,code_format);
+	here += code_length;
 
 	/* relation info */
-	deposit_integers(rel,CELLS);
-	compiling.here += rel_length;
+	deposit_integers(here,rel,CELLS);
+	here += rel_length;
 
 	/* literals */
-	deposit_objects(literals,literal_length);
-	compiling.here += literal_length;
+	deposit_objects(here,literals,literal_length);
+	here += literal_length;
 
 	/* words */
-	deposit_objects(words,words_length);
-	compiling.here += words_length;
+	deposit_objects(here,words,words_length);
+	here += words_length;
 
 	return start + sizeof(F_COMPILED);
 }
@@ -285,7 +287,6 @@ void primitive_finalize_compile(void)
 		word->xt = to_cell(get(AREF(pair,1)));
 	}
 
-	iterate_code_heap(last_flush,compiling.here,finalize_code_block);
-	flush_icache((void*)last_flush,compiling.here - last_flush);
-	last_flush = compiling.here;
+	iterate_code_heap(finalize_code_block);
+	flush_icache(compiling.base,compiling.limit - compiling.base);
 }

vm/compiler.h

@@ -1,3 +1,6 @@
+/* compiled code */
+HEAP compiling;
+
 /* The compiled code heap is structured into blocks. */
 typedef struct
 {
@@ -11,7 +14,7 @@ typedef struct
 typedef void (*CODE_HEAP_ITERATOR)(F_COMPILED *compiled, CELL code_start,
 	CELL reloc_start, CELL literal_start, CELL words_start);
 
-void iterate_code_heap(CELL start, CELL end, CODE_HEAP_ITERATOR iter);
+void iterate_code_heap(CODE_HEAP_ITERATOR iter);
 
 typedef enum {
 	/* arg is a primitive number */
@@ -53,6 +56,9 @@ typedef struct {
 	CELL offset;
 } F_REL;
 
+void relocate_code_block(F_COMPILED *relocating, CELL code_start,
+	CELL reloc_start, CELL literal_start, CELL words_start);
+
 void finalize_code_block(F_COMPILED *relocating, CELL code_start,
 	CELL reloc_start, CELL literal_start, CELL words_start);
 
@@ -62,6 +68,4 @@ void init_compiler(CELL size);
 
 void primitive_add_compiled_block(void);
 
-CELL last_flush;
-
 void primitive_finalize_compile(void);

vm/cpu-amd64.h

@@ -4,4 +4,4 @@ register CELL ds asm("r14");
 register CELL rs asm("r15");
 register CELL cards_offset asm("r13");
 
-INLINE void flush_icache(void *start, int len) {}
+INLINE void flush_icache(CELL start, CELL len) {}

vm/cpu-ppc.h

@@ -4,4 +4,4 @@ register CELL ds asm("r14");
 register CELL rs asm("r15");
 register CELL cards_offset asm("r16");
 
-void flush_icache(void *start, int len);
+void flush_icache(CELL start, CELL len);

vm/cpu-x86.h

@@ -4,4 +4,4 @@ register CELL ds asm("esi");
 register CELL rs asm("edi");
 CELL cards_offset;
 
-INLINE void flush_icache(void *start, int len) {}
+INLINE void flush_icache(CELL start, CELL len) {}

vm/factor.h

@@ -24,8 +24,9 @@
 #include "math.h"
 #include "types.h"
 #include "io.h"
-#include "image.h"
+#include "heap.h"
 #include "compiler.h"
+#include "image.h"
 #include "primitives.h"
 #include "stack.h"
 #include "alien.h"

vm/heap.c

@@ -0,0 +1,136 @@
+#include "factor.h"
+
+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;
+}
+
+INLINE CELL block_size(F_BLOCK *block)
+{
+	return (CELL)block->next - (CELL)block - sizeof(F_BLOCK);
+}
+
+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 < end)
+	{
+		if(scan->status == B_FREE)
+		{
+			update_free_list(heap,prev,scan);
+			prev = scan;
+		}
+
+		scan = scan->next;
+	}
+
+	if((CELL)(end + 1) <= heap->limit)
+	{
+		end->status = B_FREE;
+		end->next_free = NULL;
+		end->next = NULL;
+		update_free_list(heap,prev,end);
+	}
+	else
+		update_free_list(heap,prev,NULL);
+}
+
+CELL heap_allot(HEAP *heap, CELL size)
+{
+	F_BLOCK *prev = NULL;
+	F_BLOCK *scan = heap->free_list;
+
+	while(scan)
+	{
+		if(block_size(scan) >= size)
+		{
+			/* we found a candidate block */
+			F_BLOCK *next_free;
+
+			if(block_size(scan) <= size + sizeof(F_BLOCK))
+			{
+				/* too small to be split */
+				next_free = scan->next_free;
+			}
+			else
+			{
+				/* split the block in two */
+				F_BLOCK *split = (F_BLOCK *)((CELL)scan + size);
+				split->status = B_FREE;
+				split->next_free = scan->next_free;
+				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);
+		}
+
+		prev = scan;
+		scan = scan->next_free;
+	}
+
+	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(prev->next == scan)
+				prev->next = scan->next;
+			else
+			{
+				scan->status = B_FREE;
+				update_free_list(heap,prev,scan);
+				prev = scan;
+			}
+		}
+
+		scan = scan->next;
+	}
+
+	if(prev)
+		prev->next_free = NULL;
+}
+
+void iterate_heap(HEAP *heap, HEAP_ITERATOR iter)
+{
+	F_BLOCK *scan = (F_BLOCK *)heap->base;
+	while(scan)
+	{
+		iter((CELL)(scan + 1),scan->status);
+		scan = scan->next;
+	}
+}

vm/heap.h

@@ -0,0 +1,26 @@
+typedef enum
+{
+	B_FREE,
+	B_ALLOCATED,
+	B_MARKED
+} F_BLOCK_STATUS;
+
+typedef struct _F_BLOCK
+{
+	F_BLOCK_STATUS status;
+	struct _F_BLOCK *next_free;
+	struct _F_BLOCK *next;
+} F_BLOCK;
+
+typedef struct {
+	CELL base;
+	CELL limit;
+	F_BLOCK *free_list;
+} HEAP;
+
+typedef void (*HEAP_ITERATOR)(CELL here, F_BLOCK_STATUS status);
+
+void new_heap(HEAP *heap, CELL size);
+void build_free_list(HEAP *heap, CELL size);
+CELL heap_allot(HEAP *heap, CELL size);
+void free_unmarked(HEAP *heap);

vm/image.c

@@ -53,15 +53,16 @@ void load_image(const char* filename)
 	/* read code heap */
 	{
 		CELL size = h.code_size;
-		if(size + compiling.base >= compiling.limit)
+		if(size + compiling.base > compiling.limit)
 			fatal_error("Code heap too large",h.code_size);
 
 		if(h.version == IMAGE_VERSION
 			&& size != fread((void*)compiling.base,1,size,file))
 			fatal_error("Wrong code heap length",h.code_size);
 
-		last_flush = compiling.here = compiling.base + h.code_size;
 		code_relocation_base = h.code_relocation_base;
+
+		build_free_list(&compiling,0);
 	}
 
 	fclose(file);
@@ -99,7 +100,7 @@ bool save_image(const char* filename)
 	h.bignum_zero = bignum_zero;
 	h.bignum_pos_one = bignum_pos_one;
 	h.bignum_neg_one = bignum_neg_one;
-	h.code_size = compiling.here - compiling.base;
+	h.code_size = compiling.limit - compiling.base;
 	h.code_relocation_base = compiling.base;
 	fwrite(&h,sizeof(HEADER),1,file);
 
@@ -171,7 +172,7 @@ void relocate_data()
 	}
 }
 
-void relocate_code_block(F_COMPILED *relocating, CELL code_start,
+void fixup_code_block(F_COMPILED *relocating, CELL code_start,
 	CELL reloc_start, CELL literal_start, CELL words_start)
 {
 	/* relocate literal table data */
@@ -190,11 +191,11 @@ void relocate_code_block(F_COMPILED *relocating, CELL code_start,
 			data_fixup((CELL*)scan);
 	}
 
-	finalize_code_block(relocating,code_start,reloc_start,
+	relocate_code_block(relocating,code_start,reloc_start,
 		literal_start,words_start);
 }
 
 void relocate_code()
 {
-	iterate_code_heap(compiling.base,compiling.here,relocate_code_block);
+	iterate_code_heap(fixup_code_block);
 }

vm/memory.c

@@ -163,7 +163,7 @@ void primitive_room(void)
 {
 	F_ARRAY *a = array(ARRAY_TYPE,gen_count,F);
 	int gen;
-	box_unsigned_cell(compiling.limit - compiling.here);
+	box_unsigned_cell(0);
 	box_unsigned_cell(compiling.limit - compiling.base);
 	box_unsigned_cell(cards_end - cards);
 	box_unsigned_cell(prior.limit - prior.base);

vm/memory.h

@@ -204,9 +204,6 @@ ZONE *newspace;
 /* spare semi-space; rotates with tenured. */
 ZONE prior;
 
-/* compiled code */
-ZONE compiling;
-
 INLINE bool in_zone(ZONE* z, CELL pointer)
 {
 	return pointer >= z->base && pointer < z->limit;