! The start of the stack frame contains the size of this frame
! as well as the currently executing XT
: factor-area-size ( -- n ) 2 cells ; foldable
-: next-save ( n -- i ) cell - ;
-: xt-save ( n -- i ) 2 cells - ;
+: next-save ( n -- i ) cell - ; foldable
+: xt-save ( n -- i ) 2 cells - ; foldable
! Next, we have the spill area as well as the FFI parameter area.
! It is safe for them to overlap, since basic blocks with FFI calls
M: ppc %call ( word -- ) 0 BL rc-relative-ppc-3 rel-word-pic ;
M: ppc %jump ( word -- )
- 0 6 LOAD32 8 rc-absolute-ppc-2/2 rel-here
+ 0 6 LOAD32 4 rc-absolute-ppc-2/2 rel-here
0 B rc-relative-ppc-3 rel-word-pic-tail ;
M: ppc %jump-label ( label -- ) B ;
M:: ppc %dispatch ( src temp -- )
0 temp LOAD32
- 4 cells rc-absolute-ppc-2/2 rel-here
+ 3 cells rc-absolute-ppc-2/2 rel-here
temp temp src LWZX
temp MTCTR
BCTR ;
{ stack-params [ [ 0 1 ] dip LWZ [ 0 1 ] dip param@ STW ] }
} case ;
-: next-param@ ( n -- x ) param@ stack-frame get total-size>> + ;
+: next-param@ ( n -- reg x )
+ 2 1 stack-frame get total-size>> LWZ
+ [ 2 ] dip param@ ;
: store-to-frame ( src n rep -- )
{
{ int-rep [ [ 1 ] dip STW ] }
{ float-rep [ [ 1 ] dip STFS ] }
{ double-rep [ [ 1 ] dip STFD ] }
- { stack-params [ [ [ 0 1 ] dip next-param@ LWZ 0 1 ] dip STW ] }
+ { stack-params [ [ [ 0 ] dip next-param@ LWZ 0 1 ] dip STW ] }
} case ;
M: ppc %spill ( src rep dst -- )
! Call the function
"from_value_struct" f %alien-invoke ;
+M:: ppc %restore-context ( temp1 temp2 -- )
+ temp1 "ctx" %load-vm-field-addr
+ temp1 temp1 0 LWZ
+ temp2 1 stack-frame get total-size>> ADDI
+ temp2 temp1 "callstack-bottom" context-field-offset STW
+ ds-reg temp1 8 LWZ
+ rs-reg temp1 12 LWZ ;
+
M:: ppc %save-context ( temp1 temp2 -- )
- #! Save Factor stack pointers in case the C code calls a
- #! callback which does a GC, which must reliably trace
- #! all roots.
temp1 "ctx" %load-vm-field-addr
temp1 temp1 0 LWZ
1 temp1 0 STW
[ 11 ] 2dip %alien-global 11 MTLR BLRL ;
M: ppc %alien-callback ( quot -- )
+ 3 4 %restore-context
3 swap %load-reference
- 4 %load-vm-addr
- "c_to_factor" f %alien-invoke ;
+ 4 3 quot-xt-offset LWZ
+ 4 MTLR
+ BLRL
+ 3 4 %save-context ;
M: ppc %prepare-alien-indirect ( -- )
- 3 %load-vm-addr
- "from_alien" f %alien-invoke
+ 3 ds-reg 0 LWZ
+ ds-reg ds-reg 4 SUBI
+ 4 %load-vm-addr
+ "pinned_alien_offset" f %alien-invoke
16 3 MR ;
M: ppc %alien-indirect ( -- )
3 3 0 LWZ ;
M: ppc %nest-stacks ( -- )
- ! Save current frame. See comment in vm/contexts.hpp
- 3 1 stack-frame get total-size>> 2 cells - ADDI
- 4 %load-vm-addr
+ 3 %load-vm-addr
"nest_stacks" f %alien-invoke ;
M: ppc %unnest-stacks ( -- )
"unnest_stacks" f %alien-invoke ;
M: ppc %unbox-small-struct ( size -- )
- #! Alien must be in EAX.
heap-size cell align cell /i {
{ 1 [ %unbox-struct-1 ] }
{ 2 [ %unbox-struct-2 ] }
B blah
the offset from the immediate operand to LOAD32 to the instruction after
- the branch is two instructions. */
-static const fixnum xt_tail_pic_offset = 4 * 2;
+ the branch is one instruction. */
+static const fixnum xt_tail_pic_offset = 4;
inline static void check_call_site(cell return_address)
{
}
/* Defined in assembly */
-VM_C_API void c_to_factor(cell quot, void *vm);
-VM_C_API void throw_impl(cell quot, void *new_stack, void *vm);
-VM_C_API void lazy_jit_compile_impl(cell quot, void *vm);
VM_C_API void flush_icache(cell start, cell len);
-VM_C_API void set_callstack(
- void *vm,
- stack_frame *to,
- stack_frame *from,
- cell length,
- void *(*memcpy)(void*,const void*, size_t));
-
}
case RC_ABSOLUTE_PPC_2:
return load_value_masked(rel_absolute_ppc_2_mask,16,0);
case RC_RELATIVE_PPC_2:
- return load_value_masked(rel_relative_ppc_2_mask,16,0) + relative_to;
+ return load_value_masked(rel_relative_ppc_2_mask,16,0) + relative_to - sizeof(cell);
case RC_RELATIVE_PPC_3:
- return load_value_masked(rel_relative_ppc_3_mask,6,0) + relative_to;
+ return load_value_masked(rel_relative_ppc_3_mask,6,0) + relative_to - sizeof(cell);
case RC_RELATIVE_ARM_3:
return load_value_masked(rel_relative_arm_3_mask,6,2) + relative_to + sizeof(cell);
case RC_INDIRECT_ARM:
store_value_masked(absolute_value,rel_absolute_ppc_2_mask,0);
break;
case RC_RELATIVE_PPC_2:
- store_value_masked(relative_value,rel_relative_ppc_2_mask,0);
+ store_value_masked(relative_value + sizeof(cell),rel_relative_ppc_2_mask,0);
break;
case RC_RELATIVE_PPC_3:
- store_value_masked(relative_value,rel_relative_ppc_3_mask,0);
+ store_value_masked(relative_value + sizeof(cell),rel_relative_ppc_3_mask,0);
break;
case RC_RELATIVE_ARM_3:
store_value_masked(relative_value - sizeof(cell),rel_relative_arm_3_mask,2);