6 cell factor_vm::compute_entry_point_address(cell obj)
8 switch(tagged<object>(obj).type())
11 return (cell)untag<word>(obj)->entry_point;
13 return (cell)untag<quotation>(obj)->entry_point;
15 critical_error("Expected word or quotation",obj);
20 cell factor_vm::compute_entry_point_pic_address(word *w, cell tagged_quot)
22 if(!to_boolean(tagged_quot) || max_pic_size == 0)
23 return (cell)w->entry_point;
26 quotation *quot = untag<quotation>(tagged_quot);
27 if(quot_compiled_p(quot))
28 return (cell)quot->entry_point;
30 return (cell)w->entry_point;
34 cell factor_vm::compute_entry_point_pic_address(cell w_)
37 return compute_entry_point_pic_address(w.untagged(),w->pic_def);
40 cell factor_vm::compute_entry_point_pic_tail_address(cell w_)
43 return compute_entry_point_pic_address(w.untagged(),w->pic_tail_def);
46 cell factor_vm::code_block_owner(code_block *compiled)
48 tagged<object> owner(compiled->owner);
50 /* Cold generic word call sites point to quotations that call the
51 inline-cache-miss and inline-cache-miss-tail primitives. */
52 if(owner.type_p(QUOTATION_TYPE))
54 tagged<quotation> quot(owner.as<quotation>());
55 tagged<array> elements(quot->array);
57 assert(array_capacity(elements.untagged()) == 5);
58 assert(array_nth(elements.untagged(),4) == special_objects[PIC_MISS_WORD]
59 || array_nth(elements.untagged(),4) == special_objects[PIC_MISS_TAIL_WORD]);
61 tagged<wrapper> word_wrapper(array_nth(elements.untagged(),0));
62 return word_wrapper->object;
65 return compiled->owner;
68 struct update_word_references_relocation_visitor {
70 bool reset_inline_caches;
72 update_word_references_relocation_visitor(
74 bool reset_inline_caches_) :
76 reset_inline_caches(reset_inline_caches_) {}
78 void operator()(instruction_operand op)
84 code_block *compiled = op.load_code_block();
85 cell owner = compiled->owner;
87 op.store_value(parent->compute_entry_point_address(owner));
90 case RT_ENTRY_POINT_PIC:
92 code_block *compiled = op.load_code_block();
93 if(reset_inline_caches || !compiled->pic_p())
95 cell owner = parent->code_block_owner(compiled);
97 op.store_value(parent->compute_entry_point_pic_address(owner));
101 case RT_ENTRY_POINT_PIC_TAIL:
103 code_block *compiled = op.load_code_block();
104 if(reset_inline_caches || !compiled->pic_p())
106 cell owner = parent->code_block_owner(compiled);
107 if(to_boolean(owner))
108 op.store_value(parent->compute_entry_point_pic_tail_address(owner));
118 /* Relocate new code blocks completely; updating references to literals,
119 dlsyms, and words. For all other words in the code heap, we only need
120 to update references to other words, without worrying about literals
122 void factor_vm::update_word_references(code_block *compiled, bool reset_inline_caches)
124 if(code->uninitialized_p(compiled))
125 initialize_code_block(compiled);
126 /* update_word_references() is always applied to every block in
127 the code heap. Since it resets all call sites to point to
128 their canonical entry point (cold entry point for non-tail calls,
129 standard entry point for tail calls), it means that no PICs
130 are referenced after this is done. So instead of polluting
131 the code heap with dead PICs that will be freed on the next
132 GC, we add them to the free list immediately. */
133 else if(reset_inline_caches && compiled->pic_p())
134 code->free(compiled);
137 update_word_references_relocation_visitor visitor(this,reset_inline_caches);
138 compiled->each_instruction_operand(visitor);
139 compiled->flush_icache();
143 /* References to undefined symbols are patched up to call this function on
145 void factor_vm::undefined_symbol()
147 general_error(ERROR_UNDEFINED_SYMBOL,false_object,false_object);
150 void undefined_symbol()
152 return current_vm()->undefined_symbol();
155 /* Look up an external library symbol referenced by a compiled code block */
156 cell factor_vm::compute_dlsym_address(array *literals, cell index)
158 cell symbol = array_nth(literals,index);
159 cell library = array_nth(literals,index + 1);
161 dll *d = (to_boolean(library) ? untag<dll>(library) : NULL);
163 void* undefined_symbol = (void*)factor::undefined_symbol;
164 undefined_symbol = FUNCTION_CODE_POINTER(undefined_symbol);
165 if(d != NULL && !d->handle)
166 return (cell)undefined_symbol;
168 switch(tagged<object>(symbol).type())
170 case BYTE_ARRAY_TYPE:
172 symbol_char *name = alien_offset(symbol);
173 void *sym = ffi_dlsym(d,name);
178 return (cell)undefined_symbol;
182 array *names = untag<array>(symbol);
183 for(cell i = 0; i < array_capacity(names); i++)
185 symbol_char *name = alien_offset(array_nth(names,i));
186 void *sym = ffi_dlsym(d,name);
191 return (cell)undefined_symbol;
194 critical_error("Bad symbol specifier",symbol);
195 return (cell)undefined_symbol;
200 cell factor_vm::compute_dlsym_toc_address(array *literals, cell index)
202 cell symbol = array_nth(literals,index);
203 cell library = array_nth(literals,index + 1);
205 dll *d = (to_boolean(library) ? untag<dll>(library) : NULL);
207 void* undefined_toc = (void*)factor::undefined_symbol;
208 undefined_toc = FUNCTION_TOC_POINTER(undefined_toc);
209 if(d != NULL && !d->handle)
210 return (cell)undefined_toc;
212 switch(tagged<object>(symbol).type())
214 case BYTE_ARRAY_TYPE:
216 symbol_char *name = alien_offset(symbol);
217 void* toc = ffi_dlsym_toc(d,name);
221 return (cell)undefined_toc;
225 array *names = untag<array>(symbol);
226 for(cell i = 0; i < array_capacity(names); i++)
228 symbol_char *name = alien_offset(array_nth(names,i));
229 void *toc = ffi_dlsym_toc(d,name);
234 return (cell)undefined_toc;
237 critical_error("Bad symbol specifier",symbol);
238 return (cell)undefined_toc;
244 cell factor_vm::compute_vm_address(cell arg)
246 return (cell)this + untag_fixnum(arg);
249 void factor_vm::store_external_address(instruction_operand op)
251 code_block *compiled = op.parent_code_block();
252 array *parameters = (to_boolean(compiled->parameters) ? untag<array>(compiled->parameters) : NULL);
253 cell index = op.parameter_index();
255 switch(op.rel_type())
258 op.store_value(compute_dlsym_address(parameters,index));
261 op.store_value((cell)compiled->entry_point());
263 case RT_MEGAMORPHIC_CACHE_HITS:
264 op.store_value((cell)&dispatch_stats.megamorphic_cache_hits);
267 op.store_value(compute_vm_address(array_nth(parameters,index)));
269 case RT_CARDS_OFFSET:
270 op.store_value(cards_offset);
272 case RT_DECKS_OFFSET:
273 op.store_value(decks_offset);
276 case RT_EXCEPTION_HANDLER:
277 op.store_value((cell)&factor::exception_handler);
282 op.store_value(compute_dlsym_toc_address(parameters,index));
286 critical_error("Bad rel type in store_external_address()",op.rel_type());
291 cell factor_vm::compute_here_address(cell arg, cell offset, code_block *compiled)
293 fixnum n = untag_fixnum(arg);
295 return (cell)compiled->entry_point() + offset + n;
297 return (cell)compiled->entry_point() - n;
300 struct initial_code_block_visitor {
305 explicit initial_code_block_visitor(factor_vm *parent_, cell literals_)
306 : parent(parent_), literals(literals_), literal_index(0) {}
310 return array_nth(untag<array>(literals),literal_index++);
313 void operator()(instruction_operand op)
315 switch(op.rel_type())
318 op.store_value(next_literal());
321 op.store_value(parent->compute_entry_point_address(next_literal()));
323 case RT_ENTRY_POINT_PIC:
324 op.store_value(parent->compute_entry_point_pic_address(next_literal()));
326 case RT_ENTRY_POINT_PIC_TAIL:
327 op.store_value(parent->compute_entry_point_pic_tail_address(next_literal()));
330 op.store_value(parent->compute_here_address(next_literal(),op.rel_offset(),op.parent_code_block()));
333 op.store_value(untag_fixnum(next_literal()));
336 parent->store_external_address(op);
342 /* Perform all fixups on a code block */
343 void factor_vm::initialize_code_block(code_block *compiled, cell literals)
345 initial_code_block_visitor visitor(this,literals);
346 compiled->each_instruction_operand(visitor);
347 compiled->flush_icache();
349 /* next time we do a minor GC, we have to trace this code block, since
350 the newly-installed instruction operands might point to literals in
352 code->write_barrier(compiled);
355 void factor_vm::initialize_code_block(code_block *compiled)
357 std::map<code_block *,cell>::iterator iter = code->uninitialized_blocks.find(compiled);
358 initialize_code_block(compiled,iter->second);
359 code->uninitialized_blocks.erase(iter);
362 /* Fixup labels. This is done at compile time, not image load time */
363 void factor_vm::fixup_labels(array *labels, code_block *compiled)
365 cell size = array_capacity(labels);
367 for(cell i = 0; i < size; i += 3)
369 relocation_class rel_class = (relocation_class)untag_fixnum(array_nth(labels,i));
370 cell offset = untag_fixnum(array_nth(labels,i + 1));
371 cell target = untag_fixnum(array_nth(labels,i + 2));
373 relocation_entry new_entry(RT_HERE,rel_class,offset);
375 instruction_operand op(new_entry,compiled,0);
376 op.store_value(target + (cell)compiled->entry_point());
381 code_block *factor_vm::allot_code_block(cell size, code_block_type type)
383 code_block *block = code->allocator->allot(size + sizeof(code_block));
385 /* If allocation failed, do a full GC and compact the code heap.
386 A full GC that occurs as a result of the data heap filling up does not
387 trigger a compaction. This setup ensures that most GCs do not compact
388 the code heap, but if the code fills up, it probably means it will be
389 fragmented after GC anyway, so its best to compact. */
392 primitive_compact_gc();
393 block = code->allocator->allot(size + sizeof(code_block));
395 /* Insufficient room even after code GC, give up */
398 std::cout << "Code heap used: " << code->allocator->occupied_space() << "\n";
399 std::cout << "Code heap free: " << code->allocator->free_space() << "\n";
400 fatal_error("Out of memory in add-compiled-block",0);
404 block->set_type(type);
409 code_block *factor_vm::add_code_block(code_block_type type, cell code_, cell labels_, cell owner_, cell relocation_, cell parameters_, cell literals_)
411 data_root<byte_array> code(code_,this);
412 data_root<object> labels(labels_,this);
413 data_root<object> owner(owner_,this);
414 data_root<byte_array> relocation(relocation_,this);
415 data_root<array> parameters(parameters_,this);
416 data_root<array> literals(literals_,this);
418 cell code_length = array_capacity(code.untagged());
419 code_block *compiled = allot_code_block(code_length,type);
421 compiled->owner = owner.value();
423 /* slight space optimization */
424 if(relocation.type() == BYTE_ARRAY_TYPE && array_capacity(relocation.untagged()) == 0)
425 compiled->relocation = false_object;
427 compiled->relocation = relocation.value();
429 if(parameters.type() == ARRAY_TYPE && array_capacity(parameters.untagged()) == 0)
430 compiled->parameters = false_object;
432 compiled->parameters = parameters.value();
435 memcpy(compiled + 1,code.untagged() + 1,code_length);
438 if(to_boolean(labels.value()))
439 fixup_labels(labels.as<array>().untagged(),compiled);
441 /* Once we are ready, fill in literal and word references in this code
442 block's instruction operands. In most cases this is done right after this
443 method returns, except when compiling words with the non-optimizing
444 compiler at the beginning of bootstrap */
445 this->code->uninitialized_blocks.insert(std::make_pair(compiled,literals.value()));
447 /* next time we do a minor GC, we have to trace this code block, since
448 the fields of the code_block struct might point into nursery or aging */
449 this->code->write_barrier(compiled);