diff --git a/basis/cpu/ppc/ppc.factor b/basis/cpu/ppc/ppc.factor index ce7a4e13eb..3d2937f9b1 100644 --- 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 loc>operand LWZ ; +GENERIC: load-param ( reg src -- ) -M: ppc %push-stack ( -- ) - ds-reg ds-reg 4 ADDI - int-regs return-reg ds-reg 0 STW ; +M: integer load-param int-rep %copy ; -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: spill-slot load-param n>> spill@ LWZ ; -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 ; +GENERIC: store-param ( reg dst -- ) -M: ppc %unbox ( n rep func -- ) - ! Value must be in r3 +M: integer store-param swap int-rep %copy ; + +M: spill-slot store-param n>> spill@ STW ; + +:: 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 - over [ [ reg-class-of return-reg ] keep %save-param-reg ] [ 2drop ] if ; - -M: ppc %unbox-long-long ( n func -- ) - 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* ; - -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 %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. - 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 ; -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 %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 %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 + 3 dst store-param ; + +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