8 /* Allocate a code heap during startup */
9 void init_code_heap(cell size)
14 bool in_code_heap_p(cell ptr)
16 return (ptr >= code.seg->start && ptr <= code.seg->end);
19 /* Compile a word definition with the non-optimizing compiler. Allocates memory */
20 void jit_compile_word(cell word_, cell def_, bool relocate)
22 gc_root<word> word(word_);
23 gc_root<quotation> def(def_);
25 jit_compile(def.value(),relocate);
27 word->code = def->code;
29 if(word->pic_def != F) jit_compile(word->pic_def,relocate);
30 if(word->pic_tail_def != F) jit_compile(word->pic_tail_def,relocate);
33 /* Apply a function to every code block */
34 void iterate_code_heap(code_heap_iterator iter)
36 heap_block *scan = first_block(&code);
40 if(scan->status != B_FREE)
41 iter((code_block *)scan);
42 scan = next_block(&code,scan);
46 /* Copy literals referenced from all code blocks to newspace. Only for
47 aging and nursery collections */
48 void copy_code_heap_roots()
50 iterate_code_heap(copy_literal_references);
53 /* Update pointers to words referenced from all code blocks. Only after
54 defining a new word. */
55 void update_code_heap_words()
57 iterate_code_heap(update_word_references);
60 PRIMITIVE(modify_code_heap)
62 gc_root<array> alist(dpop());
64 cell count = array_capacity(alist.untagged());
70 for(i = 0; i < count; i++)
72 gc_root<array> pair(array_nth(alist.untagged(),i));
74 gc_root<word> word(array_nth(pair.untagged(),0));
75 gc_root<object> data(array_nth(pair.untagged(),1));
80 jit_compile_word(word.value(),data.value(),false);
84 array *compiled_data = data.as<array>().untagged();
85 cell literals = array_nth(compiled_data,0);
86 cell relocation = array_nth(compiled_data,1);
87 cell labels = array_nth(compiled_data,2);
88 cell code = array_nth(compiled_data,3);
90 code_block *compiled = add_code_block(
97 word->code = compiled;
101 critical_error("Expected a quotation or an array",data.value());
105 update_word_xt(word.value());
108 update_code_heap_words();
111 /* Push the free space and total size of the code heap */
114 cell used, total_free, max_free;
115 heap_usage(&code,&used,&total_free,&max_free);
116 dpush(tag_fixnum(code.seg->size / 1024));
117 dpush(tag_fixnum(used / 1024));
118 dpush(tag_fixnum(total_free / 1024));
119 dpush(tag_fixnum(max_free / 1024));
122 static unordered_map<heap_block *,char *> forwarding;
124 code_block *forward_xt(code_block *compiled)
126 return (code_block *)forwarding[compiled];
129 void forward_frame_xt(stack_frame *frame)
131 cell offset = (cell)FRAME_RETURN_ADDRESS(frame) - (cell)frame_code(frame);
132 code_block *forwarded = forward_xt(frame_code(frame));
133 frame->xt = forwarded->xt();
134 FRAME_RETURN_ADDRESS(frame) = (void *)((cell)forwarded + offset);
137 void forward_object_xts()
143 while((obj = next_object()) != F)
145 switch(tagged<object>(obj).type())
149 word *w = untag<word>(obj);
152 w->code = forward_xt(w->code);
154 w->profiling = forward_xt(w->profiling);
159 quotation *quot = untag<quotation>(obj);
162 quot->code = forward_xt(quot->code);
167 callstack *stack = untag<callstack>(obj);
168 iterate_callstack_object(stack,forward_frame_xt);
179 /* Set the XT fields now that the heap has been compacted */
180 void fixup_object_xts()
186 while((obj = next_object()) != F)
188 switch(tagged<object>(obj).type())
195 quotation *quot = untag<quotation>(obj);
197 set_quot_xt(quot,quot->code);
208 /* Move all free space to the end of the code heap. This is not very efficient,
209 since it makes several passes over the code and data heaps, but we only ever
210 do this before saving a deployed image and exiting, so performaance is not
212 void compact_code_heap()
214 /* Free all unreachable code blocks */
217 /* Figure out where the code heap blocks are going to end up */
218 cell size = compute_heap_forwarding(&code, forwarding);
220 /* Update word and quotation code pointers */
221 forward_object_xts();
223 /* Actually perform the compaction */
224 compact_heap(&code,forwarding);
226 /* Update word and quotation XTs */
229 /* Now update the free list; there will be a single free block at
231 build_free_list(&code,size);