1 ! Copyright (C) 2008, 2009 Slava Pestov, Doug Coleman.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: words sequences kernel combinators cpu.architecture assocs
5 compiler.cfg.instructions
6 compiler.cfg.intrinsics.alien
7 compiler.cfg.intrinsics.allot
8 compiler.cfg.intrinsics.fixnum
9 compiler.cfg.intrinsics.float
10 compiler.cfg.intrinsics.simd
11 compiler.cfg.intrinsics.slots
12 compiler.cfg.intrinsics.misc
13 compiler.cfg.comparisons ;
15 QUALIFIED: alien.accessors
18 QUALIFIED: byte-arrays
19 QUALIFIED: kernel.private
20 QUALIFIED: slots.private
21 QUALIFIED: strings.private
22 QUALIFIED: classes.tuple.private
23 QUALIFIED: math.private
24 QUALIFIED: math.integers.private
25 QUALIFIED: math.floats.private
26 QUALIFIED: math.vectors.simd.intrinsics
28 IN: compiler.cfg.intrinsics
30 : enable-intrinsics ( alist -- )
31 [ "intrinsic" set-word-prop ] assoc-each ;
34 { kernel.private:tag [ drop emit-tag ] }
35 { kernel.private:getenv [ emit-getenv ] }
36 { math.private:both-fixnums? [ drop emit-both-fixnums? ] }
37 { math.private:fixnum+ [ drop emit-fixnum+ ] }
38 { math.private:fixnum- [ drop emit-fixnum- ] }
39 { math.private:fixnum* [ drop emit-fixnum* ] }
40 { math.private:fixnum+fast [ drop [ ^^add ] emit-fixnum-op ] }
41 { math.private:fixnum-fast [ drop [ ^^sub ] emit-fixnum-op ] }
42 { math.private:fixnum*fast [ drop emit-fixnum*fast ] }
43 { math.private:fixnum-bitand [ drop [ ^^and ] emit-fixnum-op ] }
44 { math.private:fixnum-bitor [ drop [ ^^or ] emit-fixnum-op ] }
45 { math.private:fixnum-bitxor [ drop [ ^^xor ] emit-fixnum-op ] }
46 { math.private:fixnum-shift-fast [ emit-fixnum-shift-fast ] }
47 { math.private:fixnum-bitnot [ drop emit-fixnum-bitnot ] }
48 { math.private:fixnum< [ drop cc< emit-fixnum-comparison ] }
49 { math.private:fixnum<= [ drop cc<= emit-fixnum-comparison ] }
50 { math.private:fixnum>= [ drop cc>= emit-fixnum-comparison ] }
51 { math.private:fixnum> [ drop cc> emit-fixnum-comparison ] }
52 { kernel:eq? [ drop cc= emit-fixnum-comparison ] }
53 { slots.private:slot [ emit-slot ] }
54 { slots.private:set-slot [ emit-set-slot ] }
55 { strings.private:string-nth [ drop emit-string-nth ] }
56 { strings.private:set-string-nth-fast [ drop emit-set-string-nth-fast ] }
57 { classes.tuple.private:<tuple-boa> [ emit-<tuple-boa> ] }
58 { arrays:<array> [ emit-<array> ] }
59 { byte-arrays:<byte-array> [ emit-<byte-array> ] }
60 { byte-arrays:(byte-array) [ emit-(byte-array) ] }
61 { kernel:<wrapper> [ emit-simple-allot ] }
62 { alien:<displaced-alien> [ emit-<displaced-alien> ] }
63 { alien.accessors:alien-unsigned-1 [ 1 emit-alien-unsigned-getter ] }
64 { alien.accessors:set-alien-unsigned-1 [ 1 emit-alien-integer-setter ] }
65 { alien.accessors:alien-signed-1 [ 1 emit-alien-signed-getter ] }
66 { alien.accessors:set-alien-signed-1 [ 1 emit-alien-integer-setter ] }
67 { alien.accessors:alien-unsigned-2 [ 2 emit-alien-unsigned-getter ] }
68 { alien.accessors:set-alien-unsigned-2 [ 2 emit-alien-integer-setter ] }
69 { alien.accessors:alien-signed-2 [ 2 emit-alien-signed-getter ] }
70 { alien.accessors:set-alien-signed-2 [ 2 emit-alien-integer-setter ] }
71 { alien.accessors:alien-cell [ emit-alien-cell-getter ] }
72 { alien.accessors:set-alien-cell [ emit-alien-cell-setter ] }
75 : enable-alien-4-intrinsics ( -- )
77 { alien.accessors:alien-unsigned-4 [ 4 emit-alien-unsigned-getter ] }
78 { alien.accessors:set-alien-unsigned-4 [ 4 emit-alien-integer-setter ] }
79 { alien.accessors:alien-signed-4 [ 4 emit-alien-signed-getter ] }
80 { alien.accessors:set-alien-signed-4 [ 4 emit-alien-integer-setter ] }
83 : enable-float-intrinsics ( -- )
85 { math.private:float+ [ drop [ ^^add-float ] emit-float-op ] }
86 { math.private:float- [ drop [ ^^sub-float ] emit-float-op ] }
87 { math.private:float* [ drop [ ^^mul-float ] emit-float-op ] }
88 { math.private:float/f [ drop [ ^^div-float ] emit-float-op ] }
89 { math.private:float< [ drop cc< emit-float-ordered-comparison ] }
90 { math.private:float<= [ drop cc<= emit-float-ordered-comparison ] }
91 { math.private:float>= [ drop cc>= emit-float-ordered-comparison ] }
92 { math.private:float> [ drop cc> emit-float-ordered-comparison ] }
93 { math.private:float-u< [ drop cc< emit-float-unordered-comparison ] }
94 { math.private:float-u<= [ drop cc<= emit-float-unordered-comparison ] }
95 { math.private:float-u>= [ drop cc>= emit-float-unordered-comparison ] }
96 { math.private:float-u> [ drop cc> emit-float-unordered-comparison ] }
97 { math.private:float= [ drop cc= emit-float-unordered-comparison ] }
98 { math.private:float>fixnum [ drop emit-float>fixnum ] }
99 { math.private:fixnum>float [ drop emit-fixnum>float ] }
100 { math.floats.private:float-unordered? [ drop cc/<>= emit-float-unordered-comparison ] }
101 { alien.accessors:alien-float [ float-rep emit-alien-float-getter ] }
102 { alien.accessors:set-alien-float [ float-rep emit-alien-float-setter ] }
103 { alien.accessors:alien-double [ double-rep emit-alien-float-getter ] }
104 { alien.accessors:set-alien-double [ double-rep emit-alien-float-setter ] }
105 } enable-intrinsics ;
107 : enable-fsqrt ( -- )
109 { math.libm:fsqrt [ drop emit-fsqrt ] }
110 } enable-intrinsics ;
112 : enable-float-min/max ( -- )
114 { math.floats.private:float-min [ drop [ ^^min-float ] emit-float-op ] }
115 { math.floats.private:float-max [ drop [ ^^max-float ] emit-float-op ] }
116 } enable-intrinsics ;
118 : enable-float-functions ( -- )
120 { math.libm:facos [ drop "acos" emit-unary-float-function ] }
121 { math.libm:fasin [ drop "asin" emit-unary-float-function ] }
122 { math.libm:fatan [ drop "atan" emit-unary-float-function ] }
123 { math.libm:fatan2 [ drop "atan2" emit-binary-float-function ] }
124 { math.libm:fcos [ drop "cos" emit-unary-float-function ] }
125 { math.libm:fsin [ drop "sin" emit-unary-float-function ] }
126 { math.libm:ftan [ drop "tan" emit-unary-float-function ] }
127 { math.libm:fcosh [ drop "cosh" emit-unary-float-function ] }
128 { math.libm:fsinh [ drop "sinh" emit-unary-float-function ] }
129 { math.libm:ftanh [ drop "tanh" emit-unary-float-function ] }
130 { math.libm:fexp [ drop "exp" emit-unary-float-function ] }
131 { math.libm:flog [ drop "log" emit-unary-float-function ] }
132 { math.libm:flog10 [ drop "log10" emit-unary-float-function ] }
133 { math.libm:fpow [ drop "pow" emit-binary-float-function ] }
134 { math.libm:facosh [ drop "acosh" emit-unary-float-function ] }
135 { math.libm:fasinh [ drop "asinh" emit-unary-float-function ] }
136 { math.libm:fatanh [ drop "atanh" emit-unary-float-function ] }
137 { math.libm:fsqrt [ drop "sqrt" emit-unary-float-function ] }
138 { math.floats.private:float-min [ drop "fmin" emit-binary-float-function ] }
139 { math.floats.private:float-max [ drop "fmax" emit-binary-float-function ] }
140 { math.private:float-mod [ drop "fmod" emit-binary-float-function ] }
141 } enable-intrinsics ;
143 : enable-min/max ( -- )
145 { math.integers.private:fixnum-min [ drop [ ^^min ] emit-fixnum-op ] }
146 { math.integers.private:fixnum-max [ drop [ ^^max ] emit-fixnum-op ] }
147 } enable-intrinsics ;
149 : enable-fixnum-log2 ( -- )
151 { math.integers.private:fixnum-log2 [ drop emit-fixnum-log2 ] }
152 } enable-intrinsics ;
154 : enable-sse2-simd ( -- )
156 { math.vectors.simd.intrinsics:assert-positive [ drop ] }
157 { math.vectors.simd.intrinsics:(simd-v+) [ [ ^^add-vector ] emit-binary-vector-op ] }
158 { math.vectors.simd.intrinsics:(simd-v-) [ [ ^^sub-vector ] emit-binary-vector-op ] }
159 { math.vectors.simd.intrinsics:(simd-v*) [ [ ^^mul-vector ] emit-binary-vector-op ] }
160 { math.vectors.simd.intrinsics:(simd-v/) [ [ ^^div-vector ] emit-binary-vector-op ] }
161 { math.vectors.simd.intrinsics:(simd-vmin) [ [ ^^min-vector ] emit-binary-vector-op ] }
162 { math.vectors.simd.intrinsics:(simd-vmax) [ [ ^^max-vector ] emit-binary-vector-op ] }
163 { math.vectors.simd.intrinsics:(simd-vsqrt) [ [ ^^sqrt-vector ] emit-binary-vector-op ] }
164 { math.vectors.simd.intrinsics:(simd-broadcast) [ [ ^^broadcast-vector ] emit-unary-vector-op ] }
165 { math.vectors.simd.intrinsics:(simd-gather-2) [ emit-gather-vector-2 ] }
166 { math.vectors.simd.intrinsics:(simd-gather-4) [ emit-gather-vector-4 ] }
167 { math.vectors.simd.intrinsics:alien-vector [ emit-alien-vector ] }
168 { math.vectors.simd.intrinsics:set-alien-vector [ emit-set-alien-vector ] }
169 } enable-intrinsics ;
171 : enable-sse3-simd ( -- )
173 { math.vectors.simd.intrinsics:(simd-sum) [ [ ^^horizontal-add-vector ] emit-unary-vector-op ] }
174 } enable-intrinsics ;
176 : emit-intrinsic ( node word -- )
177 "intrinsic" word-prop call( node -- ) ;