6 cell code_block::owner_quot() const
8 tagged<object> executing(owner);
9 if (!optimized_p() && executing->type() == WORD_TYPE)
10 executing = executing.as<word>()->def;
11 return executing.value();
14 cell code_block::scan(factor_vm *vm, void *addr) const
18 case code_block_unoptimized:
20 tagged<object> obj(owner);
21 if(obj.type_p(WORD_TYPE))
22 obj = obj.as<word>()->def;
24 if(obj.type_p(QUOTATION_TYPE))
25 return tag_fixnum(vm->quot_code_offset_to_scan(obj.value(),offset(addr)));
29 case code_block_optimized:
32 critical_error("Bad frame type",type());
37 cell factor_vm::compute_entry_point_address(cell obj)
39 switch(tagged<object>(obj).type())
42 return (cell)untag<word>(obj)->entry_point;
44 return (cell)untag<quotation>(obj)->entry_point;
46 critical_error("Expected word or quotation",obj);
51 cell factor_vm::compute_entry_point_pic_address(word *w, cell tagged_quot)
53 if(!to_boolean(tagged_quot) || max_pic_size == 0)
54 return (cell)w->entry_point;
57 quotation *quot = untag<quotation>(tagged_quot);
58 if(quot_compiled_p(quot))
59 return (cell)quot->entry_point;
61 return (cell)w->entry_point;
65 cell factor_vm::compute_entry_point_pic_address(cell w_)
68 return compute_entry_point_pic_address(w.untagged(),w->pic_def);
71 cell factor_vm::compute_entry_point_pic_tail_address(cell w_)
74 return compute_entry_point_pic_address(w.untagged(),w->pic_tail_def);
77 cell factor_vm::code_block_owner(code_block *compiled)
79 tagged<object> owner(compiled->owner);
81 /* Cold generic word call sites point to quotations that call the
82 inline-cache-miss and inline-cache-miss-tail primitives. */
83 if(owner.type_p(QUOTATION_TYPE))
85 tagged<quotation> quot(owner.as<quotation>());
86 tagged<array> elements(quot->array);
88 FACTOR_ASSERT(array_capacity(elements.untagged()) == 5);
89 FACTOR_ASSERT(array_nth(elements.untagged(),4) == special_objects[PIC_MISS_WORD]
90 || array_nth(elements.untagged(),4) == special_objects[PIC_MISS_TAIL_WORD]);
92 tagged<wrapper> word_wrapper(array_nth(elements.untagged(),0));
93 return word_wrapper->object;
96 return compiled->owner;
99 struct update_word_references_relocation_visitor {
101 bool reset_inline_caches;
103 update_word_references_relocation_visitor(
105 bool reset_inline_caches_) :
107 reset_inline_caches(reset_inline_caches_) {}
109 void operator()(instruction_operand op)
111 switch(op.rel_type())
115 code_block *compiled = op.load_code_block();
116 cell owner = compiled->owner;
117 if(to_boolean(owner))
118 op.store_value(parent->compute_entry_point_address(owner));
121 case RT_ENTRY_POINT_PIC:
123 code_block *compiled = op.load_code_block();
124 if(reset_inline_caches || !compiled->pic_p())
126 cell owner = parent->code_block_owner(compiled);
127 if(to_boolean(owner))
128 op.store_value(parent->compute_entry_point_pic_address(owner));
132 case RT_ENTRY_POINT_PIC_TAIL:
134 code_block *compiled = op.load_code_block();
135 if(reset_inline_caches || !compiled->pic_p())
137 cell owner = parent->code_block_owner(compiled);
138 if(to_boolean(owner))
139 op.store_value(parent->compute_entry_point_pic_tail_address(owner));
149 /* Relocate new code blocks completely; updating references to literals,
150 dlsyms, and words. For all other words in the code heap, we only need
151 to update references to other words, without worrying about literals
153 void factor_vm::update_word_references(code_block *compiled, bool reset_inline_caches)
155 if(code->uninitialized_p(compiled))
156 initialize_code_block(compiled);
157 /* update_word_references() is always applied to every block in
158 the code heap. Since it resets all call sites to point to
159 their canonical entry point (cold entry point for non-tail calls,
160 standard entry point for tail calls), it means that no PICs
161 are referenced after this is done. So instead of polluting
162 the code heap with dead PICs that will be freed on the next
163 GC, we add them to the free list immediately. */
164 else if(reset_inline_caches && compiled->pic_p())
165 code->free(compiled);
168 update_word_references_relocation_visitor visitor(this,reset_inline_caches);
169 compiled->each_instruction_operand(visitor);
170 compiled->flush_icache();
174 /* Look up an external library symbol referenced by a compiled code block */
175 cell factor_vm::compute_dlsym_address(array *parameters, cell index)
177 cell symbol = array_nth(parameters,index);
178 cell library = array_nth(parameters,index + 1);
180 dll *d = (to_boolean(library) ? untag<dll>(library) : NULL);
182 void* undefined_symbol = (void*)factor::undefined_symbol;
183 undefined_symbol = FUNCTION_CODE_POINTER(undefined_symbol);
184 if(d != NULL && !d->handle)
185 return (cell)undefined_symbol;
187 switch(tagged<object>(symbol).type())
189 case BYTE_ARRAY_TYPE:
191 symbol_char *name = alien_offset(symbol);
192 void *sym = ffi_dlsym(d,name);
197 return (cell)undefined_symbol;
201 array *names = untag<array>(symbol);
202 for(cell i = 0; i < array_capacity(names); i++)
204 symbol_char *name = alien_offset(array_nth(names,i));
205 void *sym = ffi_dlsym(d,name);
210 return (cell)undefined_symbol;
213 critical_error("Bad symbol specifier",symbol);
214 return (cell)undefined_symbol;
219 cell factor_vm::compute_dlsym_toc_address(array *parameters, cell index)
221 cell symbol = array_nth(parameters,index);
222 cell library = array_nth(parameters,index + 1);
224 dll *d = (to_boolean(library) ? untag<dll>(library) : NULL);
226 void* undefined_toc = (void*)factor::undefined_symbol;
227 undefined_toc = FUNCTION_TOC_POINTER(undefined_toc);
228 if(d != NULL && !d->handle)
229 return (cell)undefined_toc;
231 switch(tagged<object>(symbol).type())
233 case BYTE_ARRAY_TYPE:
235 symbol_char *name = alien_offset(symbol);
236 void* toc = ffi_dlsym_toc(d,name);
240 return (cell)undefined_toc;
244 array *names = untag<array>(symbol);
245 for(cell i = 0; i < array_capacity(names); i++)
247 symbol_char *name = alien_offset(array_nth(names,i));
248 void *toc = ffi_dlsym_toc(d,name);
253 return (cell)undefined_toc;
256 critical_error("Bad symbol specifier",symbol);
257 return (cell)undefined_toc;
262 cell factor_vm::compute_vm_address(cell arg)
264 return (cell)this + untag_fixnum(arg);
267 void factor_vm::store_external_address(instruction_operand op)
269 code_block *compiled = op.compiled;
270 array *parameters = (to_boolean(compiled->parameters) ? untag<array>(compiled->parameters) : NULL);
271 cell index = op.index;
273 switch(op.rel_type())
276 op.store_value(compute_dlsym_address(parameters,index));
279 op.store_value((cell)compiled->entry_point());
281 case RT_MEGAMORPHIC_CACHE_HITS:
282 op.store_value((cell)&dispatch_stats.megamorphic_cache_hits);
285 op.store_value(compute_vm_address(array_nth(parameters,index)));
287 case RT_CARDS_OFFSET:
288 op.store_value(cards_offset);
290 case RT_DECKS_OFFSET:
291 op.store_value(decks_offset);
294 case RT_EXCEPTION_HANDLER:
295 op.store_value((cell)&factor::exception_handler);
300 op.store_value(compute_dlsym_toc_address(parameters,index));
303 case RT_INLINE_CACHE_MISS:
304 op.store_value((cell)&factor::inline_cache_miss);
307 op.store_value((cell)code->safepoint_page);
310 critical_error("Bad rel type in store_external_address()",op.rel_type());
315 cell factor_vm::compute_here_address(cell arg, cell offset, code_block *compiled)
317 fixnum n = untag_fixnum(arg);
319 return (cell)compiled->entry_point() + offset + n;
321 return (cell)compiled->entry_point() - n;
324 struct initial_code_block_visitor {
329 explicit initial_code_block_visitor(factor_vm *parent_, cell literals_)
330 : parent(parent_), literals(literals_), literal_index(0) {}
334 return array_nth(untag<array>(literals),literal_index++);
337 void operator()(instruction_operand op)
339 switch(op.rel_type())
342 op.store_value(next_literal());
345 op.store_value(parent->compute_entry_point_address(next_literal()));
347 case RT_ENTRY_POINT_PIC:
348 op.store_value(parent->compute_entry_point_pic_address(next_literal()));
350 case RT_ENTRY_POINT_PIC_TAIL:
351 op.store_value(parent->compute_entry_point_pic_tail_address(next_literal()));
354 op.store_value(parent->compute_here_address(next_literal(),op.rel_offset(),op.compiled));
357 op.store_value(untag_fixnum(next_literal()));
360 parent->store_external_address(op);
366 /* Perform all fixups on a code block */
367 void factor_vm::initialize_code_block(code_block *compiled, cell literals)
369 initial_code_block_visitor visitor(this,literals);
370 compiled->each_instruction_operand(visitor);
371 compiled->flush_icache();
373 /* next time we do a minor GC, we have to trace this code block, since
374 the newly-installed instruction operands might point to literals in
376 code->write_barrier(compiled);
379 void factor_vm::initialize_code_block(code_block *compiled)
381 std::map<code_block *,cell>::iterator iter = code->uninitialized_blocks.find(compiled);
382 initialize_code_block(compiled,iter->second);
383 code->uninitialized_blocks.erase(iter);
386 /* Fixup labels. This is done at compile time, not image load time */
387 void factor_vm::fixup_labels(array *labels, code_block *compiled)
389 cell size = array_capacity(labels);
391 for(cell i = 0; i < size; i += 3)
393 relocation_class rel_class = (relocation_class)untag_fixnum(array_nth(labels,i));
394 cell offset = untag_fixnum(array_nth(labels,i + 1));
395 cell target = untag_fixnum(array_nth(labels,i + 2));
397 relocation_entry new_entry(RT_HERE,rel_class,offset);
399 instruction_operand op(new_entry,compiled,0);
400 op.store_value(target + (cell)compiled->entry_point());
405 code_block *factor_vm::allot_code_block(cell size, code_block_type type)
407 code_block *block = code->allocator->allot(size + sizeof(code_block));
409 /* If allocation failed, do a full GC and compact the code heap.
410 A full GC that occurs as a result of the data heap filling up does not
411 trigger a compaction. This setup ensures that most GCs do not compact
412 the code heap, but if the code fills up, it probably means it will be
413 fragmented after GC anyway, so its best to compact. */
416 primitive_compact_gc();
417 block = code->allocator->allot(size + sizeof(code_block));
419 /* Insufficient room even after code GC, give up */
422 std::cout << "Code heap used: " << code->allocator->occupied_space() << "\n";
423 std::cout << "Code heap free: " << code->allocator->free_space() << "\n";
424 fatal_error("Out of memory in add-compiled-block",0);
428 block->set_type(type);
433 code_block *factor_vm::add_code_block(code_block_type type, cell code_, cell labels_,
434 cell owner_, cell relocation_, cell parameters_, cell literals_,
435 cell frame_size_untagged)
437 data_root<byte_array> code(code_,this);
438 data_root<object> labels(labels_,this);
439 data_root<object> owner(owner_,this);
440 data_root<byte_array> relocation(relocation_,this);
441 data_root<array> parameters(parameters_,this);
442 data_root<array> literals(literals_,this);
444 cell code_length = array_capacity(code.untagged());
445 code_block *compiled = allot_code_block(code_length,type);
447 compiled->owner = owner.value();
449 /* slight space optimization */
450 if(relocation.type() == BYTE_ARRAY_TYPE && array_capacity(relocation.untagged()) == 0)
451 compiled->relocation = false_object;
453 compiled->relocation = relocation.value();
455 if(parameters.type() == ARRAY_TYPE && array_capacity(parameters.untagged()) == 0)
456 compiled->parameters = false_object;
458 compiled->parameters = parameters.value();
461 memcpy(compiled + 1,code.untagged() + 1,code_length);
464 if(to_boolean(labels.value()))
465 fixup_labels(labels.as<array>().untagged(),compiled);
467 compiled->set_stack_frame_size(frame_size_untagged);
469 /* Once we are ready, fill in literal and word references in this code
470 block's instruction operands. In most cases this is done right after this
471 method returns, except when compiling words with the non-optimizing
472 compiler at the beginning of bootstrap */
473 this->code->uninitialized_blocks.insert(std::make_pair(compiled,literals.value()));
474 this->code->all_blocks.insert((cell)compiled);
476 /* next time we do a minor GC, we have to trace this code block, since
477 the fields of the code_block struct might point into nursery or aging */
478 this->code->write_barrier(compiled);
483 /* Find the RT_DLSYM relocation nearest to the given return address. */
484 struct find_symbol_at_address_visitor {
490 find_symbol_at_address_visitor(factor_vm *parent_, cell return_address_) :
491 parent(parent_), return_address(return_address_),
492 symbol(false_object), library(false_object) { }
494 void operator()(instruction_operand op)
496 if(op.rel_type() == RT_DLSYM && op.pointer <= return_address)
498 code_block *compiled = op.compiled;
499 array *parameters = untag<array>(compiled->parameters);
500 cell index = op.index;
501 symbol = array_nth(parameters,index);
502 library = array_nth(parameters,index + 1);
507 /* References to undefined symbols are patched up to call this function on
508 image load. It finds the symbol and library, and throws an error. */
509 void factor_vm::undefined_symbol()
511 stack_frame *frame = innermost_stack_frame(ctx->callstack_bottom,
513 code_block *compiled = frame_code(frame);
514 cell return_address = (cell)FRAME_RETURN_ADDRESS(frame, this);
515 find_symbol_at_address_visitor visitor(this, return_address);
516 compiled->each_instruction_operand(visitor);
517 if (!to_boolean(visitor.symbol))
518 critical_error("Can't find RT_DLSYM at return address", return_address);
520 general_error(ERROR_UNDEFINED_SYMBOL,visitor.symbol,visitor.library);
523 void undefined_symbol()
525 return current_vm()->undefined_symbol();