diff --git a/basis/cpu/ppc/assembler/assembler.factor b/basis/cpu/ppc/assembler/assembler.factor index 6711c139b9..0bb0d70ee0 100644 --- a/basis/cpu/ppc/assembler/assembler.factor +++ b/basis/cpu/ppc/assembler/assembler.factor @@ -204,6 +204,6 @@ MTSPR: CTR 9 : (SRWI) ( d a b -- d a b x y ) 32 over - swap 31 ; inline : SRWI ( d a b -- ) (SRWI) RLWINM ; : SRWI. ( d a b -- ) (SRWI) RLWINM. ; -: LOAD32 ( n r -- ) >r w>h/h r> tuck LIS dup rot ORI ; +: LOAD32 ( n r -- ) [ w>h/h ] dip tuck LIS dup rot ORI ; : immediate? ( n -- ? ) HEX: -8000 HEX: 7fff between? ; : LOAD ( n r -- ) over immediate? [ LI ] [ LOAD32 ] if ; diff --git a/basis/cpu/ppc/assembler/backend/backend.factor b/basis/cpu/ppc/assembler/backend/backend.factor index 881b094ca2..a2c3a6c8d5 100644 --- a/basis/cpu/ppc/assembler/backend/backend.factor +++ b/basis/cpu/ppc/assembler/backend/backend.factor @@ -79,8 +79,8 @@ M: label (B) 0 -rot (B) rc-relative-ppc-3 label-fixup ; GENERIC: BC ( a b c -- ) M: integer BC 0 0 16 b-insn ; -M: word BC >r 0 BC r> rc-relative-ppc-2 rel-word ; -M: label BC >r 0 BC r> rc-relative-ppc-2 label-fixup ; +M: word BC [ 0 BC ] dip rc-relative-ppc-2 rel-word ; +M: label BC [ 0 BC ] dip rc-relative-ppc-2 label-fixup ; : CREATE-B ( -- word ) scan "B" prepend create-in ; diff --git a/basis/cpu/ppc/ppc.factor b/basis/cpu/ppc/ppc.factor index c555c4b809..232608e4ef 100644 --- a/basis/cpu/ppc/ppc.factor +++ b/basis/cpu/ppc/ppc.factor @@ -467,19 +467,21 @@ M: ppc %gc M: ppc %prologue ( n -- ) 0 11 LOAD32 rc-absolute-ppc-2/2 rel-this 0 MFLR - 1 1 pick neg ADDI - 11 1 pick xt-save STW - dup 11 LI - 11 1 pick next-save STW - 0 1 rot lr-save + STW ; + { + [ [ 1 1 ] dip neg ADDI ] + [ [ 11 1 ] dip xt-save STW ] + [ 11 LI ] + [ [ 11 1 ] dip next-save STW ] + [ [ 0 1 ] dip lr-save + STW ] + } cleave ; M: ppc %epilogue ( n -- ) #! At the end of each word that calls a subroutine, we store #! the previous link register value in r0 by popping it off #! the stack, set the link register to the contents of r0, #! and jump to the link register. - 0 1 pick lr-save + LWZ - 1 1 rot ADDI + [ [ 0 1 ] dip lr-save + LWZ ] + [ [ 1 1 ] dip ADDI ] bi 0 MTLR ; :: (%boolean) ( dst temp word -- ) @@ -541,17 +543,17 @@ GENERIC: STF ( src dst off reg-class -- ) M: single-float-regs STF drop STFS ; M: double-float-regs STF drop STFD ; -M: float-regs %save-param-reg >r 1 rot local@ r> STF ; +M: float-regs %save-param-reg [ 1 rot local@ ] dip STF ; GENERIC: LF ( dst src off reg-class -- ) M: single-float-regs LF drop LFS ; M: double-float-regs LF drop LFD ; -M: float-regs %load-param-reg >r 1 rot local@ r> LF ; +M: float-regs %load-param-reg [ 1 rot local@ ] dip LF ; M: stack-params %load-param-reg ( stack reg reg-class -- ) - drop >r 0 1 rot local@ LWZ 0 1 r> param@ STW ; + drop [ 0 1 rot local@ LWZ 0 1 ] dip param@ STW ; : next-param@ ( n -- x ) param@ stack-frame get total-size>> + ; @@ -559,8 +561,8 @@ M: stack-params %save-param-reg ( stack reg reg-class -- ) #! Funky. Read the parameter from the caller's stack frame. #! This word is used in callbacks drop - 0 1 rot next-param@ LWZ - 0 1 rot local@ STW ; + [ 0 1 ] dip next-param@ LWZ + [ 0 1 ] dip local@ STW ; M: ppc %prepare-unbox ( -- ) ! First parameter is top of stack @@ -580,14 +582,14 @@ M: ppc %unbox-long-long ( n func -- ) f %alien-invoke ! Store the return value on the C stack [ - 3 1 pick local@ STW - 4 1 rot cell + local@ STW + [ [ 3 1 ] dip local@ STW ] + [ [ 4 1 ] dip cell + local@ STW ] bi ] when* ; M: ppc %unbox-large-struct ( n c-type -- ) ! Value must be in r3 ! Compute destination address and load struct size - [ 4 1 rot local@ ADDI ] [ heap-size 5 LI ] bi* + [ [ 4 1 ] dip local@ ADDI ] [ heap-size 5 LI ] bi* ! Call the function "to_value_struct" f %alien-invoke ; @@ -595,15 +597,16 @@ M: ppc %box ( n reg-class func -- ) ! If the source is a stack location, load it into freg #0. ! If the source is f, then we assume the value is already in ! freg #0. - >r - over [ 0 over param-reg swap %load-param-reg ] [ 2drop ] if - r> f %alien-invoke ; + [ over [ 0 over param-reg swap %load-param-reg ] [ 2drop ] if ] dip + f %alien-invoke ; M: ppc %box-long-long ( n func -- ) - >r [ - 3 1 pick local@ LWZ - 4 1 rot cell + local@ LWZ - ] when* r> f %alien-invoke ; + [ + [ + [ [ 3 1 ] dip local@ LWZ ] + [ [ 4 1 ] dip cell + local@ LWZ ] bi + ] when* + ] dip f %alien-invoke ; : struct-return@ ( n -- n ) [ stack-frame get params>> ] unless* local@ ; @@ -616,7 +619,7 @@ M: ppc %prepare-box-struct ( -- ) M: ppc %box-large-struct ( n c-type -- ) ! If n = f, then we're boxing a returned struct ! Compute destination address and load struct size - [ 3 1 rot struct-return@ ADDI ] [ heap-size 4 LI ] bi* + [ [ 3 1 ] dip struct-return@ ADDI ] [ heap-size 4 LI ] bi* ! Call the function "box_value_struct" f %alien-invoke ;