Clean up PPC backend a bit

diff --git a/basis/cpu/ppc/assembler/assembler.factor b/basis/cpu/ppc/assembler/assembler.factor
index 6711c139b9ad336d35f3fbac3900387aaa9f7e1b..0bb0d70ee077bef4a34992164760a5cface81da9 100644 (file)
--- 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 881b094ca229e9fdd32d194e449de3d34e351d98..a2c3a6c8d519723aa81697732ac8a1070247edef 100644 (file)
--- 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 c555c4b8090ba60779b5e0f097d54e5ce8b2a876..232608e4ef89b8c776fc9b775e8a1c85498fde43 100644 (file)
--- 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 ;