Update x86.32 backend for profiler changes
Slava Pestov
parent
fa126b0b72
commit
77cbc56873
|
|
@ -4,7 +4,7 @@ math.constants math.private sequences strings tools.test words
|
|||
continuations sequences.private hashtables.private byte-arrays
|
||||
strings.private system random layouts vectors.private
|
||||
sbufs.private strings.private slots.private alien alien.c-types
|
||||
alien.syntax namespaces libc ;
|
||||
alien.syntax namespaces libc combinators.private ;
|
||||
|
||||
! Make sure that intrinsic ops compile to correct code.
|
||||
[ ] [ 1 [ drop ] compile-1 ] unit-test
|
||||
|
|
@ -433,3 +433,13 @@ cell 8 = [
|
|||
[
|
||||
B{ 0 0 0 0 } [ { c-ptr } declare <void*> ] compile-1
|
||||
] unit-test-fails
|
||||
|
||||
[
|
||||
4 5
|
||||
] [
|
||||
3 [
|
||||
[
|
||||
{ [ 4444 ] [ 444 ] [ 44 ] [ 4 ] } dispatch
|
||||
] keep 2 fixnum+fast
|
||||
] compile-1
|
||||
] unit-test
|
||||
|
|
|
|||
|
|
@ -8,20 +8,23 @@ alien.compiler combinators command-line
|
|||
compiler io vocabs.loader ;
|
||||
IN: cpu.x86.32
|
||||
|
||||
PREDICATE: x86-backend x86-32-backend
|
||||
x86-backend-cell 4 = ;
|
||||
|
||||
! We implement the FFI for Linux, OS X and Windows all at once.
|
||||
! OS X requires that the stack be 16-byte aligned, and we do
|
||||
! this on all platforms, sacrificing some stack space for
|
||||
! code simplicity.
|
||||
|
||||
M: x86-backend ds-reg ESI ;
|
||||
M: x86-backend rs-reg EDI ;
|
||||
M: x86-backend stack-reg ESP ;
|
||||
M: x86-backend xt-reg ECX ;
|
||||
M: x86-backend stack-save-reg EDX ;
|
||||
M: x86-32-backend ds-reg ESI ;
|
||||
M: x86-32-backend rs-reg EDI ;
|
||||
M: x86-32-backend stack-reg ESP ;
|
||||
M: x86-32-backend xt-reg ECX ;
|
||||
M: x86-32-backend stack-save-reg EDX ;
|
||||
|
||||
M: temp-reg v>operand drop EBX ;
|
||||
|
||||
M: x86-backend %alien-invoke ( symbol dll -- )
|
||||
M: x86-32-backend %alien-invoke ( symbol dll -- )
|
||||
(CALL) rel-dlsym ;
|
||||
|
||||
! On x86, parameters are never passed in registers.
|
||||
|
|
@ -58,20 +61,20 @@ M: float-regs store-return-reg load/store-float-return FSTP ;
|
|||
|
||||
! On x86, we can always use an address as an operand
|
||||
! directly.
|
||||
M: x86-backend address-operand ;
|
||||
M: x86-32-backend address-operand ;
|
||||
|
||||
M: x86-backend fixnum>slot@ 1 SHR ;
|
||||
M: x86-32-backend fixnum>slot@ 1 SHR ;
|
||||
|
||||
M: x86-backend prepare-division CDQ ;
|
||||
M: x86-32-backend prepare-division CDQ ;
|
||||
|
||||
M: x86-backend load-indirect
|
||||
M: x86-32-backend load-indirect
|
||||
0 [] MOV rc-absolute-cell rel-literal ;
|
||||
|
||||
M: object %load-param-reg 3drop ;
|
||||
|
||||
M: object %save-param-reg 3drop ;
|
||||
|
||||
M: x86-backend %prepare-unbox ( -- )
|
||||
M: x86-32-backend %prepare-unbox ( -- )
|
||||
#! Move top of data stack to EAX.
|
||||
EAX ESI [] MOV
|
||||
ESI 4 SUB ;
|
||||
|
|
@ -84,7 +87,7 @@ M: x86-backend %prepare-unbox ( -- )
|
|||
f %alien-invoke
|
||||
] with-aligned-stack ;
|
||||
|
||||
M: x86-backend %unbox ( n reg-class func -- )
|
||||
M: x86-32-backend %unbox ( n reg-class func -- )
|
||||
#! The value being unboxed must already be in EAX.
|
||||
#! If n is f, we're unboxing a return value about to be
|
||||
#! returned by the callback. Otherwise, we're unboxing
|
||||
|
|
@ -93,7 +96,7 @@ M: x86-backend %unbox ( n reg-class func -- )
|
|||
! Store the return value on the C stack
|
||||
over [ store-return-reg ] [ 2drop ] if ;
|
||||
|
||||
M: x86-backend %unbox-long-long ( n func -- )
|
||||
M: x86-32-backend %unbox-long-long ( n func -- )
|
||||
(%unbox)
|
||||
! Store the return value on the C stack
|
||||
[
|
||||
|
|
@ -101,7 +104,7 @@ M: x86-backend %unbox-long-long ( n func -- )
|
|||
cell + stack@ EDX MOV
|
||||
] when* ;
|
||||
|
||||
M: x86-backend %unbox-struct-2
|
||||
M: x86-32-backend %unbox-struct-2
|
||||
#! Alien must be in EAX.
|
||||
4 [
|
||||
EAX PUSH
|
||||
|
|
@ -112,7 +115,7 @@ M: x86-backend %unbox-struct-2
|
|||
EAX EAX [] MOV
|
||||
] with-aligned-stack ;
|
||||
|
||||
M: x86-backend %unbox-large-struct ( n size -- )
|
||||
M: x86-32-backend %unbox-large-struct ( n size -- )
|
||||
#! Alien must be in EAX.
|
||||
! Compute destination address
|
||||
ECX ESP roll [+] LEA
|
||||
|
|
@ -144,7 +147,7 @@ M: x86-backend %unbox-large-struct ( n size -- )
|
|||
over [ [ box@ ] keep [ load-return-reg ] keep ] [ nip ] if
|
||||
push-return-reg ;
|
||||
|
||||
M: x86-backend %box ( n reg-class func -- )
|
||||
M: x86-32-backend %box ( n reg-class func -- )
|
||||
over reg-size [
|
||||
>r (%box) r> f %alien-invoke
|
||||
] with-aligned-stack ;
|
||||
|
|
@ -162,12 +165,12 @@ M: x86-backend %box ( n reg-class func -- )
|
|||
EDX PUSH
|
||||
EAX PUSH ;
|
||||
|
||||
M: x86-backend %box-long-long ( n func -- )
|
||||
M: x86-32-backend %box-long-long ( n func -- )
|
||||
8 [
|
||||
>r (%box-long-long) r> f %alien-invoke
|
||||
] with-aligned-stack ;
|
||||
|
||||
M: x86-backend %box-large-struct ( n size -- )
|
||||
M: x86-32-backend %box-large-struct ( n size -- )
|
||||
! Compute destination address
|
||||
[ swap struct-return@ ] keep
|
||||
ECX ESP roll [+] LEA
|
||||
|
|
@ -180,13 +183,13 @@ M: x86-backend %box-large-struct ( n size -- )
|
|||
"box_value_struct" f %alien-invoke
|
||||
] with-aligned-stack ;
|
||||
|
||||
M: x86-backend %prepare-box-struct ( size -- )
|
||||
M: x86-32-backend %prepare-box-struct ( size -- )
|
||||
! Compute target address for value struct return
|
||||
EAX ESP rot f struct-return@ [+] LEA
|
||||
! Store it as the first parameter
|
||||
ESP [] EAX MOV ;
|
||||
|
||||
M: x86-backend %unbox-struct-1
|
||||
M: x86-32-backend %unbox-struct-1
|
||||
#! Alien must be in EAX.
|
||||
4 [
|
||||
EAX PUSH
|
||||
|
|
@ -195,7 +198,7 @@ M: x86-backend %unbox-struct-1
|
|||
EAX EAX [] MOV
|
||||
] with-aligned-stack ;
|
||||
|
||||
M: x86-backend %box-small-struct ( size -- )
|
||||
M: x86-32-backend %box-small-struct ( size -- )
|
||||
#! Box a <= 8-byte struct returned in EAX:DX. OS X only.
|
||||
12 [
|
||||
PUSH
|
||||
|
|
@ -204,21 +207,21 @@ M: x86-backend %box-small-struct ( size -- )
|
|||
"box_small_struct" f %alien-invoke
|
||||
] with-aligned-stack ;
|
||||
|
||||
M: x86-backend %prepare-alien-indirect ( -- )
|
||||
M: x86-32-backend %prepare-alien-indirect ( -- )
|
||||
"unbox_alien" f %alien-invoke
|
||||
cell temp@ EAX MOV ;
|
||||
|
||||
M: x86-backend %alien-indirect ( -- )
|
||||
M: x86-32-backend %alien-indirect ( -- )
|
||||
cell temp@ CALL ;
|
||||
|
||||
M: x86-backend %alien-callback ( quot -- )
|
||||
M: x86-32-backend %alien-callback ( quot -- )
|
||||
4 [
|
||||
EAX load-indirect
|
||||
EAX PUSH
|
||||
"c_to_factor" f %alien-invoke
|
||||
] with-aligned-stack ;
|
||||
|
||||
M: x86-backend %callback-value ( ctype -- )
|
||||
M: x86-32-backend %callback-value ( ctype -- )
|
||||
! Align C stack
|
||||
ESP 12 SUB
|
||||
! Save top of data stack
|
||||
|
|
@ -233,7 +236,7 @@ M: x86-backend %callback-value ( ctype -- )
|
|||
! Unbox EAX
|
||||
unbox-return ;
|
||||
|
||||
M: x86-backend %cleanup ( alien-node -- )
|
||||
M: x86-32-backend %cleanup ( alien-node -- )
|
||||
#! a) If we just called an 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.
|
||||
|
|
@ -251,7 +254,7 @@ M: x86-backend %cleanup ( alien-node -- )
|
|||
}
|
||||
} cond ;
|
||||
|
||||
M: x86-backend %unwind ( n -- ) %epilogue-later RET ;
|
||||
M: x86-32-backend %unwind ( n -- ) %epilogue-later RET ;
|
||||
|
||||
windows? [
|
||||
cell "longlong" c-type set-c-type-align
|
||||
|
|
@ -272,6 +275,8 @@ T{ x86-backend f 4 } compiler-backend set-global
|
|||
JNE
|
||||
] { } define-if-intrinsic
|
||||
|
||||
10 set-profiler-prologues
|
||||
|
||||
"-no-sse2" cli-args member? [
|
||||
"Checking if your CPU supports SSE2..." print flush
|
||||
[ sse2? ] compile-1 [
|
||||
|
|
@ -281,5 +286,3 @@ T{ x86-backend f 4 } compiler-backend set-global
|
|||
" - no" print
|
||||
] if
|
||||
] unless
|
||||
|
||||
9 set-profiler-prologues
|
||||
|
|
|
|||
|
|
@ -101,14 +101,16 @@ M: x86-backend %jump-t ( label -- )
|
|||
! since on AMD64 we have to load a 64-bit immediate. On
|
||||
! x86, this is redundant.
|
||||
"scratch" operand HEX: ffffffff MOV rc-absolute-cell rel-dispatch
|
||||
"n" operand "scratch" operand ADD ;
|
||||
"n" operand "n" operand "scratch" operand [+] MOV
|
||||
"n" operand compiled-header-size ADD ;
|
||||
|
||||
: dispatch-template ( word-table# quot -- )
|
||||
[
|
||||
>r (%dispatch) "n" operand [] r> call
|
||||
>r (%dispatch) "n" operand r> call
|
||||
] H{
|
||||
{ +input+ { { f "n" } } }
|
||||
{ +scratch+ { { f "scratch" } } }
|
||||
{ +clobber+ { "n" } }
|
||||
} with-template ; inline
|
||||
|
||||
M: x86-backend %call-dispatch ( word-table# -- )
|
||||
|
|
|
|||
Loading…
Reference in New Issue