// Compile code in boot image so that we can execute the startup quotation
// Allocates memory
void factor_vm::prepare_boot_image() {
std::cout << "*** Stage 2 early init... " << std::flush;
// Compile all words.
data_root<array> words(instances(WORD_TYPE), this);
cell n_words = array_capacity(words.untagged());
for (cell i = 0; i < n_words; i++) {
data_root<word> word(array_nth(words.untagged(), i), this);
FACTOR_ASSERT(!word->entry_point);
jit_compile_word(word.value(), word->def, false);
}
update_code_heap_words(true);
// Initialize all quotations
data_root<array> quotations(instances(QUOTATION_TYPE), this);
cell n_quots = array_capacity(quotations.untagged());
for (cell i = 0; i < n_quots; i++) {
data_root<quotation> quot(array_nth(quotations.untagged(), i), this);
if (!quot->entry_point)
quot->entry_point = lazy_jit_compile_entry_point();
}
special_objects[OBJ_STAGE2] = special_objects[OBJ_CANONICAL_TRUE];
std::cout << "done" << std::endl;
}
// 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));
}
/* Allocates memory */
void growable_byte_array::append_byte_array(cell byte_array_) {
data_root<byte_array> byte_array(byte_array_, elements.parent);
cell len = array_capacity(byte_array.untagged());
cell new_size = count + len;
factor_vm* parent = elements.parent;
if (new_size >= array_capacity(elements.untagged()))
elements = parent->reallot_array(elements.untagged(), new_size * 2);
memcpy(&elements->data<uint8_t>()[count], byte_array->data<uint8_t>(), len);
count += len;
}
void growable_byte_array::append_byte_array(cell byte_array_)
{
gc_root<byte_array> byte_array(byte_array_,elements.myvm);
cell len = array_capacity(byte_array.untagged());
cell new_size = count + len;
factorvm *myvm = elements.myvm;
if(new_size >= array_capacity(elements.untagged()))
elements = myvm->reallot_array(elements.untagged(),new_size * 2);
memcpy(&elements->data<u8>()[count],byte_array->data<u8>(),len);
count += len;
}
/* Might GC */
code_block *factor_vm::add_code_block(code_block_type type, cell code_, cell labels_,
cell owner_, cell relocation_, cell parameters_, cell literals_,
cell frame_size_untagged)
{
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> parameters(parameters_,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(parameters.type() == ARRAY_TYPE && array_capacity(parameters.untagged()) == 0)
compiled->parameters = false_object;
else
compiled->parameters = parameters.value();
/* code */
memcpy(compiled + 1,code.untagged() + 1,code_length);
/* fixup labels */
if(to_boolean(labels.value()))
fixup_labels(labels.as<array>().untagged(),compiled);
compiled->set_stack_frame_size(frame_size_untagged);
/* Once we are ready, fill in literal and word references in this code
block's instruction operands. In most cases this is done right after this
method returns, except when compiling words with the non-optimizing
compiler at the beginning of bootstrap */
this->code->uninitialized_blocks.insert(std::make_pair(compiled,literals.value()));
this->code->all_blocks.insert((cell)compiled);
/* next time we do a minor GC, we have to trace this code block, since
the fields of the code_block struct might point into nursery or aging */
this->code->write_barrier(compiled);
return compiled;
}
/* Allocates memory */
void factor_vm::set_profiling(bool profiling)
{
if(profiling == profiling_p)
return;
profiling_p = profiling;
/* Push everything to tenured space so that we can heap scan
and allocate profiling blocks if necessary */
gc();
gc_root<array> words(find_all_words(),this);
cell i;
cell length = array_capacity(words.untagged());
for(i = 0; i < length; i++)
{
tagged<word> word(array_nth(words.untagged(),i));
if(profiling)
word->counter = tag_fixnum(0);
update_word_xt(word.value());
}
update_code_heap_words();
}
void VolumePimWizardPage::SetPimValidator ()
{
wxTextValidator validator (wxFILTER_INCLUDE_CHAR_LIST); // wxFILTER_NUMERIC does not exclude - . , etc.
const wxChar *valArr[] = { L"0", L"1", L"2", L"3", L"4", L"5", L"6", L"7", L"8", L"9" };
validator.SetIncludes (wxArrayString (array_capacity (valArr), (const wxChar **) &valArr));
VolumePimTextCtrl->SetValidator (validator);
}
code_block* callback_heap::add(cell owner, cell return_rewind) {
/* code_template is a 2-tuple where the first element contains the
relocations and the second a byte array of compiled assembly
code. The code assumes that there are four relocations on x86 and
three on ppc. */
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 in two relocations. */
store_callback_operand(stub, 0, (cell)parent);
store_callback_operand(stub, 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, 3, return_rewind);
update(stub);
return stub;
}
void set_profiling(bool profiling)
{
if(profiling == profiling_p)
return;
profiling_p = profiling;
/* Push everything to tenured space so that we can heap scan
and allocate profiling blocks if necessary */
gc();
CELL words = find_all_words();
REGISTER_ROOT(words);
CELL i;
CELL length = array_capacity(untag_object(words));
for(i = 0; i < length; i++)
{
F_WORD *word = untag_word(array_nth(untag_array(words),i));
if(profiling)
word->counter = tag_fixnum(0);
update_word_xt(word);
}
UNREGISTER_ROOT(words);
/* Update XTs in code heap */
iterate_code_heap(relocate_code_block);
}
void primitive_fwrite(void)
{
FILE *file = unbox_alien();
F_BYTE_ARRAY *text = untag_byte_array(dpop());
F_FIXNUM length = array_capacity(text);
char *string = (char *)(text + 1);
if(length == 0)
return;
for(;;)
{
size_t written = fwrite(string,1,length,file);
if(written == length)
break;
else
{
if(feof(file))
break;
else
io_error();
/* Still here? EINTR */
length -= written;
string += written;
}
}
}
inline void factor_vm::set_array_nth(array* array, cell slot, cell value) {
FACTOR_ASSERT(slot < array_capacity(array));
FACTOR_ASSERT(array->type() == ARRAY_TYPE);
cell* slot_ptr = &array->data()[slot];
*slot_ptr = value;
write_barrier(slot_ptr);
}
/* The number of cells from the start of the object which should be scanned by
the GC. Some types have a binary payload at the end (string, word, DLL) which
we ignore. */
cell factor_vm::binary_payload_start(object *pointer)
{
switch(pointer->h.hi_tag())
{
/* these objects do not refer to other objects at all */
case FLOAT_TYPE:
case BYTE_ARRAY_TYPE:
case BIGNUM_TYPE:
case CALLSTACK_TYPE:
return 0;
/* these objects have some binary data at the end */
case WORD_TYPE:
return sizeof(word) - sizeof(cell) * 3;
case ALIEN_TYPE:
return sizeof(cell) * 3;
case DLL_TYPE:
return sizeof(cell) * 2;
case QUOTATION_TYPE:
return sizeof(quotation) - sizeof(cell) * 2;
case STRING_TYPE:
return sizeof(string);
/* everything else consists entirely of pointers */
case ARRAY_TYPE:
return array_size<array>(array_capacity((array*)pointer));
case TUPLE_TYPE:
return tuple_size(untag<tuple_layout>(((tuple *)pointer)->layout));
case WRAPPER_TYPE:
return sizeof(wrapper);
default:
critical_error("Invalid header",(cell)pointer);
return 0; /* can't happen */
}
}
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;
}
/* Do some initialization that we do once only */
void do_stage1_init(void)
{
print_string("*** Stage 2 early init... ");
fflush(stdout);
CELL words = find_all_words();
REGISTER_ROOT(words);
CELL i;
CELL length = array_capacity(untag_object(words));
for(i = 0; i < length; i++)
{
F_WORD *word = untag_word(array_nth(untag_array(words),i));
REGISTER_UNTAGGED(word);
default_word_code(word,false);
UNREGISTER_UNTAGGED(word);
update_word_xt(word);
}
UNREGISTER_ROOT(words);
iterate_code_heap(relocate_code_block);
userenv[STAGE2_ENV] = T;
print_string("done\n");
fflush(stdout);
}
/* Allocates memory */
void jit::emit(cell code_template_)
{
gc_root<array> code_template(code_template_,parent_vm);
emit_relocation(code_template.value());
gc_root<byte_array> insns(array_nth(code_template.untagged(),0),parent_vm);
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());
}
inline cell array_nth(array *array, cell slot)
{
#ifdef FACTOR_DEBUG
assert(slot < array_capacity(array));
assert(array->h.hi_tag() == ARRAY_TYPE);
#endif
return array->data()[slot];
}
int edb_array_capacity(obj_handle *h, u32 *capacity) {
LOG_HERE;
int err = 0;
u32 root;
CHECK(obj_read(h, &root));
*capacity = array_capacity(h->db, root);
err: return err;
}
// Allocates memory
void growable_array::add(cell elt_) {
factor_vm* parent = elements.parent;
data_root<object> elt(elt_, parent);
if (count == array_capacity(elements.untagged()))
elements = parent->reallot_array(elements.untagged(), count * 2);
parent->set_array_nth(elements.untagged(), count++, elt.value());
}
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;
}
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);
}
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);
code_block *compiled = add_code_block(
code_block_optimized,
code,
labels,
word.value(),
relocation,
parameters,
literals);
word->code = compiled;
}
break;
default:
critical_error("Expected a quotation or an array",data.value());
break;
}
update_word_entry_point(word.untagged());
}
if(update_existing_words)
update_code_heap_words(reset_inline_caches);
else
initialize_code_blocks();
}
/* 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;
}
// 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;
}
// 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;
}
//arrays.hpp
inline void factorvm::set_array_nth(array *array, cell slot, cell value)
{
#ifdef FACTOR_DEBUG
assert(slot < array_capacity(array));
assert(array->h.hi_tag() == ARRAY_TYPE);
check_tagged_pointer(value);
#endif
array->data()[slot] = value;
write_barrier(array);
}
/* 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 growable_byte_array::append_bytes(void *elts, cell len)
{
cell new_size = count + len;
factorvm *myvm = elements.myvm;
if(new_size >= array_capacity(elements.untagged()))
elements = myvm->reallot_array(elements.untagged(),new_size * 2);
memcpy(&elements->data<u8>()[count],elts,len);
count += len;
}
// All quotations wants a stack frame, except if they contain:
// 1) calls to the special subprimitives, see #295.
// 2) mega cache lookups, see #651
bool quotation_jit::stack_frame_p() {
cell length = array_capacity(elements.untagged());
for (cell i = 0; i < length; i++) {
cell obj = nth(i);
cell tag = TAG(obj);
if ((tag == WORD_TYPE && special_subprimitive_p(obj)) ||
(tag == ARRAY_TYPE && mega_lookup_p(i, length)))
return false;
}
return true;
}
void jit::emit_relocation(cell relocation_template_) {
data_root<byte_array> relocation_template(relocation_template_, parent);
cell capacity =
array_capacity(relocation_template.untagged()) / sizeof(relocation_entry);
relocation_entry* relocations = relocation_template->data<relocation_entry>();
for (cell i = 0; i < capacity; i++) {
relocation_entry entry = relocations[i];
relocation_entry new_entry(entry.rel_type(), entry.rel_class(),
entry.rel_offset() + code.count);
relocation.append_bytes(&new_entry, sizeof(relocation_entry));
}
}
