cpu.ppc: update for recent changes -- untested

diff --git a/basis/cpu/ppc/ppc.factor b/basis/cpu/ppc/ppc.factor
index ce7a4e13eb01dc0b6f36be5dd9442826199571c9..3d2937f9b1f036235e9fabad1590b643851918f1 100644 (file)
--- a/basis/cpu/ppc/ppc.factor
+++ b/basis/cpu/ppc/ppc.factor
@@ -677,69 +677,55 @@ M:: ppc %save-param-reg ( stack reg rep -- )
 M:: ppc %load-param-reg ( stack reg rep -- )
     reg stack local@ rep load-from-frame ;
 
-M: ppc %pop-stack ( n -- )
-    [ 3 ] dip <ds-loc> loc>operand LWZ ;
-
-M: ppc %push-stack ( -- )
-    ds-reg ds-reg 4 ADDI
-    int-regs return-reg ds-reg 0 STW ;
-
-M: ppc %push-context-stack ( -- )
-    11 %context
-    12 11 "datastack" context-field-offset LWZ
-    12 12 4 ADDI
-    12 11 "datastack" context-field-offset STW
-    int-regs return-reg 12 0 STW ;
-
-M: ppc %pop-context-stack ( -- )
-    11 %context
-    12 11 "datastack" context-field-offset LWZ
-    int-regs return-reg 12 0 LWZ
-    12 12 4 SUBI
-    12 11 "datastack" context-field-offset STW ;
-
-M: ppc %unbox ( n rep func -- )
-    ! Value must be in r3
-    4 %load-vm-addr
-    ! Call the unboxer
-    f %alien-invoke
-    ! Store the return value on the C stack
-    over [ [ reg-class-of return-reg ] keep %save-param-reg ] [ 2drop ] if ;
+GENERIC: load-param ( reg src -- )
+
+M: integer load-param int-rep %copy ;
+
+M: spill-slot load-param n>> spill@ LWZ ;
+
+GENERIC: store-param ( reg dst -- )
+
+M: integer store-param swap int-rep %copy ;
+
+M: spill-slot store-param n>> spill@ STW ;
 
-M: ppc %unbox-long-long ( n func -- )
+:: call-unbox-func ( src func -- )
+    3 src load-param
     4 %load-vm-addr
-    ! Call the unboxer
-    f %alien-invoke
-    ! Store the return value on the C stack
-    [
-        [ [ 3 1 ] dip local@ STW ]
-        [ [ 4 1 ] dip cell + local@ STW ] bi
-    ] when* ;
+    func f %alien-invoke ;
 
-M: ppc %unbox-large-struct ( n c-type -- )
-    ! Value must be in r3
-    ! Compute destination address and load struct size
-    [ [ 4 1 ] dip local@ ADDI ] [ heap-size 5 LI ] bi*
-    6 %load-vm-addr
-    ! Call the function
-    "to_value_struct" f %alien-invoke ;
+M:: ppc %unbox ( src n rep func -- )
+    src func call-unbox-func
+    ! Store the return value on the C stack
+    n [ rep reg-class-of return-reg rep %save-param-reg ] when* ;
 
