void factor_vm::sampler_thread_loop() {
LARGE_INTEGER counter, new_counter, units_per_second;
DWORD ok;
ok = QueryPerformanceFrequency(&units_per_second);
FACTOR_ASSERT(ok);
ok = QueryPerformanceCounter(&counter);
FACTOR_ASSERT(ok);
counter.QuadPart *= samples_per_second;
while (atomic::load(&sampling_profiler_p)) {
SwitchToThread();
ok = QueryPerformanceCounter(&new_counter);
FACTOR_ASSERT(ok);
new_counter.QuadPart *= samples_per_second;
cell samples = 0;
while (new_counter.QuadPart - counter.QuadPart >
units_per_second.QuadPart) {
++samples;
counter.QuadPart += units_per_second.QuadPart;
}
if (samples == 0)
continue;
cell pc = get_thread_pc(thread);
enqueue_samples(samples, pc, false);
}
}
void set_stack_frame_size(cell frame_size) {
FACTOR_ASSERT(size() < 0xFFFFFF);
FACTOR_ASSERT(!free_p());
FACTOR_ASSERT(frame_size % 16 == 0);
FACTOR_ASSERT(frame_size <= 0xFF0);
header = (header & 0xFFFFFF) | (frame_size << 20);
}
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);
}
code_block* code_heap::code_block_for_address(cell address) {
std::set<cell>::const_iterator blocki = all_blocks.upper_bound(address);
FACTOR_ASSERT(blocki != all_blocks.begin());
--blocki;
code_block* found_block = (code_block*)*blocki;
FACTOR_ASSERT(found_block->entry_point() <=
address /* XXX this isn't valid during fixup. should store the
size in the map
&& address - found_block->entry_point() <
found_block->size()*/);
return found_block;
}
cell get_thread_pc(THREADHANDLE th) {
DWORD suscount = SuspendThread(th);
FACTOR_ASSERT(suscount == 0);
CONTEXT context;
memset((void*)&context, 0, sizeof(CONTEXT));
context.ContextFlags = CONTEXT_CONTROL;
BOOL context_ok = GetThreadContext(th, &context);
FACTOR_ASSERT(context_ok);
suscount = ResumeThread(th);
FACTOR_ASSERT(suscount == 1);
return context.EIP;
}
void factor_vm::dispatch_non_resumable_signal(cell* sp, cell* pc,
cell handler,
cell limit) {
// Fault came from the VM or foreign code. We don't try to fix the
// call stack from *sp and instead use the last saved "good value"
// which we get from ctx->callstack_top. Then launch the handler
// without going through the resumable subprimitive.
cell frame_top = ctx->callstack_top;
cell seg_start = ctx->callstack_seg->start;
if (frame_top < seg_start) {
// The saved callstack pointer is outside the callstack
// segment. That means that we need to carefully cut off one frame
// first which hopefully should put the pointer within the
// callstack's bounds.
code_block *block = code->code_block_for_address(*pc);
cell frame_size = block->stack_frame_size_for_address(*pc);
frame_top += frame_size;
}
// Cut the callstack down to the shallowest Factor stack
// frame that leaves room for the signal handler to do its thing,
// and launch the handler without going through the resumable
// subprimitive.
FACTOR_ASSERT(seg_start <= frame_top);
while (frame_top < ctx->callstack_bottom && frame_top < limit) {
frame_top = code->frame_predecessor(frame_top);
}
ctx->callstack_top = frame_top;
*sp = frame_top;
*pc = handler;
}
void code_heap::free(code_block* compiled) {
FACTOR_ASSERT(!uninitialized_p(compiled));
points_to_nursery.erase(compiled);
points_to_aging.erase(compiled);
all_blocks.erase((cell)compiled);
allocator->free(compiled);
}
inline void factor_vm::iterate_callstack(context* ctx, Iterator& iterator,
Fixup& fixup) {
if (ctx->callstack_top == ctx->callstack_bottom)
return;
char* frame_top = (char*)ctx->callstack_top;
while (frame_top < (char*)ctx->callstack_bottom) {
void* addr = frame_return_address((void*)frame_top);
FACTOR_ASSERT(addr != 0);
void* fixed_addr = Fixup::translated_code_block_map
? (void*)fixup.translate_code((code_block*)addr)
: addr;
code_block* owner = code->code_block_for_address((cell)fixed_addr);
code_block* fixed_owner =
Fixup::translated_code_block_map ? owner : fixup.translate_code(owner);
cell frame_size =
fixed_owner->stack_frame_size_for_address((cell)fixed_addr);
void* fixed_addr_for_iter =
Fixup::translated_code_block_map ? fixed_addr : addr;
iterator(frame_top, frame_size, owner, fixed_addr_for_iter);
frame_top += frame_size;
}
}
// 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;
}
void *factor_vm::frame_predecessor(void *frame_top)
{
void *addr = frame_return_address((void*)frame_top);
FACTOR_ASSERT(addr != 0);
code_block *owner = code->code_block_for_address((cell)addr);
cell frame_size = owner->stack_frame_size_for_address((cell)addr);
return (void*)((char*)frame_top + frame_size);
}
cell code_heap::frame_predecessor(cell frame_top) {
cell addr = *(cell*)frame_top;
FACTOR_ASSERT(seg->in_segment_p(addr));
//FACTOR_ASSERT(addr != 0);
code_block* owner = code_block_for_address(addr);
cell frame_size = owner->stack_frame_size_for_address(addr);
return frame_top + frame_size;
}
void factor_vm::lock_console() {
FACTOR_ASSERT(stdin_thread_initialized_p);
/* Lock the stdin_mutex and send the stdin_loop thread a signal to interrupt
any read() it has in progress. When the stdin loop iterates again, it will
try to lock the same mutex and wait until unlock_console() is called. */
pthread_mutex_lock(&stdin_mutex);
pthread_kill(stdin_thread, SIGUSR2);
}
inline static THREADHANDLE thread_id() {
DWORD id = GetCurrentThreadId();
HANDLE threadHandle = OpenThread(
THREAD_GET_CONTEXT | THREAD_SET_CONTEXT | THREAD_SUSPEND_RESUME, FALSE,
id);
FACTOR_ASSERT(threadHandle != NULL);
return threadHandle;
}
void factor_vm::open_console() {
FACTOR_ASSERT(!stdin_thread_initialized_p);
safe_pipe(&control_read, &control_write);
safe_pipe(&size_read, &size_write);
safe_pipe(&stdin_read, &stdin_write);
stdin_thread = start_thread(stdin_loop, NULL);
stdin_thread_initialized_p = true;
pthread_mutex_init(&stdin_mutex, NULL);
}
void factor_vm::delete_contexts() {
FACTOR_ASSERT(!ctx);
std::list<context*>::const_iterator iter = unused_contexts.begin();
std::list<context*>::const_iterator end = unused_contexts.end();
while (iter != end) {
delete *iter;
iter++;
}
}
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
from_unsigned_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 = compiled->entry_point();
FACTOR_ASSERT((entry_point & (data_alignment - 1)) == 0);
FACTOR_ASSERT((entry_point & TAG_MASK) == FIXNUM_TYPE);
objects.push_back(entry_point);
}
// Allocates memory
cell factor_vm::lazy_jit_compile(cell quot_) {
data_root<quotation> quot(quot_, this);
FACTOR_ASSERT(!quotation_compiled_p(quot.untagged()));
code_block* compiled =
jit_compile_quotation(quot.value(), quot.value(), true);
quot.untagged()->entry_point = compiled->entry_point();
return quot.value();
}
/*
frame top -> [return address]
[spill area]
...
[entry_point]
[size]
*/
void operator()(void* frame_top, cell frame_size, code_block* owner,
void* addr) {
cell return_address = owner->offset(addr);
code_block* compiled =
Fixup::translated_code_block_map ? owner
: visitor->fixup.translate_code(owner);
gc_info* info = compiled->block_gc_info();
FACTOR_ASSERT(return_address < compiled->size());
cell callsite = info->return_address_index(return_address);
if (callsite == (cell)-1)
return;
#ifdef DEBUG_GC_MAPS
std::cout << "call frame code block " << compiled << " with offset "
<< return_address << std::endl;
#endif
cell* stack_pointer = (cell*)frame_top;
uint8_t* bitmap = info->gc_info_bitmap();
/* Subtract old value of base pointer from every derived pointer. */
for (cell spill_slot = 0; spill_slot < info->derived_root_count;
spill_slot++) {
uint32_t base_pointer = info->lookup_base_pointer(callsite, spill_slot);
if (base_pointer != (uint32_t)-1) {
#ifdef DEBUG_GC_MAPS
std::cout << "visiting derived root " << spill_slot
<< " with base pointer " << base_pointer << std::endl;
#endif
stack_pointer[spill_slot] -= stack_pointer[base_pointer];
}
}
/* Update all GC roots, including base pointers. */
cell callsite_gc_roots = info->callsite_gc_roots(callsite);
for (cell spill_slot = 0; spill_slot < info->gc_root_count; spill_slot++) {
if (bitmap_p(bitmap, callsite_gc_roots + spill_slot)) {
#ifdef DEBUG_GC_MAPS
std::cout << "visiting GC root " << spill_slot << std::endl;
#endif
visitor->visit_handle(stack_pointer + spill_slot);
}
}
/* Add the base pointers to obtain new derived pointer values. */
for (cell spill_slot = 0; spill_slot < info->derived_root_count;
spill_slot++) {
uint32_t base_pointer = info->lookup_base_pointer(callsite, spill_slot);
if (base_pointer != (uint32_t)-1)
stack_pointer[spill_slot] += stack_pointer[base_pointer];
}
}
void operator()(void *frame_top, cell frame_size, code_block *owner, void *addr)
{
cell return_address = owner->offset(addr);
gc_info *info = owner->block_gc_info();
FACTOR_ASSERT(return_address < owner->size());
cell index = info->return_address_index(return_address);
if(index != (cell)-1)
ctx->scrub_stacks(info,index);
}
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
FACTOR_ASSERT(array_capacity(elements.untagged()) == 5);
FACTOR_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;
}
cell object_start_map::find_object_containing_card(cell card_index) {
if (card_index == 0)
return start;
card_index--;
while (object_start_offsets[card_index] == card_starts_inside_object) {
// First card should start with an object
FACTOR_ASSERT(card_index > 0);
card_index--;
}
return start + card_index * card_size + object_start_offsets[card_index];
}
/* Allocates memory */
jit::jit(code_block_type type, cell owner, factor_vm* vm)
: type(type),
owner(owner, vm),
code(vm),
relocation(vm),
parameters(vm),
literals(vm),
computing_offset_p(false),
position(0),
offset(0),
parent(vm) {
fixnum old_count = atomic::fetch_add(&parent->current_jit_count, 1);
FACTOR_ASSERT(old_count >= 0);
(void)old_count;
}
void factor_vm::dispatch_resumable_signal(cell* sp, cell* pc, cell handler) {
// Fault came from Factor, and we've got a good callstack. Route the
// signal handler through the resumable signal handler
// subprimitive.
cell offset = *sp % 16;
signal_handler_addr = handler;
// True stack frames are always 16-byte aligned. Leaf procedures
// that don't create a stack frame will be out of alignment by
// sizeof(cell) bytes.
// On architectures with a link register we would have to check for
// leafness by matching the PC to a word. We should also use
// FRAME_RETURN_ADDRESS instead of assuming the stack pointer is the
// right place to put the resume address.
cell index = 0;
cell delta = 0;
if (offset == 0) {
delta = sizeof(cell);
index = SIGNAL_HANDLER_WORD;
} else if (offset == 16 - sizeof(cell)) {
// Make a fake frame for the leaf procedure
FACTOR_ASSERT(code->code_block_for_address(*pc) != NULL);
delta = LEAF_FRAME_SIZE;
index = LEAF_SIGNAL_HANDLER_WORD;
} else {
FACTOR_ASSERT(false);
}
cell new_sp = *sp - delta;
*sp = new_sp;
*(cell*)new_sp = *pc;
*pc = untag<word>(special_objects[index])->entry_point;
}
static void call_fault_handler(mach_port_t thread, exception_type_t exception,
exception_data_type_t code,
MACH_EXC_STATE_TYPE* exc_state,
MACH_THREAD_STATE_TYPE* thread_state,
MACH_FLOAT_STATE_TYPE* float_state) {
/* Look up the VM instance involved */
THREADHANDLE thread_id = pthread_from_mach_thread_np(thread);
FACTOR_ASSERT(thread_id);
std::map<THREADHANDLE, factor_vm*>::const_iterator vm =
thread_vms.find(thread_id);
/* Handle the exception */
if (vm != thread_vms.end())
vm->second->call_fault_handler(exception, code, exc_state, thread_state,
float_state);
}
void safepoint_state::handle_safepoint(factor_vm* parent, cell pc) volatile {
parent->code->set_safepoint_guard(false);
parent->faulting_p = false;
if (atomic::load(&fep_p)) {
if (atomic::load(&parent->sampling_profiler_p))
parent->end_sampling_profiler();
std::cout << "Interrupted\n";
parent->factorbug();
atomic::store(&fep_p, false);
} else if (atomic::load(&parent->sampling_profiler_p)) {
FACTOR_ASSERT(parent->code->seg->in_segment_p(pc));
code_block* block = parent->code->code_block_for_address(pc);
bool prolog_p = block->entry_point() == pc;
parent->record_sample(prolog_p);
}
}
// Allocates memory
inline object* factor_vm::allot_object(cell type, cell size) {
FACTOR_ASSERT(!current_gc);
bump_allocator *nursery = data->nursery;
// If the object is bigger than the nursery, allocate it in tenured space
if (size >= nursery->size)
return allot_large_object(type, size);
// If the object is smaller than the nursery, allocate it in the nursery,
// after a GC if needed
if (nursery->here + size > nursery->end)
primitive_minor_gc();
object* obj = nursery->allot(size);
obj->initialize(type);
return obj;
}
static BOOL WINAPI ctrl_handler(DWORD dwCtrlType) {
switch (dwCtrlType) {
case CTRL_C_EVENT: {
// The CtrlHandler runs in its own thread without stopping the main
// thread. Since in practice nobody uses the multi-VM stuff yet, we just
// grab the first VM we can get. This will not be a good idea when we
// actually support native threads.
FACTOR_ASSERT(thread_vms.size() == 1);
factor_vm* vm = thread_vms.begin()->second;
vm->enqueue_fep();
// Before leaving the ctrl_handler, try and wake up the main thread.
wake_up_thread(factor::boot_thread);
return TRUE;
}
default:
return FALSE;
}
}
/* Allocates memory */
inline object* factor_vm::allot_object(cell type, cell size) {
FACTOR_ASSERT(!current_gc);
bump_allocator *nursery = data->nursery;
/* If the object is smaller than the nursery, allocate it in the nursery,
after a GC if needed */
if (nursery->size > size) {
/* If there is insufficient room, collect the nursery */
if (nursery->here + size > nursery->end)
primitive_minor_gc();
object* obj = nursery->allot(size);
obj->initialize(type);
return obj;
} /* If the object is bigger than the nursery, allocate it in
tenured space */
else
return allot_large_object(type, size);
}
size_t raw_fread(void* ptr, size_t size, size_t nitems, FILE* stream) {
FACTOR_ASSERT(nitems > 0);
size_t items_read = 0;
do {
size_t ret = fread((void*)((int*)ptr + items_read * size), size,
nitems - items_read, stream);
if (ret == 0) {
if (feof(stream)) {
break;
}
else if (errno != EINTR) {
return 0;
}
}
items_read += ret;
} while (items_read != nitems);
return items_read;
}
/* Modify a suspended thread's thread_state so that when the thread resumes
executing, the call frame of the current C primitive (if any) is rewound, and
the appropriate Factor error is thrown from the top-most Factor frame. */
void factor_vm::call_fault_handler(exception_type_t exception,
exception_data_type_t code,
MACH_EXC_STATE_TYPE* exc_state,
MACH_THREAD_STATE_TYPE* thread_state,
MACH_FLOAT_STATE_TYPE* float_state) {
cell handler = 0;
if (exception == EXC_BAD_ACCESS) {
signal_fault_addr = MACH_EXC_STATE_FAULT(exc_state);
signal_fault_pc = (cell)MACH_PROGRAM_COUNTER(thread_state);
verify_memory_protection_error(signal_fault_addr);
handler = (cell)factor::memory_signal_handler_impl;
} else if (exception == EXC_ARITHMETIC && code != MACH_EXC_INTEGER_DIV) {
signal_fpu_status = fpu_status(mach_fpu_status(float_state));
mach_clear_fpu_status(float_state);
handler = (cell)factor::fp_signal_handler_impl;
} else {
switch (exception) {
case EXC_ARITHMETIC:
signal_number = SIGFPE;
break;
case EXC_BAD_INSTRUCTION:
signal_number = SIGILL;
break;
default:
signal_number = SIGABRT;
break;
}
handler = (cell)factor::synchronous_signal_handler_impl;
}
FACTOR_ASSERT(handler != 0);
dispatch_signal_handler((cell*)&MACH_STACK_POINTER(thread_state),
(cell*)&MACH_PROGRAM_COUNTER(thread_state),
(cell)handler);
}
