steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Update x86.32 backend for profiler changes

release
Slava Pestov 2007-10-29 01:17:44 -05:00
parent fa126b0b72
commit 77cbc56873
3 changed files with 47 additions and 32 deletions
core
compiler/test
cpu/x86

12
core/compiler/test/intrinsics.factor
View File

@ -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

61
core/cpu/x86/32/32.factor
View File

@ -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

6
core/cpu/x86/architecture/architecture.factor
View File

@ -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# -- )