-M:: ppc %box ( n rep 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.
+M:: ppc %unbox-long-long ( src n func -- )
+    src func call-unbox-func
+    ! Store the return value on the C stack
+    n [
+        3 1 n local@ STW
+        4 1 n cell + local@ STW
+    ] when ;
+
+M:: ppc %unbox-large-struct ( src n c-type -- )
+    4 src load-param
+    3 1 n local@ ADDI
+    heap-size 5 LI
+    "memcpy" "libc" load-library %alien-invoke ;
+
+M:: ppc %box ( dst n rep func -- )
     n [ 0 rep reg-class-of cdecl param-reg rep %load-param-reg ] when*
     rep double-rep? 5 4 ? %load-vm-addr
-    func f %alien-invoke ;
+    func f %alien-invoke
+    3 dst store-param ;
 
-M: ppc %box-long-long ( n func -- )
-    [
-        [
-            [ [ 3 1 ] dip local@ LWZ ]
-            [ [ 4 1 ] dip cell + local@ LWZ ] bi
-        ] when*
-        5 %load-vm-addr
-    ] dip f %alien-invoke ;
+M:: ppc %box-long-long ( dst n func -- )
+    n [
+        3 1 n local@ LWZ
+        4 1 n cell + local@ LWZ
+    ] when
+    func f %alien-invoke
+    3 dst store-param ;
 
 : struct-return@ ( n -- n )
     [ stack-frame get params>> ] unless* local@ ;
@@ -749,13 +735,15 @@ M: ppc %prepare-box-struct ( -- )
     3 1 f struct-return@ ADDI
     3 1 0 local@ STW ;
 
-M: ppc %box-large-struct ( n c-type -- )
+M:: ppc %box-large-struct ( dst n c-type -- )
     ! If n = f, then we're boxing a returned struct
     ! Compute destination address and load struct size
-    [ [ 3 1 ] dip struct-return@ ADDI ] [ heap-size 4 LI ] bi*
+    3 1 n struct-return@ ADDI
+    c-type heap-size 4 LI
     5 %load-vm-addr
     ! Call the function
-    "from_value_struct" f %alien-invoke ;
+    "from_value_struct" f %alien-invoke
+    3 dst store-param ;
 
 M:: ppc %restore-context ( temp1 temp2 -- )
     temp1 %context
@@ -771,15 +759,8 @@ M:: ppc %save-context ( temp1 temp2 -- )
 M: ppc %alien-invoke ( symbol dll -- )
     [ 11 ] 2dip %alien-global 11 MTLR BLRL ;
 
-M: ppc %prepare-alien-indirect ( -- )
-    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 ( -- )
-    16 MTLR BLRL ;
+M: ppc %alien-indirect ( src -- )
+    [ 11 ] dip load-param 11 MTLR BLRL ;
 
 M: ppc immediate-arithmetic? ( n -- ? ) -32768 32767 between? ;
 
@@ -792,61 +773,51 @@ M: ppc struct-return-pointer-type void* ;
 M: ppc return-struct-in-registers? ( c-type -- ? )
     c-type return-in-registers?>> ;
 
-M: ppc %box-small-struct ( c-type -- )
+M:: ppc %box-small-struct ( dst c-type -- )
     #! Box a <= 16-byte struct returned in r3:r4:r5:r6
-    heap-size 7 LI
+    c-type heap-size 7 LI
     8 %load-vm-addr
-    "from_medium_struct" f %alien-invoke ;
+    "from_medium_struct" f %alien-invoke
+    3 dst store-param ;
 
 : %unbox-struct-1 ( -- )
     ! Alien must be in r3.
-    4 %load-vm-addr
-    "alien_offset" f %alien-invoke
     3 3 0 LWZ ;
 
 : %unbox-struct-2 ( -- )
     ! Alien must be in r3.
-    4 %load-vm-addr
-    "alien_offset" f %alien-invoke
     4 3 4 LWZ
     3 3 0 LWZ ;
 
 : %unbox-struct-4 ( -- )
     ! Alien must be in r3.
-    4 %load-vm-addr
-    "alien_offset" f %alien-invoke
     6 3 12 LWZ
     5 3 8 LWZ
     4 3 4 LWZ
     3 3 0 LWZ ;
 
+M:: ppc %unbox-small-struct ( src c-type -- )
+    src 3 load-param
+    c-type heap-size {
+        { [ dup 4 <= ] [ drop %unbox-struct-1 ] }
+        { [ dup 8 <= ] [ drop %unbox-struct-2 ] }
+        { [ dup 16 <= ] [ drop %unbox-struct-4 ] }
+    } cond ;
+
 M: ppc %begin-callback ( -- )
     3 %load-vm-addr
     "begin_callback" f %alien-invoke ;
 
 M: ppc %alien-callback ( quot -- )
-    3 4 %restore-context
     3 swap %load-reference
     4 3 quot-entry-point-offset LWZ
     4 MTLR
-    BLRL
-    3 4 %save-context ;
+    BLRL ;
 
 M: ppc %end-callback ( -- )
     3 %load-vm-addr
     "end_callback" f %alien-invoke ;
 
-M: ppc %to-nv ( -- ) 16 3 MR ;
-
-M: ppc %from-nv ( -- ) 3 16 MR ;
-
-M: ppc %unbox-small-struct ( size -- )
-    heap-size cell align cell /i {
-        { 1 [ %unbox-struct-1 ] }
-        { 2 [ %unbox-struct-2 ] }
-        { 4 [ %unbox-struct-4 ] }
-    } case ;
-
 enable-float-functions
 
 USE: vocabs.loader