vm/byte_arrays.o \
vm/callbacks.o \
vm/callstack.o \
- vm/code_block.o \
+ vm/code_blocks.o \
vm/code_heap.o \
vm/compaction.o \
vm/contexts.o \
vm/data_heap_checker.o \
vm/debug.o \
vm/dispatch.o \
+ vm/embedded_pointers.o \
vm/errors.o \
vm/factor.o \
vm/free_list.o \
cell rel_class = untag_fixnum(array_nth(code_template.untagged(),1));
cell offset = untag_fixnum(array_nth(code_template.untagged(),3));
- parent->store_address_in_code_block(rel_class,
- (cell)(stub + 1) + offset,
- (cell)(stub->compiled + 1));
+ embedded_pointer ptr(rel_class,offset + (cell)(stub + 1));
+ ptr.store_address((cell)(stub->compiled + 1));
flush_icache((cell)stub,stub->size);
}
+++ /dev/null
-#include "master.hpp"
-
-namespace factor
-{
-
-relocation_type factor_vm::relocation_type_of(relocation_entry r)
-{
- return (relocation_type)((r & 0xf0000000) >> 28);
-}
-
-relocation_class factor_vm::relocation_class_of(relocation_entry r)
-{
- return (relocation_class)((r & 0x0f000000) >> 24);
-}
-
-cell factor_vm::relocation_offset_of(relocation_entry r)
-{
- return (r & 0x00ffffff);
-}
-
-void factor_vm::flush_icache_for(code_block *block)
-{
- flush_icache((cell)block,block->size());
-}
-
-int factor_vm::number_of_parameters(relocation_type type)
-{
- switch(type)
- {
- case RT_PRIMITIVE:
- case RT_XT:
- case RT_XT_PIC:
- case RT_XT_PIC_TAIL:
- case RT_IMMEDIATE:
- case RT_HERE:
- case RT_UNTAGGED:
- case RT_VM:
- return 1;
- case RT_DLSYM:
- return 2;
- case RT_THIS:
- case RT_CONTEXT:
- case RT_MEGAMORPHIC_CACHE_HITS:
- case RT_CARDS_OFFSET:
- case RT_DECKS_OFFSET:
- return 0;
- default:
- critical_error("Bad rel type",type);
- return -1; /* Can't happen */
- }
-}
-
-void *factor_vm::object_xt(cell obj)
-{
- switch(tagged<object>(obj).type())
- {
- case WORD_TYPE:
- return untag<word>(obj)->xt;
- case QUOTATION_TYPE:
- return untag<quotation>(obj)->xt;
- default:
- critical_error("Expected word or quotation",obj);
- return NULL;
- }
-}
-
-void *factor_vm::xt_pic(word *w, cell tagged_quot)
-{
- if(!to_boolean(tagged_quot) || max_pic_size == 0)
- return w->xt;
- else
- {
- quotation *quot = untag<quotation>(tagged_quot);
- if(quot->code)
- return quot->xt;
- else
- return w->xt;
- }
-}
-
-void *factor_vm::word_xt_pic(word *w)
-{
- return xt_pic(w,w->pic_def);
-}
-
-void *factor_vm::word_xt_pic_tail(word *w)
-{
- return xt_pic(w,w->pic_tail_def);
-}
-
-/* References to undefined symbols are patched up to call this function on
-image load */
-void factor_vm::undefined_symbol()
-{
- general_error(ERROR_UNDEFINED_SYMBOL,false_object,false_object,NULL);
-}
-
-void undefined_symbol()
-{
- return tls_vm()->undefined_symbol();
-}
-
-/* Look up an external library symbol referenced by a compiled code block */
-void *factor_vm::get_rel_symbol(array *literals, cell index)
-{
- cell symbol = array_nth(literals,index);
- cell library = array_nth(literals,index + 1);
-
- dll *d = (to_boolean(library) ? untag<dll>(library) : NULL);
-
- if(d != NULL && !d->dll)
- return (void *)factor::undefined_symbol;
-
- switch(tagged<object>(symbol).type())
- {
- case BYTE_ARRAY_TYPE:
- {
- symbol_char *name = alien_offset(symbol);
- void *sym = ffi_dlsym(d,name);
-
- if(sym)
- return sym;
- else
- {
- return (void *)factor::undefined_symbol;
- }
- }
- case ARRAY_TYPE:
- {
- array *names = untag<array>(symbol);
- for(cell i = 0; i < array_capacity(names); i++)
- {
- symbol_char *name = alien_offset(array_nth(names,i));
- void *sym = ffi_dlsym(d,name);
-
- if(sym)
- return sym;
- }
- return (void *)factor::undefined_symbol;
- }
- default:
- critical_error("Bad symbol specifier",symbol);
- return (void *)factor::undefined_symbol;
- }
-}
-
-cell factor_vm::compute_relocation(relocation_entry rel, cell index, code_block *compiled)
-{
- array *literals = (to_boolean(compiled->literals)
- ? untag<array>(compiled->literals) : NULL);
- cell offset = relocation_offset_of(rel) + (cell)compiled->xt();
-
-#define ARG array_nth(literals,index)
-
- switch(relocation_type_of(rel))
- {
- case RT_PRIMITIVE:
- return (cell)primitives[untag_fixnum(ARG)];
- case RT_DLSYM:
- return (cell)get_rel_symbol(literals,index);
- case RT_IMMEDIATE:
- return ARG;
- case RT_XT:
- return (cell)object_xt(ARG);
- case RT_XT_PIC:
- return (cell)word_xt_pic(untag<word>(ARG));
- case RT_XT_PIC_TAIL:
- return (cell)word_xt_pic_tail(untag<word>(ARG));
- case RT_HERE:
- {
- fixnum arg = untag_fixnum(ARG);
- return (arg >= 0 ? offset + arg : (cell)(compiled + 1) - arg);
- }
- case RT_THIS:
- return (cell)(compiled + 1);
- case RT_CONTEXT:
- return (cell)&ctx;
- case RT_UNTAGGED:
- return untag_fixnum(ARG);
- case RT_MEGAMORPHIC_CACHE_HITS:
- return (cell)&dispatch_stats.megamorphic_cache_hits;
- case RT_VM:
- return (cell)this + untag_fixnum(ARG);
- case RT_CARDS_OFFSET:
- return cards_offset;
- case RT_DECKS_OFFSET:
- return decks_offset;
- default:
- critical_error("Bad rel type",rel);
- return 0; /* Can't happen */
- }
-
-#undef ARG
-}
-
-template<typename Iterator> void factor_vm::iterate_relocations(code_block *compiled, Iterator &iter)
-{
- if(to_boolean(compiled->relocation))
- {
- byte_array *relocation = untag<byte_array>(compiled->relocation);
-
- cell index = 0;
- cell length = array_capacity(relocation) / sizeof(relocation_entry);
-
- for(cell i = 0; i < length; i++)
- {
- relocation_entry rel = relocation->data<relocation_entry>()[i];
- iter(rel,index,compiled);
- index += number_of_parameters(relocation_type_of(rel));
- }
- }
-}
-
-/* Store a 32-bit value into a PowerPC LIS/ORI sequence */
-void factor_vm::store_address_2_2(cell *ptr, cell value)
-{
- ptr[-1] = ((ptr[-1] & ~0xffff) | ((value >> 16) & 0xffff));
- ptr[ 0] = ((ptr[ 0] & ~0xffff) | (value & 0xffff));
-}
-
-/* Store a value into a bitfield of a PowerPC instruction */
-void factor_vm::store_address_masked(cell *ptr, fixnum value, cell mask, fixnum shift)
-{
- /* This is unaccurate but good enough */
- fixnum test = (fixnum)mask >> 1;
- if(value <= -test || value >= test)
- critical_error("Value does not fit inside relocation",0);
-
- *ptr = ((*ptr & ~mask) | ((value >> shift) & mask));
-}
-
-/* Perform a fixup on a code block */
-void factor_vm::store_address_in_code_block(cell klass, cell offset, fixnum absolute_value)
-{
- fixnum relative_value = absolute_value - offset;
-
- switch(klass)
- {
- case RC_ABSOLUTE_CELL:
- *(cell *)offset = absolute_value;
- break;
- case RC_ABSOLUTE:
- *(u32*)offset = absolute_value;
- break;
- case RC_RELATIVE:
- *(u32*)offset = relative_value - sizeof(u32);
- break;
- case RC_ABSOLUTE_PPC_2_2:
- store_address_2_2((cell *)offset,absolute_value);
- break;
- case RC_ABSOLUTE_PPC_2:
- store_address_masked((cell *)offset,absolute_value,rel_absolute_ppc_2_mask,0);
- break;
- case RC_RELATIVE_PPC_2:
- store_address_masked((cell *)offset,relative_value,rel_relative_ppc_2_mask,0);
- break;
- case RC_RELATIVE_PPC_3:
- store_address_masked((cell *)offset,relative_value,rel_relative_ppc_3_mask,0);
- break;
- case RC_RELATIVE_ARM_3:
- store_address_masked((cell *)offset,relative_value - sizeof(cell) * 2,
- rel_relative_arm_3_mask,2);
- break;
- case RC_INDIRECT_ARM:
- store_address_masked((cell *)offset,relative_value - sizeof(cell),
- rel_indirect_arm_mask,0);
- break;
- case RC_INDIRECT_ARM_PC:
- store_address_masked((cell *)offset,relative_value - sizeof(cell) * 2,
- rel_indirect_arm_mask,0);
- break;
- default:
- critical_error("Bad rel class",klass);
- break;
- }
-}
-
-struct literal_references_updater {
- factor_vm *parent;
-
- explicit literal_references_updater(factor_vm *parent_) : parent(parent_) {}
-
- void operator()(relocation_entry rel, cell index, code_block *compiled)
- {
- if(parent->relocation_type_of(rel) == RT_IMMEDIATE)
- {
- cell offset = parent->relocation_offset_of(rel) + (cell)(compiled + 1);
- array *literals = untag<array>(compiled->literals);
- fixnum absolute_value = array_nth(literals,index);
- parent->store_address_in_code_block(parent->relocation_class_of(rel),offset,absolute_value);
- }
- }
-};
-
-/* Update pointers to literals from compiled code. */
-void factor_vm::update_literal_references(code_block *compiled)
-{
- if(!code->needs_fixup_p(compiled))
- {
- literal_references_updater updater(this);
- iterate_relocations(compiled,updater);
- flush_icache_for(compiled);
- }
-}
-
-/* Compute an address to store at a relocation */
-void factor_vm::relocate_code_block_step(relocation_entry rel, cell index, code_block *compiled)
-{
-#ifdef FACTOR_DEBUG
- if(to_boolean(compiled->literals))
- tagged<array>(compiled->literals).untag_check(this);
- if(to_boolean(compiled->relocation))
- tagged<byte_array>(compiled->relocation).untag_check(this);
-#endif
-
- store_address_in_code_block(relocation_class_of(rel),
- relocation_offset_of(rel) + (cell)compiled->xt(),
- compute_relocation(rel,index,compiled));
-}
-
-struct word_references_updater {
- factor_vm *parent;
-
- explicit word_references_updater(factor_vm *parent_) : parent(parent_) {}
- void operator()(relocation_entry rel, cell index, code_block *compiled)
- {
- relocation_type type = parent->relocation_type_of(rel);
- if(type == RT_XT || type == RT_XT_PIC || type == RT_XT_PIC_TAIL)
- parent->relocate_code_block_step(rel,index,compiled);
- }
-};
-
-/* Relocate new code blocks completely; updating references to literals,
-dlsyms, and words. For all other words in the code heap, we only need
-to update references to other words, without worrying about literals
-or dlsyms. */
-void factor_vm::update_word_references(code_block *compiled)
-{
- if(code->needs_fixup_p(compiled))
- relocate_code_block(compiled);
- /* update_word_references() is always applied to every block in
- the code heap. Since it resets all call sites to point to
- their canonical XT (cold entry point for non-tail calls,
- standard entry point for tail calls), it means that no PICs
- are referenced after this is done. So instead of polluting
- the code heap with dead PICs that will be freed on the next
- GC, we add them to the free list immediately. */
- else if(compiled->pic_p())
- code->code_heap_free(compiled);
- else
- {
- word_references_updater updater(this);
- iterate_relocations(compiled,updater);
- flush_icache_for(compiled);
- }
-}
-
-/* This runs after a full collection */
-struct literal_and_word_references_updater {
- factor_vm *parent;
-
- explicit literal_and_word_references_updater(factor_vm *parent_) : parent(parent_) {}
-
- void operator()(relocation_entry rel, cell index, code_block *compiled)
- {
- relocation_type type = parent->relocation_type_of(rel);
- switch(type)
- {
- case RT_IMMEDIATE:
- case RT_XT:
- case RT_XT_PIC:
- case RT_XT_PIC_TAIL:
- parent->relocate_code_block_step(rel,index,compiled);
- break;
- default:
- break;
- }
- }
-};
-
-void factor_vm::update_code_block_words_and_literals(code_block *compiled)
-{
- if(code->needs_fixup_p(compiled))
- relocate_code_block(compiled);
- else
- {
- literal_and_word_references_updater updater(this);
- iterate_relocations(compiled,updater);
- flush_icache_for(compiled);
- }
-}
-
-void factor_vm::check_code_address(cell address)
-{
-#ifdef FACTOR_DEBUG
- assert(address >= code->seg->start && address < code->seg->end);
-#endif
-}
-
-struct code_block_relocator {
- factor_vm *parent;
-
- explicit code_block_relocator(factor_vm *parent_) : parent(parent_) {}
-
- void operator()(relocation_entry rel, cell index, code_block *compiled)
- {
- parent->relocate_code_block_step(rel,index,compiled);
- }
-};
-
-/* Perform all fixups on a code block */
-void factor_vm::relocate_code_block(code_block *compiled)
-{
- code->needs_fixup.erase(compiled);
- code_block_relocator relocator(this);
- iterate_relocations(compiled,relocator);
- flush_icache_for(compiled);
-}
-
-/* Fixup labels. This is done at compile time, not image load time */
-void factor_vm::fixup_labels(array *labels, code_block *compiled)
-{
- cell i;
- cell size = array_capacity(labels);
-
- for(i = 0; i < size; i += 3)
- {
- cell klass = untag_fixnum(array_nth(labels,i));
- cell offset = untag_fixnum(array_nth(labels,i + 1));
- cell target = untag_fixnum(array_nth(labels,i + 2));
-
- store_address_in_code_block(klass,
- offset + (cell)(compiled + 1),
- target + (cell)(compiled + 1));
- }
-}
-
-/* Might GC */
-code_block *factor_vm::allot_code_block(cell size, code_block_type type)
-{
- code_block *block = code->allocator->allot(size + sizeof(code_block));
-
- /* If allocation failed, do a full GC and compact the code heap.
- A full GC that occurs as a result of the data heap filling up does not
- trigger a compaction. This setup ensures that most GCs do not compact
- the code heap, but if the code fills up, it probably means it will be
- fragmented after GC anyway, so its best to compact. */
- if(block == NULL)
- {
- primitive_compact_gc();
- block = code->allocator->allot(size + sizeof(code_block));
-
- /* Insufficient room even after code GC, give up */
- if(block == NULL)
- {
- std::cout << "Code heap used: " << code->allocator->occupied_space() << "\n";
- std::cout << "Code heap free: " << code->allocator->free_space() << "\n";
- fatal_error("Out of memory in add-compiled-block",0);
- }
- }
-
- block->set_type(type);
- return block;
-}
-
-/* Might GC */
-code_block *factor_vm::add_code_block(code_block_type type, cell code_, cell labels_, cell owner_, cell relocation_, cell literals_)
-{
- data_root<byte_array> code(code_,this);
- data_root<object> labels(labels_,this);
- data_root<object> owner(owner_,this);
- data_root<byte_array> relocation(relocation_,this);
- data_root<array> literals(literals_,this);
-
- cell code_length = array_capacity(code.untagged());
- code_block *compiled = allot_code_block(code_length,type);
-
- compiled->owner = owner.value();
-
- /* slight space optimization */
- if(relocation.type() == BYTE_ARRAY_TYPE && array_capacity(relocation.untagged()) == 0)
- compiled->relocation = false_object;
- else
- compiled->relocation = relocation.value();
-
- if(literals.type() == ARRAY_TYPE && array_capacity(literals.untagged()) == 0)
- compiled->literals = false_object;
- else
- compiled->literals = literals.value();
-
- /* code */
- memcpy(compiled + 1,code.untagged() + 1,code_length);
-
- /* fixup labels */
- if(to_boolean(labels.value()))
- fixup_labels(labels.as<array>().untagged(),compiled);
-
- /* next time we do a minor GC, we have to scan the code heap for
- literals */
- this->code->write_barrier(compiled);
- this->code->needs_fixup.insert(compiled);
-
- return compiled;
-}
-
-}
+++ /dev/null
-namespace factor
-{
-
-enum relocation_type {
- /* arg is a primitive number */
- RT_PRIMITIVE,
- /* arg is a literal table index, holding an array pair (symbol/dll) */
- RT_DLSYM,
- /* a pointer to a compiled word reference */
- RT_DISPATCH,
- /* a word or quotation's general entry point */
- RT_XT,
- /* a word's PIC entry point */
- RT_XT_PIC,
- /* a word's tail-call PIC entry point */
- RT_XT_PIC_TAIL,
- /* current offset */
- RT_HERE,
- /* current code block */
- RT_THIS,
- /* immediate literal */
- RT_IMMEDIATE,
- /* address of ctx var */
- RT_CONTEXT,
- /* untagged fixnum literal */
- RT_UNTAGGED,
- /* address of megamorphic_cache_hits var */
- RT_MEGAMORPHIC_CACHE_HITS,
- /* address of vm object */
- RT_VM,
- /* value of vm->cards_offset */
- RT_CARDS_OFFSET,
- /* value of vm->decks_offset */
- RT_DECKS_OFFSET,
-};
-
-enum relocation_class {
- /* absolute address in a 64-bit location */
- RC_ABSOLUTE_CELL,
- /* absolute address in a 32-bit location */
- RC_ABSOLUTE,
- /* relative address in a 32-bit location */
- RC_RELATIVE,
- /* absolute address in a PowerPC LIS/ORI sequence */
- RC_ABSOLUTE_PPC_2_2,
- /* absolute address in a PowerPC LWZ instruction */
- RC_ABSOLUTE_PPC_2,
- /* relative address in a PowerPC LWZ/STW/BC instruction */
- RC_RELATIVE_PPC_2,
- /* relative address in a PowerPC B/BL instruction */
- RC_RELATIVE_PPC_3,
- /* relative address in an ARM B/BL instruction */
- RC_RELATIVE_ARM_3,
- /* pointer to address in an ARM LDR/STR instruction */
- RC_INDIRECT_ARM,
- /* pointer to address in an ARM LDR/STR instruction offset by 8 bytes */
- RC_INDIRECT_ARM_PC
-};
-
-static const cell rel_absolute_ppc_2_mask = 0xffff;
-static const cell rel_relative_ppc_2_mask = 0xfffc;
-static const cell rel_relative_ppc_3_mask = 0x3fffffc;
-static const cell rel_indirect_arm_mask = 0xfff;
-static const cell rel_relative_arm_3_mask = 0xffffff;
-
-/* code relocation table consists of a table of entries for each fixup */
-typedef u32 relocation_entry;
-
-}
--- /dev/null
+#include "master.hpp"
+
+namespace factor
+{
+
+void factor_vm::flush_icache_for(code_block *block)
+{
+ flush_icache((cell)block,block->size());
+}
+
+void *factor_vm::object_xt(cell obj)
+{
+ switch(tagged<object>(obj).type())
+ {
+ case WORD_TYPE:
+ return untag<word>(obj)->xt;
+ case QUOTATION_TYPE:
+ return untag<quotation>(obj)->xt;
+ default:
+ critical_error("Expected word or quotation",obj);
+ return NULL;
+ }
+}
+
+void *factor_vm::xt_pic(word *w, cell tagged_quot)
+{
+ if(!to_boolean(tagged_quot) || max_pic_size == 0)
+ return w->xt;
+ else
+ {
+ quotation *quot = untag<quotation>(tagged_quot);
+ if(quot->code)
+ return quot->xt;
+ else
+ return w->xt;
+ }
+}
+
+void *factor_vm::word_xt_pic(word *w)
+{
+ return xt_pic(w,w->pic_def);
+}
+
+void *factor_vm::word_xt_pic_tail(word *w)
+{
+ return xt_pic(w,w->pic_tail_def);
+}
+
+/* References to undefined symbols are patched up to call this function on
+image load */
+void factor_vm::undefined_symbol()
+{
+ general_error(ERROR_UNDEFINED_SYMBOL,false_object,false_object,NULL);
+}
+
+void undefined_symbol()
+{
+ return tls_vm()->undefined_symbol();
+}
+
+/* Look up an external library symbol referenced by a compiled code block */
+void *factor_vm::get_rel_symbol(array *literals, cell index)
+{
+ cell symbol = array_nth(literals,index);
+ cell library = array_nth(literals,index + 1);
+
+ dll *d = (to_boolean(library) ? untag<dll>(library) : NULL);
+
+ if(d != NULL && !d->dll)
+ return (void *)factor::undefined_symbol;
+
+ switch(tagged<object>(symbol).type())
+ {
+ case BYTE_ARRAY_TYPE:
+ {
+ symbol_char *name = alien_offset(symbol);
+ void *sym = ffi_dlsym(d,name);
+
+ if(sym)
+ return sym;
+ else
+ {
+ return (void *)factor::undefined_symbol;
+ }
+ }
+ case ARRAY_TYPE:
+ {
+ array *names = untag<array>(symbol);
+ for(cell i = 0; i < array_capacity(names); i++)
+ {
+ symbol_char *name = alien_offset(array_nth(names,i));
+ void *sym = ffi_dlsym(d,name);
+
+ if(sym)
+ return sym;
+ }
+ return (void *)factor::undefined_symbol;
+ }
+ default:
+ critical_error("Bad symbol specifier",symbol);
+ return (void *)factor::undefined_symbol;
+ }
+}
+
+cell factor_vm::compute_relocation(relocation_entry rel, cell index, code_block *compiled)
+{
+ array *literals = (to_boolean(compiled->literals)
+ ? untag<array>(compiled->literals) : NULL);
+ cell offset = rel.rel_offset() + (cell)compiled->xt();
+
+#define ARG array_nth(literals,index)
+
+ switch(rel.rel_type())
+ {
+ case RT_PRIMITIVE:
+ return (cell)primitives[untag_fixnum(ARG)];
+ case RT_DLSYM:
+ return (cell)get_rel_symbol(literals,index);
+ case RT_IMMEDIATE:
+ return ARG;
+ case RT_XT:
+ return (cell)object_xt(ARG);
+ case RT_XT_PIC:
+ return (cell)word_xt_pic(untag<word>(ARG));
+ case RT_XT_PIC_TAIL:
+ return (cell)word_xt_pic_tail(untag<word>(ARG));
+ case RT_HERE:
+ {
+ fixnum arg = untag_fixnum(ARG);
+ return (arg >= 0 ? offset + arg : (cell)(compiled + 1) - arg);
+ }
+ case RT_THIS:
+ return (cell)(compiled + 1);
+ case RT_CONTEXT:
+ return (cell)&ctx;
+ case RT_UNTAGGED:
+ return untag_fixnum(ARG);
+ case RT_MEGAMORPHIC_CACHE_HITS:
+ return (cell)&dispatch_stats.megamorphic_cache_hits;
+ case RT_VM:
+ return (cell)this + untag_fixnum(ARG);
+ case RT_CARDS_OFFSET:
+ return cards_offset;
+ case RT_DECKS_OFFSET:
+ return decks_offset;
+ default:
+ critical_error("Bad rel type",rel.rel_type());
+ return 0; /* Can't happen */
+ }
+
+#undef ARG
+}
+
+template<typename Iterator> void factor_vm::iterate_relocations(code_block *compiled, Iterator &iter)
+{
+ if(to_boolean(compiled->relocation))
+ {
+ byte_array *relocation = untag<byte_array>(compiled->relocation);
+
+ cell index = 0;
+ cell length = array_capacity(relocation) / sizeof(relocation_entry);
+
+ for(cell i = 0; i < length; i++)
+ {
+ relocation_entry rel = relocation->data<relocation_entry>()[i];
+ iter(rel,index,compiled);
+ index += rel.number_of_parameters();
+ }
+ }
+}
+
+struct literal_references_updater {
+ factor_vm *parent;
+
+ explicit literal_references_updater(factor_vm *parent_) : parent(parent_) {}
+
+ void operator()(relocation_entry rel, cell index, code_block *compiled)
+ {
+ if(rel.rel_type() == RT_IMMEDIATE)
+ {
+ embedded_pointer ptr(rel.rel_class(),rel.rel_offset() + (cell)(compiled + 1));
+ array *literals = untag<array>(compiled->literals);
+ ptr.store_address(array_nth(literals,index));
+ }
+ }
+};
+
+/* Update pointers to literals from compiled code. */
+void factor_vm::update_literal_references(code_block *compiled)
+{
+ if(!code->needs_fixup_p(compiled))
+ {
+ literal_references_updater updater(this);
+ iterate_relocations(compiled,updater);
+ flush_icache_for(compiled);
+ }
+}
+
+/* Compute an address to store at a relocation */
+void factor_vm::relocate_code_block_step(relocation_entry rel, cell index, code_block *compiled)
+{
+#ifdef FACTOR_DEBUG
+ if(to_boolean(compiled->literals))
+ tagged<array>(compiled->literals).untag_check(this);
+ if(to_boolean(compiled->relocation))
+ tagged<byte_array>(compiled->relocation).untag_check(this);
+#endif
+
+ embedded_pointer ptr(rel.rel_class(),rel.rel_offset() + (cell)compiled->xt());
+ ptr.store_address(compute_relocation(rel,index,compiled));
+}
+
+struct word_references_updater {
+ factor_vm *parent;
+
+ explicit word_references_updater(factor_vm *parent_) : parent(parent_) {}
+ void operator()(relocation_entry rel, cell index, code_block *compiled)
+ {
+ relocation_type type = rel.rel_type();
+ if(type == RT_XT || type == RT_XT_PIC || type == RT_XT_PIC_TAIL)
+ parent->relocate_code_block_step(rel,index,compiled);
+ }
+};
+
+/* Relocate new code blocks completely; updating references to literals,
+dlsyms, and words. For all other words in the code heap, we only need
+to update references to other words, without worrying about literals
+or dlsyms. */
+void factor_vm::update_word_references(code_block *compiled)
+{
+ if(code->needs_fixup_p(compiled))
+ relocate_code_block(compiled);
+ /* update_word_references() is always applied to every block in
+ the code heap. Since it resets all call sites to point to
+ their canonical XT (cold entry point for non-tail calls,
+ standard entry point for tail calls), it means that no PICs
+ are referenced after this is done. So instead of polluting
+ the code heap with dead PICs that will be freed on the next
+ GC, we add them to the free list immediately. */
+ else if(compiled->pic_p())
+ code->code_heap_free(compiled);
+ else
+ {
+ word_references_updater updater(this);
+ iterate_relocations(compiled,updater);
+ flush_icache_for(compiled);
+ }
+}
+
+/* This runs after a full collection */
+struct literal_and_word_references_updater {
+ factor_vm *parent;
+
+ explicit literal_and_word_references_updater(factor_vm *parent_) : parent(parent_) {}
+
+ void operator()(relocation_entry rel, cell index, code_block *compiled)
+ {
+ relocation_type type = rel.rel_type();
+
+ switch(type)
+ {
+ case RT_IMMEDIATE:
+ case RT_XT:
+ case RT_XT_PIC:
+ case RT_XT_PIC_TAIL:
+ parent->relocate_code_block_step(rel,index,compiled);
+ break;
+ default:
+ break;
+ }
+ }
+};
+
+void factor_vm::update_code_block_words_and_literals(code_block *compiled)
+{
+ if(code->needs_fixup_p(compiled))
+ relocate_code_block(compiled);
+ else
+ {
+ literal_and_word_references_updater updater(this);
+ iterate_relocations(compiled,updater);
+ flush_icache_for(compiled);
+ }
+}
+
+void factor_vm::check_code_address(cell address)
+{
+#ifdef FACTOR_DEBUG
+ assert(address >= code->seg->start && address < code->seg->end);
+#endif
+}
+
+struct code_block_relocator {
+ factor_vm *parent;
+
+ explicit code_block_relocator(factor_vm *parent_) : parent(parent_) {}
+
+ void operator()(relocation_entry rel, cell index, code_block *compiled)
+ {
+ parent->relocate_code_block_step(rel,index,compiled);
+ }
+};
+
+/* Perform all fixups on a code block */
+void factor_vm::relocate_code_block(code_block *compiled)
+{
+ code->needs_fixup.erase(compiled);
+ code_block_relocator relocator(this);
+ iterate_relocations(compiled,relocator);
+ flush_icache_for(compiled);
+}
+
+/* Fixup labels. This is done at compile time, not image load time */
+void factor_vm::fixup_labels(array *labels, code_block *compiled)
+{
+ cell i;
+ cell size = array_capacity(labels);
+
+ for(i = 0; i < size; i += 3)
+ {
+ cell rel_class = untag_fixnum(array_nth(labels,i));
+ cell offset = untag_fixnum(array_nth(labels,i + 1));
+ cell target = untag_fixnum(array_nth(labels,i + 2));
+
+ embedded_pointer ptr(rel_class,offset + (cell)(compiled + 1));
+ ptr.store_address(target + (cell)(compiled + 1));
+ }
+}
+
+/* Might GC */
+code_block *factor_vm::allot_code_block(cell size, code_block_type type)
+{
+ code_block *block = code->allocator->allot(size + sizeof(code_block));
+
+ /* If allocation failed, do a full GC and compact the code heap.
+ A full GC that occurs as a result of the data heap filling up does not
+ trigger a compaction. This setup ensures that most GCs do not compact
+ the code heap, but if the code fills up, it probably means it will be
+ fragmented after GC anyway, so its best to compact. */
+ if(block == NULL)
+ {
+ primitive_compact_gc();
+ block = code->allocator->allot(size + sizeof(code_block));
+
+ /* Insufficient room even after code GC, give up */
+ if(block == NULL)
+ {
+ std::cout << "Code heap used: " << code->allocator->occupied_space() << "\n";
+ std::cout << "Code heap free: " << code->allocator->free_space() << "\n";
+ fatal_error("Out of memory in add-compiled-block",0);
+ }
+ }
+
+ block->set_type(type);
+ return block;
+}
+
+/* Might GC */
+code_block *factor_vm::add_code_block(code_block_type type, cell code_, cell labels_, cell owner_, cell relocation_, cell literals_)
+{
+ data_root<byte_array> code(code_,this);
+ data_root<object> labels(labels_,this);
+ data_root<object> owner(owner_,this);
+ data_root<byte_array> relocation(relocation_,this);
+ data_root<array> literals(literals_,this);
+
+ cell code_length = array_capacity(code.untagged());
+ code_block *compiled = allot_code_block(code_length,type);
+
+ compiled->owner = owner.value();
+
+ /* slight space optimization */
+ if(relocation.type() == BYTE_ARRAY_TYPE && array_capacity(relocation.untagged()) == 0)
+ compiled->relocation = false_object;
+ else
+ compiled->relocation = relocation.value();
+
+ if(literals.type() == ARRAY_TYPE && array_capacity(literals.untagged()) == 0)
+ compiled->literals = false_object;
+ else
+ compiled->literals = literals.value();
+
+ /* code */
+ memcpy(compiled + 1,code.untagged() + 1,code_length);
+
+ /* fixup labels */
+ if(to_boolean(labels.value()))
+ fixup_labels(labels.as<array>().untagged(),compiled);
+
+ /* next time we do a minor GC, we have to scan the code heap for
+ literals */
+ this->code->write_barrier(compiled);
+ this->code->needs_fixup.insert(compiled);
+
+ return compiled;
+}
+
+}
--- /dev/null
+namespace factor
+{
+
+/* The compiled code heap is structured into blocks. */
+struct code_block
+{
+ cell header;
+ cell owner; /* tagged pointer to word, quotation or f */
+ cell literals; /* tagged pointer to array or f */
+ cell relocation; /* tagged pointer to byte-array or f */
+
+ bool free_p() const
+ {
+ return header & 1 == 1;
+ }
+
+ code_block_type type() const
+ {
+ return (code_block_type)((header >> 1) & 0x3);
+ }
+
+ void set_type(code_block_type type)
+ {
+ header = ((header & ~0x7) | (type << 1));
+ }
+
+ bool pic_p() const
+ {
+ return type() == code_block_pic;
+ }
+
+ bool optimized_p() const
+ {
+ return type() == code_block_optimized;
+ }
+
+ cell size() const
+ {
+ return header & ~7;
+ }
+
+ void *xt() const
+ {
+ return (void *)(this + 1);
+ }
+};
+
+}
--- /dev/null
+#include "master.hpp"
+
+namespace factor
+{
+
+/* Load a 32-bit value from a PowerPC LIS/ORI sequence */
+fixnum embedded_pointer::load_address_2_2()
+{
+ cell *ptr = (cell *)pointer;
+ cell hi = (ptr[-1] & 0xffff);
+ cell lo = (ptr[ 0] & 0xffff);
+ return hi << 16 | lo;
+}
+
+/* Load a value from a bitfield of a PowerPC instruction */
+fixnum embedded_pointer::load_address_masked(cell mask, fixnum shift)
+{
+ cell *ptr = (cell *)pointer;
+
+ return (*ptr & mask) << shift;
+}
+
+fixnum embedded_pointer::load_address()
+{
+ switch(rel_class)
+ {
+ case RC_ABSOLUTE_CELL:
+ return *(cell *)pointer;
+ case RC_ABSOLUTE:
+ return *(u32*)pointer;
+ case RC_RELATIVE:
+ return *(u32*)pointer + pointer + sizeof(u32);
+ case RC_ABSOLUTE_PPC_2_2:
+ return load_address_2_2();
+ case RC_ABSOLUTE_PPC_2:
+ return load_address_masked(rel_absolute_ppc_2_mask,0);
+ case RC_RELATIVE_PPC_2:
+ return load_address_masked(rel_relative_ppc_2_mask,0) + pointer;
+ case RC_RELATIVE_PPC_3:
+ return load_address_masked(rel_relative_ppc_3_mask,0) + pointer;
+ case RC_RELATIVE_ARM_3:
+ return load_address_masked(rel_relative_arm_3_mask,2) + pointer + sizeof(cell) * 2;
+ case RC_INDIRECT_ARM:
+ return load_address_masked(rel_indirect_arm_mask,0) + pointer + sizeof(cell);
+ case RC_INDIRECT_ARM_PC:
+ return load_address_masked(rel_indirect_arm_mask,0) + pointer + sizeof(cell) * 2;
+ default:
+ critical_error("Bad rel class",rel_class);
+ return 0;
+ }
+}
+
+/* Store a 32-bit value into a PowerPC LIS/ORI sequence */
+void embedded_pointer::store_address_2_2(fixnum value)
+{
+ cell *ptr = (cell *)pointer;
+ ptr[-1] = ((ptr[-1] & ~0xffff) | ((value >> 16) & 0xffff));
+ ptr[ 0] = ((ptr[ 0] & ~0xffff) | (value & 0xffff));
+}
+
+/* Store a value into a bitfield of a PowerPC instruction */
+void embedded_pointer::store_address_masked(fixnum value, cell mask, fixnum shift)
+{
+ cell *ptr = (cell *)pointer;
+
+ /* This is unaccurate but good enough */
+ fixnum test = (fixnum)mask >> 1;
+ if(value <= -test || value >= test)
+ critical_error("Value does not fit inside relocation",0);
+
+ *ptr = ((*ptr & ~mask) | ((value >> shift) & mask));
+}
+
+void embedded_pointer::store_address(fixnum absolute_value)
+{
+ fixnum relative_value = absolute_value - pointer;
+
+ switch(rel_class)
+ {
+ case RC_ABSOLUTE_CELL:
+ *(cell *)pointer = absolute_value;
+ break;
+ case RC_ABSOLUTE:
+ *(u32*)pointer = absolute_value;
+ break;
+ case RC_RELATIVE:
+ *(u32*)pointer = relative_value - sizeof(u32);
+ break;
+ case RC_ABSOLUTE_PPC_2_2:
+ store_address_2_2(absolute_value);
+ break;
+ case RC_ABSOLUTE_PPC_2:
+ store_address_masked(absolute_value,rel_absolute_ppc_2_mask,0);
+ break;
+ case RC_RELATIVE_PPC_2:
+ store_address_masked(relative_value,rel_relative_ppc_2_mask,0);
+ break;
+ case RC_RELATIVE_PPC_3:
+ store_address_masked(relative_value,rel_relative_ppc_3_mask,0);
+ break;
+ case RC_RELATIVE_ARM_3:
+ store_address_masked(relative_value - sizeof(cell) * 2,rel_relative_arm_3_mask,2);
+ break;
+ case RC_INDIRECT_ARM:
+ store_address_masked(relative_value - sizeof(cell),rel_indirect_arm_mask,0);
+ break;
+ case RC_INDIRECT_ARM_PC:
+ store_address_masked(relative_value - sizeof(cell) * 2,rel_indirect_arm_mask,0);
+ break;
+ default:
+ critical_error("Bad rel class",rel_class);
+ break;
+ }
+}
+
+}
--- /dev/null
+namespace factor
+{
+
+enum relocation_type {
+ /* arg is a primitive number */
+ RT_PRIMITIVE,
+ /* arg is a literal table index, holding an array pair (symbol/dll) */
+ RT_DLSYM,
+ /* a pointer to a compiled word reference */
+ RT_DISPATCH,
+ /* a word or quotation's general entry point */
+ RT_XT,
+ /* a word's PIC entry point */
+ RT_XT_PIC,
+ /* a word's tail-call PIC entry point */
+ RT_XT_PIC_TAIL,
+ /* current offset */
+ RT_HERE,
+ /* current code block */
+ RT_THIS,
+ /* immediate literal */
+ RT_IMMEDIATE,
+ /* address of ctx var */
+ RT_CONTEXT,
+ /* untagged fixnum literal */
+ RT_UNTAGGED,
+ /* address of megamorphic_cache_hits var */
+ RT_MEGAMORPHIC_CACHE_HITS,
+ /* address of vm object */
+ RT_VM,
+ /* value of vm->cards_offset */
+ RT_CARDS_OFFSET,
+ /* value of vm->decks_offset */
+ RT_DECKS_OFFSET,
+};
+
+enum relocation_class {
+ /* absolute address in a 64-bit location */
+ RC_ABSOLUTE_CELL,
+ /* absolute address in a 32-bit location */
+ RC_ABSOLUTE,
+ /* relative address in a 32-bit location */
+ RC_RELATIVE,
+ /* absolute address in a PowerPC LIS/ORI sequence */
+ RC_ABSOLUTE_PPC_2_2,
+ /* absolute address in a PowerPC LWZ instruction */
+ RC_ABSOLUTE_PPC_2,
+ /* relative address in a PowerPC LWZ/STW/BC instruction */
+ RC_RELATIVE_PPC_2,
+ /* relative address in a PowerPC B/BL instruction */
+ RC_RELATIVE_PPC_3,
+ /* relative address in an ARM B/BL instruction */
+ RC_RELATIVE_ARM_3,
+ /* pointer to address in an ARM LDR/STR instruction */
+ RC_INDIRECT_ARM,
+ /* pointer to address in an ARM LDR/STR instruction offset by 8 bytes */
+ RC_INDIRECT_ARM_PC
+};
+
+static const cell rel_absolute_ppc_2_mask = 0xffff;
+static const cell rel_relative_ppc_2_mask = 0xfffc;
+static const cell rel_relative_ppc_3_mask = 0x3fffffc;
+static const cell rel_indirect_arm_mask = 0xfff;
+static const cell rel_relative_arm_3_mask = 0xffffff;
+
+/* code relocation table consists of a table of entries for each fixup */
+struct relocation_entry {
+ u32 value;
+
+ relocation_entry(u32 value_) : value(value_) {}
+
+ relocation_entry(relocation_type rel_type,
+ relocation_class rel_class,
+ cell offset)
+ {
+ value = (rel_type << 28) | (rel_class << 24) | offset;
+ }
+
+ relocation_type rel_type()
+ {
+ return (relocation_type)((value & 0xf0000000) >> 28);
+ }
+
+ relocation_class rel_class()
+ {
+ return (relocation_class)((value & 0x0f000000) >> 24);
+ }
+
+ cell rel_offset()
+ {
+ return (value & 0x00ffffff);
+ }
+
+ int number_of_parameters()
+ {
+ switch(rel_type())
+ {
+ case RT_PRIMITIVE:
+ case RT_XT:
+ case RT_XT_PIC:
+ case RT_XT_PIC_TAIL:
+ case RT_IMMEDIATE:
+ case RT_HERE:
+ case RT_UNTAGGED:
+ case RT_VM:
+ return 1;
+ case RT_DLSYM:
+ return 2;
+ case RT_THIS:
+ case RT_CONTEXT:
+ case RT_MEGAMORPHIC_CACHE_HITS:
+ case RT_CARDS_OFFSET:
+ case RT_DECKS_OFFSET:
+ return 0;
+ default:
+ critical_error("Bad rel type",rel_type());
+ return -1; /* Can't happen */
+ }
+ }
+};
+
+struct embedded_pointer {
+ cell rel_class;
+ cell pointer;
+
+ embedded_pointer(cell rel_class_, cell pointer_) :
+ rel_class(rel_class_), pointer(pointer_) {}
+
+ fixnum load_address_2_2();
+ fixnum load_address_masked(cell mask, fixnum shift);
+ fixnum load_address();
+
+ void store_address_2_2(fixnum value);
+ void store_address_masked(fixnum value, cell mask, fixnum shift);
+ void store_address(fixnum value);
+};
+
+}
cell rel_type = array_nth(code_template.untagged(),i + 1);
cell offset = array_nth(code_template.untagged(),i + 2);
- relocation_entry new_entry
- = (untag_fixnum(rel_type) << 28)
- | (untag_fixnum(rel_class) << 24)
- | ((code.count + untag_fixnum(offset)));
+ relocation_entry new_entry(
+ (relocation_type)untag_fixnum(rel_type),
+ (relocation_class)untag_fixnum(rel_class),
+ code.count + untag_fixnum(offset));
relocation.append_bytes(&new_entry,sizeof(relocation_entry));
}
}
cell nth(cell i) const;
};
-/* The compiled code heap is structured into blocks. */
-struct code_block
-{
- cell header;
- cell owner; /* tagged pointer to word, quotation or f */
- cell literals; /* tagged pointer to array or f */
- cell relocation; /* tagged pointer to byte-array or f */
-
- bool free_p() const
- {
- return (header & 1) == 1;
- }
-
- code_block_type type() const
- {
- return (code_block_type)((header >> 1) & 0x3);
- }
-
- void set_type(code_block_type type)
- {
- header = ((header & ~0x7) | (type << 1));
- }
-
- bool pic_p() const
- {
- return type() == code_block_pic;
- }
-
- bool optimized_p() const
- {
- return type() == code_block_optimized;
- }
-
- cell size() const
- {
- return header & ~7;
- }
-
- void *xt() const
- {
- return (void *)(this + 1);
- }
-};
+struct code_block;
/* Assembly code makes assumptions about the layout of this struct */
struct word : public object {
#include "errors.hpp"
#include "bignumint.hpp"
#include "bignum.hpp"
-#include "code_block.hpp"
+#include "embedded_pointers.hpp"
+#include "code_blocks.hpp"
#include "bump_allocator.hpp"
#include "bitwise_hacks.hpp"
#include "mark_bits.hpp"
explicit slot_visitor<Visitor>(factor_vm *parent_, Visitor visitor_) :
parent(parent_), visitor(visitor_) {}
- void visit_handle(cell *handle)
+ cell visit_pointer(cell pointer)
{
- cell pointer = *handle;
- if(immediate_p(pointer)) return;
+ if(immediate_p(pointer)) return pointer;
object *untagged = untag<object>(pointer);
untagged = visitor(untagged);
- *handle = RETAG(untagged,TAG(pointer));
+ return RETAG(untagged,TAG(pointer));
+ }
+
+ void visit_handle(cell *handle)
+ {
+ *handle = visit_pointer(*handle);
}
void visit_slots(object *ptr, cell payload_start)
void primitive_fclose();
//code_block
- relocation_type relocation_type_of(relocation_entry r);
- relocation_class relocation_class_of(relocation_entry r);
- cell relocation_offset_of(relocation_entry r);
void flush_icache_for(code_block *block);
- int number_of_parameters(relocation_type type);
void *object_xt(cell obj);
void *xt_pic(word *w, cell tagged_quot);
void *word_xt_pic(word *w);
void *get_rel_symbol(array *literals, cell index);
cell compute_relocation(relocation_entry rel, cell index, code_block *compiled);
template<typename Iterator> void iterate_relocations(code_block *compiled, Iterator &iter);
- void store_address_2_2(cell *ptr, cell value);
- void store_address_masked(cell *ptr, fixnum value, cell mask, fixnum shift);
- void store_address_in_code_block(cell klass, cell offset, fixnum absolute_value);
void update_literal_references(code_block *compiled);
void relocate_code_block_step(relocation_entry rel, cell index, code_block *compiled);
void update_word_references(code_block *compiled);
projects / factor.git / commitdiff