Working on x86-64 FFI
parent
c64c2e8df8
commit
c41f21412e
|
@ -27,11 +27,11 @@ GENERIC: alien-node-abi ( node -- str )
|
|||
: alien-node-return* ( node -- ctype )
|
||||
alien-node-return dup large-struct? [ drop "void" ] when ;
|
||||
|
||||
: c-type-stack-align ( type -- align )
|
||||
dup c-type-stack-align? [ c-type-align ] [ drop cell ] if ;
|
||||
|
||||
: parameter-align ( n type -- n delta )
|
||||
over >r
|
||||
dup c-type-stack-align? [ c-type-align ] [ drop cell ] if
|
||||
align
|
||||
dup r> - ;
|
||||
over >r c-type-stack-align align dup r> - ;
|
||||
|
||||
: parameter-sizes ( types -- total offsets )
|
||||
#! Compute stack frame locations.
|
||||
|
@ -91,24 +91,33 @@ M: float-regs inc-reg-class
|
|||
[ dup class get swap inc-reg-class ] keep ;
|
||||
|
||||
: alloc-parameter ( parameter -- reg reg-class )
|
||||
c-type c-type-reg-class dup reg-class-full?
|
||||
c-type-reg-class dup reg-class-full?
|
||||
[ spill-param ] [ fastcall-param ] if
|
||||
[ param-reg ] keep ;
|
||||
|
||||
: (flatten-int-type) ( size -- )
|
||||
cell /i "void*" <repetition> % ;
|
||||
cell /i "void*" c-type <repetition> % ;
|
||||
|
||||
: flatten-int-type ( n type -- n )
|
||||
[ parameter-align (flatten-int-type) ] keep
|
||||
stack-size cell align dup (flatten-int-type) + ;
|
||||
GENERIC: flatten-value-type ( type -- )
|
||||
|
||||
: flatten-value-type ( n type -- n )
|
||||
dup c-type c-type-reg-class T{ int-regs } =
|
||||
[ flatten-int-type ] [ , ] if ;
|
||||
M: object flatten-value-type , ;
|
||||
|
||||
M: struct-type flatten-value-type ( type -- )
|
||||
stack-size cell align (flatten-int-type) ;
|
||||
|
||||
M: long-long-type flatten-value-type ( type -- )
|
||||
stack-size cell align (flatten-int-type) ;
|
||||
|
||||
: flatten-value-types ( params -- params )
|
||||
#! Convert value type structs to consecutive void*s.
|
||||
[ 0 [ flatten-value-type ] reduce drop ] { } make ;
|
||||
[
|
||||
0 [
|
||||
c-type
|
||||
[ parameter-align (flatten-int-type) ] keep
|
||||
[ stack-size cell align + ] keep
|
||||
flatten-value-type
|
||||
] reduce drop
|
||||
] { } make ;
|
||||
|
||||
: each-parameter ( parameters quot -- )
|
||||
>r [ parameter-sizes nip ] keep r> 2each ; inline
|
||||
|
@ -127,11 +136,11 @@ M: float-regs inc-reg-class
|
|||
#! Moves values from C stack to registers (if word is
|
||||
#! %load-param-reg) and registers to C stack (if word is
|
||||
#! %save-param-reg).
|
||||
swap
|
||||
>r
|
||||
alien-node-parameters*
|
||||
flatten-value-types
|
||||
[ pick >r alloc-parameter r> execute ] each-parameter
|
||||
drop ; inline
|
||||
r> [ >r alloc-parameter r> execute ] curry each-parameter ;
|
||||
inline
|
||||
|
||||
: if-void ( type true false -- )
|
||||
pick "void" = [ drop nip call ] [ nip call ] if ; inline
|
||||
|
|
|
@ -175,3 +175,31 @@ USE: cpu.x86.intrinsics
|
|||
\ set-alien-signed-4 small-reg-32 define-setter
|
||||
|
||||
T{ x86-backend f 8 } compiler-backend set-global
|
||||
|
||||
! The ABI for passing structs by value is pretty messed up
|
||||
"void*" c-type clone "__stack_value" define-primitive-type
|
||||
T{ stack-regs } "__stack_value" c-type set-c-type-reg-class
|
||||
|
||||
: struct-types&offset ( ctype -- pairs )
|
||||
c-type struct-type-fields [
|
||||
dup slot-spec-type swap slot-spec-offset 2array
|
||||
] map ;
|
||||
|
||||
: split-struct ( pairs -- seq )
|
||||
[
|
||||
[ first2 8 mod zero? [ t , ] when , ] each
|
||||
] { } make { t } split [ empty? not ] subset ;
|
||||
|
||||
: flatten-large-struct ( type -- )
|
||||
heap-size cell align
|
||||
cell /i "__stack_value" <repetition> % ;
|
||||
|
||||
M: struct-type flatten-value-type ( type -- seq )
|
||||
dup c-size 16 > [
|
||||
flatten-large-struct
|
||||
] [
|
||||
struct-types&offset split-struct [
|
||||
[ c-type c-type-reg-class ] map
|
||||
T{ int-regs } swap member? "void*" "double" ? ,
|
||||
] each
|
||||
] if ;
|
||||
|
|
Loading…
Reference in New Issue