2009-05-02 05:04:19 -04:00
|
|
|
#include "master.hpp"
|
|
|
|
|
2009-05-04 02:46:13 -04:00
|
|
|
namespace factor
|
|
|
|
{
|
|
|
|
|
2009-08-17 16:37:08 -04:00
|
|
|
void factorvm::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-08-17 16:37:08 -04:00
|
|
|
void check_frame(stack_frame *frame)
|
|
|
|
{
|
|
|
|
return vm->check_frame(frame);
|
|
|
|
}
|
|
|
|
|
|
|
|
callstack *factorvm::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-08-17 16:37:08 -04:00
|
|
|
callstack *allot_callstack(cell size)
|
|
|
|
{
|
|
|
|
return vm->allot_callstack(size);
|
|
|
|
}
|
|
|
|
|
|
|
|
stack_frame *factorvm::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;
|
|
|
|
}
|
|
|
|
|
2009-08-17 16:37:08 -04:00
|
|
|
stack_frame *fix_callstack_top(stack_frame *top, stack_frame *bottom)
|
|
|
|
{
|
|
|
|
return vm->fix_callstack_top(top,bottom);
|
|
|
|
}
|
|
|
|
|
2009-05-02 05:04:19 -04:00
|
|
|
/* We ignore the topmost frame, the one calling 'callstack',
|
|
|
|
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. */
|
2009-08-17 16:37:08 -04:00
|
|
|
stack_frame *factorvm::capture_start()
|
2009-05-02 05:04:19 -04:00
|
|
|
{
|
2009-05-04 05:50:24 -04:00
|
|
|
stack_frame *frame = stack_chain->callstack_bottom - 1;
|
2009-05-02 05:04:19 -04:00
|
|
|
while(frame >= stack_chain->callstack_top
|
|
|
|
&& frame_successor(frame) >= stack_chain->callstack_top)
|
|
|
|
{
|
|
|
|
frame = frame_successor(frame);
|
|
|
|
}
|
|
|
|
return frame + 1;
|
|
|
|
}
|
|
|
|
|
2009-08-17 16:37:08 -04:00
|
|
|
stack_frame *capture_start()
|
|
|
|
{
|
|
|
|
return vm->capture_start();
|
|
|
|
}
|
|
|
|
|
|
|
|
inline void factorvm::vmprim_callstack()
|
2009-05-02 05:04:19 -04:00
|
|
|
{
|
2009-05-04 05:50:24 -04:00
|
|
|
stack_frame *top = capture_start();
|
|
|
|
stack_frame *bottom = stack_chain->callstack_bottom;
|
2009-05-02 05:04:19 -04:00
|
|
|
|
2009-05-04 05:50:24 -04:00
|
|
|
fixnum size = (cell)bottom - (cell)top;
|
2009-05-02 05:04:19 -04:00
|
|
|
if(size < 0)
|
|
|
|
size = 0;
|
|
|
|
|
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);
|
2009-05-04 05:50:24 -04:00
|
|
|
dpush(tag<callstack>(stack));
|
2009-05-02 05:04:19 -04:00
|
|
|
}
|
|
|
|
|
2009-08-17 16:37:08 -04:00
|
|
|
PRIMITIVE(callstack)
|
|
|
|
{
|
|
|
|
PRIMITIVE_GETVM()->vmprim_callstack();
|
|
|
|
}
|
|
|
|
|
|
|
|
inline void factorvm::vmprim_set_callstack()
|
2009-05-02 05:04:19 -04:00
|
|
|
{
|
2009-05-04 05:50:24 -04:00
|
|
|
callstack *stack = untag_check<callstack>(dpop());
|
2009-05-02 05:04:19 -04:00
|
|
|
|
|
|
|
set_callstack(stack_chain->callstack_bottom,
|
2009-05-08 16:05:55 -04:00
|
|
|
stack->top(),
|
2009-05-02 21:47:29 -04:00
|
|
|
untag_fixnum(stack->length),
|
2009-05-02 05:04:19 -04:00
|
|
|
memcpy);
|
|
|
|
|
|
|
|
/* We cannot return here ... */
|
|
|
|
critical_error("Bug in set_callstack()",0);
|
|
|
|
}
|
|
|
|
|
2009-08-17 16:37:08 -04:00
|
|
|
PRIMITIVE(set_callstack)
|
|
|
|
{
|
|
|
|
PRIMITIVE_GETVM()->vmprim_set_callstack();
|
|
|
|
}
|
|
|
|
|
|
|
|
code_block *factorvm::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
|
|
|
}
|
|
|
|
|
2009-08-17 16:37:08 -04:00
|
|
|
code_block *frame_code(stack_frame *frame)
|
|
|
|
{
|
|
|
|
return vm->frame_code(frame);
|
|
|
|
}
|
|
|
|
|
|
|
|
cell factorvm::frame_type(stack_frame *frame)
|
2009-05-02 05:04:19 -04:00
|
|
|
{
|
2009-05-05 12:07:20 -04:00
|
|
|
return frame_code(frame)->type;
|
2009-05-02 05:04:19 -04:00
|
|
|
}
|
|
|
|
|
2009-08-17 16:37:08 -04:00
|
|
|
cell frame_type(stack_frame *frame)
|
|
|
|
{
|
|
|
|
return vm->frame_type(frame);
|
|
|
|
}
|
|
|
|
|
|
|
|
cell factorvm::frame_executing(stack_frame *frame)
|
2009-05-02 05:04:19 -04:00
|
|
|
{
|
2009-05-04 05:50:24 -04:00
|
|
|
code_block *compiled = frame_code(frame);
|
2009-05-02 05:04:19 -04:00
|
|
|
if(compiled->literals == F || !stack_traces_p())
|
|
|
|
return F;
|
|
|
|
else
|
|
|
|
{
|
2009-05-04 05:50:24 -04:00
|
|
|
array *literals = untag<array>(compiled->literals);
|
2009-05-17 19:18:07 -04:00
|
|
|
cell executing = array_nth(literals,0);
|
|
|
|
check_data_pointer((object *)executing);
|
|
|
|
return executing;
|
2009-05-02 05:04:19 -04:00
|
|
|
}
|
|
|
|
}
|
|
|
|
|
2009-08-17 16:37:08 -04:00
|
|
|
cell frame_executing(stack_frame *frame)
|
|
|
|
{
|
|
|
|
return vm->frame_executing(frame);
|
|
|
|
}
|
|
|
|
|
|
|
|
stack_frame *factorvm::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-08-17 16:37:08 -04:00
|
|
|
stack_frame *frame_successor(stack_frame *frame)
|
|
|
|
{
|
|
|
|
return vm->frame_successor(frame);
|
|
|
|
}
|
|
|
|
|
2009-05-17 19:18:07 -04:00
|
|
|
/* Allocates memory */
|
2009-08-17 16:37:08 -04:00
|
|
|
cell factorvm::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-05-20 19:52:21 -04:00
|
|
|
case QUOTATION_TYPE:
|
2009-05-02 05:04:19 -04:00
|
|
|
{
|
2009-05-20 20:01:21 -04:00
|
|
|
cell quot = frame_executing(frame);
|
|
|
|
if(quot == F)
|
|
|
|
return F;
|
|
|
|
else
|
|
|
|
{
|
|
|
|
char *return_addr = (char *)FRAME_RETURN_ADDRESS(frame);
|
|
|
|
char *quot_xt = (char *)(frame_code(frame) + 1);
|
|
|
|
|
|
|
|
return tag_fixnum(quot_code_offset_to_scan(
|
|
|
|
quot,(cell)(return_addr - quot_xt)));
|
|
|
|
}
|
2009-05-02 05:04:19 -04:00
|
|
|
}
|
2009-05-20 19:52:21 -04:00
|
|
|
case WORD_TYPE:
|
|
|
|
return F;
|
|
|
|
default:
|
|
|
|
critical_error("Bad frame type",frame_type(frame));
|
2009-05-02 05:04:19 -04:00
|
|
|
return F;
|
2009-05-20 19:52:21 -04:00
|
|
|
}
|
2009-05-02 05:04:19 -04:00
|
|
|
}
|
|
|
|
|
2009-08-17 16:37:08 -04:00
|
|
|
cell frame_scan(stack_frame *frame)
|
|
|
|
{
|
|
|
|
return vm->frame_scan(frame);
|
|
|
|
}
|
|
|
|
|
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-05-20 19:52:21 -04:00
|
|
|
growable_array frames;
|
|
|
|
|
2009-08-17 16:37:09 -04:00
|
|
|
stack_frame_accumulator(factorvm *vm) : frames(vm) {}
|
|
|
|
|
2009-08-17 16:37:14 -04:00
|
|
|
void operator()(stack_frame *frame, factorvm *myvm)
|
2009-05-13 01:58:54 -04:00
|
|
|
{
|
2009-08-17 16:37:14 -04:00
|
|
|
gc_root<object> executing(frame_executing(frame),myvm);
|
|
|
|
gc_root<object> scan(frame_scan(frame),myvm);
|
2009-05-20 19:52:21 -04:00
|
|
|
|
|
|
|
frames.add(executing.value());
|
|
|
|
frames.add(scan.value());
|
2009-05-13 01:58:54 -04:00
|
|
|
}
|
|
|
|
};
|
2009-05-02 05:04:19 -04:00
|
|
|
|
|
|
|
}
|
|
|
|
|
2009-08-17 16:37:08 -04:00
|
|
|
inline void factorvm::vmprim_callstack_to_array()
|
2009-05-02 05:04:19 -04:00
|
|
|
{
|
2009-08-17 16:37:09 -04:00
|
|
|
gc_root<callstack> callstack(dpop(),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-05-20 19:52:21 -04:00
|
|
|
dpush(accum.frames.elements.value());
|
2009-05-02 05:04:19 -04:00
|
|
|
}
|
|
|
|
|
2009-08-17 16:37:08 -04:00
|
|
|
PRIMITIVE(callstack_to_array)
|
|
|
|
{
|
|
|
|
PRIMITIVE_GETVM()->vmprim_callstack_to_array();
|
|
|
|
}
|
|
|
|
|
|
|
|
stack_frame *factorvm::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;
|
|
|
|
}
|
|
|
|
|
2009-08-17 16:37:08 -04:00
|
|
|
stack_frame *innermost_stack_frame(callstack *stack)
|
|
|
|
{
|
|
|
|
return vm->innermost_stack_frame(stack);
|
|
|
|
}
|
|
|
|
|
|
|
|
stack_frame *factorvm::innermost_stack_frame_quot(callstack *callstack)
|
2009-05-04 02:00:30 -04:00
|
|
|
{
|
2009-05-04 05:50:24 -04:00
|
|
|
stack_frame *inner = innermost_stack_frame(callstack);
|
|
|
|
tagged<quotation>(frame_executing(inner)).untag_check();
|
2009-05-04 02:00:30 -04:00
|
|
|
return inner;
|
|
|
|
}
|
|
|
|
|
2009-08-17 16:37:08 -04:00
|
|
|
stack_frame *innermost_stack_frame_quot(callstack *callstack)
|
|
|
|
{
|
|
|
|
return vm->innermost_stack_frame_quot(callstack);
|
|
|
|
}
|
|
|
|
|
2009-05-02 05:04:19 -04:00
|
|
|
/* Some primitives implementing a limited form of callstack mutation.
|
|
|
|
Used by the single stepper. */
|
2009-08-17 16:37:08 -04:00
|
|
|
inline void factorvm::vmprim_innermost_stack_frame_executing()
|
2009-05-02 05:04:19 -04:00
|
|
|
{
|
2009-05-05 10:12:32 -04:00
|
|
|
dpush(frame_executing(innermost_stack_frame(untag_check<callstack>(dpop()))));
|
2009-05-02 05:04:19 -04:00
|
|
|
}
|
|
|
|
|
2009-08-17 16:37:08 -04:00
|
|
|
PRIMITIVE(innermost_stack_frame_executing)
|
|
|
|
{
|
|
|
|
PRIMITIVE_GETVM()->vmprim_innermost_stack_frame_executing();
|
|
|
|
}
|
|
|
|
|
|
|
|
inline void factorvm::vmprim_innermost_stack_frame_scan()
|
2009-05-02 05:04:19 -04:00
|
|
|
{
|
2009-05-04 05:50:24 -04:00
|
|
|
dpush(frame_scan(innermost_stack_frame_quot(untag_check<callstack>(dpop()))));
|
2009-05-02 05:04:19 -04:00
|
|
|
}
|
|
|
|
|
2009-08-17 16:37:08 -04:00
|
|
|
PRIMITIVE(innermost_stack_frame_scan)
|
|
|
|
{
|
|
|
|
PRIMITIVE_GETVM()->vmprim_innermost_stack_frame_scan();
|
|
|
|
}
|
|
|
|
|
|
|
|
inline void factorvm::vmprim_set_innermost_stack_frame_quot()
|
2009-05-02 05:04:19 -04:00
|
|
|
{
|
2009-08-17 16:37:09 -04:00
|
|
|
gc_root<callstack> callstack(dpop(),this);
|
|
|
|
gc_root<quotation> quot(dpop(),this);
|
2009-05-02 05:04:19 -04:00
|
|
|
|
2009-05-04 02:00:30 -04:00
|
|
|
callstack.untag_check();
|
|
|
|
quot.untag_check();
|
2009-05-02 05:04:19 -04:00
|
|
|
|
2009-05-04 02:00:30 -04:00
|
|
|
jit_compile(quot.value(),true);
|
2009-05-02 05:04:19 -04:00
|
|
|
|
2009-05-04 05:50:24 -04:00
|
|
|
stack_frame *inner = innermost_stack_frame_quot(callstack.untagged());
|
|
|
|
cell offset = (char *)FRAME_RETURN_ADDRESS(inner) - (char *)inner->xt;
|
2009-05-02 05:04:19 -04:00
|
|
|
inner->xt = quot->xt;
|
|
|
|
FRAME_RETURN_ADDRESS(inner) = (char *)quot->xt + offset;
|
|
|
|
}
|
2009-05-04 02:00:30 -04:00
|
|
|
|
2009-08-17 16:37:08 -04:00
|
|
|
PRIMITIVE(set_innermost_stack_frame_quot)
|
|
|
|
{
|
|
|
|
PRIMITIVE_GETVM()->vmprim_set_innermost_stack_frame_quot();
|
|
|
|
}
|
|
|
|
|
2009-05-04 02:00:30 -04:00
|
|
|
/* called before entry into Factor code. */
|
2009-08-17 16:37:08 -04:00
|
|
|
void factorvm::save_callstack_bottom(stack_frame *callstack_bottom)
|
2009-05-04 02:00:30 -04:00
|
|
|
{
|
|
|
|
stack_chain->callstack_bottom = callstack_bottom;
|
|
|
|
}
|
2009-05-04 02:46:13 -04:00
|
|
|
|
2009-08-17 16:37:08 -04:00
|
|
|
VM_ASM_API void save_callstack_bottom(stack_frame *callstack_bottom)
|
|
|
|
{
|
|
|
|
return vm->save_callstack_bottom(callstack_bottom);
|
|
|
|
}
|
|
|
|
|
2009-05-04 02:46:13 -04:00
|
|
|
}
|