514 lines
13 KiB
C++
Executable File
514 lines
13 KiB
C++
Executable File
#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:
|
|
{
|
|
cell i;
|
|
array *names = untag<array>(symbol);
|
|
for(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)&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 = parent->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)
|
|
{
|
|
heap_block *block = code->heap_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->heap_allot(size + sizeof(code_block));
|
|
|
|
/* Insufficient room even after code GC, give up */
|
|
if(block == NULL)
|
|
{
|
|
cell used, total_free, max_free;
|
|
code->heap_usage(&used,&total_free,&max_free);
|
|
|
|
print_string("Code heap stats:\n");
|
|
print_string("Used: "); print_cell(used); nl();
|
|
print_string("Total free space: "); print_cell(total_free); nl();
|
|
print_string("Largest free block: "); print_cell(max_free); nl();
|
|
fatal_error("Out of memory in add-compiled-block",0);
|
|
}
|
|
}
|
|
|
|
code_block *compiled = (code_block *)block;
|
|
compiled->set_type(type);
|
|
return compiled;
|
|
}
|
|
|
|
/* Might GC */
|
|
code_block *factor_vm::add_code_block(code_block_type type, cell code_, cell labels_, cell owner_, cell relocation_, cell literals_)
|
|
{
|
|
gc_root<byte_array> code(code_,this);
|
|
gc_root<object> labels(labels_,this);
|
|
gc_root<object> owner(owner_,this);
|
|
gc_root<byte_array> relocation(relocation_,this);
|
|
gc_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;
|
|
}
|
|
|
|
}
|