ppc asm to pass vm pointer: alien + compiled code
parent
e91cb04aeb
commit
86593598d0
|
|
@ -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 -- )
|
||||||
|
|
|
||||||
Loading…
Reference in New Issue