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
|
2010-01-18 02:51:27 -05:00
|
|
|
check_code_pointer((cell)frame->entry_point);
|
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
|
|
|
{
|
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
|
|
|
}
|
|
|
|
|
2010-03-27 07:33:28 -04:00
|
|
|
/* If 'stack' points into the middle of the frame, find the nearest valid stack
|
|
|
|
pointer where we can resume execution and hope to capture the call trace without
|
|
|
|
crashing. Also, make sure we have at least 'stack_reserved' bytes available so
|
|
|
|
that we don't run out of callstack space while handling the error. */
|
|
|
|
stack_frame *factor_vm::fix_callstack_top(stack_frame *stack)
|
2009-05-02 05:04:19 -04:00
|
|
|
{
|
2010-03-27 07:33:28 -04:00
|
|
|
stack_frame *frame = ctx->callstack_bottom - 1;
|
2009-05-02 05:04:19 -04:00
|
|
|
|
2010-03-27 07:33:28 -04:00
|
|
|
while(frame >= stack
|
|
|
|
&& frame >= ctx->callstack_top
|
|
|
|
&& (cell)frame >= ctx->callstack_seg->start + stack_reserved)
|
2009-05-02 05:04:19 -04:00
|
|
|
frame = frame_successor(frame);
|
|
|
|
|
|
|
|
return frame + 1;
|
|
|
|
}
|
|
|
|
|
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. */
|
2010-03-29 20:40:17 -04:00
|
|
|
stack_frame *factor_vm::second_from_top_stack_frame(context *ctx)
|
2009-05-02 05:04:19 -04:00
|
|
|
{
|
2009-10-16 12:39:22 -04:00
|
|
|
stack_frame *frame = ctx->callstack_bottom - 1;
|
2009-12-15 07:20:09 -05:00
|
|
|
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-12-15 07:20:09 -05:00
|
|
|
}
|
2009-05-02 05:04:19 -04:00
|
|
|
return frame + 1;
|
|
|
|
}
|
|
|
|
|
2010-03-29 20:40:17 -04:00
|
|
|
cell factor_vm::capture_callstack(context *ctx)
|
2009-05-02 05:04:19 -04:00
|
|
|
{
|
2010-03-29 20:40:17 -04:00
|
|
|
stack_frame *top = second_from_top_stack_frame(ctx);
|
2009-10-16 12:39:22 -04:00
|
|
|
stack_frame *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
|
|
|
}
|
|
|
|
|
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);
|
2010-01-18 02:51:27 -05:00
|
|
|
return (code_block *)frame->entry_point - 1;
|
2009-05-02 05:04:19 -04:00
|
|
|
}
|
|
|
|
|
2009-10-20 13:19:02 -04:00
|
|
|
code_block_type factor_vm::frame_type(stack_frame *frame)
|
2009-05-02 05:04:19 -04:00
|
|
|
{
|
2009-10-06 06:52:45 -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
|
|
|
{
|
2009-10-06 07:25:07 -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
|
|
|
}
|
|
|
|
|
2009-05-17 19:18:07 -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
|
|
|
{
|
2009-05-20 19:52:21 -04:00
|
|
|
switch(frame_type(frame))
|
2009-05-02 05:04:19 -04:00
|
|
|
{
|
2009-10-20 13:19:02 -04:00
|
|
|
case code_block_unoptimized:
|
2009-05-02 05:04:19 -04:00
|
|
|
{
|
2009-11-24 23:38:15 -05: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
|
|
|
{
|
2009-10-03 09:47:05 -04:00
|
|
|
char *return_addr = (char *)FRAME_RETURN_ADDRESS(frame,this);
|
2010-01-18 02:51:27 -05:00
|
|
|
char *quot_entry_point = (char *)(frame_code(frame) + 1);
|
2009-05-20 20:01:21 -04:00
|
|
|
|
|
|
|
return tag_fixnum(quot_code_offset_to_scan(
|
2010-01-18 02:51:27 -05:00
|
|
|
obj.value(),(cell)(return_addr - quot_entry_point)));
|
2009-10-18 21:26:21 -04:00
|
|
|
}
|
|
|
|
else
|
|
|
|
return false_object;
|
2009-05-02 05:04:19 -04:00
|
|
|
}
|
2009-10-20 13:19:02 -04:00
|
|
|
case code_block_optimized:
|
2009-10-18 21:26:21 -04:00
|
|
|
return false_object;
|
2009-05-20 19:52:21 -04:00
|
|
|
default:
|
|
|
|
critical_error("Bad frame type",frame_type(frame));
|
2009-10-18 21:26:21 -04:00
|
|
|
return false_object;
|
2009-05-20 19:52:21 -04:00
|
|
|
}
|
2009-05-02 05:04:19 -04:00
|
|
|
}
|
|
|
|
|
2009-05-13 01:58:54 -04:00
|
|
|
namespace
|
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;
|
|
|
|
|
2009-10-18 21:31:59 -04:00
|
|
|
explicit stack_frame_accumulator(factor_vm *parent_) : parent(parent_), frames(parent_) {}
|
2009-08-17 16:37:09 -04:00
|
|
|
|
2009-10-03 09:47:05 -04:00
|
|
|
void operator()(stack_frame *frame)
|
2009-05-13 01:58:54 -04:00
|
|
|
{
|
2010-02-01 00:45:08 -05:00
|
|
|
data_root<object> executing_quot(parent->frame_executing_quot(frame),parent);
|
|
|
|
data_root<object> executing(parent->frame_executing(frame),parent);
|
2009-11-02 19:10:34 -05:00
|
|
|
data_root<object> scan(parent->frame_scan(frame),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
|
|
|
|
|
|
|
}
|
|
|
|
|
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);
|
2009-05-13 01:58:54 -04:00
|
|
|
iterate_callstack_object(callstack.untagged(),accum);
|
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());
|
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
|
|
|
{
|
2009-05-08 16:05:55 -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. */
|
2009-09-27 14:42:18 -04:00
|
|
|
void factor_vm::primitive_innermost_stack_frame_executing()
|
2009-05-02 05:04:19 -04:00
|
|
|
{
|
2009-12-18 16:59:56 -05: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
|
|
|
}
|
|
|
|
|
2009-09-27 14:42:18 -04:00
|
|
|
void factor_vm::primitive_innermost_stack_frame_scan()
|
2009-05-02 05:04:19 -04:00
|
|
|
{
|
2009-12-18 16:59:56 -05: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
|
|
|
}
|
|
|
|
|
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
|
|
|
{
|
2009-12-18 16:59:56 -05: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
|
|
|
|
2009-11-24 23:38:15 -05: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());
|
2010-01-18 02:51:27 -05:00
|
|
|
cell offset = (char *)FRAME_RETURN_ADDRESS(inner,this) - (char *)inner->entry_point;
|
|
|
|
inner->entry_point = quot->entry_point;
|
|
|
|
FRAME_RETURN_ADDRESS(inner,this) = (char *)quot->entry_point + offset;
|
2009-05-02 05:04:19 -04:00
|
|
|
}
|
2009-05-04 02:00:30 -04:00
|
|
|
|
2009-05-04 02:46:13 -04:00
|
|
|
}
|