instruction_operand callback_heap::callback_operand(code_block *stub, cell index)
{
tagged<array> code_template(parent->special_objects[CALLBACK_STUB]);
tagged<byte_array> relocation_template(array_nth(code_template.untagged(),0));
relocation_entry entry(relocation_template->data<relocation_entry>()[index]);
return instruction_operand(entry,stub,0);
}
instruction_operand callback_heap::callback_operand(code_block *stub, cell index)
{
tagged<array> code_template(parent->special_objects[CALLBACK_STUB]);
cell rel_class = untag_fixnum(array_nth(code_template.untagged(),3 * index + 1));
cell rel_type = untag_fixnum(array_nth(code_template.untagged(),3 * index + 2));
cell offset = untag_fixnum(array_nth(code_template.untagged(),3 * index + 3));
relocation_entry rel(
(relocation_type)rel_type,
(relocation_class)rel_class,
offset);
instruction_operand op(rel,stub,0);
return op;
}
void jit::emit_relocation(cell code_template_)
{
gc_root<array> code_template(code_template_,parent_vm);
cell capacity = array_capacity(code_template.untagged());
for(cell i = 1; i < capacity; i += 3)
{
cell rel_class = array_nth(code_template.untagged(),i);
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.append_bytes(&new_entry,sizeof(relocation_entry));
}
}
// index: 0 = top of stack, 1 = item underneath, etc
// cache_entries: array of class/method pairs
// Allocates memory
void inline_cache_jit::emit_inline_cache(fixnum index, cell generic_word_,
cell methods_, cell cache_entries_,
bool tail_call_p) {
data_root<word> generic_word(generic_word_, parent);
data_root<array> methods(methods_, parent);
data_root<array> cache_entries(cache_entries_, parent);
cell ic_type = determine_inline_cache_type(cache_entries.untagged());
parent->update_pic_count(ic_type);
// Generate machine code to determine the object's class.
emit_with_literal(parent->special_objects[PIC_LOAD],
tag_fixnum(-index * sizeof(cell)));
// Put the tag of the object, or class of the tuple in a register.
emit(parent->special_objects[ic_type]);
// Generate machine code to check, in turn, if the class is one of the cached
// entries.
for (cell i = 0; i < array_capacity(cache_entries.untagged()); i += 2) {
cell klass = array_nth(cache_entries.untagged(), i);
cell method = array_nth(cache_entries.untagged(), i + 1);
emit_check_and_jump(ic_type, i, klass, method);
}
// If none of the above conditionals tested true, then execution "falls
// through" to here.
// A stack frame is set up, since the inline-cache-miss sub-primitive
// makes a subroutine call to the VM.
emit(parent->special_objects[JIT_PROLOG]);
// The inline-cache-miss sub-primitive call receives enough information to
// reconstruct the PIC with the new entry.
push(generic_word.value());
push(methods.value());
push(tag_fixnum(index));
push(cache_entries.value());
emit_subprimitive(
parent->special_objects[tail_call_p ? PIC_MISS_TAIL_WORD : PIC_MISS_WORD],
true, // tail_call_p
true); // stack_frame_p
}
/* Allocates memory */
bool jit::emit_subprimitive(cell word_, bool tail_call_p, bool stack_frame_p) {
data_root<word> word(word_, parent);
data_root<array> code_template(word->subprimitive, parent);
parameters.append(untag<array>(array_nth(code_template.untagged(), 0)));
literals.append(untag<array>(array_nth(code_template.untagged(), 1)));
emit(array_nth(code_template.untagged(), 2));
if (array_capacity(code_template.untagged()) == 5) {
if (tail_call_p) {
if (stack_frame_p)
emit(parent->special_objects[JIT_EPILOG]);
emit(array_nth(code_template.untagged(), 4));
return true;
} else
emit(array_nth(code_template.untagged(), 3));
}
return false;
}
// Figure out what kind of type check the PIC needs based on the methods
// it contains
static cell determine_inline_cache_type(array* cache_entries) {
for (cell i = 0; i < array_capacity(cache_entries); i += 2) {
// Is it a tuple layout?
if (TAG(array_nth(cache_entries, i)) == ARRAY_TYPE) {
return PIC_TUPLE;
}
}
return PIC_TAG;
}
cell factor_vm::search_lookup_hash(cell table, cell klass, cell hashcode)
{
array *buckets = untag<array>(table);
cell bucket = array_nth(buckets,hashcode & (array_capacity(buckets) - 1));
if(tagged<object>(bucket).type_p(WORD_TYPE) || bucket == F)
return bucket;
else
return search_lookup_alist(bucket,klass);
}
cell factor_vm::lookup_hi_tag_method(cell obj, cell methods)
{
array *hi_tag_methods = untag<array>(methods);
cell tag = untag<object>(obj)->h.hi_tag() - HEADER_TYPE;
#ifdef FACTOR_DEBUG
assert(tag < TYPE_COUNT - HEADER_TYPE);
#endif
return array_nth(hi_tag_methods,tag);
}
/* true if there are no non-safepoint words in the quoation... */
bool quotation_jit::no_non_safepoint_words_p() {
cell length = array_capacity(elements.untagged());
for (cell i = 0; i < length; i++) {
cell obj = array_nth(elements.untagged(), i);
if (TAG(obj) == WORD_TYPE && !word_safepoint_p(obj))
return false;
}
return true;
}
cell factor_vm::search_lookup_hash(cell table, cell klass, cell hashcode)
{
array *buckets = untag<array>(table);
cell bucket = array_nth(buckets,hashcode & (array_capacity(buckets) - 1));
if(TAG(bucket) == ARRAY_TYPE)
return search_lookup_alist(bucket,klass);
else
return bucket;
}
/* 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 = (library == F ? NULL : untag<dll>(library));
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;
}
}
/* classes.tuple uses this to reshape tuples; tools.deploy.shaker uses this
to coalesce equal but distinct quotations and wrappers. */
void factor_vm::primitive_become()
{
array *new_objects = untag_check<array>(ctx->pop());
array *old_objects = untag_check<array>(ctx->pop());
cell capacity = array_capacity(new_objects);
if(capacity != array_capacity(old_objects))
critical_error("bad parameters to become",0);
/* Build the forwarding map */
std::map<object *,object *> become_map;
for(cell i = 0; i < capacity; i++)
{
tagged<object> old_obj(array_nth(old_objects,i));
tagged<object> new_obj(array_nth(new_objects,i));
if(old_obj != new_obj)
become_map[old_obj.untagged()] = new_obj.untagged();
}
/* Update all references to old objects to point to new objects */
{
slot_visitor<slot_become_fixup> workhorse(this,slot_become_fixup(&become_map));
workhorse.visit_roots();
workhorse.visit_contexts();
object_become_visitor object_visitor(&workhorse);
each_object(object_visitor);
code_block_become_visitor code_block_visitor(&workhorse);
each_code_block(code_block_visitor);
}
/* Since we may have introduced old->new references, need to revisit
all objects and code blocks on a minor GC. */
data->mark_all_cards();
{
code_block_write_barrier_visitor code_block_visitor(code);
each_code_block(code_block_visitor);
}
}
// classes.tuple uses this to reshape tuples; tools.deploy.shaker uses this
// to coalesce equal but distinct quotations and wrappers.
// Calls gc
void factor_vm::primitive_become() {
primitive_minor_gc();
array* new_objects = untag_check<array>(ctx->pop());
array* old_objects = untag_check<array>(ctx->pop());
cell capacity = array_capacity(new_objects);
if (capacity != array_capacity(old_objects))
critical_error("bad parameters to become", 0);
// Build the forwarding map
std::map<object*, object*> become_map;
for (cell i = 0; i < capacity; i++) {
cell old_ptr = array_nth(old_objects, i);
cell new_ptr = array_nth(new_objects, i);
if (old_ptr != new_ptr)
become_map[untag<object>(old_ptr)] = untag<object>(new_ptr);
}
// Update all references to old objects to point to new objects
{
slot_visitor<slot_become_fixup> visitor(this,
slot_become_fixup(&become_map));
visitor.visit_all_roots();
auto object_become_func = [&](object* obj) {
visitor.visit_slots(obj);
};
each_object(object_become_func);
auto code_block_become_func = [&](code_block* compiled, cell size) {
visitor.visit_code_block_objects(compiled);
visitor.visit_embedded_literals(compiled);
code->write_barrier(compiled);
};
each_code_block(code_block_become_func);
}
// Since we may have introduced old->new references, need to revisit
// all objects and code blocks on a minor GC.
data->mark_all_cards();
}
void factor_vm::primitive_modify_code_heap()
{
gc_root<array> alist(dpop(),this);
cell count = array_capacity(alist.untagged());
if(count == 0)
return;
cell i;
for(i = 0; i < count; i++)
{
gc_root<array> pair(array_nth(alist.untagged(),i),this);
gc_root<word> word(array_nth(pair.untagged(),0),this);
gc_root<object> data(array_nth(pair.untagged(),1),this);
switch(data.type())
{
case QUOTATION_TYPE:
jit_compile_word(word.value(),data.value(),false);
break;
case ARRAY_TYPE:
{
array *compiled_data = data.as<array>().untagged();
cell owner = array_nth(compiled_data,0);
cell literals = array_nth(compiled_data,1);
cell relocation = array_nth(compiled_data,2);
cell labels = array_nth(compiled_data,3);
cell code = array_nth(compiled_data,4);
code_block *compiled = add_code_block(
WORD_TYPE,
code,
labels,
owner,
relocation,
literals);
word->code = compiled;
}
break;
default:
critical_error("Expected a quotation or an array",data.value());
break;
}
update_word_xt(word.value());
}
update_code_heap_words();
}
/* Look up an external library symbol referenced by a compiled code block */
cell factor_vm::compute_dlsym_address(array *parameters, cell index)
{
cell symbol = array_nth(parameters,index);
cell library = array_nth(parameters,index + 1);
dll *d = (to_boolean(library) ? untag<dll>(library) : NULL);
void* undefined_symbol = (void*)factor::undefined_symbol;
undefined_symbol = FUNCTION_CODE_POINTER(undefined_symbol);
if(d != NULL && !d->handle)
return (cell)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 (cell)sym;
else
return (cell)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 (cell)sym;
}
return (cell)undefined_symbol;
}
default:
critical_error("Bad symbol specifier",symbol);
return (cell)undefined_symbol;
}
}
/* Allocates memory */
void factor_vm::primitive_modify_code_heap() {
bool reset_inline_caches = to_boolean(ctx->pop());
bool update_existing_words = to_boolean(ctx->pop());
data_root<array> alist(ctx->pop(), this);
cell count = array_capacity(alist.untagged());
if (count == 0)
return;
for (cell i = 0; i < count; i++) {
data_root<array> pair(array_nth(alist.untagged(), i), this);
data_root<word> word(array_nth(pair.untagged(), 0), this);
data_root<object> data(array_nth(pair.untagged(), 1), this);
switch (data.type()) {
case QUOTATION_TYPE:
jit_compile_word(word.value(), data.value(), false);
break;
case ARRAY_TYPE: {
array* compiled_data = data.as<array>().untagged();
cell parameters = array_nth(compiled_data, 0);
cell literals = array_nth(compiled_data, 1);
cell relocation = array_nth(compiled_data, 2);
cell labels = array_nth(compiled_data, 3);
cell code = array_nth(compiled_data, 4);
cell frame_size = untag_fixnum(array_nth(compiled_data, 5));
code_block* compiled =
add_code_block(code_block_optimized, code, labels, word.value(),
relocation, parameters, literals, frame_size);
word->entry_point = compiled->entry_point();
} break;
default:
critical_error("Expected a quotation or an array", data.value());
break;
}
}
if (update_existing_words)
update_code_heap_words(reset_inline_caches);
else
initialize_code_blocks();
}
cell factor_vm::code_block_owner(code_block *compiled)
{
tagged<object> owner(compiled->owner);
/* Cold generic word call sites point to quotations that call the
inline-cache-miss and inline-cache-miss-tail primitives. */
if(owner.type_p(QUOTATION_TYPE))
{
tagged<quotation> quot(owner.as<quotation>());
tagged<array> elements(quot->array);
#ifdef FACTOR_DEBUG
assert(array_capacity(elements.untagged()) == 5);
assert(array_nth(elements.untagged(),4) == special_objects[PIC_MISS_WORD]
|| array_nth(elements.untagged(),4) == special_objects[PIC_MISS_TAIL_WORD]);
#endif
tagged<wrapper> word_wrapper(array_nth(elements.untagged(),0));
return word_wrapper->object;
}
else
return compiled->owner;
}
// Allocates memory
void growable_array::append(array* elts_) {
factor_vm* parent = elements.parent;
data_root<array> elts(elts_, parent);
cell capacity = array_capacity(elts.untagged());
if (count + capacity > array_capacity(elements.untagged())) {
reallot_array(2 * (count + capacity));
}
for (cell index = 0; index < capacity; index++)
parent->set_array_nth(elements.untagged(), count++,
array_nth(elts.untagged(), index));
}
/* index: 0 = top of stack, 1 = item underneath, etc
cache_entries: array of class/method pairs */
void inline_cache_jit::compile_inline_cache(fixnum index,
cell generic_word_,
cell methods_,
cell cache_entries_,
bool tail_call_p)
{
gc_root<word> generic_word(generic_word_,parent);
gc_root<array> methods(methods_,parent);
gc_root<array> cache_entries(cache_entries_,parent);
cell inline_cache_type = parent->determine_inline_cache_type(cache_entries.untagged());
parent->update_pic_count(inline_cache_type);
/* Generate machine code to determine the object's class. */
emit_class_lookup(index,inline_cache_type);
/* Generate machine code to check, in turn, if the class is one of the cached entries. */
cell i;
for(i = 0; i < array_capacity(cache_entries.untagged()); i += 2)
{
/* Class equal? */
cell klass = array_nth(cache_entries.untagged(),i);
emit_check(klass);
/* Yes? Jump to method */
cell method = array_nth(cache_entries.untagged(),i + 1);
emit_with(parent->userenv[PIC_HIT],method);
}
/* Generate machine code to handle a cache miss, which ultimately results in
this function being called again.
The inline-cache-miss primitive call receives enough information to
reconstruct the PIC. */
push(generic_word.value());
push(methods.value());
push(tag_fixnum(index));
push(cache_entries.value());
word_special(parent->userenv[tail_call_p ? PIC_MISS_TAIL_WORD : PIC_MISS_WORD]);
}
cell frame_executing(stack_frame *frame)
{
code_block *compiled = frame_code(frame);
if(compiled->literals == F || !stack_traces_p())
return F;
else
{
array *literals = untag<array>(compiled->literals);
cell executing = array_nth(literals,0);
check_data_pointer((object *)executing);
return executing;
}
}
/* Allocates memory */
void jit::emit(cell code_template_) {
data_root<array> code_template(code_template_, parent);
emit_relocation(array_nth(code_template.untagged(), 0));
data_root<byte_array> insns(array_nth(code_template.untagged(), 1), parent);
if (computing_offset_p) {
cell size = array_capacity(insns.untagged());
if (offset == 0) {
position--;
computing_offset_p = false;
} else if (offset < size) {
position++;
computing_offset_p = false;
} else
offset -= size;
}
code.append_byte_array(insns.value());
}
void factor_vm::store_external_address(instruction_operand op)
{
code_block *compiled = op.parent_code_block();
array *parameters = (to_boolean(compiled->parameters) ? untag<array>(compiled->parameters) : NULL);
cell index = op.parameter_index();
switch(op.rel_type())
{
case RT_PRIMITIVE:
op.store_value(compute_primitive_address(array_nth(parameters,index)));
break;
case RT_DLSYM:
op.store_value(compute_dlsym_address(parameters,index));
break;
case RT_THIS:
op.store_value((cell)compiled->xt());
break;
case RT_CONTEXT:
op.store_value(compute_context_address());
break;
case RT_MEGAMORPHIC_CACHE_HITS:
op.store_value((cell)&dispatch_stats.megamorphic_cache_hits);
break;
case RT_VM:
op.store_value(compute_vm_address(array_nth(parameters,index)));
break;
case RT_CARDS_OFFSET:
op.store_value(cards_offset);
break;
case RT_DECKS_OFFSET:
op.store_value(decks_offset);
break;
default:
critical_error("Bad rel type",op.rel_type());
break;
}
}
void factor_vm::compile_all_words()
{
data_root<array> words(find_all_words(),this);
cell length = array_capacity(words.untagged());
for(cell i = 0; i < length; i++)
{
data_root<word> word(array_nth(words.untagged(),i),this);
if(!word->code || !word->code->optimized_p())
jit_compile_word(word.value(),word->def,false);
update_word_entry_point(word.untagged());
}
}
// Allocates memory conditionally
void quotation_jit::emit_quotation(cell quot_) {
data_root<quotation> quot(quot_, parent);
array* elements = untag<array>(quot->array);
// If the quotation consists of a single word, compile a direct call
// to the word.
if (trivial_quotation_p(elements))
literal(array_nth(elements, 0));
else {
if (compiling)
parent->jit_compile_quotation(quot.value(), relocate);
literal(quot.value());
}
}
cell factor_vm::lookup_method(cell obj, cell methods)
{
cell tag = TAG(obj);
cell method = array_nth(untag<array>(methods),tag);
if(tag == TUPLE_TYPE)
{
if(TAG(method) == ARRAY_TYPE)
return lookup_tuple_method(obj,method);
else
return method;
}
else
return method;
}
void factor_vm::store_external_address(instruction_operand op)
{
code_block *compiled = op.compiled;
array *parameters = (to_boolean(compiled->parameters) ? untag<array>(compiled->parameters) : NULL);
cell index = op.index;
switch(op.rel_type())
{
case RT_DLSYM:
op.store_value(compute_dlsym_address(parameters,index));
break;
case RT_THIS:
op.store_value((cell)compiled->entry_point());
break;
case RT_MEGAMORPHIC_CACHE_HITS:
op.store_value((cell)&dispatch_stats.megamorphic_cache_hits);
break;
case RT_VM:
op.store_value(compute_vm_address(array_nth(parameters,index)));
break;
case RT_CARDS_OFFSET:
op.store_value(cards_offset);
break;
case RT_DECKS_OFFSET:
op.store_value(decks_offset);
break;
#ifdef WINDOWS
case RT_EXCEPTION_HANDLER:
op.store_value((cell)&factor::exception_handler);
break;
#endif
#ifdef FACTOR_PPC
case RT_DLSYM_TOC:
op.store_value(compute_dlsym_toc_address(parameters,index));
break;
#endif
case RT_INLINE_CACHE_MISS:
op.store_value((cell)&factor::inline_cache_miss);
break;
case RT_SAFEPOINT:
op.store_value((cell)code->safepoint_page);
break;
default:
critical_error("Bad rel type in store_external_address()",op.rel_type());
break;
}
}
code_block *callback_heap::add(cell owner, cell return_rewind)
{
tagged<array> code_template(parent->special_objects[CALLBACK_STUB]);
tagged<byte_array> insns(array_nth(code_template.untagged(),1));
cell size = array_capacity(insns.untagged());
cell bump = align(size + sizeof(code_block),data_alignment);
if(here + bump > seg->end) fatal_error("Out of callback space",0);
free_heap_block *free_block = (free_heap_block *)here;
free_block->make_free(bump);
here += bump;
code_block *stub = (code_block *)free_block;
stub->owner = owner;
stub->parameters = false_object;
stub->relocation = false_object;
memcpy(stub->entry_point(),insns->data<void>(),size);
/* Store VM pointer */
store_callback_operand(stub,0,(cell)parent);
cell index;
if(setup_seh_p())
{
store_callback_operand(stub,1);
index = 1;
}
else
index = 0;
/* Store VM pointer */
store_callback_operand(stub,index + 2,(cell)parent);
/* On x86, the RET instruction takes an argument which depends on
the callback's calling convention */
if(return_takes_param_p())
store_callback_operand(stub,index + 3,return_rewind);
update(stub);
return stub;
}
code_block* callback_heap::add(cell owner, cell return_rewind) {
tagged<array> code_template(parent->special_objects[CALLBACK_STUB]);
tagged<byte_array> insns(array_nth(code_template.untagged(), 1));
cell size = array_capacity(insns.untagged());
cell bump = align(size + sizeof(code_block), data_alignment);
code_block* stub = allocator->allot(bump);
if (!stub) {
parent->general_error(ERROR_CALLBACK_SPACE_OVERFLOW,
false_object,
false_object);
}
stub->header = bump & ~7;
stub->owner = owner;
stub->parameters = false_object;
stub->relocation = false_object;
memcpy((void*)stub->entry_point(), insns->data<void>(), size);
/* Store VM pointer */
store_callback_operand(stub, 0, (cell)parent);
cell index;
if (setup_seh_p()) {
store_callback_operand(stub, 1);
index = 1;
} else
index = 0;
/* Store VM pointer */
store_callback_operand(stub, index + 2, (cell) parent);
/* On x86, the RET instruction takes an argument which depends on
the callback's calling convention */
if (return_takes_param_p())
store_callback_operand(stub, index + 3, return_rewind);
update(stub);
return stub;
}
callback *callback_heap::add(code_block *compiled)
{
tagged<array> code_template(parent->userenv[CALLBACK_STUB]);
tagged<byte_array> insns(array_nth(code_template.untagged(),0));
cell size = array_capacity(insns.untagged());
cell bump = align8(size) + sizeof(callback);
if(here + bump > seg->end) fatal_error("Out of callback space",0);
callback *stub = (callback *)here;
stub->compiled = compiled;
memcpy(stub + 1,insns->data<void>(),size);
stub->size = align8(size);
here += bump;
update(stub);
return stub;
}
cell factor_vm::lookup_hairy_method(cell obj, cell methods)
{
cell method = array_nth(untag<array>(methods),TAG(obj));
if(tagged<object>(method).type_p(WORD_TYPE))
return method;
else
{
switch(TAG(obj))
{
case TUPLE_TYPE:
return lookup_tuple_method(obj,method);
break;
case OBJECT_TYPE:
return lookup_hi_tag_method(obj,method);
break;
default:
critical_error("Bad methods array",methods);
return 0;
}
}
}