2009-05-02 05:04:19 -04:00
|
|
|
#include "master.hpp"
|
|
|
|
|
2009-05-04 02:46:13 -04:00
|
|
|
namespace factor
|
|
|
|
{
|
|
|
|
|
2009-09-23 14:05:46 -04:00
|
|
|
callstack *factor_vm::allot_callstack(cell size)
|
2009-05-02 05:04:19 -04:00
|
|
|
{
|
2010-03-26 22:44:43 -04:00
|
|
|
callstack *stack = allot<callstack>(callstack_object_size(size));
|
2009-05-04 05:50:24 -04:00
|
|
|
stack->length = tag_fixnum(size);
|
|
|
|
return stack;
|
2009-05-02 05:04:19 -04:00
|
|
|
}
|
|
|
|
|
2009-12-15 07:20:09 -05:00
|
|
|
/* We ignore the two topmost frames, the 'callstack' primitive
|
|
|
|
frame itself, and the frame calling the 'callstack' primitive,
|
2009-05-02 05:04:19 -04:00
|
|
|
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. */
|
2011-12-06 20:53:52 -05:00
|
|
|
void *factor_vm::second_from_top_stack_frame(context *ctx)
|
2009-05-02 05:04:19 -04:00
|
|
|
{
|
2011-12-06 20:53:52 -05:00
|
|
|
void *frame_top = ctx->callstack_top;
|
2011-12-14 12:52:43 -05:00
|
|
|
for (cell i = 0; i < 2; ++i)
|
2009-12-15 07:20:09 -05:00
|
|
|
{
|
2011-12-06 20:53:52 -05:00
|
|
|
void *pred = frame_predecessor(frame_top);
|
|
|
|
if (pred >= ctx->callstack_bottom)
|
|
|
|
return frame_top;
|
|
|
|
frame_top = pred;
|
2009-12-15 07:20:09 -05:00
|
|
|
}
|
2011-12-06 20:53:52 -05:00
|
|
|
return frame_top;
|
2009-05-02 05:04:19 -04:00
|
|
|
}
|
|
|
|
|
2010-03-29 20:40:17 -04:00
|
|
|
cell factor_vm::capture_callstack(context *ctx)
|
2009-05-02 05:04:19 -04:00
|
|
|
{
|
2011-12-06 20:53:52 -05:00
|
|
|
void *top = second_from_top_stack_frame(ctx);
|
|
|
|
void *bottom = ctx->callstack_bottom;
|
2009-05-02 05:04:19 -04:00
|
|
|
|
2009-12-15 07:20:09 -05:00
|
|
|
fixnum size = std::max((fixnum)0,(fixnum)bottom - (fixnum)top);
|
2009-05-02 05:04:19 -04:00
|
|
|
|
2009-05-04 05:50:24 -04:00
|
|
|
callstack *stack = allot_callstack(size);
|
2009-05-08 16:05:55 -04:00
|
|
|
memcpy(stack->top(),top,size);
|
2010-03-29 20:40:17 -04:00
|
|
|
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));
|
2009-05-02 05:04:19 -04:00
|
|
|
}
|
|
|
|
|
2011-12-06 20:53:52 -05:00
|
|
|
void *factor_vm::frame_predecessor(void *frame_top)
|
2010-06-13 17:57:16 -04:00
|
|
|
{
|
2011-12-06 20:53:52 -05:00
|
|
|
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);
|
2009-05-02 05:04:19 -04:00
|
|
|
}
|
|
|
|
|
2009-05-13 01:58:54 -04:00
|
|
|
struct stack_frame_accumulator {
|
2009-10-18 21:31:59 -04:00
|
|
|
factor_vm *parent;
|
2009-05-20 19:52:21 -04:00
|
|
|
growable_array frames;
|
|
|
|
|
2011-12-06 17:51:41 -05:00
|
|
|
explicit stack_frame_accumulator(factor_vm *parent_)
|
|
|
|
: parent(parent_), frames(parent_) {}
|
2009-08-17 16:37:09 -04:00
|
|
|
|
2011-12-06 17:51:41 -05:00
|
|
|
void operator()(void *frame_top, cell frame_size, code_block *owner, void *addr)
|
2009-05-13 01:58:54 -04:00
|
|
|
{
|
2011-12-06 17:51:41 -05:00
|
|
|
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);
|
2009-05-20 19:52:21 -04:00
|
|
|
|
|
|
|
frames.add(executing.value());
|
2010-02-01 00:45:08 -05:00
|
|
|
frames.add(executing_quot.value());
|
2009-05-20 19:52:21 -04:00
|
|
|
frames.add(scan.value());
|
2009-05-13 01:58:54 -04:00
|
|
|
}
|
|
|
|
};
|
2009-05-02 05:04:19 -04:00
|
|
|
|
2011-12-06 17:51:41 -05:00
|
|
|
struct stack_frame_in_array { cell cells[3]; };
|
|
|
|
|
2009-09-27 14:42:18 -04:00
|
|
|
void factor_vm::primitive_callstack_to_array()
|
2009-05-02 05:04:19 -04:00
|
|
|
{
|
2009-12-18 16:59:56 -05:00
|
|
|
data_root<callstack> callstack(ctx->pop(),this);
|
2009-05-02 05:04:19 -04:00
|
|
|
|
2009-08-17 16:37:09 -04:00
|
|
|
stack_frame_accumulator accum(this);
|
2011-12-06 18:00:02 -05:00
|
|
|
iterate_callstack_object(callstack.untagged(),accum);
|
2011-12-06 17:51:41 -05:00
|
|
|
|
|
|
|
/* 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));
|
|
|
|
|
2009-05-20 19:52:21 -04:00
|
|
|
accum.frames.trim();
|
2009-05-02 05:04:19 -04:00
|
|
|
|
2009-12-18 16:59:56 -05:00
|
|
|
ctx->push(accum.frames.elements.value());
|
2011-12-06 17:51:41 -05:00
|
|
|
|
2009-05-02 05:04:19 -04:00
|
|
|
}
|
|
|
|
|
|
|
|
/* Some primitives implementing a limited form of callstack mutation.
|
|
|
|
Used by the single stepper. */
|
2009-09-27 14:42:18 -04:00
|
|
|
void factor_vm::primitive_innermost_stack_frame_executing()
|
2009-05-02 05:04:19 -04:00
|
|
|
{
|
2011-09-12 03:56:24 -04:00
|
|
|
callstack *stack = untag_check<callstack>(ctx->pop());
|
2011-12-13 19:21:53 -05:00
|
|
|
void *frame = stack->top();
|
2011-12-06 20:53:52 -05:00
|
|
|
void *addr = frame_return_address(frame);
|
|
|
|
ctx->push(code->code_block_for_address((cell)addr)->owner_quot());
|
2009-05-02 05:04:19 -04:00
|
|
|
}
|
|
|
|
|
2009-09-27 14:42:18 -04:00
|
|
|
void factor_vm::primitive_innermost_stack_frame_scan()
|
2009-05-02 05:04:19 -04:00
|
|
|
{
|
2011-09-12 03:56:24 -04:00
|
|
|
callstack *stack = untag_check<callstack>(ctx->pop());
|
2011-12-13 19:21:53 -05:00
|
|
|
void *frame = stack->top();
|
2011-12-06 20:53:52 -05:00
|
|
|
void *addr = frame_return_address(frame);
|
|
|
|
ctx->push(code->code_block_for_address((cell)addr)->scan(this,addr));
|
2009-05-02 05:04:19 -04:00
|
|
|
}
|
|
|
|
|
2009-09-27 14:42:18 -04:00
|
|
|
void factor_vm::primitive_set_innermost_stack_frame_quot()
|
2009-05-02 05:04:19 -04:00
|
|
|
{
|
2011-09-13 02:15:00 -04:00
|
|
|
data_root<callstack> stack(ctx->pop(),this);
|
2009-12-18 16:59:56 -05:00
|
|
|
data_root<quotation> quot(ctx->pop(),this);
|
2009-05-02 05:04:19 -04:00
|
|
|
|
2011-09-13 02:15:00 -04:00
|
|
|
stack.untag_check(this);
|
2009-08-17 16:37:15 -04:00
|
|
|
quot.untag_check(this);
|
2009-05-02 05:04:19 -04:00
|
|
|
|
2009-11-24 23:38:15 -05:00
|
|
|
jit_compile_quot(quot.value(),true);
|
2009-05-02 05:04:19 -04:00
|
|
|
|
2011-12-13 19:21:53 -05:00
|
|
|
void *inner = stack->top();
|
2011-12-06 20:53:52 -05:00
|
|
|
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);
|
2009-05-02 05:04:19 -04:00
|
|
|
}
|
2009-05-04 02:00:30 -04:00
|
|
|
|
2010-04-19 21:08:15 -04:00
|
|
|
void factor_vm::primitive_callstack_bounds()
|
|
|
|
{
|
|
|
|
ctx->push(allot_alien((void*)ctx->callstack_seg->start));
|
|
|
|
ctx->push(allot_alien((void*)ctx->callstack_seg->end));
|
|
|
|
}
|
|
|
|
|
2009-05-04 02:46:13 -04:00
|
|
|
}
|