void factor_vm::primitive_set_string_nth_slow()
{
string *str = untag<string>(ctx->pop());
cell index = untag_fixnum(ctx->pop());
cell value = untag_fixnum(ctx->pop());
set_string_nth_slow(str,index,value);
}
cell factor_vm::lookup_tuple_method(cell obj, cell methods)
{
tuple_layout *layout = untag<tuple_layout>(untag<tuple>(obj)->layout);
array *echelons = untag<array>(methods);
fixnum echelon = untag_fixnum(layout->echelon);
fixnum max_echelon = array_capacity(echelons) - 1;
if(echelon > max_echelon) echelon = max_echelon;
while(echelon >= 0)
{
cell echelon_methods = array_nth(echelons,echelon);
if(tagged<object>(echelon_methods).type_p(WORD_TYPE))
return echelon_methods;
else if(echelon_methods != F)
{
cell klass = nth_superclass(layout,echelon);
cell hashcode = untag_fixnum(nth_hashcode(layout,echelon));
cell result = search_lookup_hash(echelon_methods,klass,hashcode);
if(result != F)
return result;
}
echelon--;
}
critical_error("Cannot find tuple method",methods);
return F;
}
void callback_heap::update(callback *stub)
{
tagged<array> code_template(parent->userenv[CALLBACK_STUB]);
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));
flush_icache((cell)stub,stub->size);
}
void jit::emit_relocation(cell code_template_)
{
data_root<array> code_template(code_template_,parent);
cell capacity = array_capacity(code_template.untagged());
for(cell i = 1; i < capacity; i += 3)
{
relocation_class rel_class = (relocation_class)untag_fixnum(array_nth(code_template.untagged(),i));
relocation_type rel_type = (relocation_type)untag_fixnum(array_nth(code_template.untagged(),i + 1));
cell offset = array_nth(code_template.untagged(),i + 2);
relocation_entry new_entry(rel_type,rel_class,code.count + untag_fixnum(offset));
relocation.append_bytes(&new_entry,sizeof(relocation_entry));
}
}
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
}
/* Fixup labels. This is done at compile time, not image load time */
void factor_vm::fixup_labels(array *labels, code_block *compiled)
{
cell size = array_capacity(labels);
for(cell i = 0; i < size; i += 3)
{
relocation_class rel_class = (relocation_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));
relocation_entry new_entry(RT_HERE,rel_class,offset);
instruction_operand op(new_entry,compiled,0);
op.store_value(target + (cell)compiled->xt());
}
}
void factor_vm::set_string_nth_slow(string *str_, cell index, cell ch)
{
data_root<string> str(str_,this);
byte_array *aux;
str->data()[index] = ((ch & 0x7f) | 0x80);
if(to_boolean(str->aux))
aux = untag<byte_array>(str->aux);
else
{
/* We don't need to pre-initialize the
byte array with any data, since we
only ever read from the aux vector
if the most significant bit of a
character is set. Initially all of
the bits are clear. */
aux = allot_uninitialized_array<byte_array>(untag_fixnum(str->length) * sizeof(u16));
str->aux = tag<byte_array>(aux);
write_barrier(&str->aux);
}
aux->data<u16>()[index] = (u16)((ch >> 7) ^ 1);
}
void factor_vm::primitive_load_locals()
{
fixnum count = untag_fixnum(dpop());
memcpy((cell *)(rs + sizeof(cell)),(cell *)(ds - sizeof(cell) * (count - 1)),sizeof(cell) * count);
ds -= sizeof(cell) * count;
rs += sizeof(cell) * count;
}
/* Size of the data area of an object pointed to by an untagged pointer */
cell factor_vm::unaligned_object_size(object *pointer)
{
switch(pointer->h.hi_tag())
{
case ARRAY_TYPE:
return array_size((array*)pointer);
case BIGNUM_TYPE:
return array_size((bignum*)pointer);
case BYTE_ARRAY_TYPE:
return array_size((byte_array*)pointer);
case STRING_TYPE:
return string_size(string_capacity((string*)pointer));
case TUPLE_TYPE:
return tuple_size(untag<tuple_layout>(((tuple *)pointer)->layout));
case QUOTATION_TYPE:
return sizeof(quotation);
case WORD_TYPE:
return sizeof(word);
case FLOAT_TYPE:
return sizeof(boxed_float);
case DLL_TYPE:
return sizeof(dll);
case ALIEN_TYPE:
return sizeof(alien);
case WRAPPER_TYPE:
return sizeof(wrapper);
case CALLSTACK_TYPE:
return callstack_size(untag_fixnum(((callstack *)pointer)->length));
default:
critical_error("Invalid header",(cell)pointer);
return 0; /* can't happen */
}
}
void operator()(instruction_operand op)
{
switch(op.rel_type())
{
case RT_LITERAL:
op.store_value(next_literal());
break;
case RT_XT:
op.store_value(parent->compute_xt_address(next_literal()));
break;
case RT_XT_PIC:
op.store_value(parent->compute_xt_pic_address(next_literal()));
break;
case RT_XT_PIC_TAIL:
op.store_value(parent->compute_xt_pic_tail_address(next_literal()));
break;
case RT_HERE:
op.store_value(parent->compute_here_address(next_literal(),op.rel_offset(),op.parent_code_block()));
break;
case RT_UNTAGGED:
op.store_value(untag_fixnum(next_literal()));
break;
default:
parent->store_external_address(op);
break;
}
}
cell factor_vm::compute_here_address(cell arg, cell offset, code_block *compiled)
{
fixnum n = untag_fixnum(arg);
if(n >= 0)
return (cell)compiled->entry_point() + offset + n;
else
return (cell)compiled->entry_point() - n;
}
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));
}
}
void factor_vm::primitive_load_locals() {
fixnum count = untag_fixnum(ctx->pop());
memcpy((cell*)(ctx->retainstack + sizeof(cell)),
(cell*)(ctx->datastack - sizeof(cell) * (count - 1)),
sizeof(cell) * count);
ctx->datastack -= sizeof(cell) * count;
ctx->retainstack += sizeof(cell) * count;
}
/* 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();
}
void factor_vm::primitive_set_slot() {
fixnum slot = untag_fixnum(ctx->pop());
object* obj = untag<object>(ctx->pop());
cell value = ctx->pop();
cell* slot_ptr = &obj->slots()[slot];
*slot_ptr = value;
write_barrier(slot_ptr);
}
/* push a new tuple on the stack, filling its slots from the stack */
inline void factorvm::vmprim_tuple_boa()
{
gc_root<tuple_layout> layout(dpop(),this);
gc_root<tuple> t(allot_tuple(layout.value()),this);
cell size = untag_fixnum(layout.untagged()->size) * sizeof(cell);
memcpy(t->data(),(cell *)(ds - (size - sizeof(cell))),size);
ds -= size;
dpush(t.value());
}
// The cache_entries parameter is empty (on cold call site) or has entries
// (on cache miss). Called from assembly with the actual return address.
// Compilation of the inline cache may trigger a GC, which may trigger a
// compaction;
// also, the block containing the return address may now be dead. Use a
// code_root to take care of the details.
// Allocates memory
cell factor_vm::inline_cache_miss(cell return_address_) {
code_root return_address(return_address_, this);
bool tail_call_site = tail_call_site_p(return_address.value);
#ifdef PIC_DEBUG
FACTOR_PRINT("Inline cache miss at "
<< (tail_call_site ? "tail" : "non-tail")
<< " call site 0x" << std::hex << return_address.value
<< std::dec);
print_callstack();
#endif
data_root<array> cache_entries(ctx->pop(), this);
fixnum index = untag_fixnum(ctx->pop());
data_root<array> methods(ctx->pop(), this);
data_root<word> generic_word(ctx->pop(), this);
data_root<object> object(((cell*)ctx->datastack)[-index], this);
cell pic_size = array_capacity(cache_entries.untagged()) / 2;
update_pic_transitions(pic_size);
cell xt = generic_word->entry_point;
if (pic_size < max_pic_size) {
cell klass = object_class(object.value());
cell method = lookup_method(object.value(), methods.value());
data_root<array> new_cache_entries(
add_inline_cache_entry(cache_entries.value(), klass, method), this);
inline_cache_jit jit(generic_word.value(), this);
jit.emit_inline_cache(index, generic_word.value(), methods.value(),
new_cache_entries.value(), tail_call_site);
code_block* code = jit.to_code_block(CODE_BLOCK_PIC, JIT_FRAME_SIZE);
initialize_code_block(code);
xt = code->entry_point();
}
// Install the new stub.
if (return_address.valid) {
// Since each PIC is only referenced from a single call site,
// if the old call target was a PIC, we can deallocate it immediately,
// instead of leaving dead PICs around until the next GC.
deallocate_inline_cache(return_address.value);
set_call_target(return_address.value, xt);
#ifdef PIC_DEBUG
FACTOR_PRINT("Updated " << (tail_call_site ? "tail" : "non-tail")
<< " call site 0x" << std::hex << return_address.value << std::dec
<< " with 0x" << std::hex << (cell)xt << std::dec);
print_callstack();
#endif
}
return xt;
}
void inline_cache_jit::emit_check(cell klass)
{
cell code_template;
if(TAG(klass) == FIXNUM_TYPE && untag_fixnum(klass) < HEADER_TYPE)
code_template = parent->userenv[PIC_CHECK_TAG];
else
code_template = parent->userenv[PIC_CHECK];
emit_with(code_template,klass);
}
/* This is a little tricky. The iterator may allocate memory, so we
keep the callstack in a GC root and use relative offsets */
template<typename Iterator> void factor_vm::iterate_callstack_object(callstack *stack_, Iterator &iterator)
{
data_root<callstack> stack(stack_,this);
fixnum frame_offset = untag_fixnum(stack->length) - sizeof(stack_frame);
while(frame_offset >= 0)
{
stack_frame *frame = stack->frame_at(frame_offset);
frame_offset -= frame->size;
iterator(frame);
}
}
void factor_vm::primitive_set_callstack()
{
callstack *stack = untag_check<callstack>(dpop());
set_callstack(stack_chain->callstack_bottom,
stack->top(),
untag_fixnum(stack->length),
memcpy);
/* We cannot return here ... */
critical_error("Bug in set_callstack()",0);
}
/* The cache_entries parameter is either f (on cold call site) or an array (on cache miss).
Called from assembly with the actual return address */
void *factor_vm::inline_cache_miss(cell return_address)
{
check_code_pointer(return_address);
/* Since each PIC is only referenced from a single call site,
if the old call target was a PIC, we can deallocate it immediately,
instead of leaving dead PICs around until the next GC. */
deallocate_inline_cache(return_address);
gc_root<array> cache_entries(dpop(),this);
fixnum index = untag_fixnum(dpop());
gc_root<array> methods(dpop(),this);
gc_root<word> generic_word(dpop(),this);
gc_root<object> object(((cell *)ds)[-index],this);
void *xt;
cell pic_size = inline_cache_size(cache_entries.value());
update_pic_transitions(pic_size);
if(pic_size >= max_pic_size)
xt = megamorphic_call_stub(generic_word.value());
else
{
cell klass = object_class(object.value());
cell method = lookup_method(object.value(),methods.value());
gc_root<array> new_cache_entries(add_inline_cache_entry(
cache_entries.value(),
klass,
method),this);
xt = compile_inline_cache(index,
generic_word.value(),
methods.value(),
new_cache_entries.value(),
tail_call_site_p(return_address))->xt();
}
/* Install the new stub. */
set_call_target(return_address,xt);
#ifdef PIC_DEBUG
printf("Updated %s call site 0x%lx with 0x%lx\n",
tail_call_site_p(return_address) ? "tail" : "non-tail",
return_address,
(cell)xt);
#endif
return xt;
}
inline cell factor_vm::unbox_array_size()
{
cell obj = ctx->peek();
if(TAG(obj) == FIXNUM_TYPE)
{
fixnum n = untag_fixnum(obj);
if(n >= 0 && n < (fixnum)array_size_max)
{
ctx->pop();
return n;
}
}
return unbox_array_size_slow();
}
template <typename Iterator> void each_instruction_operand(Iterator& iter) {
if (!to_boolean(relocation))
return;
byte_array* rels = untag<byte_array>(relocation);
cell index = 0;
cell length = untag_fixnum(rels->capacity) / sizeof(relocation_entry);
for (cell i = 0; i < length; i++) {
relocation_entry rel = rels->data<relocation_entry>()[i];
iter(instruction_operand(rel, this, index));
index += rel.number_of_parameters();
}
}
/* Size of the object pointed to by an untagged pointer */
template <typename Fixup> cell object::size(Fixup fixup) const {
if (free_p())
return ((free_heap_block*)this)->size();
switch (type()) {
case ARRAY_TYPE:
return align(array_size((array*)this), data_alignment);
case BIGNUM_TYPE:
return align(array_size((bignum*)this), data_alignment);
case BYTE_ARRAY_TYPE:
return align(array_size((byte_array*)this), data_alignment);
case STRING_TYPE:
return align(string_size(string_capacity((string*)this)), data_alignment);
case TUPLE_TYPE: {
tuple_layout* layout = (tuple_layout*)fixup.translate_data(
untag<object>(((tuple*)this)->layout));
return align(tuple_size(layout), data_alignment);
}
case QUOTATION_TYPE:
return align(sizeof(quotation), data_alignment);
case WORD_TYPE:
return align(sizeof(word), data_alignment);
case FLOAT_TYPE:
return align(sizeof(boxed_float), data_alignment);
case DLL_TYPE:
return align(sizeof(dll), data_alignment);
case ALIEN_TYPE:
return align(sizeof(alien), data_alignment);
case WRAPPER_TYPE:
return align(sizeof(wrapper), data_alignment);
case CALLSTACK_TYPE:
return align(
callstack_object_size(untag_fixnum(((callstack*)this)->length)),
data_alignment);
default:
critical_error("Invalid header in size", (cell)this);
return 0; /* can't happen */
}
}
/* Allocates memory */
void factor_vm::fill_string(string* str_, cell start, cell capacity,
cell fill) {
data_root<string> str(str_, this);
if (fill <= 0x7f)
memset(&str->data()[start], (uint8_t)fill, capacity - start);
else {
byte_array* aux;
if (to_boolean(str->aux))
aux = untag<byte_array>(str->aux);
else {
aux =
allot_uninitialized_array<byte_array>(untag_fixnum(str->length) * 2);
str->aux = tag<byte_array>(aux);
write_barrier(&str->aux);
}
uint8_t lo_fill = (uint8_t)((fill & 0x7f) | 0x80);
uint16_t hi_fill = (uint16_t)((fill >> 7) ^ 0x1);
memset(&str->data()[start], lo_fill, capacity - start);
memset_2(&aux->data<uint16_t>()[start], hi_fill,
(capacity - start) * sizeof(uint16_t));
}
}
/* Figure out what kind of type check the PIC needs based on the methods
it contains */
cell factor_vm::determine_inline_cache_type(array *cache_entries)
{
bool seen_hi_tag = false, seen_tuple = false;
cell i;
for(i = 0; i < array_capacity(cache_entries); i += 2)
{
cell klass = array_nth(cache_entries,i);
/* Is it a tuple layout? */
switch(TAG(klass))
{
case FIXNUM_TYPE:
{
fixnum type = untag_fixnum(klass);
if(type >= HEADER_TYPE)
seen_hi_tag = true;
}
break;
case ARRAY_TYPE:
seen_tuple = true;
break;
default:
critical_error("Expected a fixnum or array",klass);
break;
}
}
if(seen_hi_tag && seen_tuple) return PIC_HI_TAG_TUPLE;
if(seen_hi_tag && !seen_tuple) return PIC_HI_TAG;
if(!seen_hi_tag && seen_tuple) return PIC_TUPLE;
if(!seen_hi_tag && !seen_tuple) return PIC_TAG;
critical_error("Oops",0);
return 0;
}
void factor_vm::primitive_context_object_for() {
context* other_ctx = (context*)pinned_alien_offset(ctx->pop());
fixnum n = untag_fixnum(ctx->peek());
ctx->replace(other_ctx->context_objects[n]);
}
void factor_vm::primitive_set_context_object() {
fixnum n = untag_fixnum(ctx->pop());
cell value = ctx->pop();
ctx->context_objects[n] = value;
}
void factor_vm::primitive_context_object() {
fixnum n = untag_fixnum(ctx->peek());
ctx->replace(ctx->context_objects[n]);
}
