void forward_frame_xt(F_STACK_FRAME *frame)
{
CELL offset = (CELL)FRAME_RETURN_ADDRESS(frame) - (CELL)frame_code(frame);
F_COMPILED *forwarded = forward_xt(frame_code(frame));
frame->xt = (XT)(forwarded + 1);
FRAME_RETURN_ADDRESS(frame) = (XT)((CELL)forwarded + offset);
}
/* Allocates memory */
cell frame_scan(stack_frame *frame)
{
switch(frame_type(frame))
{
case QUOTATION_TYPE:
{
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)));
}
}
case WORD_TYPE:
return F;
default:
critical_error("Bad frame type",frame_type(frame));
return F;
}
}
/* Allocates memory */
cell factor_vm::frame_scan(stack_frame *frame)
{
switch(frame_type(frame))
{
case code_block_unoptimized:
{
tagged<object> obj(frame_executing(frame));
if(obj.type_p(WORD_TYPE))
obj = obj.as<word>()->def;
if(obj.type_p(QUOTATION_TYPE))
{
char *return_addr = (char *)FRAME_RETURN_ADDRESS(frame,this);
char *quot_entry_point = (char *)(frame_code(frame) + 1);
return tag_fixnum(quot_code_offset_to_scan(
obj.value(),(cell)(return_addr - quot_entry_point)));
}
else
return false_object;
}
case code_block_optimized:
return false_object;
default:
critical_error("Bad frame type",frame_type(frame));
return false_object;
}
}
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();
}
cell frame_executing(stack_frame *frame)
{
code_block *compiled = frame_code(frame);
if(compiled->literals == F || !stack_traces_p())
return F;
else
{
array *literals = untag<array>(compiled->literals);
cell executing = array_nth(literals,0);
check_data_pointer((object *)executing);
return executing;
}
}
/* References to undefined symbols are patched up to call this function on
image load. It finds the symbol and library, and throws an error. */
void factor_vm::undefined_symbol()
{
stack_frame *frame = innermost_stack_frame(ctx->callstack_bottom,
ctx->callstack_top);
code_block *compiled = frame_code(frame);
cell return_address = (cell)FRAME_RETURN_ADDRESS(frame, this);
find_symbol_at_address_visitor visitor(this, return_address);
compiled->each_instruction_operand(visitor);
if (!to_boolean(visitor.symbol))
critical_error("Can't find RT_DLSYM at return address", return_address);
else
general_error(ERROR_UNDEFINED_SYMBOL,visitor.symbol,visitor.library);
}
cell frame_type(stack_frame *frame)
{
return frame_code(frame)->type;
}
cell factor_vm::frame_executing(stack_frame *frame)
{
return frame_code(frame)->owner;
}
code_block_type factor_vm::frame_type(stack_frame *frame)
{
return frame_code(frame)->type();
}
cell factor_vm::frame_type(stack_frame *frame)
{
return frame_code(frame)->type;
}