Merge git://factorcode.org/git/factor
commit
ac208e23ff
|
@ -248,6 +248,7 @@ M: alien-invoke generate-node
|
||||||
end-basic-block
|
end-basic-block
|
||||||
%prepare-alien-invoke
|
%prepare-alien-invoke
|
||||||
dup objects>registers
|
dup objects>registers
|
||||||
|
%prepare-var-args
|
||||||
dup alien-invoke-dlsym %alien-invoke
|
dup alien-invoke-dlsym %alien-invoke
|
||||||
dup %cleanup
|
dup %cleanup
|
||||||
box-return*
|
box-return*
|
||||||
|
@ -287,6 +288,7 @@ M: alien-indirect generate-node
|
||||||
! Save alien at top of stack to temporary storage
|
! Save alien at top of stack to temporary storage
|
||||||
%prepare-alien-indirect
|
%prepare-alien-indirect
|
||||||
dup objects>registers
|
dup objects>registers
|
||||||
|
%prepare-var-args
|
||||||
! Call alien in temporary storage
|
! Call alien in temporary storage
|
||||||
%alien-indirect
|
%alien-indirect
|
||||||
dup %cleanup
|
dup %cleanup
|
||||||
|
|
|
@ -132,6 +132,10 @@ GENERIC: %load-param-reg ( stack reg reg-class -- )
|
||||||
|
|
||||||
HOOK: %prepare-alien-invoke compiler-backend ( -- )
|
HOOK: %prepare-alien-invoke compiler-backend ( -- )
|
||||||
|
|
||||||
|
HOOK: %prepare-var-args compiler-backend ( -- )
|
||||||
|
|
||||||
|
M: object %prepare-var-args ;
|
||||||
|
|
||||||
HOOK: %alien-invoke compiler-backend ( library function -- )
|
HOOK: %alien-invoke compiler-backend ( library function -- )
|
||||||
|
|
||||||
HOOK: %cleanup compiler-backend ( alien-node -- )
|
HOOK: %cleanup compiler-backend ( alien-node -- )
|
||||||
|
|
|
@ -40,9 +40,6 @@ M: amd64-backend address-operand ( address -- operand )
|
||||||
#! call, where all vregs have been flushed anyway.
|
#! call, where all vregs have been flushed anyway.
|
||||||
temp-reg v>operand [ swap MOV ] keep ;
|
temp-reg v>operand [ swap MOV ] keep ;
|
||||||
|
|
||||||
: compile-c-call ( symbol dll -- )
|
|
||||||
0 address-operand >r rc-absolute-cell rel-dlsym r> CALL ;
|
|
||||||
|
|
||||||
M: amd64-backend fixnum>slot@ drop ;
|
M: amd64-backend fixnum>slot@ drop ;
|
||||||
|
|
||||||
M: amd64-backend prepare-division CQO ;
|
M: amd64-backend prepare-division CQO ;
|
||||||
|
@ -65,7 +62,7 @@ M: amd64-backend %prepare-unbox ( -- )
|
||||||
|
|
||||||
M: amd64-backend %unbox ( n reg-class func -- )
|
M: amd64-backend %unbox ( n reg-class func -- )
|
||||||
! Call the unboxer
|
! Call the unboxer
|
||||||
f compile-c-call
|
f %alien-invoke
|
||||||
! Store the return value on the C stack
|
! Store the return value on the C stack
|
||||||
over [ [ return-reg ] keep %save-param-reg ] [ 2drop ] if ;
|
over [ [ return-reg ] keep %save-param-reg ] [ 2drop ] if ;
|
||||||
|
|
||||||
|
@ -74,13 +71,13 @@ M: amd64-backend %unbox-long-long ( n func -- )
|
||||||
|
|
||||||
M: amd64-backend %unbox-struct-1 ( -- )
|
M: amd64-backend %unbox-struct-1 ( -- )
|
||||||
#! Alien must be in RDI.
|
#! Alien must be in RDI.
|
||||||
"alien_offset" f compile-c-call
|
"alien_offset" f %alien-invoke
|
||||||
! Load first cell
|
! Load first cell
|
||||||
RAX RAX [] MOV ;
|
RAX RAX [] MOV ;
|
||||||
|
|
||||||
M: amd64-backend %unbox-struct-2 ( -- )
|
M: amd64-backend %unbox-struct-2 ( -- )
|
||||||
#! Alien must be in RDI.
|
#! Alien must be in RDI.
|
||||||
"alien_offset" f compile-c-call
|
"alien_offset" f %alien-invoke
|
||||||
! Load second cell
|
! Load second cell
|
||||||
RDX RAX cell [+] MOV
|
RDX RAX cell [+] MOV
|
||||||
! Load first cell
|
! Load first cell
|
||||||
|
@ -93,7 +90,7 @@ M: amd64-backend %unbox-large-struct ( n size -- )
|
||||||
! Load structure size
|
! Load structure size
|
||||||
RDX swap MOV
|
RDX swap MOV
|
||||||
! Copy the struct to the C stack
|
! Copy the struct to the C stack
|
||||||
"to_value_struct" f compile-c-call ;
|
"to_value_struct" f %alien-invoke ;
|
||||||
|
|
||||||
: load-return-value ( reg-class -- )
|
: load-return-value ( reg-class -- )
|
||||||
0 over param-reg swap return-reg
|
0 over param-reg swap return-reg
|
||||||
|
@ -105,7 +102,7 @@ M: amd64-backend %box ( n reg-class func -- )
|
||||||
] [
|
] [
|
||||||
swap load-return-value
|
swap load-return-value
|
||||||
] if*
|
] if*
|
||||||
f compile-c-call ;
|
f %alien-invoke ;
|
||||||
|
|
||||||
M: amd64-backend %box-long-long ( n func -- )
|
M: amd64-backend %box-long-long ( n func -- )
|
||||||
T{ int-regs } swap %box ;
|
T{ int-regs } swap %box ;
|
||||||
|
@ -117,7 +114,7 @@ M: amd64-backend %box-small-struct ( size -- )
|
||||||
RDI RAX MOV
|
RDI RAX MOV
|
||||||
RSI RDX MOV
|
RSI RDX MOV
|
||||||
RDX swap MOV
|
RDX swap MOV
|
||||||
"box_small_struct" f compile-c-call ;
|
"box_small_struct" f %alien-invoke ;
|
||||||
|
|
||||||
M: amd64-backend %box-large-struct ( n size -- )
|
M: amd64-backend %box-large-struct ( n size -- )
|
||||||
! Struct size is parameter 2
|
! Struct size is parameter 2
|
||||||
|
@ -125,28 +122,27 @@ M: amd64-backend %box-large-struct ( n size -- )
|
||||||
! Compute destination address
|
! Compute destination address
|
||||||
swap struct-return@ RDI RSP rot [+] LEA
|
swap struct-return@ RDI RSP rot [+] LEA
|
||||||
! Copy the struct from the C stack
|
! Copy the struct from the C stack
|
||||||
"box_value_struct" f compile-c-call ;
|
"box_value_struct" f %alien-invoke ;
|
||||||
|
|
||||||
M: amd64-backend %prepare-box-struct ( size -- )
|
M: amd64-backend %prepare-box-struct ( size -- )
|
||||||
! Compute target address for value struct return
|
! Compute target address for value struct return
|
||||||
RAX RSP rot f struct-return@ [+] LEA
|
RAX RSP rot f struct-return@ [+] LEA
|
||||||
RSP 0 [+] RAX MOV ;
|
RSP 0 [+] RAX MOV ;
|
||||||
|
|
||||||
: reset-sse RAX RAX XOR ;
|
M: amd64-backend %prepare-var-args RAX RAX XOR ;
|
||||||
|
|
||||||
M: amd64-backend %alien-invoke ( symbol dll -- )
|
M: amd64-backend %alien-invoke ( symbol dll -- )
|
||||||
reset-sse compile-c-call ;
|
0 address-operand >r rc-absolute-cell rel-dlsym r> CALL ;
|
||||||
|
|
||||||
M: amd64-backend %prepare-alien-indirect ( -- )
|
M: amd64-backend %prepare-alien-indirect ( -- )
|
||||||
"unbox_alien" f compile-c-call
|
"unbox_alien" f %alien-invoke
|
||||||
cell temp@ RAX MOV ;
|
cell temp@ RAX MOV ;
|
||||||
|
|
||||||
M: amd64-backend %alien-indirect ( -- )
|
M: amd64-backend %alien-indirect ( -- )
|
||||||
reset-sse
|
|
||||||
cell temp@ CALL ;
|
cell temp@ CALL ;
|
||||||
|
|
||||||
M: amd64-backend %alien-callback ( quot -- )
|
M: amd64-backend %alien-callback ( quot -- )
|
||||||
RDI load-indirect "c_to_factor" f compile-c-call ;
|
RDI load-indirect "c_to_factor" f %alien-invoke ;
|
||||||
|
|
||||||
M: amd64-backend %callback-value ( ctype -- )
|
M: amd64-backend %callback-value ( ctype -- )
|
||||||
! Save top of data stack
|
! Save top of data stack
|
||||||
|
@ -205,4 +201,4 @@ M: struct-type flatten-value-type ( type -- seq )
|
||||||
] each
|
] each
|
||||||
] if ;
|
] if ;
|
||||||
|
|
||||||
14 set-profiler-prologues
|
12 set-profiler-prologues
|
||||||
|
|
Loading…
Reference in New Issue