compiler: FFI is now slightly more efficient when unboxing parameters, only changes data stack height once
Slava Pestov
parent
560b6f45cc
commit
1e7893b6ce
|
|
@ -20,8 +20,7 @@ IN: compiler.alien
|
|||
: parameter-align ( n type -- n delta )
|
||||
[ c-type-stack-align align dup ] [ drop ] 2bi - ;
|
||||
|
||||
: parameter-sizes ( types -- total offsets )
|
||||
#! Compute stack frame locations.
|
||||
: parameter-offsets ( types -- total offsets )
|
||||
[
|
||||
0 [
|
||||
[ parameter-align drop dup , ] keep stack-size +
|
||||
|
|
|
|||
|
|
@ -212,7 +212,7 @@ M: #terminate emit-node drop ##no-tco end-basic-block ;
|
|||
stack-frame new
|
||||
swap
|
||||
[ return>> return-size >>return ]
|
||||
[ alien-parameters parameter-sizes drop >>params ] bi ;
|
||||
[ alien-parameters parameter-offsets drop >>params ] bi ;
|
||||
|
||||
: alien-node-height ( params -- )
|
||||
[ out-d>> length ] [ in-d>> length ] bi - adjust-d ;
|
||||
|
|
|
|||
|
|
@ -355,10 +355,7 @@ M: c-type-name flatten-value-type c-type flatten-value-type ;
|
|||
] { } make ;
|
||||
|
||||
: each-parameter ( parameters quot -- )
|
||||
[ [ parameter-sizes nip ] keep ] dip 2each ; inline
|
||||
|
||||
: reverse-each-parameter ( parameters quot -- )
|
||||
[ [ parameter-sizes nip ] keep ] dip 2reverse-each ; inline
|
||||
[ [ parameter-offsets nip ] keep ] dip 2each ; inline
|
||||
|
||||
: reset-fastcall-counts ( -- )
|
||||
{ int-regs float-regs stack-params } [ 0 swap set ] each ;
|
||||
|
|
@ -375,10 +372,17 @@ M: c-type-name flatten-value-type c-type flatten-value-type ;
|
|||
[ '[ alloc-parameter _ execute ] ]
|
||||
bi* each-parameter ; inline
|
||||
|
||||
: reverse-each-parameter ( parameters quot -- )
|
||||
[ [ parameter-offsets nip ] keep ] dip 2reverse-each ; inline
|
||||
|
||||
: prepare-unbox-parameters ( parameters -- offsets types indices )
|
||||
[ parameter-offsets nip ] [ ] [ length iota reverse ] tri ;
|
||||
|
||||
: unbox-parameters ( offset node -- )
|
||||
parameters>> [
|
||||
%prepare-unbox [ over + ] dip unbox-parameter
|
||||
] reverse-each-parameter drop ;
|
||||
parameters>> swap
|
||||
'[ prepare-unbox-parameters [ %prepare-unbox [ _ + ] dip unbox-parameter ] 3each ]
|
||||
[ length neg %inc-d ]
|
||||
bi ;
|
||||
|
||||
: prepare-box-struct ( node -- offset )
|
||||
#! Return offset on C stack where to store unboxed
|
||||
|
|
@ -410,7 +414,7 @@ M: c-type-name flatten-value-type c-type flatten-value-type ;
|
|||
] if ;
|
||||
|
||||
: stdcall-mangle ( symbol params -- symbol )
|
||||
parameters>> parameter-sizes drop number>string "@" glue ;
|
||||
parameters>> parameter-offsets drop number>string "@" glue ;
|
||||
|
||||
: alien-invoke-dlsym ( params -- symbols dll )
|
||||
[ [ function>> dup ] keep stdcall-mangle 2array ]
|
||||
|
|
|
|||
|
|
@ -463,7 +463,7 @@ HOOK: dummy-int-params? cpu ( -- ? )
|
|||
! If t, all int parameters are shadowed by dummy FP parameters
|
||||
HOOK: dummy-fp-params? cpu ( -- ? )
|
||||
|
||||
HOOK: %prepare-unbox cpu ( -- )
|
||||
HOOK: %prepare-unbox cpu ( n -- )
|
||||
|
||||
HOOK: %unbox cpu ( n rep func -- )
|
||||
|
||||
|
|
|
|||
|
|
@ -577,10 +577,8 @@ M:: ppc %save-param-reg ( stack reg rep -- )
|
|||
M:: ppc %load-param-reg ( stack reg rep -- )
|
||||
reg stack local@ rep load-from-frame ;
|
||||
|
||||
M: ppc %prepare-unbox ( -- )
|
||||
! First parameter is top of stack
|
||||
3 ds-reg 0 LWZ
|
||||
ds-reg dup cell SUBI ;
|
||||
M: ppc %prepare-unbox ( n -- )
|
||||
[ 3 ] dip <ds-loc> loc>operand LWZ ;
|
||||
|
||||
M: ppc %unbox ( n rep func -- )
|
||||
! Value must be in r3
|
||||
|
|
|
|||
|
|
@ -151,9 +151,7 @@ M: x86.32 %box-small-struct ( c-type -- )
|
|||
"box_small_struct" f %alien-invoke ;
|
||||
|
||||
M: x86.32 %prepare-unbox ( -- )
|
||||
#! Move top of data stack to EAX.
|
||||
EAX ESI [] MOV
|
||||
ESI 4 SUB ;
|
||||
EAX swap ds-reg reg-stack MOV ;
|
||||
|
||||
: call-unbox-func ( func -- )
|
||||
4 save-vm-ptr
|
||||
|
|
@ -238,8 +236,7 @@ M: x86.32 %alien-callback ( quot -- )
|
|||
"c_to_factor" f %alien-invoke ;
|
||||
|
||||
M: x86.32 %callback-value ( ctype -- )
|
||||
! Save top of data stack in non-volatile register
|
||||
%prepare-unbox
|
||||
0 %prepare-unbox
|
||||
4 stack@ EAX MOV
|
||||
0 save-vm-ptr
|
||||
! Restore data/call/retain stacks
|
||||
|
|
|
|||
|
|
@ -84,10 +84,8 @@ M: x86 %load-param-reg [ swap param@ ] dip %copy ;
|
|||
call
|
||||
] with-scope ; inline
|
||||
|
||||
M: x86.64 %prepare-unbox ( -- )
|
||||
! First parameter is top of stack
|
||||
param-reg-1 R14 [] MOV
|
||||
R14 cell SUB ;
|
||||
M: x86.64 %prepare-unbox ( n -- )
|
||||
param-reg-1 swap ds-reg reg-stack MOV ;
|
||||
|
||||
M:: x86.64 %unbox ( n rep func -- )
|
||||
param-reg-2 %mov-vm-ptr
|
||||
|
|
@ -217,9 +215,7 @@ M: x86.64 %alien-callback ( quot -- )
|
|||
"c_to_factor" f %alien-invoke ;
|
||||
|
||||
M: x86.64 %callback-value ( ctype -- )
|
||||
! Save top of data stack
|
||||
%prepare-unbox
|
||||
! Save top of data stack
|
||||
0 %prepare-unbox
|
||||
RSP 8 SUB
|
||||
param-reg-1 PUSH
|
||||
param-reg-1 %mov-vm-ptr
|
||||
|
|
|
|||
Loading…
Reference in New Issue