factor/vm/callstack.cpp

199 lines
4.8 KiB
C++
Raw Normal View History

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
void factor_vm::check_frame(stack_frame *frame)
2009-05-02 21:01:54 -04:00
{
#ifdef FACTOR_DEBUG
2009-05-04 05:50:24 -04:00
check_code_pointer((cell)frame->xt);
2009-05-02 21:01:54 -04:00
assert(frame->size != 0);
#endif
}
2009-09-23 14:05:46 -04:00
callstack *factor_vm::allot_callstack(cell size)
2009-05-02 05:04:19 -04:00
{
2009-05-04 05:50:24 -04:00
callstack *stack = allot<callstack>(callstack_size(size));
stack->length = tag_fixnum(size);
return stack;
2009-05-02 05:04:19 -04:00
}
2009-09-23 14:05:46 -04:00
stack_frame *factor_vm::fix_callstack_top(stack_frame *top, stack_frame *bottom)
2009-05-02 05:04:19 -04:00
{
2009-05-04 05:50:24 -04:00
stack_frame *frame = bottom - 1;
2009-05-02 05:04:19 -04:00
while(frame >= top)
frame = frame_successor(frame);
return frame + 1;
}
/* 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. */
stack_frame *factor_vm::second_from_top_stack_frame()
2009-05-02 05:04:19 -04:00
{
stack_frame *frame = ctx->callstack_bottom - 1;
while(frame >= ctx->callstack_top
&& frame_successor(frame) >= ctx->callstack_top
&& frame_successor(frame_successor(frame)) >= ctx->callstack_top)
{
2009-05-02 05:04:19 -04:00
frame = frame_successor(frame);
}
2009-05-02 05:04:19 -04:00
return frame + 1;
}
void factor_vm::primitive_callstack()
2009-05-02 05:04:19 -04:00
{
stack_frame *top = second_from_top_stack_frame();
stack_frame *bottom = ctx->callstack_bottom;
2009-05-02 05:04:19 -04: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);
memcpy(stack->top(),top,size);
ctx->push(tag<callstack>(stack));
2009-05-02 05:04:19 -04:00
}
2009-09-23 14:05:46 -04:00
code_block *factor_vm::frame_code(stack_frame *frame)
2009-05-02 05:04:19 -04:00
{
2009-05-02 21:01:54 -04:00
check_frame(frame);
2009-05-04 05:50:24 -04:00
return (code_block *)frame->xt - 1;
2009-05-02 05:04:19 -04:00
}
code_block_type factor_vm::frame_type(stack_frame *frame)
2009-05-02 05:04:19 -04:00
{
return frame_code(frame)->type();
2009-05-02 05:04:19 -04:00
}
2009-09-23 14:05:46 -04:00
cell factor_vm::frame_executing(stack_frame *frame)
2009-05-02 05:04:19 -04:00
{
return frame_code(frame)->owner;
2009-05-02 05:04:19 -04:00
}
2009-12-02 17:57:39 -05:00
cell factor_vm::frame_executing_quot(stack_frame *frame)
{
tagged<object> executing(frame_executing(frame));
code_block *compiled = frame_code(frame);
if(!compiled->optimized_p() && executing->type() == WORD_TYPE)
executing = executing.as<word>()->def;
return executing.value();
}
2009-09-23 14:05:46 -04:00
stack_frame *factor_vm::frame_successor(stack_frame *frame)
2009-05-02 05:04:19 -04:00
{
2009-05-02 21:01:54 -04:00
check_frame(frame);
2009-05-04 05:50:24 -04:00
return (stack_frame *)((cell)frame - frame->size);
2009-05-02 05:04:19 -04:00
}
/* Allocates memory */
2009-09-23 14:05:46 -04:00
cell factor_vm::frame_scan(stack_frame *frame)
2009-05-02 05:04:19 -04:00
{
switch(frame_type(frame))
2009-05-02 05:04:19 -04:00
{
case code_block_unoptimized:
2009-05-02 05:04:19 -04:00
{
tagged<object> obj(frame_executing(frame));
if(obj.type_p(WORD_TYPE))
obj = obj.as<word>()->def;
if(obj.type_p(QUOTATION_TYPE))
2009-05-20 20:01:21 -04:00
{
char *return_addr = (char *)FRAME_RETURN_ADDRESS(frame,this);
2009-05-20 20:01:21 -04:00
char *quot_xt = (char *)(frame_code(frame) + 1);
return tag_fixnum(quot_code_offset_to_scan(
obj.value(),(cell)(return_addr - quot_xt)));
}
else
return false_object;
2009-05-02 05:04:19 -04:00
}
case code_block_optimized:
return false_object;
default:
critical_error("Bad frame type",frame_type(frame));
return false_object;
}
2009-05-02 05:04:19 -04:00
}
namespace
2009-05-02 05:04:19 -04:00
{
struct stack_frame_accumulator {
factor_vm *parent;
growable_array frames;
explicit stack_frame_accumulator(factor_vm *parent_) : parent(parent_), frames(parent_) {}
void operator()(stack_frame *frame)
{
2009-12-02 17:57:39 -05:00
data_root<object> executing(parent->frame_executing_quot(frame),parent);
data_root<object> scan(parent->frame_scan(frame),parent);
frames.add(executing.value());
frames.add(scan.value());
}
};
2009-05-02 05:04:19 -04:00
}
void factor_vm::primitive_callstack_to_array()
2009-05-02 05:04:19 -04:00
{
data_root<callstack> callstack(ctx->pop(),this);
2009-05-02 05:04:19 -04:00
stack_frame_accumulator accum(this);
iterate_callstack_object(callstack.untagged(),accum);
accum.frames.trim();
2009-05-02 05:04:19 -04:00
ctx->push(accum.frames.elements.value());
2009-05-02 05:04:19 -04:00
}
2009-09-23 14:05:46 -04:00
stack_frame *factor_vm::innermost_stack_frame(callstack *stack)
2009-05-02 05:04:19 -04:00
{
stack_frame *top = stack->top();
stack_frame *bottom = stack->bottom();
stack_frame *frame = bottom - 1;
2009-05-02 05:04:19 -04:00
while(frame >= top && frame_successor(frame) >= top)
frame = frame_successor(frame);
return frame;
}
/* Some primitives implementing a limited form of callstack mutation.
Used by the single stepper. */
void factor_vm::primitive_innermost_stack_frame_executing()
2009-05-02 05:04:19 -04:00
{
stack_frame *frame = innermost_stack_frame(untag_check<callstack>(ctx->pop()));
ctx->push(frame_executing_quot(frame));
2009-05-02 05:04:19 -04:00
}
void factor_vm::primitive_innermost_stack_frame_scan()
2009-05-02 05:04:19 -04:00
{
stack_frame *frame = innermost_stack_frame(untag_check<callstack>(ctx->pop()));
ctx->push(frame_scan(frame));
2009-05-02 05:04:19 -04:00
}
void factor_vm::primitive_set_innermost_stack_frame_quot()
2009-05-02 05:04:19 -04:00
{
data_root<callstack> callstack(ctx->pop(),this);
data_root<quotation> quot(ctx->pop(),this);
2009-05-02 05:04:19 -04:00
2009-08-17 16:37:15 -04:00
callstack.untag_check(this);
quot.untag_check(this);
2009-05-02 05:04:19 -04:00
jit_compile_quot(quot.value(),true);
2009-05-02 05:04:19 -04:00
2009-12-02 17:57:39 -05:00
stack_frame *inner = innermost_stack_frame(callstack.untagged());
cell offset = (char *)FRAME_RETURN_ADDRESS(inner,this) - (char *)inner->xt;
2009-05-02 05:04:19 -04:00
inner->xt = quot->xt;
FRAME_RETURN_ADDRESS(inner,this) = (char *)quot->xt + offset;
2009-05-02 05:04:19 -04:00
}
2009-05-04 02:46:13 -04:00
}