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 FACTOR_ASSERT(array_capacity(elements.untagged()) == 5);
58 FACTOR_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 /* Look up an external library symbol referenced by a compiled code block */
144 cell factor_vm::compute_dlsym_address(array *parameters, cell index)
146 cell symbol = array_nth(parameters,index);
147 cell library = array_nth(parameters,index + 1);
149 dll *d = (to_boolean(library) ? untag<dll>(library) : NULL);
151 void* undefined_symbol = (void*)factor::undefined_symbol;
152 undefined_symbol = FUNCTION_CODE_POINTER(undefined_symbol);
153 if(d != NULL && !d->handle)
154 return (cell)undefined_symbol;
156 switch(tagged<object>(symbol).type())
158 case BYTE_ARRAY_TYPE:
160 symbol_char *name = alien_offset(symbol);
161 void *sym = ffi_dlsym(d,name);
166 return (cell)undefined_symbol;
170 array *names = untag<array>(symbol);
171 for(cell i = 0; i < array_capacity(names); i++)
173 symbol_char *name = alien_offset(array_nth(names,i));
174 void *sym = ffi_dlsym(d,name);
179 return (cell)undefined_symbol;
182 critical_error("Bad symbol specifier",symbol);
183 return (cell)undefined_symbol;
188 cell factor_vm::compute_dlsym_toc_address(array *parameters, cell index)
190 cell symbol = array_nth(parameters,index);
191 cell library = array_nth(parameters,index + 1);
193 dll *d = (to_boolean(library) ? untag<dll>(library) : NULL);
195 void* undefined_toc = (void*)factor::undefined_symbol;
196 undefined_toc = FUNCTION_TOC_POINTER(undefined_toc);
197 if(d != NULL && !d->handle)
198 return (cell)undefined_toc;
200 switch(tagged<object>(symbol).type())
202 case BYTE_ARRAY_TYPE:
204 symbol_char *name = alien_offset(symbol);
205 void* toc = ffi_dlsym_toc(d,name);
209 return (cell)undefined_toc;
213 array *names = untag<array>(symbol);
214 for(cell i = 0; i < array_capacity(names); i++)
216 symbol_char *name = alien_offset(array_nth(names,i));
217 void *toc = ffi_dlsym_toc(d,name);
222 return (cell)undefined_toc;
225 critical_error("Bad symbol specifier",symbol);
226 return (cell)undefined_toc;
231 cell factor_vm::compute_vm_address(cell arg)
233 return (cell)this + untag_fixnum(arg);
236 void factor_vm::store_external_address(instruction_operand op)
238 code_block *compiled = op.compiled;
239 array *parameters = (to_boolean(compiled->parameters) ? untag<array>(compiled->parameters) : NULL);
240 cell index = op.index;
242 switch(op.rel_type())
245 op.store_value(compute_dlsym_address(parameters,index));
248 op.store_value((cell)compiled->entry_point());
250 case RT_MEGAMORPHIC_CACHE_HITS:
251 op.store_value((cell)&dispatch_stats.megamorphic_cache_hits);
254 op.store_value(compute_vm_address(array_nth(parameters,index)));
256 case RT_CARDS_OFFSET:
257 op.store_value(cards_offset);
259 case RT_DECKS_OFFSET:
260 op.store_value(decks_offset);
263 case RT_EXCEPTION_HANDLER:
264 op.store_value((cell)&factor::exception_handler);
269 op.store_value(compute_dlsym_toc_address(parameters,index));
272 case RT_INLINE_CACHE_MISS:
273 op.store_value((cell)&factor::inline_cache_miss);
276 op.store_value((cell)code->safepoint_page);
279 critical_error("Bad rel type in store_external_address()",op.rel_type());
284 cell factor_vm::compute_here_address(cell arg, cell offset, code_block *compiled)
286 fixnum n = untag_fixnum(arg);
288 return (cell)compiled->entry_point() + offset + n;
290 return (cell)compiled->entry_point() - n;
293 struct initial_code_block_visitor {
298 explicit initial_code_block_visitor(factor_vm *parent_, cell literals_)
299 : parent(parent_), literals(literals_), literal_index(0) {}
303 return array_nth(untag<array>(literals),literal_index++);
306 void operator()(instruction_operand op)
308 switch(op.rel_type())
311 op.store_value(next_literal());
314 op.store_value(parent->compute_entry_point_address(next_literal()));
316 case RT_ENTRY_POINT_PIC:
317 op.store_value(parent->compute_entry_point_pic_address(next_literal()));
319 case RT_ENTRY_POINT_PIC_TAIL:
320 op.store_value(parent->compute_entry_point_pic_tail_address(next_literal()));
323 op.store_value(parent->compute_here_address(next_literal(),op.rel_offset(),op.compiled));
326 op.store_value(untag_fixnum(next_literal()));
329 parent->store_external_address(op);
335 /* Perform all fixups on a code block */
336 void factor_vm::initialize_code_block(code_block *compiled, cell literals)
338 initial_code_block_visitor visitor(this,literals);
339 compiled->each_instruction_operand(visitor);
340 compiled->flush_icache();
342 /* next time we do a minor GC, we have to trace this code block, since
343 the newly-installed instruction operands might point to literals in
345 code->write_barrier(compiled);
348 void factor_vm::initialize_code_block(code_block *compiled)
350 std::map<code_block *,cell>::iterator iter = code->uninitialized_blocks.find(compiled);
351 initialize_code_block(compiled,iter->second);
352 code->uninitialized_blocks.erase(iter);
355 /* Fixup labels. This is done at compile time, not image load time */
356 void factor_vm::fixup_labels(array *labels, code_block *compiled)
358 cell size = array_capacity(labels);
360 for(cell i = 0; i < size; i += 3)
362 relocation_class rel_class = (relocation_class)untag_fixnum(array_nth(labels,i));
363 cell offset = untag_fixnum(array_nth(labels,i + 1));
364 cell target = untag_fixnum(array_nth(labels,i + 2));
366 relocation_entry new_entry(RT_HERE,rel_class,offset);
368 instruction_operand op(new_entry,compiled,0);
369 op.store_value(target + (cell)compiled->entry_point());
374 code_block *factor_vm::allot_code_block(cell size, code_block_type type)
376 code_block *block = code->allocator->allot(size + sizeof(code_block));
378 /* If allocation failed, do a full GC and compact the code heap.
379 A full GC that occurs as a result of the data heap filling up does not
380 trigger a compaction. This setup ensures that most GCs do not compact
381 the code heap, but if the code fills up, it probably means it will be
382 fragmented after GC anyway, so its best to compact. */
385 primitive_compact_gc();
386 block = code->allocator->allot(size + sizeof(code_block));
388 /* Insufficient room even after code GC, give up */
391 std::cout << "Code heap used: " << code->allocator->occupied_space() << "\n";
392 std::cout << "Code heap free: " << code->allocator->free_space() << "\n";
393 fatal_error("Out of memory in add-compiled-block",0);
397 block->set_type(type);
402 code_block *factor_vm::add_code_block(code_block_type type, cell code_, cell labels_, cell owner_, cell relocation_, cell parameters_, cell literals_)
404 data_root<byte_array> code(code_,this);
405 data_root<object> labels(labels_,this);
406 data_root<object> owner(owner_,this);
407 data_root<byte_array> relocation(relocation_,this);
408 data_root<array> parameters(parameters_,this);
409 data_root<array> literals(literals_,this);
411 cell code_length = array_capacity(code.untagged());
412 code_block *compiled = allot_code_block(code_length,type);
414 compiled->owner = owner.value();
416 /* slight space optimization */
417 if(relocation.type() == BYTE_ARRAY_TYPE && array_capacity(relocation.untagged()) == 0)
418 compiled->relocation = false_object;
420 compiled->relocation = relocation.value();
422 if(parameters.type() == ARRAY_TYPE && array_capacity(parameters.untagged()) == 0)
423 compiled->parameters = false_object;
425 compiled->parameters = parameters.value();
428 memcpy(compiled + 1,code.untagged() + 1,code_length);
431 if(to_boolean(labels.value()))
432 fixup_labels(labels.as<array>().untagged(),compiled);
434 /* Once we are ready, fill in literal and word references in this code
435 block's instruction operands. In most cases this is done right after this
436 method returns, except when compiling words with the non-optimizing
437 compiler at the beginning of bootstrap */
438 this->code->uninitialized_blocks.insert(std::make_pair(compiled,literals.value()));
439 this->code->all_blocks.insert(compiled);
441 /* next time we do a minor GC, we have to trace this code block, since
442 the fields of the code_block struct might point into nursery or aging */
443 this->code->write_barrier(compiled);
448 /* Find the RT_DLSYM relocation nearest to the given return address. */
449 struct find_symbol_at_address_visitor {
455 find_symbol_at_address_visitor(factor_vm *parent_, cell return_address_) :
456 parent(parent_), return_address(return_address_),
457 symbol(false_object), library(false_object) { }
459 void operator()(instruction_operand op)
461 if(op.rel_type() == RT_DLSYM && op.pointer <= return_address)
463 code_block *compiled = op.compiled;
464 array *parameters = untag<array>(compiled->parameters);
465 cell index = op.index;
466 symbol = array_nth(parameters,index);
467 library = array_nth(parameters,index + 1);
472 /* References to undefined symbols are patched up to call this function on
473 image load. It finds the symbol and library, and throws an error. */
474 void factor_vm::undefined_symbol()
476 stack_frame *frame = innermost_stack_frame(ctx->callstack_bottom,
478 code_block *compiled = frame_code(frame);
479 cell return_address = (cell)FRAME_RETURN_ADDRESS(frame, this);
480 find_symbol_at_address_visitor visitor(this, return_address);
481 compiled->each_instruction_operand(visitor);
482 if (!to_boolean(visitor.symbol))
483 critical_error("Can't find RT_DLSYM at return address", return_address);
485 general_error(ERROR_UNDEFINED_SYMBOL,visitor.symbol,visitor.library);
488 void undefined_symbol()
490 return current_vm()->undefined_symbol();