diff --git a/basis/cpu/ppc/ppc.factor b/basis/cpu/ppc/ppc.factor index d641ed7039..4842327973 100644 --- a/basis/cpu/ppc/ppc.factor +++ b/basis/cpu/ppc/ppc.factor @@ -83,8 +83,8 @@ HOOK: reserved-area-size os ( -- n ) ! 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 @@ -126,7 +126,7 @@ M: ppc stack-frame-size ( stack-frame -- i ) 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 ; @@ -134,7 +134,7 @@ M: ppc %return ( -- ) BLR ; 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 ; @@ -564,14 +564,16 @@ M:: ppc %compare-float-unordered-branch ( label src1 src2 cc -- ) { 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 -- ) @@ -679,10 +681,15 @@ M: ppc %box-large-struct ( n c-type -- ) ! 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 @@ -693,13 +700,18 @@ M: ppc %alien-invoke ( symbol dll -- ) [ 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 ( -- ) @@ -753,9 +765,7 @@ M: ppc %box-small-struct ( c-type -- ) 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 ( -- ) @@ -763,7 +773,6 @@ 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 ] } diff --git a/vm/cpu-ppc.hpp b/vm/cpu-ppc.hpp index f0f6f80ae3..cd98d6a6ab 100644 --- a/vm/cpu-ppc.hpp +++ b/vm/cpu-ppc.hpp @@ -9,8 +9,8 @@ namespace factor 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) { @@ -77,16 +77,6 @@ inline static unsigned int fpu_status(unsigned int status) } /* 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)); - } diff --git a/vm/instruction_operands.cpp b/vm/instruction_operands.cpp index e815fc9619..69b82b1435 100644 --- a/vm/instruction_operands.cpp +++ b/vm/instruction_operands.cpp @@ -38,9 +38,9 @@ fixnum instruction_operand::load_value(cell relative_to) 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: @@ -107,10 +107,10 @@ void instruction_operand::store_value(fixnum absolute_value) 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);