cpu.x86.32: cleanups and fixes to make fastcall and thiscall callbacks work
parent
0aab7aa872
commit
ed40eb4239
|
@ -595,6 +595,6 @@ HOOK: %end-callback cpu ( -- )
|
|||
|
||||
HOOK: %end-callback-value cpu ( c-type -- )
|
||||
|
||||
HOOK: callback-return-rewind cpu ( params -- n )
|
||||
HOOK: stack-cleanup cpu ( params -- n )
|
||||
|
||||
M: object callback-return-rewind drop 0 ;
|
||||
M: object stack-cleanup drop 0 ;
|
||||
|
|
|
@ -129,8 +129,7 @@ M: stack-params copy-register*
|
|||
{ [ over integer? ] [ EAX swap MOV param@ EAX MOV ] }
|
||||
} cond ;
|
||||
|
||||
M: x86.32 %save-param-reg
|
||||
dup stack-params? [ 3drop ] [ [ param@ ] 2dip %copy ] if ;
|
||||
M: x86.32 %save-param-reg [ local@ ] 2dip %copy ;
|
||||
|
||||
M: x86.32 %load-param-reg [ swap local@ ] dip %copy ;
|
||||
|
||||
|
@ -139,7 +138,7 @@ M: x86.32 %load-param-reg [ swap local@ ] dip %copy ;
|
|||
#! are boxing a return value of a C function. If n is an
|
||||
#! integer, push [ESP+n] on the stack; we are boxing a
|
||||
#! parameter being passed to a callback from C.
|
||||
over [ [ next-stack@ ] dip load-return-reg ] [ 2drop ] if ;
|
||||
over [ [ local@ ] dip load-return-reg ] [ 2drop ] if ;
|
||||
|
||||
M:: x86.32 %box ( n rep func -- )
|
||||
n rep (%box)
|
||||
|
@ -327,18 +326,20 @@ M:: x86.32 %binary-float-function ( dst src1 src2 func -- )
|
|||
stack-params get
|
||||
] with-param-regs ;
|
||||
|
||||
M: x86.32 %cleanup ( params -- )
|
||||
#! a) If we just called a stdcall function in Windows, it
|
||||
#! cleaned up the stack frame for us. But we don't want that
|
||||
#! so we 'undo' the cleanup since we do that in %epilogue.
|
||||
#! b) If we just called a function returning a struct, we
|
||||
#! have to fix ESP.
|
||||
M: x86.32 stack-cleanup ( params -- n )
|
||||
#! a) Functions which are stdcall/fastcall/thiscall have to
|
||||
#! clean up the caller's stack frame.
|
||||
#! b) Functions returning large structs on MINGW have to
|
||||
#! fix ESP.
|
||||
{
|
||||
{ [ dup abi>> callee-cleanup? ] [ stack-arg-size ESP swap SUB ] }
|
||||
{ [ dup funny-large-struct-return? ] [ drop EAX PUSH ] }
|
||||
[ drop ]
|
||||
{ [ dup abi>> callee-cleanup? ] [ stack-arg-size ] }
|
||||
{ [ dup funny-large-struct-return? ] [ drop 4 ] }
|
||||
[ drop 0 ]
|
||||
} cond ;
|
||||
|
||||
M: x86.32 %cleanup ( params -- )
|
||||
stack-cleanup [ ESP swap SUB ] unless-zero ;
|
||||
|
||||
M:: x86.32 %call-gc ( gc-root-count temp -- )
|
||||
temp gc-root-base special@ LEA
|
||||
8 save-vm-ptr
|
||||
|
@ -352,17 +353,6 @@ M: x86.32 dummy-int-params? f ;
|
|||
|
||||
M: x86.32 dummy-fp-params? f ;
|
||||
|
||||
M: x86.32 callback-return-rewind ( params -- n )
|
||||
#! a) If the callback is stdcall, we have to clean up the
|
||||
#! caller's stack frame.
|
||||
#! b) If the callback is returning a large struct, we have
|
||||
#! to fix ESP.
|
||||
{
|
||||
{ [ dup stdcall? ] [ <alien-stack-frame> [ params>> ] [ return>> ] bi + ] }
|
||||
{ [ dup funny-large-struct-return? ] [ drop 4 ] }
|
||||
[ drop 0 ]
|
||||
} cond ;
|
||||
|
||||
! Dreadful
|
||||
M: object flatten-value-type (flatten-stack-type) ;
|
||||
M: struct-c-type flatten-value-type (flatten-stack-type) ;
|
||||
|
|
|
@ -66,9 +66,10 @@ big-endian off
|
|||
|
||||
frame-reg POP
|
||||
|
||||
! Callbacks which return structs, or use stdcall, need a
|
||||
! parameter here. See the comment in callback-return-rewind
|
||||
! in cpu.x86.32
|
||||
! Callbacks which return structs, or use stdcall/fastcall/thiscall,
|
||||
! need a parameter here.
|
||||
|
||||
! See the comment for M\ x86.32 stack-cleanup in cpu.x86.32
|
||||
HEX: ffff RET rc-absolute-2 rt-untagged jit-rel
|
||||
] callback-stub jit-define
|
||||
|
||||
|
|
|
@ -107,8 +107,7 @@ TUPLE: alien-callback-params < alien-node-params quot xt ;
|
|||
[ callbacks get ] dip '[ _ <callback> ] cache ;
|
||||
|
||||
: callback-bottom ( params -- )
|
||||
[ xt>> ] [ callback-return-rewind ] bi
|
||||
'[ _ _ callback-xt ] infer-quot-here ;
|
||||
[ xt>> ] [ stack-cleanup ] bi '[ _ _ callback-xt ] infer-quot-here ;
|
||||
|
||||
: infer-alien-callback ( -- )
|
||||
alien-callback-params new
|
||||
|
|
Loading…
Reference in New Issue