From 77cbc5687392fe48e023eda429d3fe1958dd2a7b Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 29 Oct 2007 01:17:44 -0500 Subject: [PATCH] Update x86.32 backend for profiler changes --- core/compiler/test/intrinsics.factor | 12 +++- core/cpu/x86/32/32.factor | 61 ++++++++++--------- core/cpu/x86/architecture/architecture.factor | 6 +- 3 files changed, 47 insertions(+), 32 deletions(-) diff --git a/core/compiler/test/intrinsics.factor b/core/compiler/test/intrinsics.factor index 2d738b96dd..a907c4c152 100755 --- a/core/compiler/test/intrinsics.factor +++ b/core/compiler/test/intrinsics.factor @@ -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 ] compile-1 ] unit-test-fails + +[ + 4 5 +] [ + 3 [ + [ + { [ 4444 ] [ 444 ] [ 44 ] [ 4 ] } dispatch + ] keep 2 fixnum+fast + ] compile-1 +] unit-test diff --git a/core/cpu/x86/32/32.factor b/core/cpu/x86/32/32.factor index df41571e55..62ea28609b 100755 --- a/core/cpu/x86/32/32.factor +++ b/core/cpu/x86/32/32.factor @@ -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 diff --git a/core/cpu/x86/architecture/architecture.factor b/core/cpu/x86/architecture/architecture.factor index 0ff85d637b..b85081fb6c 100755 --- a/core/cpu/x86/architecture/architecture.factor +++ b/core/cpu/x86/architecture/architecture.factor @@ -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# -- )