Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Fetching contributors…

Cannot retrieve contributors at this time

executable file 147 lines (117 sloc) 4.152 kb
#include "master.hpp"
namespace factor
{
callstack *factor_vm::allot_callstack(cell size)
{
callstack *stack = allot<callstack>(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<callstack>(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<object> executing_quot(owner->owner_quot(),parent);
data_root<object> executing(owner->owner,parent);
data_root<object> 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> 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<callstack>(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<callstack>(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<callstack> stack(ctx->pop(),this);
data_root<quotation> 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));
}
}
Jump to Line
Something went wrong with that request. Please try again.