remove math.blas.syntax and merge parsing words into math.blas.vectors/matrices
[factor/jcg.git] / vm / code_gc.c
blob8c734c263c33bbf34a4afa087933cb9e0efd292b
1 #include "master.h"
3 /* This malloc-style heap code is reasonably generic. Maybe in the future, it
4 will be used for the data heap too, if we ever get incremental
5 mark/sweep/compact GC. */
6 void new_heap(F_HEAP *heap, CELL size)
8 heap->segment = alloc_segment(align_page(size));
9 if(!heap->segment)
10 fatal_error("Out of memory in new_heap",size);
11 heap->free_list = NULL;
14 /* If there is no previous block, next_free becomes the head of the free list,
15 else its linked in */
16 INLINE void update_free_list(F_HEAP *heap, F_BLOCK *prev, F_BLOCK *next_free)
18 if(prev)
19 prev->next_free = next_free;
20 else
21 heap->free_list = next_free;
24 /* Called after reading the code heap from the image file, and after code GC.
26 In the former case, we must add a large free block from compiling.base + size to
27 compiling.limit. */
28 void build_free_list(F_HEAP *heap, CELL size)
30 F_BLOCK *prev = NULL;
31 F_BLOCK *prev_free = NULL;
32 F_BLOCK *scan = first_block(heap);
33 F_BLOCK *end = (F_BLOCK *)(heap->segment->start + size);
35 /* Add all free blocks to the free list */
36 while(scan && scan < end)
38 switch(scan->status)
40 case B_FREE:
41 update_free_list(heap,prev_free,scan);
42 prev_free = scan;
43 break;
44 case B_ALLOCATED:
45 break;
46 default:
47 critical_error("Invalid scan->status",(CELL)scan);
48 break;
51 prev = scan;
52 scan = next_block(heap,scan);
55 /* If there is room at the end of the heap, add a free block. This
56 branch is only taken after loading a new image, not after code GC */
57 if((CELL)(end + 1) <= heap->segment->end)
59 end->status = B_FREE;
60 end->next_free = NULL;
61 end->size = heap->segment->end - (CELL)end;
63 /* add final free block */
64 update_free_list(heap,prev_free,end);
66 /* This branch is taken if the newly loaded image fits exactly, or
67 after code GC */
68 else
70 /* even if there's no room at the end of the heap for a new
71 free block, we might have to jigger it up by a few bytes in
72 case prev + prev->size */
73 if(prev)
74 prev->size = heap->segment->end - (CELL)prev;
76 /* this is the last free block */
77 update_free_list(heap,prev_free,NULL);
82 /* Allocate a block of memory from the mark and sweep GC heap */
83 void *heap_allot(F_HEAP *heap, CELL size)
85 F_BLOCK *prev = NULL;
86 F_BLOCK *scan = heap->free_list;
88 size = (size + 31) & ~31;
90 while(scan)
92 CELL this_size = scan->size - sizeof(F_BLOCK);
94 if(scan->status != B_FREE)
95 critical_error("Invalid block in free list",(CELL)scan);
97 if(this_size < size)
99 prev = scan;
100 scan = scan->next_free;
101 continue;
104 /* we found a candidate block */
105 F_BLOCK *next_free;
107 if(this_size - size <= sizeof(F_BLOCK))
109 /* too small to be split */
110 next_free = scan->next_free;
112 else
114 /* split the block in two */
115 CELL new_size = size + sizeof(F_BLOCK);
116 F_BLOCK *split = (F_BLOCK *)((CELL)scan + new_size);
117 split->status = B_FREE;
118 split->size = scan->size - new_size;
119 split->next_free = scan->next_free;
120 scan->size = new_size;
121 next_free = split;
124 /* update the free list */
125 update_free_list(heap,prev,next_free);
127 /* this is our new block */
128 scan->status = B_ALLOCATED;
130 return scan + 1;
133 return NULL;
136 void mark_block(F_BLOCK *block)
138 /* If already marked, do nothing */
139 switch(block->status)
141 case B_MARKED:
142 return;
143 case B_ALLOCATED:
144 block->status = B_MARKED;
145 break;
146 default:
147 critical_error("Marking the wrong block",(CELL)block);
148 break;
152 /* If in the middle of code GC, we have to grow the heap, data GC restarts from
153 scratch, so we have to unmark any marked blocks. */
154 void unmark_marked(F_HEAP *heap)
156 F_BLOCK *scan = first_block(heap);
158 while(scan)
160 if(scan->status == B_MARKED)
161 scan->status = B_ALLOCATED;
163 scan = next_block(heap,scan);
167 /* After code GC, all referenced code blocks have status set to B_MARKED, so any
168 which are allocated and not marked can be reclaimed. */
169 void free_unmarked(F_HEAP *heap)
171 F_BLOCK *prev = NULL;
172 F_BLOCK *scan = first_block(heap);
174 while(scan)
176 switch(scan->status)
178 case B_ALLOCATED:
179 if(prev && prev->status == B_FREE)
180 prev->size += scan->size;
181 else
183 scan->status = B_FREE;
184 prev = scan;
186 break;
187 case B_FREE:
188 if(prev && prev->status == B_FREE)
189 prev->size += scan->size;
190 break;
191 case B_MARKED:
192 scan->status = B_ALLOCATED;
193 prev = scan;
194 break;
195 default:
196 critical_error("Invalid scan->status",(CELL)scan);
199 scan = next_block(heap,scan);
202 build_free_list(heap,heap->segment->size);
205 /* Compute total sum of sizes of free blocks, and size of largest free block */
206 void heap_usage(F_HEAP *heap, CELL *used, CELL *total_free, CELL *max_free)
208 *used = 0;
209 *total_free = 0;
210 *max_free = 0;
212 F_BLOCK *scan = first_block(heap);
214 while(scan)
216 switch(scan->status)
218 case B_ALLOCATED:
219 *used += scan->size;
220 break;
221 case B_FREE:
222 *total_free += scan->size;
223 if(scan->size > *max_free)
224 *max_free = scan->size;
225 break;
226 default:
227 critical_error("Invalid scan->status",(CELL)scan);
230 scan = next_block(heap,scan);
234 /* The size of the heap, not including the last block if it's free */
235 CELL heap_size(F_HEAP *heap)
237 F_BLOCK *scan = first_block(heap);
239 while(next_block(heap,scan) != NULL)
240 scan = next_block(heap,scan);
242 /* this is the last block in the heap, and it is free */
243 if(scan->status == B_FREE)
244 return (CELL)scan - heap->segment->start;
245 /* otherwise the last block is allocated */
246 else
247 return heap->segment->size;
250 /* Compute where each block is going to go, after compaction */
251 CELL compute_heap_forwarding(F_HEAP *heap)
253 F_BLOCK *scan = first_block(heap);
254 CELL address = (CELL)first_block(heap);
256 while(scan)
258 if(scan->status == B_ALLOCATED)
260 scan->forwarding = (F_BLOCK *)address;
261 address += scan->size;
263 else if(scan->status == B_MARKED)
264 critical_error("Why is the block marked?",0);
266 scan = next_block(heap,scan);
269 return address - heap->segment->start;
272 void compact_heap(F_HEAP *heap)
274 F_BLOCK *scan = first_block(heap);
276 while(scan)
278 F_BLOCK *next = next_block(heap,scan);
280 if(scan->status == B_ALLOCATED && scan != scan->forwarding)
281 memcpy(scan->forwarding,scan,scan->size);
282 scan = next;