Code heap manager fixes

diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt
index 88101ab1ac18022968a9a9840898f9287698453d..bd0c37c77ea4cc55a6380769442d953f2ac82d59 100644 (file)
--- a/TODO.FACTOR.txt
+++ b/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

diff --git a/vm/compiler.c b/vm/compiler.c
index 77945e97128ea294f55e4543d2520054d5f7cce6..c7786c39e4cdbedf13bff6c270b92d40f4cebb00 100644 (file)
--- a/vm/compiler.c
+++ b/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);

diff --git a/vm/heap.c b/vm/heap.c
index 883d053973a2457b4b5675ab95c9d08714cd8e7d..732c74016cc470508b3ce9e76d14398400680ef9 100644 (file)
--- a/vm/heap.c
+++ b/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)
-               {
-                       /* we found a candidate block */
-                       F_BLOCK *next_free;
+               CELL this_size = scan->size - sizeof(F_BLOCK);
 
-                       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;
-                       }
+               if(this_size < size)
+               {
+                       prev = scan;
+                       scan = scan->next_free;
+                       continue;
+               }
 
-                       /* update the free list */
-                       update_free_list(heap,prev,next_free);
+               /* we found a candidate block */
+               F_BLOCK *next_free;
 
-                       /* this is our new block */
-                       scan->status = B_ALLOCATED;
-                       return (CELL)(scan + 1);
+               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;
 
-               prev = scan;
-               scan = scan->next_free;
+               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;
-       }
-}

diff --git a/vm/heap.h b/vm/heap.h
index 34da26fd3f3eb228d732b5c57f6781474b8c011f..56cb03a2ca01fbc4ae962310b5dc3e63c2a28d26 100644 (file)
--- a/vm/heap.h
+++ b/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;
+}

diff --git a/vm/image.c b/vm/image.c
index d820c114d910074b72f55e86bdefc02b90d594ec..3965bad1b16b5ae411364e11e382e2babce427dd 100644 (file)
--- a/vm/image.c
+++ b/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);