5 cell code_block::owner_quot() const {
6 tagged<object> executing(owner);
7 if (!optimized_p() && executing->type() == WORD_TYPE)
8 executing = executing.as<word>()->def;
9 return executing.value();
12 /* If the code block is an unoptimized quotation, we can calculate the
13 scan offset. In all other cases -1 is returned. */
14 cell code_block::scan(factor_vm* vm, void* addr) const {
15 if (type() != code_block_unoptimized) {
16 return tag_fixnum(-1);
19 tagged<object> obj(owner);
20 if (obj.type_p(WORD_TYPE))
21 obj = obj.as<word>()->def;
22 if (!obj.type_p(QUOTATION_TYPE))
23 return tag_fixnum(-1);
25 cell ofs = offset(addr);
26 return tag_fixnum(vm->quot_code_offset_to_scan(obj.value(), ofs));
29 cell factor_vm::compute_entry_point_address(cell obj) {
30 switch (tagged<object>(obj).type()) {
32 return (cell)untag<word>(obj)->entry_point;
34 return (cell)untag<quotation>(obj)->entry_point;
36 critical_error("Expected word or quotation", obj);
41 cell factor_vm::compute_entry_point_pic_address(word* w, cell tagged_quot) {
42 if (!to_boolean(tagged_quot) || max_pic_size == 0)
43 return (cell)w->entry_point;
45 quotation* quot = untag<quotation>(tagged_quot);
46 if (quot_compiled_p(quot))
47 return (cell)quot->entry_point;
49 return (cell)w->entry_point;
53 cell factor_vm::compute_entry_point_pic_address(cell w_) {
55 return compute_entry_point_pic_address(w.untagged(), w->pic_def);
58 cell factor_vm::compute_entry_point_pic_tail_address(cell w_) {
60 return compute_entry_point_pic_address(w.untagged(), w->pic_tail_def);
63 cell factor_vm::code_block_owner(code_block* compiled) {
64 tagged<object> owner(compiled->owner);
66 /* Cold generic word call sites point to quotations that call the
67 inline-cache-miss and inline-cache-miss-tail primitives. */
68 if (owner.type_p(QUOTATION_TYPE)) {
69 tagged<quotation> quot(owner.as<quotation>());
70 tagged<array> elements(quot->array);
72 FACTOR_ASSERT(array_capacity(elements.untagged()) == 5);
73 FACTOR_ASSERT(array_nth(elements.untagged(), 4) ==
74 special_objects[PIC_MISS_WORD] ||
75 array_nth(elements.untagged(), 4) ==
76 special_objects[PIC_MISS_TAIL_WORD]);
78 tagged<wrapper> word_wrapper(array_nth(elements.untagged(), 0));
79 return word_wrapper->object;
81 return compiled->owner;
84 struct update_word_references_relocation_visitor {
86 bool reset_inline_caches;
88 update_word_references_relocation_visitor(factor_vm* parent,
89 bool reset_inline_caches)
90 : parent(parent), reset_inline_caches(reset_inline_caches) {}
92 void operator()(instruction_operand op) {
93 switch (op.rel_type()) {
94 case RT_ENTRY_POINT: {
95 code_block* compiled = op.load_code_block();
96 cell owner = compiled->owner;
97 if (to_boolean(owner))
98 op.store_value(parent->compute_entry_point_address(owner));
101 case RT_ENTRY_POINT_PIC: {
102 code_block* compiled = op.load_code_block();
103 if (reset_inline_caches || !compiled->pic_p()) {
104 cell owner = parent->code_block_owner(compiled);
105 if (to_boolean(owner))
106 op.store_value(parent->compute_entry_point_pic_address(owner));
110 case RT_ENTRY_POINT_PIC_TAIL: {
111 code_block* compiled = op.load_code_block();
112 if (reset_inline_caches || !compiled->pic_p()) {
113 cell owner = parent->code_block_owner(compiled);
114 if (to_boolean(owner))
115 op.store_value(parent->compute_entry_point_pic_tail_address(owner));
125 /* Relocate new code blocks completely; updating references to literals,
126 dlsyms, and words. For all other words in the code heap, we only need
127 to update references to other words, without worrying about literals
129 void factor_vm::update_word_references(code_block* compiled,
130 bool reset_inline_caches) {
131 if (code->uninitialized_p(compiled))
132 initialize_code_block(compiled);
133 /* update_word_references() is always applied to every block in
134 the code heap. Since it resets all call sites to point to
135 their canonical entry point (cold entry point for non-tail calls,
136 standard entry point for tail calls), it means that no PICs
137 are referenced after this is done. So instead of polluting
138 the code heap with dead PICs that will be freed on the next
139 GC, we add them to the free list immediately. */
140 else if (reset_inline_caches && compiled->pic_p())
141 code->free(compiled);
143 update_word_references_relocation_visitor visitor(this,
144 reset_inline_caches);
145 compiled->each_instruction_operand(visitor);
146 compiled->flush_icache();
150 /* Look up an external library symbol referenced by a compiled code block */
151 cell factor_vm::compute_dlsym_address(array* parameters, cell index) {
152 cell symbol = array_nth(parameters, index);
153 cell library = array_nth(parameters, index + 1);
155 dll* d = (to_boolean(library) ? untag<dll>(library) : NULL);
157 void* undefined_symbol = (void*)factor::undefined_symbol;
158 undefined_symbol = FUNCTION_CODE_POINTER(undefined_symbol);
159 if (d != NULL && !d->handle)
160 return (cell)undefined_symbol;
162 switch (tagged<object>(symbol).type()) {
163 case BYTE_ARRAY_TYPE: {
164 symbol_char* name = alien_offset(symbol);
165 void* sym = ffi_dlsym(d, name);
170 return (cell)undefined_symbol;
173 array* names = untag<array>(symbol);
174 for (cell i = 0; i < array_capacity(names); i++) {
175 symbol_char* name = alien_offset(array_nth(names, i));
176 void* sym = ffi_dlsym(d, name);
181 return (cell)undefined_symbol;
184 critical_error("Bad symbol specifier in compute_dlsym_address", symbol);
185 return (cell)undefined_symbol;
190 cell factor_vm::compute_dlsym_toc_address(array* parameters, cell index) {
191 cell symbol = array_nth(parameters, index);
192 cell library = array_nth(parameters, index + 1);
194 dll* d = (to_boolean(library) ? untag<dll>(library) : NULL);
196 void* undefined_toc = (void*)factor::undefined_symbol;
197 undefined_toc = FUNCTION_TOC_POINTER(undefined_toc);
198 if (d != NULL && !d->handle)
199 return (cell)undefined_toc;
201 switch (tagged<object>(symbol).type()) {
202 case BYTE_ARRAY_TYPE: {
203 symbol_char* name = alien_offset(symbol);
204 void* toc = ffi_dlsym_toc(d, name);
208 return (cell)undefined_toc;
211 array* names = untag<array>(symbol);
212 for (cell i = 0; i < array_capacity(names); i++) {
213 symbol_char* name = alien_offset(array_nth(names, i));
214 void* toc = ffi_dlsym_toc(d, name);
219 return (cell)undefined_toc;
222 critical_error("Bad symbol specifier in compute_dlsym_toc_address", symbol);
223 return (cell)undefined_toc;
228 cell factor_vm::compute_vm_address(cell arg) {
229 return (cell)this + untag_fixnum(arg);
232 void factor_vm::store_external_address(instruction_operand op) {
233 code_block* compiled = op.compiled;
235 (to_boolean(compiled->parameters) ? untag<array>(compiled->parameters)
237 cell index = op.index;
239 switch (op.rel_type()) {
241 op.store_value(compute_dlsym_address(parameters, index));
244 op.store_value((cell)compiled->entry_point());
246 case RT_MEGAMORPHIC_CACHE_HITS:
247 op.store_value((cell)&dispatch_stats.megamorphic_cache_hits);
250 op.store_value(compute_vm_address(array_nth(parameters, index)));
252 case RT_CARDS_OFFSET:
253 op.store_value(cards_offset);
255 case RT_DECKS_OFFSET:
256 op.store_value(decks_offset);
259 case RT_EXCEPTION_HANDLER:
260 op.store_value((cell)&factor::exception_handler);
265 op.store_value(compute_dlsym_toc_address(parameters, index));
268 case RT_INLINE_CACHE_MISS:
269 op.store_value((cell)&factor::inline_cache_miss);
272 op.store_value((cell)code->safepoint_page);
275 critical_error("Bad rel type in store_external_address()", op.rel_type());
280 cell factor_vm::compute_here_address(cell arg, cell offset,
281 code_block* compiled) {
282 fixnum n = untag_fixnum(arg);
284 return (cell)compiled->entry_point() + offset + n;
286 return (cell)compiled->entry_point() - n;
289 struct initial_code_block_visitor {
294 initial_code_block_visitor(factor_vm* parent, cell literals)
295 : parent(parent), literals(literals), literal_index(0) {}
297 cell next_literal() {
298 return array_nth(untag<array>(literals), literal_index++);
301 void operator()(instruction_operand op) {
302 switch (op.rel_type()) {
304 op.store_value(next_literal());
307 op.store_value(parent->compute_entry_point_address(next_literal()));
309 case RT_ENTRY_POINT_PIC:
310 op.store_value(parent->compute_entry_point_pic_address(next_literal()));
312 case RT_ENTRY_POINT_PIC_TAIL:
314 parent->compute_entry_point_pic_tail_address(next_literal()));
317 op.store_value(parent->compute_here_address(
318 next_literal(), op.rel_offset(), op.compiled));
321 op.store_value(untag_fixnum(next_literal()));
324 parent->store_external_address(op);
330 /* Perform all fixups on a code block */
331 void factor_vm::initialize_code_block(code_block* compiled, cell literals) {
332 initial_code_block_visitor visitor(this, literals);
333 compiled->each_instruction_operand(visitor);
334 compiled->flush_icache();
336 /* next time we do a minor GC, we have to trace this code block, since
337 the newly-installed instruction operands might point to literals in
339 code->write_barrier(compiled);
342 void factor_vm::initialize_code_block(code_block* compiled) {
343 std::map<code_block*, cell>::iterator iter =
344 code->uninitialized_blocks.find(compiled);
345 initialize_code_block(compiled, iter->second);
346 code->uninitialized_blocks.erase(iter);
349 /* Fixup labels. This is done at compile time, not image load time */
350 void factor_vm::fixup_labels(array* labels, code_block* compiled) {
351 cell size = array_capacity(labels);
353 for (cell i = 0; i < size; i += 3) {
354 relocation_class rel_class =
355 (relocation_class) untag_fixnum(array_nth(labels, i));
356 cell offset = untag_fixnum(array_nth(labels, i + 1));
357 cell target = untag_fixnum(array_nth(labels, i + 2));
359 relocation_entry new_entry(RT_HERE, rel_class, offset);
361 instruction_operand op(new_entry, compiled, 0);
362 op.store_value(target + (cell)compiled->entry_point());
367 /* Allocates memory */
368 code_block* factor_vm::allot_code_block(cell size, code_block_type type) {
369 code_block* block = code->allocator->allot(size + sizeof(code_block));
371 /* If allocation failed, do a full GC and compact the code heap.
372 A full GC that occurs as a result of the data heap filling up does not
373 trigger a compaction. This setup ensures that most GCs do not compact
374 the code heap, but if the code fills up, it probably means it will be
375 fragmented after GC anyway, so its best to compact. */
377 primitive_compact_gc();
378 block = code->allocator->allot(size + sizeof(code_block));
380 /* Insufficient room even after code GC, give up */
382 std::cout << "Code heap used: " << code->allocator->occupied_space()
384 std::cout << "Code heap free: " << code->allocator->free_space() << "\n";
385 fatal_error("Out of memory in add-compiled-block", 0);
389 block->set_type(type);
394 /* Allocates memory */
395 code_block* factor_vm::add_code_block(code_block_type type, cell code_,
396 cell labels_, cell owner_,
397 cell relocation_, cell parameters_,
399 cell frame_size_untagged) {
400 data_root<byte_array> code(code_, this);
401 data_root<object> labels(labels_, this);
402 data_root<object> owner(owner_, this);
403 data_root<byte_array> relocation(relocation_, this);
404 data_root<array> parameters(parameters_, this);
405 data_root<array> literals(literals_, this);
407 cell code_length = array_capacity(code.untagged());
408 code_block* compiled = allot_code_block(code_length, type);
410 compiled->owner = owner.value();
412 /* slight space optimization */
413 if (relocation.type() == BYTE_ARRAY_TYPE &&
414 array_capacity(relocation.untagged()) == 0)
415 compiled->relocation = false_object;
417 compiled->relocation = relocation.value();
419 if (parameters.type() == ARRAY_TYPE &&
420 array_capacity(parameters.untagged()) == 0)
421 compiled->parameters = false_object;
423 compiled->parameters = parameters.value();
426 memcpy(compiled + 1, code.untagged() + 1, code_length);
429 if (to_boolean(labels.value()))
430 fixup_labels(labels.as<array>().untagged(), compiled);
432 compiled->set_stack_frame_size(frame_size_untagged);
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(
439 std::make_pair(compiled, literals.value()));
440 this->code->all_blocks.insert((cell)compiled);
442 /* next time we do a minor GC, we have to trace this code block, since
443 the fields of the code_block struct might point into nursery or aging */
444 this->code->write_barrier(compiled);
449 /* Find the RT_DLSYM relocation nearest to the given return address. */
450 struct find_symbol_at_address_visitor {
456 find_symbol_at_address_visitor(factor_vm* parent, cell return_address)
458 return_address(return_address),
459 symbol(false_object),
460 library(false_object) {}
462 void operator()(instruction_operand op) {
463 if (op.rel_type() == RT_DLSYM && op.pointer <= return_address) {
464 code_block* compiled = op.compiled;
465 array* parameters = untag<array>(compiled->parameters);
466 cell index = op.index;
467 symbol = array_nth(parameters, index);
468 library = array_nth(parameters, index + 1);
473 /* References to undefined symbols are patched up to call this function on
474 image load. It finds the symbol and library, and throws an error. */
475 void factor_vm::undefined_symbol() {
476 void* frame = ctx->callstack_top;
477 void* return_address = frame_return_address(frame);
478 code_block* compiled = code->code_block_for_address((cell)return_address);
479 find_symbol_at_address_visitor visitor(this, (cell)return_address);
480 compiled->each_instruction_operand(visitor);
481 if (!to_boolean(visitor.symbol))
482 critical_error("Can't find RT_DLSYM at return address",
483 (cell)return_address);
485 general_error(ERROR_UNDEFINED_SYMBOL, visitor.symbol, visitor.library);
488 void undefined_symbol() { return current_vm()->undefined_symbol(); }