6 cell factor_vm::compute_xt_address(cell obj)
8 switch(tagged<object>(obj).type())
11 return (cell)untag<word>(obj)->xt;
13 return (cell)untag<quotation>(obj)->xt;
15 critical_error("Expected word or quotation",obj);
20 cell factor_vm::compute_xt_pic_address(word *w, cell tagged_quot)
22 if(!to_boolean(tagged_quot) || max_pic_size == 0)
26 quotation *quot = untag<quotation>(tagged_quot);
27 if(quot_compiled_p(quot))
28 return (cell)quot->xt;
34 cell factor_vm::compute_xt_pic_address(cell w_)
37 return compute_xt_pic_address(w.untagged(),w->pic_def);
40 cell factor_vm::compute_xt_pic_tail_address(cell w_)
43 return compute_xt_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 {
71 explicit update_word_references_relocation_visitor(factor_vm *parent_) : parent(parent_) {}
73 void operator()(instruction_operand op)
79 code_block *compiled = op.load_code_block();
80 cell owner = compiled->owner;
81 if(to_boolean(owner)) op.store_value(parent->compute_xt_address(owner));
86 code_block *compiled = op.load_code_block();
87 cell owner = parent->code_block_owner(compiled);
88 if(to_boolean(owner)) op.store_value(parent->compute_xt_pic_address(owner));
93 code_block *compiled = op.load_code_block();
94 cell owner = parent->code_block_owner(compiled);
95 if(to_boolean(owner)) op.store_value(parent->compute_xt_pic_tail_address(owner));
104 /* Relocate new code blocks completely; updating references to literals,
105 dlsyms, and words. For all other words in the code heap, we only need
106 to update references to other words, without worrying about literals
108 void factor_vm::update_word_references(code_block *compiled)
110 if(code->uninitialized_p(compiled))
111 initialize_code_block(compiled);
112 /* update_word_references() is always applied to every block in
113 the code heap. Since it resets all call sites to point to
114 their canonical XT (cold entry point for non-tail calls,
115 standard entry point for tail calls), it means that no PICs
116 are referenced after this is done. So instead of polluting
117 the code heap with dead PICs that will be freed on the next
118 GC, we add them to the free list immediately. */
119 else if(compiled->pic_p())
120 code->free(compiled);
123 update_word_references_relocation_visitor visitor(this);
124 compiled->each_instruction_operand(visitor);
125 compiled->flush_icache();
129 void factor_vm::check_code_address(cell address)
132 assert(address >= code->seg->start && address < code->seg->end);
137 cell factor_vm::compute_primitive_address(cell arg)
139 return (cell)primitives[untag_fixnum(arg)];
142 /* References to undefined symbols are patched up to call this function on
144 void factor_vm::undefined_symbol()
146 general_error(ERROR_UNDEFINED_SYMBOL,false_object,false_object,NULL);
149 void undefined_symbol()
151 return tls_vm()->undefined_symbol();
154 /* Look up an external library symbol referenced by a compiled code block */
155 cell factor_vm::compute_dlsym_address(array *literals, cell index)
157 cell symbol = array_nth(literals,index);
158 cell library = array_nth(literals,index + 1);
160 dll *d = (to_boolean(library) ? untag<dll>(library) : NULL);
162 if(d != NULL && !d->handle)
163 return (cell)factor::undefined_symbol;
165 switch(tagged<object>(symbol).type())
167 case BYTE_ARRAY_TYPE:
169 symbol_char *name = alien_offset(symbol);
170 void *sym = ffi_dlsym(d,name);
175 return (cell)factor::undefined_symbol;
179 array *names = untag<array>(symbol);
180 for(cell i = 0; i < array_capacity(names); i++)
182 symbol_char *name = alien_offset(array_nth(names,i));
183 void *sym = ffi_dlsym(d,name);
188 return (cell)factor::undefined_symbol;
191 critical_error("Bad symbol specifier",symbol);
192 return (cell)factor::undefined_symbol;
196 cell factor_vm::compute_context_address()
201 cell factor_vm::compute_vm_address(cell arg)
203 return (cell)this + untag_fixnum(arg);
206 void factor_vm::store_external_address(instruction_operand op)
208 code_block *compiled = op.parent_code_block();
209 array *parameters = (to_boolean(compiled->parameters) ? untag<array>(compiled->parameters) : NULL);
210 cell index = op.parameter_index();
212 switch(op.rel_type())
215 op.store_value(compute_primitive_address(array_nth(parameters,index)));
218 op.store_value(compute_dlsym_address(parameters,index));
221 op.store_value((cell)compiled->xt());
224 op.store_value(compute_context_address());
226 case RT_MEGAMORPHIC_CACHE_HITS:
227 op.store_value((cell)&dispatch_stats.megamorphic_cache_hits);
230 op.store_value(compute_vm_address(array_nth(parameters,index)));
232 case RT_CARDS_OFFSET:
233 op.store_value(cards_offset);
235 case RT_DECKS_OFFSET:
236 op.store_value(decks_offset);
239 critical_error("Bad rel type",op.rel_type());
244 cell factor_vm::compute_here_address(cell arg, cell offset, code_block *compiled)
246 fixnum n = untag_fixnum(arg);
247 return n >= 0 ? ((cell)compiled->xt() + offset + n) : ((cell)compiled->xt() - n);
250 struct initial_code_block_visitor {
255 explicit initial_code_block_visitor(factor_vm *parent_, cell literals_)
256 : parent(parent_), literals(literals_), literal_index(0) {}
260 return array_nth(untag<array>(literals),literal_index++);
263 void operator()(instruction_operand op)
265 switch(op.rel_type())
268 op.store_value(next_literal());
271 op.store_value(parent->compute_xt_address(next_literal()));
274 op.store_value(parent->compute_xt_pic_address(next_literal()));
277 op.store_value(parent->compute_xt_pic_tail_address(next_literal()));
280 op.store_value(parent->compute_here_address(next_literal(),op.rel_offset(),op.parent_code_block()));
283 op.store_value(untag_fixnum(next_literal()));
286 parent->store_external_address(op);
292 /* Perform all fixups on a code block */
293 void factor_vm::initialize_code_block(code_block *compiled)
295 std::map<code_block *,cell>::iterator iter = code->uninitialized_blocks.find(compiled);
297 initial_code_block_visitor visitor(this,iter->second);
298 compiled->each_instruction_operand(visitor);
299 compiled->flush_icache();
301 code->uninitialized_blocks.erase(iter);
303 /* next time we do a minor GC, we have to trace this code block, since
304 the newly-installed instruction operands might point to literals in
306 code->write_barrier(compiled);
309 /* Fixup labels. This is done at compile time, not image load time */
310 void factor_vm::fixup_labels(array *labels, code_block *compiled)
312 cell size = array_capacity(labels);
314 for(cell i = 0; i < size; i += 3)
316 relocation_class rel_class = (relocation_class)untag_fixnum(array_nth(labels,i));
317 cell offset = untag_fixnum(array_nth(labels,i + 1));
318 cell target = untag_fixnum(array_nth(labels,i + 2));
320 relocation_entry new_entry(RT_HERE,rel_class,offset);
322 instruction_operand op(new_entry,compiled,0);
323 op.store_value(target + (cell)compiled->xt());
328 code_block *factor_vm::allot_code_block(cell size, code_block_type type)
330 code_block *block = code->allocator->allot(size + sizeof(code_block));
332 /* If allocation failed, do a full GC and compact the code heap.
333 A full GC that occurs as a result of the data heap filling up does not
334 trigger a compaction. This setup ensures that most GCs do not compact
335 the code heap, but if the code fills up, it probably means it will be
336 fragmented after GC anyway, so its best to compact. */
339 primitive_compact_gc();
340 block = code->allocator->allot(size + sizeof(code_block));
342 /* Insufficient room even after code GC, give up */
345 std::cout << "Code heap used: " << code->allocator->occupied_space() << "\n";
346 std::cout << "Code heap free: " << code->allocator->free_space() << "\n";
347 fatal_error("Out of memory in add-compiled-block",0);
351 block->set_type(type);
356 code_block *factor_vm::add_code_block(code_block_type type, cell code_, cell labels_, cell owner_, cell relocation_, cell parameters_, cell literals_)
358 data_root<byte_array> code(code_,this);
359 data_root<object> labels(labels_,this);
360 data_root<object> owner(owner_,this);
361 data_root<byte_array> relocation(relocation_,this);
362 data_root<array> parameters(parameters_,this);
363 data_root<array> literals(literals_,this);
365 cell code_length = array_capacity(code.untagged());
366 code_block *compiled = allot_code_block(code_length,type);
368 compiled->owner = owner.value();
370 /* slight space optimization */
371 if(relocation.type() == BYTE_ARRAY_TYPE && array_capacity(relocation.untagged()) == 0)
372 compiled->relocation = false_object;
374 compiled->relocation = relocation.value();
376 if(parameters.type() == ARRAY_TYPE && array_capacity(parameters.untagged()) == 0)
377 compiled->parameters = false_object;
379 compiled->parameters = parameters.value();
382 memcpy(compiled + 1,code.untagged() + 1,code_length);
385 if(to_boolean(labels.value()))
386 fixup_labels(labels.as<array>().untagged(),compiled);
388 /* Once we are ready, fill in literal and word references in this code
389 block's instruction operands. In most cases this is done right after this
390 method returns, except when compiling words with the non-optimizing
391 compiler at the beginning of bootstrap */
392 this->code->uninitialized_blocks.insert(std::make_pair(compiled,literals.value()));
394 /* next time we do a minor GC, we have to trace this code block, since
395 the fields of the code_block struct might point into nursery or aging */
396 this->code->write_barrier(compiled);