! Copyright (C) 2007, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays assocs assocs.private classes
-classes.tuple.private compiler.units hashtables
+classes.tuple.private compiler.units cpu.architecture hashtables
hashtables.private io kernel libc math math.parser memory
namespaces namespaces.private quotations quotations.private
sbufs sequences sequences.private splitting system vectors
"cpu." cpu name>> append require
+enable-cpu-features
+
enable-optimizer
! Push all tuple layouts to tenured space to improve method caching
{ $description "Emits machine code for stack \"allocating\" a chunk of memory. No memory is really allocated and instead a pointer to it is just put in the destination register." }
{ $see-also ##local-allot } ;
-HELP: reg-class-of
-{ $values { "rep" representation } { "reg-class" reg-class } }
-{ $description "Register class for values of the given representation." } ;
-
HELP: %replace-imm
{ $values
{ "src" integer }
{ $values { "?" boolean } }
{ $description "Whether this architecture support " { $link %load-float } ", " { $link %load-double } ", and " { $link %load-vector } "." } ;
+HELP: enable-cpu-features
+{ $description "This word is run when compiling the compiler during bootstrap and enables optional features that the processor is found to support." } ;
+
HELP: gc-root-offset
{ $values { "spill-slot" spill-slot } { "n" integer } }
{ $description "Offset in the " { $link stack-frame } " for the word being constructed where the spill slot is located. The value is given in " { $link cell } " units." }
{ $values { "rep" representation } { "n" integer } }
{ $description "Size in bytes of a representation." } ;
+HELP: reg-class-of
+{ $values { "rep" representation } { "reg-class" reg-class } }
+{ $description "Register class for values of the given representation." } ;
+
HELP: return-regs
{ $values { "regs" assoc } }
{ $description "What registers that will be used for function return values of which class." } ;
HOOK: %callback-outputs cpu ( reg-inputs -- )
HOOK: stack-cleanup cpu ( stack-size return abi -- n )
+
+HOOK: enable-cpu-features cpu ( -- )
CONSTANT: rs-reg 15
CONSTANT: vm-reg 16
-enable-float-intrinsics
-
M: ppc machine-registers ( -- assoc )
{
{ int-regs $[ 3 12 [a,b] 17 29 [a,b] append ] }
M: ppc immediate-bitwise? ( n -- ? ) 0 65535 between? ;
M: ppc immediate-store? ( n -- ? ) immediate-comparand? ;
+M: ppc enable-cpu-features ( -- )
+ enable-float-intrinsics ;
+
USE: vocabs
{
{ [ os linux? ] [
EDI 12 [+] EDX MOV
EDI POP
] alien-assembly ;
-
-check-cpu-features
RSI 12 [+] EDX MOV
] alien-assembly ;
-! The result of reading 4 bytes from memory is a fixnum on
-! x86-64.
-enable-alien-4-intrinsics
-
{
{ [ os unix? ] [ "cpu.x86.64.unix" require ] }
{ [ os windows? ] [ "cpu.x86.64.windows" require ] }
} cond
-
-check-cpu-features
M: x86 %vector>scalar %copy ;
M: x86 %scalar>vector %copy ;
-
-enable-float-intrinsics
-enable-float-min/max
-enable-fsqrt
{ cc/<>= [ src1 src2 compare call( a b -- ) label JP ] }
} case ;
-enable-min/max
-enable-log2
-
M:: x86 %bit-test ( dst src1 src2 temp -- )
src1 src2 BT
dst temp \ CMOVB (%boolean) ;
-enable-bit-test
+M: x86 enable-cpu-features ( -- )
+ enable-min/max
+ enable-log2
+ enable-bit-test
+
+ ! The result of reading 4 bytes from memory is a fixnum on
+ ! x86-64.
+ cpu x86.64? [ enable-alien-4-intrinsics ] when
+
+ ! These words uses alien-assembly
+ optimizing-compiler compiler-impl [
+ { (sse-version) popcnt? } compile
+ ] with-variable
-: check-sse ( -- )
+ ! SSE floats
"Checking for multimedia extensions... " write flush
sse-version
[ sse-string " detected" append print ]
- [ 20 < "cpu.x86.x87" "cpu.x86.sse" ? require ] bi ;
+ [
+ 20 < [ "cpu.x86.x87" require ] [
+ "cpu.x86.sse" require
+ enable-float-min/max
+ ] if
+ ] bi
-: check-popcnt ( -- )
+ ! POPCNT
enable-popcnt? [
"Building with POPCNT support" print
enable-bit-count
- ] when ;
+ ] when
-: check-cpu-features ( -- )
- [ { (sse-version) popcnt? } compile ] with-optimizer
- check-sse
- check-popcnt ;
+ enable-float-intrinsics
+ enable-fsqrt ;
M: x86 %compare-float-unordered-branch ( label src1 src2 cc -- )
[ [ FUCOMI ] compare-op ] (%compare-float-branch) ;
-
-enable-float-intrinsics
-enable-fsqrt