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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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