Code heap manager fixes

TODO.FACTOR.txt

@@ -2,6 +2,10 @@
 
 - signal 4 on datastack underflow on mac intel??
 - test alien-indirect
+- code GC:
+  - get code heap load/save working
+  - get room. working
+  - compact the heap on save
 
 + ui:
 
@@ -31,7 +35,6 @@
 - figure out if we need both set-model and set-model*
 - if i do 10000 [ . ] each and then clear, the listener window is slow
 - full-height nodes should really be full height
-- draw-world: bail out if world is 0x0
 - better help result ranking
 - page scrolling should be timer-based too
 - x11: scroll up/down wiggles caret
@@ -102,7 +105,6 @@
 - float= doesn't consider nans equal
 - intrinsic fixnum>float float>fixnum
 - C functions returning structs by value
-- code gc
 - infer which variables are read, written in a quotation
 - compiled continuations
 - compiled call traces

vm/compiler.c

@@ -25,7 +25,7 @@ void iterate_code_heap(CODE_HEAP_ITERATOR iter)
 				literal_start,words_start);
 		}
 
-		scan = scan->next;
+		scan = next_block(&compiling,scan);
 	}
 }
 
@@ -227,7 +227,7 @@ CELL add_compiled_block(CELL code_format, F_VECTOR *code,
 	CELL literal_length = untag_fixnum_fast(literals->top) * CELLS;
 	CELL words_length = untag_fixnum_fast(words->top) * CELLS;
 
-	CELL total_length = code_length + rel_length
+	CELL total_length = sizeof(F_COMPILED) + code_length + rel_length
 		+ literal_length + words_length;
 
 	CELL start = heap_allot(&compiling,total_length);

vm/heap.c

@@ -9,11 +9,6 @@ void new_heap(HEAP *heap, CELL 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)
@@ -31,7 +26,7 @@ void build_free_list(HEAP *heap, CELL size)
 	F_BLOCK *scan = (F_BLOCK *)heap->base;
 	F_BLOCK *end = (F_BLOCK *)(heap->base + size);
 
-	while(scan < end)
+	while(scan && scan < end)
 	{
 		if(scan->status == B_FREE)
 		{
@@ -39,18 +34,24 @@ void build_free_list(HEAP *heap, CELL size)
 			prev = scan;
 		}
 
-		scan = scan->next;
+		scan = next_block(heap,scan);
 	}
 
 	if((CELL)(end + 1) <= heap->limit)
 	{
 		end->status = B_FREE;
 		end->next_free = NULL;
-		end->next = NULL;
-		update_free_list(heap,prev,end);
+		end->size = heap->limit - (CELL)end;
 	}
 	else
-		update_free_list(heap,prev,NULL);
+	{
+		end = NULL;
+
+		if(prev)
+			prev->size = heap->limit - (CELL)prev;
+	}
+
+	update_free_list(heap,prev,end);
 }
 
 CELL heap_allot(HEAP *heap, CELL size)
@@ -60,35 +61,42 @@ CELL heap_allot(HEAP *heap, CELL size)
 
 	while(scan)
 	{
-		if(block_size(scan) >= size)
+		CELL this_size = scan->size - sizeof(F_BLOCK);
+
+		if(this_size < 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;
+			continue;
 		}
 
-		prev = scan;
-		scan = scan->next_free;
+		/* 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)
@@ -108,8 +116,8 @@ void free_unmarked(HEAP *heap)
 		if(scan->status == B_ALLOCATED)
 		{
 			/* merge blocks? */
-			if(prev->next == scan)
-				prev->next = scan->next;
+			if(next_block(heap,prev) == scan)
+				prev->size += scan->size;
 			else
 			{
 				scan->status = B_FREE;
@@ -118,19 +126,9 @@ void free_unmarked(HEAP *heap)
 			}
 		}
 
-		scan = scan->next;
+		scan = next_block(heap,scan);
 	}
 
 	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

@@ -8,8 +8,8 @@ typedef enum
 typedef struct _F_BLOCK
 {
 	F_BLOCK_STATUS status;
+	CELL size;
 	struct _F_BLOCK *next_free;
-	struct _F_BLOCK *next;
 } F_BLOCK;
 
 typedef struct {
@@ -18,9 +18,16 @@ typedef struct {
 	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);
+
+INLINE F_BLOCK *next_block(HEAP *heap, F_BLOCK *block)
+{
+	CELL next = ((CELL)block + block->size);
+	if(next == heap->limit)
+		return NULL;
+	else
+		return (F_BLOCK *)next;
+}

vm/image.c

@@ -62,7 +62,7 @@ void load_image(const char* filename)
 
 		code_relocation_base = h.code_relocation_base;
 
-		build_free_list(&compiling,0);
+		build_free_list(&compiling,size);
 	}
 
 	fclose(file);