/* Allocates memory */
string* factor_vm::reallot_string(string* str_, cell capacity) {
data_root<string> str(str_, this);
if (reallot_string_in_place_p(str.untagged(), capacity)) {
str->length = tag_fixnum(capacity);
if (to_boolean(str->aux)) {
byte_array* aux = untag<byte_array>(str->aux);
aux->capacity = tag_fixnum(capacity * 2);
}
return str.untagged();
} else {
cell to_copy = string_capacity(str.untagged());
if (capacity < to_copy)
to_copy = capacity;
data_root<string> new_str(allot_string_internal(capacity), this);
memcpy(new_str->data(), str->data(), to_copy);
if (to_boolean(str->aux)) {
byte_array* new_aux = allot_uninitialized_array<byte_array>(capacity * 2);
new_str->aux = tag<byte_array>(new_aux);
write_barrier(&new_str->aux);
byte_array* aux = untag<byte_array>(str->aux);
memcpy(new_aux->data<uint16_t>(), aux->data<uint16_t>(),
to_copy * sizeof(uint16_t));
}
fill_string(new_str.untagged(), to_copy, capacity, '\0');
return new_str.untagged();
}
}
// Allocates memory
void quotation_jit::emit_mega_cache_lookup(cell methods_, fixnum index,
cell cache_) {
data_root<array> methods(methods_, parent);
data_root<array> cache(cache_, parent);
// Load the object from the datastack.
emit_with_literal(parent->special_objects[PIC_LOAD],
tag_fixnum(-index * sizeof(cell)));
// Do a cache lookup.
emit_with_literal(parent->special_objects[MEGA_LOOKUP], cache.value());
// If we end up here, the cache missed.
emit(parent->special_objects[JIT_PROLOG]);
// Push index, method table and cache on the stack.
push(methods.value());
push(tag_fixnum(index));
push(cache.value());
word_call(parent->special_objects[MEGA_MISS_WORD]);
// Now the new method has been stored into the cache, and its on
// the stack.
emit(parent->special_objects[JIT_EPILOG]);
emit(parent->special_objects[JIT_EXECUTE]);
}
/* Push the free space and total size of the code heap */
void factor_vm::primitive_code_room()
{
cell used, total_free, max_free;
code->heap_usage(&used,&total_free,&max_free);
dpush(tag_fixnum(code->seg->size / 1024));
dpush(tag_fixnum(used / 1024));
dpush(tag_fixnum(total_free / 1024));
dpush(tag_fixnum(max_free / 1024));
}
/* Push the free space and total size of the code heap */
void primitive_code_room(void)
{
CELL used, total_free, max_free;
heap_usage(&code_heap,&used,&total_free,&max_free);
dpush(tag_fixnum((code_heap.segment->size) / 1024));
dpush(tag_fixnum(used / 1024));
dpush(tag_fixnum(total_free / 1024));
dpush(tag_fixnum(max_free / 1024));
}
/* Allocates memory */
void factor_vm::general_error(vm_error_type error, cell arg1_, cell arg2_) {
data_root<object> arg1(arg1_, this);
data_root<object> arg2(arg2_, this);
faulting_p = true;
/* If we had an underflow or overflow, data or retain stack
pointers might be out of bounds, so fix them before allocating
anything */
ctx->fix_stacks();
/* If error was thrown during heap scan, we re-enable the GC */
gc_off = false;
/* If the error handler is set, we rewind any C stack frames and
pass the error to user-space. */
if (!current_gc && to_boolean(special_objects[ERROR_HANDLER_QUOT])) {
#ifdef FACTOR_DEBUG
/* Doing a GC here triggers all kinds of funny errors */
primitive_compact_gc();
#endif
/* Now its safe to allocate and GC */
cell error_object =
allot_array_4(tag_fixnum(KERNEL_ERROR), tag_fixnum(error),
arg1.value(), arg2.value());
ctx->push(error_object);
/* Clear the data roots since arg1 and arg2's destructors won't be
called. */
data_roots.clear();
/* The unwind-native-frames subprimitive will clear faulting_p
if it was successfully reached. */
unwind_native_frames(special_objects[ERROR_HANDLER_QUOT],
ctx->callstack_top);
} /* Error was thrown in early startup before error handler is set, so just
crash. */
else {
std::cout << "You have triggered a bug in Factor. Please report.\n";
std::cout << "error: " << error << std::endl;
std::cout << "arg 1: ";
print_obj(std::cout, arg1.value());
std::cout << std::endl;
std::cout << "arg 2: ";
print_obj(std::cout, arg2.value());
std::cout << std::endl;
factorbug();
abort();
}
}
// Allocates memory
void factor_vm::primitive_get_samples() {
if (atomic::load(&sampling_profiler_p) || samples.empty()) {
ctx->push(false_object);
} else {
data_root<array> samples_array(allot_array(samples.size(), false_object),
this);
std::vector<profiling_sample>::const_iterator from_iter = samples.begin();
cell to_i = 0;
for (; from_iter != samples.end(); ++from_iter, ++to_i) {
data_root<array> sample(allot_array(7, false_object), this);
set_array_nth(sample.untagged(), 0,
tag_fixnum(from_iter->counts.sample_count));
set_array_nth(sample.untagged(), 1,
tag_fixnum(from_iter->counts.gc_sample_count));
set_array_nth(sample.untagged(), 2,
tag_fixnum(from_iter->counts.jit_sample_count));
set_array_nth(sample.untagged(), 3,
tag_fixnum(from_iter->counts.foreign_sample_count));
set_array_nth(sample.untagged(), 4,
tag_fixnum(from_iter->counts.foreign_thread_sample_count));
set_array_nth(sample.untagged(), 5, from_iter->thread);
cell callstack_size =
from_iter->callstack_end - from_iter->callstack_begin;
data_root<array> callstack(allot_array(callstack_size, false_object),
this);
std::vector<cell>::const_iterator callstacks_begin =
sample_callstacks.begin(),
c_from_iter =
callstacks_begin +
from_iter->callstack_begin,
c_from_iter_end =
callstacks_begin +
from_iter->callstack_end;
cell c_to_i = 0;
for (; c_from_iter != c_from_iter_end; ++c_from_iter, ++c_to_i)
set_array_nth(callstack.untagged(), c_to_i, *c_from_iter);
set_array_nth(sample.untagged(), 6, callstack.value());
set_array_nth(samples_array.untagged(), to_i, sample.value());
}
ctx->push(samples_array.value());
}
}
word *factor_vm::allot_word(cell name_, cell vocab_, cell hashcode_)
{
data_root<object> vocab(vocab_,this);
data_root<object> name(name_,this);
data_root<word> new_word(allot<word>(sizeof(word)),this);
new_word->hashcode = hashcode_;
new_word->vocabulary = vocab.value();
new_word->name = name.value();
new_word->def = special_objects[OBJ_UNDEFINED];
new_word->props = false_object;
new_word->counter = tag_fixnum(0);
new_word->pic_def = false_object;
new_word->pic_tail_def = false_object;
new_word->subprimitive = false_object;
new_word->profiling = NULL;
new_word->code = NULL;
jit_compile_word(new_word.value(),new_word->def,true);
if(counting_profiler_p)
{
code_block *profiling_block = compile_profiling_stub(new_word.value());
new_word->profiling = profiling_block;
initialize_code_block(new_word->profiling);
}
update_word_entry_point(new_word.untagged());
return new_word.untagged();
}
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);
}
/* Allocates memory */
cell frame_scan(stack_frame *frame)
{
switch(frame_type(frame))
{
case QUOTATION_TYPE:
{
cell quot = frame_executing(frame);
if(quot == F)
return F;
else
{
char *return_addr = (char *)FRAME_RETURN_ADDRESS(frame);
char *quot_xt = (char *)(frame_code(frame) + 1);
return tag_fixnum(quot_code_offset_to_scan(
quot,(cell)(return_addr - quot_xt)));
}
}
case WORD_TYPE:
return F;
default:
critical_error("Bad frame type",frame_type(frame));
return F;
}
}
inline cell factor_vm::allot_cell(cell x)
{
if(x > (cell)fixnum_max)
return tag<bignum>(cell_to_bignum(x));
else
return tag_fixnum(x);
}
/* Allocates memory */
cell factor_vm::frame_scan(stack_frame *frame)
{
switch(frame_type(frame))
{
case code_block_unoptimized:
{
tagged<object> obj(frame_executing(frame));
if(obj.type_p(WORD_TYPE))
obj = obj.as<word>()->def;
if(obj.type_p(QUOTATION_TYPE))
{
char *return_addr = (char *)FRAME_RETURN_ADDRESS(frame,this);
char *quot_entry_point = (char *)(frame_code(frame) + 1);
return tag_fixnum(quot_code_offset_to_scan(
obj.value(),(cell)(return_addr - quot_entry_point)));
}
else
return false_object;
}
case code_block_optimized:
return false_object;
default:
critical_error("Bad frame type",frame_type(frame));
return false_object;
}
}
inline cell factor_vm::allot_integer(fixnum x)
{
if(x < fixnum_min || x > fixnum_max)
return tag<bignum>(fixnum_to_bignum(x));
else
return tag_fixnum(x);
}
/* 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();
}
cell factor_vm::object_class(cell obj)
{
cell tag = TAG(obj);
if(tag == TUPLE_TYPE)
return untag<tuple>(obj)->layout;
else
return tag_fixnum(tag);
}
static void init_signal_pipe(factor_vm* vm) {
safe_pipe(&vm->signal_pipe_input, &vm->signal_pipe_output);
if (fcntl(vm->signal_pipe_output, F_SETFL, O_NONBLOCK) < 0)
fatal_error("Error with fcntl", errno);
vm->special_objects[OBJ_SIGNAL_PIPE] = tag_fixnum(vm->signal_pipe_input);
}
/* Allocates memory (literal(), emit())*/
void word_jump(cell word_) {
data_root<word> word(word_, parent);
#ifndef FACTOR_AMD64
literal(tag_fixnum(xt_tail_pic_offset));
#endif
literal(word.value());
emit(parent->special_objects[JIT_WORD_JUMP]);
}
// 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
}
inline cell factor_vm::unbox_array_size() {
cell obj = ctx->pop();
fixnum n = to_fixnum_strict(obj);
if (n >= 0 && n < (fixnum)array_size_max) {
return n;
}
general_error(ERROR_ARRAY_SIZE, obj, tag_fixnum(array_size_max));
return 0; /* can't happen */
}
void factor_vm::move_file(const vm_char* path1, const vm_char* path2) {
int ret = 0;
do {
ret = rename((path1), (path2));
} while (ret < 0 && errno == EINTR);
if (ret < 0)
general_error(ERROR_IO, tag_fixnum(errno), false_object);
}
/* Allocates memory */
string* factor_vm::allot_string_internal(cell capacity) {
string* str = allot<string>(string_size(capacity));
str->length = tag_fixnum(capacity);
str->hashcode = false_object;
str->aux = false_object;
return str;
}
void factor_vm::init_factor(vm_parameters *p)
{
/* Kilobytes */
p->datastack_size = align_page(p->datastack_size << 10);
p->retainstack_size = align_page(p->retainstack_size << 10);
p->callstack_size = align_page(p->callstack_size << 10);
p->callback_size = align_page(p->callback_size << 10);
/* Megabytes */
p->young_size <<= 20;
p->aging_size <<= 20;
p->tenured_size <<= 20;
p->code_size <<= 20;
/* Disable GC during init as a sanity check */
gc_off = true;
/* OS-specific initialization */
early_init();
const vm_char *executable_path = vm_executable_path();
if(executable_path)
p->executable_path = executable_path;
if(p->image_path == NULL)
p->image_path = default_image_path();
srand((unsigned int)nano_count());
init_ffi();
init_contexts(p->datastack_size,p->retainstack_size,p->callstack_size);
init_callbacks(p->callback_size);
load_image(p);
init_c_io();
init_inline_caching((int)p->max_pic_size);
if(p->signals)
init_signals();
if(p->console)
open_console();
init_profiler();
special_objects[OBJ_CPU] = allot_alien(false_object,(cell)FACTOR_CPU_STRING);
special_objects[OBJ_OS] = allot_alien(false_object,(cell)FACTOR_OS_STRING);
special_objects[OBJ_CELL_SIZE] = tag_fixnum(sizeof(cell));
special_objects[OBJ_EXECUTABLE] = allot_alien(false_object,(cell)p->executable_path);
special_objects[OBJ_ARGS] = false_object;
special_objects[OBJ_EMBEDDED] = false_object;
special_objects[OBJ_VM_COMPILER] = allot_alien(false_object,(cell)FACTOR_COMPILER_VERSION);
/* We can GC now */
gc_off = false;
if(!to_boolean(special_objects[OBJ_STAGE2]))
prepare_boot_image();
}
// Allocates memory
void fp_signal_handler_impl() {
factor_vm* vm = current_vm();
// Clear pending exceptions to avoid getting stuck in a loop
vm->set_fpu_state(vm->get_fpu_state());
vm->general_error(ERROR_FP_TRAP,
tag_fixnum(vm->signal_fpu_status),
false_object);
}
void factor_vm::primitive_fgetc() {
FILE* file = peek_file_handle();
int c = safe_fgetc(file);
if (c == EOF && feof(file)) {
clearerr(file);
ctx->replace(false_object);
} else
ctx->replace(tag_fixnum(c));
}
void operator()(code_block *compiled, cell size)
{
objects.push_back(compiled->owner);
objects.push_back(compiled->parameters);
objects.push_back(compiled->relocation);
objects.push_back(tag_fixnum(compiled->type()));
objects.push_back(tag_fixnum(compiled->size()));
/* Note: the entry point is always a multiple of the heap
alignment (16 bytes). We cannot allocate while iterating
through the code heap, so it is not possible to call allot_cell()
here. It is OK, however, to add it as if it were a fixnum, and
have library code shift it to the left by 4. */
cell entry_point = (cell)compiled->entry_point();
assert((entry_point & (data_alignment - 1)) == 0);
assert((entry_point & TAG_MASK) == FIXNUM_TYPE);
objects.push_back(entry_point);
}
void factorvm::init_factor(vm_parameters *p)
{
/* Kilobytes */
p->ds_size = align_page(p->ds_size << 10);
p->rs_size = align_page(p->rs_size << 10);
/* Megabytes */
p->young_size <<= 20;
p->aging_size <<= 20;
p->tenured_size <<= 20;
p->code_size <<= 20;
/* Disable GC during init as a sanity check */
gc_off = true;
/* OS-specific initialization */
early_init();
const vm_char *executable_path = vm_executable_path();
if(executable_path)
p->executable_path = executable_path;
if(p->image_path == NULL)
p->image_path = default_image_path();
srand(current_micros());
init_ffi();
init_stacks(p->ds_size,p->rs_size);
load_image(p);
init_c_io();
init_inline_caching(p->max_pic_size);
init_signals();
if(p->console)
open_console();
init_profiler();
userenv[CPU_ENV] = allot_alien(F,(cell)FACTOR_CPU_STRING);
userenv[OS_ENV] = allot_alien(F,(cell)FACTOR_OS_STRING);
userenv[CELL_SIZE_ENV] = tag_fixnum(sizeof(cell));
userenv[EXECUTABLE_ENV] = allot_alien(F,(cell)p->executable_path);
userenv[ARGS_ENV] = F;
userenv[EMBEDDED_ENV] = F;
/* We can GC now */
gc_off = false;
if(userenv[STAGE2_ENV] == F)
{
userenv[STACK_TRACES_ENV] = tag_boolean(p->stack_traces);
do_stage1_init();
}
}
cell factor_vm::object_class(cell obj)
{
switch(TAG(obj))
{
case TUPLE_TYPE:
return untag<tuple>(obj)->layout;
case OBJECT_TYPE:
return untag<object>(obj)->h.value;
default:
return tag_fixnum(TAG(obj));
}
}
/* Get things started */
void init_factor(F_PARAMETERS *p)
{
/* Kilobytes */
p->ds_size = align_page(p->ds_size << 10);
p->rs_size = align_page(p->rs_size << 10);
/* Megabytes */
p->young_size <<= 20;
p->aging_size <<= 20;
p->tenured_size <<= 20;
p->code_size <<= 20;
/* Disable GC during init as a sanity check */
gc_off = true;
/* OS-specific initialization */
early_init();
if(p->image == NULL)
p->image = default_image_path();
srand(current_micros());
init_ffi();
init_stacks(p->ds_size,p->rs_size);
load_image(p);
init_c_io();
init_signals();
if(p->console)
open_console();
stack_chain = NULL;
profiling_p = false;
performing_gc = false;
last_code_heap_scan = NURSERY;
collecting_aging_again = false;
userenv[CPU_ENV] = tag_object(from_char_string(FACTOR_CPU_STRING));
userenv[OS_ENV] = tag_object(from_char_string(FACTOR_OS_STRING));
userenv[CELL_SIZE_ENV] = tag_fixnum(sizeof(CELL));
userenv[STACK_TRACES_ENV] = tag_boolean(p->stack_traces);
/* We can GC now */
gc_off = false;
if(!stage2)
do_stage1_init();
}
/* make a new array with an initial element */
array *factor_vm::allot_array(cell capacity, cell fill_)
{
gc_root<object> fill(fill_,this);
gc_root<array> new_array(allot_array_internal<array>(capacity),this);
if(fill.value() == tag_fixnum(0))
memset(new_array->data(),'\0',capacity * sizeof(cell));
else
{
/* No need for write barrier here. Either the object is in
the nursery, or it was allocated directly in tenured space
and the write barrier is already hit for us in that case. */
cell i;
for(i = 0; i < capacity; i++)
new_array->data()[i] = fill.value();
}
return new_array.untagged();
}
// Allocates memory
void factor_vm::primitive_save_image() {
// We unbox this before doing anything else. This is the only point
// where we might throw an error, so we have to throw an error here since
// later steps destroy the current image.
bool then_die = to_boolean(ctx->pop());
byte_array* path2 = untag_check<byte_array>(ctx->pop());
byte_array* path1 = untag_check<byte_array>(ctx->pop());
// Copy the paths to non-gc memory to avoid them hanging around in
// the saved image.
vm_char* path1_saved = safe_strdup(path1->data<vm_char>());
vm_char* path2_saved = safe_strdup(path2->data<vm_char>());
if (then_die) {
// strip out special_objects data which is set on startup anyway
for (cell i = 0; i < special_object_count; i++)
if (!save_special_p(i))
special_objects[i] = false_object;
// dont trace objects only reachable from context stacks so we don't
// get volatile data saved in the image.
active_contexts.clear();
code->uninitialized_blocks.clear();
// I think clearing the callback heap should be fine too.
callbacks->allocator->initial_free_list(0);
}
// do a full GC to push everything remaining into tenured space
primitive_compact_gc();
// Save the image
bool ret = save_image(path1_saved, path2_saved);
if (then_die) {
exit(ret ? 0 : 1);
}
free(path1_saved);
free(path2_saved);
if (!ret) {
general_error(ERROR_IO, tag_fixnum(errno), false_object);
}
}
/* Allocates memory */
void update_word_xt(F_WORD *word)
{
/* If we just enabled the profiler, reset call count */
if(profiling_p)
{
word->counter = tag_fixnum(0);
if(!word->profiling)
{
REGISTER_UNTAGGED(word);
F_COMPILED *profiling = compile_profiling_stub(word);
UNREGISTER_UNTAGGED(word);
word->profiling = profiling;
}
word->xt = (XT)(word->profiling + 1);
}
else
word->xt = (XT)(word->code + 1);
}
