ppc asm to pass vm pointer: alien + compiled code

Phil Dawes 2009-09-30 21:23:53 +01:00
parent e91cb04aeb
commit 86593598d0
1 changed files with 21 additions and 4 deletions

View File

@ -466,6 +466,7 @@ M:: ppc %load-gc-root ( gc-root register -- )
M:: ppc %call-gc ( gc-root-count temp -- ) M:: ppc %call-gc ( gc-root-count temp -- )
3 1 gc-root-base local@ ADDI 3 1 gc-root-base local@ ADDI
gc-root-count 4 LI gc-root-count 4 LI
5 %load-vm-addr
"inline_gc" f %alien-invoke ; "inline_gc" f %alien-invoke ;
M: ppc %prologue ( n -- ) M: ppc %prologue ( n -- )
@ -614,6 +615,7 @@ M: ppc %prepare-unbox ( -- )
M: ppc %unbox ( n rep func -- ) M: ppc %unbox ( n rep func -- )
! Value must be in r3 ! Value must be in r3
4 %load-vm-addr
! Call the unboxer ! Call the unboxer
f %alien-invoke f %alien-invoke
! Store the return value on the C stack ! Store the return value on the C stack
@ -621,6 +623,7 @@ M: ppc %unbox ( n rep func -- )
M: ppc %unbox-long-long ( n func -- ) M: ppc %unbox-long-long ( n func -- )
! Value must be in r3:r4 ! Value must be in r3:r4
4 %load-vm-addr
! Call the unboxer ! Call the unboxer
f %alien-invoke f %alien-invoke
! Store the return value on the C stack ! Store the return value on the C stack
@ -633,15 +636,17 @@ M: ppc %unbox-large-struct ( n c-type -- )
! Value must be in r3 ! Value must be in r3
! Compute destination address and load struct size ! Compute destination address and load struct size
[ [ 4 1 ] dip local@ ADDI ] [ heap-size 5 LI ] bi* [ [ 4 1 ] dip local@ ADDI ] [ heap-size 5 LI ] bi*
6 %load-vm-addr
! Call the function ! Call the function
"to_value_struct" f %alien-invoke ; "to_value_struct" f %alien-invoke ;
M: ppc %box ( n rep func -- ) M:: ppc %box ( n rep func -- )
! If the source is a stack location, load it into freg #0. ! 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 ! If the source is f, then we assume the value is already in
! freg #0. ! freg #0.
[ over [ 0 over reg-class-of param-reg swap %load-param-reg ] [ 2drop ] if ] dip n [ 0 rep reg-class-of param-reg rep %load-param-reg ] when*
f %alien-invoke ; rep double-rep? 5 4 ? %load-vm-addr
func f %alien-invoke ;
M: ppc %box-long-long ( n func -- ) M: ppc %box-long-long ( n func -- )
[ [
@ -649,6 +654,7 @@ M: ppc %box-long-long ( n func -- )
[ [ 3 1 ] dip local@ LWZ ] [ [ 3 1 ] dip local@ LWZ ]
[ [ 4 1 ] dip cell + local@ LWZ ] bi [ [ 4 1 ] dip cell + local@ LWZ ] bi
] when* ] when*
5 %load-vm-addr
] dip f %alien-invoke ; ] dip f %alien-invoke ;
: struct-return@ ( n -- n ) : struct-return@ ( n -- n )
@ -663,6 +669,7 @@ M: ppc %box-large-struct ( n c-type -- )
! If n = f, then we're boxing a returned struct ! If n = f, then we're boxing a returned struct
! Compute destination address and load struct size ! Compute destination address and load struct size
[ [ 3 1 ] dip struct-return@ ADDI ] [ heap-size 4 LI ] bi* [ [ 3 1 ] dip struct-return@ ADDI ] [ heap-size 4 LI ] bi*
5 %load-vm-addr
! Call the function ! Call the function
"box_value_struct" f %alien-invoke ; "box_value_struct" f %alien-invoke ;
@ -682,9 +689,12 @@ M: ppc %alien-invoke ( symbol dll -- )
[ 11 ] 2dip %alien-global 11 MTLR BLRL ; [ 11 ] 2dip %alien-global 11 MTLR BLRL ;
M: ppc %alien-callback ( quot -- ) M: ppc %alien-callback ( quot -- )
3 swap %load-reference "c_to_factor" f %alien-invoke ; 3 swap %load-reference
4 %load-vm-addr
"c_to_factor" f %alien-invoke ;
M: ppc %prepare-alien-indirect ( -- ) M: ppc %prepare-alien-indirect ( -- )
3 %load-vm-addr
"unbox_alien" f %alien-invoke "unbox_alien" f %alien-invoke
15 3 MR ; 15 3 MR ;
@ -695,6 +705,7 @@ M: ppc %callback-value ( ctype -- )
! Save top of data stack ! Save top of data stack
3 ds-reg 0 LWZ 3 ds-reg 0 LWZ
3 1 0 local@ STW 3 1 0 local@ STW
3 %load-vm-addr
! Restore data/call/retain stacks ! Restore data/call/retain stacks
"unnest_stacks" f %alien-invoke "unnest_stacks" f %alien-invoke
! Restore top of data stack ! Restore top of data stack
@ -710,21 +721,25 @@ M: ppc return-struct-in-registers? ( c-type -- ? )
M: ppc %box-small-struct ( c-type -- ) M: ppc %box-small-struct ( c-type -- )
#! Box a <= 16-byte struct returned in r3:r4:r5:r6 #! Box a <= 16-byte struct returned in r3:r4:r5:r6
heap-size 7 LI heap-size 7 LI
8 %load-vm-addr
"box_medium_struct" f %alien-invoke ; "box_medium_struct" f %alien-invoke ;
: %unbox-struct-1 ( -- ) : %unbox-struct-1 ( -- )
! Alien must be in r3. ! Alien must be in r3.
4 %load-vm-addr
"alien_offset" f %alien-invoke "alien_offset" f %alien-invoke
3 3 0 LWZ ; 3 3 0 LWZ ;
: %unbox-struct-2 ( -- ) : %unbox-struct-2 ( -- )
! Alien must be in r3. ! Alien must be in r3.
4 %load-vm-addr
"alien_offset" f %alien-invoke "alien_offset" f %alien-invoke
4 3 4 LWZ 4 3 4 LWZ
3 3 0 LWZ ; 3 3 0 LWZ ;
: %unbox-struct-4 ( -- ) : %unbox-struct-4 ( -- )
! Alien must be in r3. ! Alien must be in r3.
4 %load-vm-addr
"alien_offset" f %alien-invoke "alien_offset" f %alien-invoke
6 3 12 LWZ 6 3 12 LWZ
5 3 8 LWZ 5 3 8 LWZ
@ -732,9 +747,11 @@ M: ppc %box-small-struct ( c-type -- )
3 3 0 LWZ ; 3 3 0 LWZ ;
M: ppc %nest-stacks ( -- ) M: ppc %nest-stacks ( -- )
3 %load-vm-addr
"nest_stacks" f %alien-invoke ; "nest_stacks" f %alien-invoke ;
M: ppc %unnest-stacks ( -- ) M: ppc %unnest-stacks ( -- )
3 %load-vm-addr
"unnest_stacks" f %alien-invoke ; "unnest_stacks" f %alien-invoke ;
M: ppc %unbox-small-struct ( size -- ) M: ppc %unbox-small-struct ( size -- )