#include "master.hpp" namespace factor { callstack *factor_vm::allot_callstack(cell size) { callstack *stack = allot(callstack_object_size(size)); stack->length = tag_fixnum(size); return stack; } /* We ignore the two topmost frames, the 'callstack' primitive frame itself, and the frame calling the 'callstack' primitive, so that set-callstack doesn't get stuck in an infinite loop. This means that if 'callstack' is called in tail position, we will have popped a necessary frame... however this word is only called by continuation implementation, and user code shouldn't be calling it at all, so we leave it as it is for now. */ void *factor_vm::second_from_top_stack_frame(context *ctx) { void *frame_top = ctx->callstack_top; for (cell i = 0; i < 2; ++i) { void *pred = frame_predecessor(frame_top); if (pred >= ctx->callstack_bottom) return frame_top; frame_top = pred; } return frame_top; } cell factor_vm::capture_callstack(context *ctx) { void *top = second_from_top_stack_frame(ctx); void *bottom = ctx->callstack_bottom; fixnum size = std::max((fixnum)0,(fixnum)bottom - (fixnum)top); callstack *stack = allot_callstack(size); memcpy(stack->top(),top,size); return tag(stack); } void factor_vm::primitive_callstack() { ctx->push(capture_callstack(ctx)); } void factor_vm::primitive_callstack_for() { context *other_ctx = (context *)pinned_alien_offset(ctx->pop()); ctx->push(capture_callstack(other_ctx)); } 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); } struct stack_frame_accumulator { factor_vm *parent; growable_array frames; explicit stack_frame_accumulator(factor_vm *parent_) : parent(parent_), frames(parent_) {} void operator()(void *frame_top, cell frame_size, code_block *owner, void *addr) { data_root executing_quot(owner->owner_quot(),parent); data_root executing(owner->owner,parent); data_root scan(owner->scan(parent, addr),parent); frames.add(executing.value()); frames.add(executing_quot.value()); frames.add(scan.value()); } }; struct stack_frame_in_array { cell cells[3]; }; void factor_vm::primitive_callstack_to_array() { data_root callstack(ctx->pop(),this); stack_frame_accumulator accum(this); iterate_callstack_object(callstack.untagged(),accum); /* The callstack iterator visits frames in reverse order (top to bottom) */ std::reverse( (stack_frame_in_array*)accum.frames.elements->data(), (stack_frame_in_array*)(accum.frames.elements->data() + accum.frames.count)); accum.frames.trim(); ctx->push(accum.frames.elements.value()); } /* Some primitives implementing a limited form of callstack mutation. Used by the single stepper. */ void factor_vm::primitive_innermost_stack_frame_executing() { callstack *stack = untag_check(ctx->pop()); void *frame = stack->top(); void *addr = frame_return_address(frame); ctx->push(code->code_block_for_address((cell)addr)->owner_quot()); } void factor_vm::primitive_innermost_stack_frame_scan() { callstack *stack = untag_check(ctx->pop()); void *frame = stack->top(); void *addr = frame_return_address(frame); ctx->push(code->code_block_for_address((cell)addr)->scan(this,addr)); } void factor_vm::primitive_set_innermost_stack_frame_quot() { data_root stack(ctx->pop(),this); data_root quot(ctx->pop(),this); stack.untag_check(this); quot.untag_check(this); jit_compile_quot(quot.value(),true); void *inner = stack->top(); void *addr = frame_return_address(inner); code_block *block = code->code_block_for_address((cell)addr); cell offset = block->offset(addr); set_frame_return_address(inner, (char*)quot->entry_point + offset); } void factor_vm::primitive_callstack_bounds() { ctx->push(allot_alien((void*)ctx->callstack_seg->start)); ctx->push(allot_alien((void*)ctx->callstack_seg->end)); } }