moved %(un)nest-stacks out to cpu specific files to eliminate %vm-invoke from compiler.codegen
parent
28420c587a
commit
d457df1fbf
|
@ -447,7 +447,7 @@ M: ##alien-indirect generate-insn
|
||||||
! Generate code for boxing input parameters in a callback.
|
! Generate code for boxing input parameters in a callback.
|
||||||
[
|
[
|
||||||
dup \ %save-param-reg move-parameters
|
dup \ %save-param-reg move-parameters
|
||||||
"nest_stacks" %vm-invoke-1st-arg
|
%nest-stacks
|
||||||
box-parameters
|
box-parameters
|
||||||
] with-param-regs ;
|
] with-param-regs ;
|
||||||
|
|
||||||
|
@ -485,8 +485,6 @@ TUPLE: callback-context ;
|
||||||
[ callback-context new do-callback ] %
|
[ callback-context new do-callback ] %
|
||||||
] [ ] make ;
|
] [ ] make ;
|
||||||
|
|
||||||
: %unnest-stacks ( -- ) "unnest_stacks" %vm-invoke-1st-arg ;
|
|
||||||
|
|
||||||
M: ##callback-return generate-insn
|
M: ##callback-return generate-insn
|
||||||
#! All the extra book-keeping for %unwind is only for x86.
|
#! All the extra book-keeping for %unwind is only for x86.
|
||||||
#! On other platforms its an alias for %return.
|
#! On other platforms its an alias for %return.
|
||||||
|
|
|
@ -395,6 +395,10 @@ HOOK: %alien-callback cpu ( quot -- )
|
||||||
|
|
||||||
HOOK: %callback-value cpu ( ctype -- )
|
HOOK: %callback-value cpu ( ctype -- )
|
||||||
|
|
||||||
|
HOOK: %nest-stacks cpu ( -- )
|
||||||
|
|
||||||
|
HOOK: %unnest-stacks cpu ( -- )
|
||||||
|
|
||||||
! Return to caller with stdcall unwinding (only for x86)
|
! Return to caller with stdcall unwinding (only for x86)
|
||||||
HOOK: %callback-return cpu ( params -- )
|
HOOK: %callback-return cpu ( params -- )
|
||||||
|
|
||||||
|
|
|
@ -778,6 +778,12 @@ M: ppc %box-small-struct ( c-type -- )
|
||||||
4 3 4 LWZ
|
4 3 4 LWZ
|
||||||
3 3 0 LWZ ;
|
3 3 0 LWZ ;
|
||||||
|
|
||||||
|
M: ppc %nest-stacks ( -- )
|
||||||
|
"nest_stacks" f %alien-invoke ;
|
||||||
|
|
||||||
|
M: ppc %unnest-stacks ( -- )
|
||||||
|
"unnest_stacks" f %alien-invoke ;
|
||||||
|
|
||||||
M: ppc %unbox-small-struct ( size -- )
|
M: ppc %unbox-small-struct ( size -- )
|
||||||
#! Alien must be in EAX.
|
#! Alien must be in EAX.
|
||||||
heap-size cell align cell /i {
|
heap-size cell align cell /i {
|
||||||
|
|
|
@ -48,8 +48,7 @@ M: x86.32 reserved-area-size 0 ;
|
||||||
M: x86.32 %alien-invoke 0 CALL rc-relative rel-dlsym ;
|
M: x86.32 %alien-invoke 0 CALL rc-relative rel-dlsym ;
|
||||||
|
|
||||||
: push-vm-ptr ( -- )
|
: push-vm-ptr ( -- )
|
||||||
temp-reg 0 MOV rc-absolute-cell rt-vm rel-fixup ! push the vm ptr as an argument
|
0 PUSH rc-absolute-cell rt-vm rel-fixup ; ! push the vm ptr as an argument
|
||||||
temp-reg PUSH ;
|
|
||||||
|
|
||||||
M: x86.32 return-struct-in-registers? ( c-type -- ? )
|
M: x86.32 return-struct-in-registers? ( c-type -- ? )
|
||||||
c-type
|
c-type
|
||||||
|
@ -238,6 +237,18 @@ M:: x86.32 %unbox-large-struct ( n c-type -- )
|
||||||
"to_value_struct" f %alien-invoke
|
"to_value_struct" f %alien-invoke
|
||||||
] with-aligned-stack ;
|
] with-aligned-stack ;
|
||||||
|
|
||||||
|
M: x86.32 %nest-stacks ( -- )
|
||||||
|
4 [
|
||||||
|
push-vm-ptr
|
||||||
|
"nest_stacks" f %alien-invoke
|
||||||
|
] with-aligned-stack ;
|
||||||
|
|
||||||
|
M: x86.32 %unnest-stacks ( -- )
|
||||||
|
4 [
|
||||||
|
push-vm-ptr
|
||||||
|
"unnest_stacks" f %alien-invoke
|
||||||
|
] with-aligned-stack ;
|
||||||
|
|
||||||
M: x86.32 %prepare-alien-indirect ( -- )
|
M: x86.32 %prepare-alien-indirect ( -- )
|
||||||
push-vm-ptr "unbox_alien" f %alien-invoke
|
push-vm-ptr "unbox_alien" f %alien-invoke
|
||||||
temp-reg POP
|
temp-reg POP
|
||||||
|
@ -271,6 +282,7 @@ M: x86.32 %callback-value ( ctype -- )
|
||||||
! Unbox EAX
|
! Unbox EAX
|
||||||
unbox-return ;
|
unbox-return ;
|
||||||
|
|
||||||
|
|
||||||
M: x86.32 %cleanup ( params -- )
|
M: x86.32 %cleanup ( params -- )
|
||||||
#! a) If we just called an stdcall function in Windows, it
|
#! a) If we just called an stdcall function in Windows, it
|
||||||
#! cleaned up the stack frame for us. But we don't want that
|
#! cleaned up the stack frame for us. But we don't want that
|
||||||
|
|
|
@ -190,6 +190,13 @@ M: x86.64 %alien-invoke
|
||||||
rc-absolute-cell rel-dlsym
|
rc-absolute-cell rel-dlsym
|
||||||
R11 CALL ;
|
R11 CALL ;
|
||||||
|
|
||||||
|
M: x86.64 %nest-stacks ( -- )
|
||||||
|
param-reg-1 0 MOV rc-absolute-cell rt-vm rel-fixup
|
||||||
|
"nest_stacks" f %alien-invoke ;
|
||||||
|
|
||||||
|
M: x86.64 %unnest-stacks ( -- )
|
||||||
|
param-reg-1 0 MOV rc-absolute-cell rt-vm rel-fixup
|
||||||
|
"unnest_stacks" f %alien-invoke ;
|
||||||
|
|
||||||
M: x86.64 %prepare-alien-indirect ( -- )
|
M: x86.64 %prepare-alien-indirect ( -- )
|
||||||
"unbox_alien" %vm-invoke-1st-arg
|
"unbox_alien" %vm-invoke-1st-arg
|
||||||
|
|
Loading…
Reference in New Issue