1 ! Copyright (C) 2008 Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: words sequences kernel combinators cpu.architecture
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.slots
11 compiler.cfg.intrinsics.misc
12 compiler.cfg.iterator ;
15 QUALIFIED: byte-arrays
16 QUALIFIED: kernel.private
17 QUALIFIED: slots.private
18 QUALIFIED: strings.private
19 QUALIFIED: classes.tuple.private
20 QUALIFIED: math.private
21 QUALIFIED: math.integers.private
22 QUALIFIED: alien.accessors
23 IN: compiler.cfg.intrinsics
28 math.private:both-fixnums?
32 math.private:fixnum+fast
33 math.private:fixnum-fast
34 math.private:fixnum-bitand
35 math.private:fixnum-bitor
36 math.private:fixnum-bitxor
37 math.private:fixnum-shift-fast
38 math.private:fixnum-bitnot
39 math.private:fixnum*fast
44 math.private:bignum>fixnum
45 math.private:fixnum>bignum
48 slots.private:set-slot
49 strings.private:string-nth
50 strings.private:set-string-nth-fast
51 classes.tuple.private:<tuple-boa>
53 byte-arrays:<byte-array>
54 byte-arrays:(byte-array)
55 math.private:<complex>
58 alien.accessors:alien-unsigned-1
59 alien.accessors:set-alien-unsigned-1
60 alien.accessors:alien-signed-1
61 alien.accessors:set-alien-signed-1
62 alien.accessors:alien-unsigned-2
63 alien.accessors:set-alien-unsigned-2
64 alien.accessors:alien-signed-2
65 alien.accessors:set-alien-signed-2
66 alien.accessors:alien-cell
67 alien.accessors:set-alien-cell
68 } [ t "intrinsic" set-word-prop ] each
70 : enable-alien-4-intrinsics ( -- )
72 alien.accessors:alien-unsigned-4
73 alien.accessors:set-alien-unsigned-4
74 alien.accessors:alien-signed-4
75 alien.accessors:set-alien-signed-4
76 } [ t "intrinsic" set-word-prop ] each ;
78 : enable-float-intrinsics ( -- )
84 math.private:fixnum>float
85 math.private:float>fixnum
91 alien.accessors:alien-float
92 alien.accessors:set-alien-float
93 alien.accessors:alien-double
94 alien.accessors:set-alien-double
95 } [ t "intrinsic" set-word-prop ] each ;
97 : enable-fixnum-log2 ( -- )
98 \ math.integers.private:fixnum-log2 t "intrinsic" set-word-prop ;
100 : emit-intrinsic ( node word -- node/f )
102 { \ kernel.private:tag [ drop emit-tag iterate-next ] }
103 { \ kernel.private:getenv [ emit-getenv iterate-next ] }
104 { \ math.private:both-fixnums? [ drop emit-both-fixnums? iterate-next ] }
105 { \ math.private:fixnum+ [ drop [ ##fixnum-add ] [ ##fixnum-add-tail ] emit-fixnum-overflow-op ] }
106 { \ math.private:fixnum- [ drop [ ##fixnum-sub ] [ ##fixnum-sub-tail ] emit-fixnum-overflow-op ] }
107 { \ math.private:fixnum* [ drop [ i i ##fixnum-mul ] [ i i ##fixnum-mul-tail ] emit-fixnum-overflow-op ] }
108 { \ math.private:fixnum+fast [ [ ^^add ] [ ^^add-imm ] emit-fixnum-op iterate-next ] }
109 { \ math.private:fixnum-fast [ [ ^^sub ] [ ^^sub-imm ] emit-fixnum-op iterate-next ] }
110 { \ math.private:fixnum-bitand [ [ ^^and ] [ ^^and-imm ] emit-fixnum-op iterate-next ] }
111 { \ math.private:fixnum-bitor [ [ ^^or ] [ ^^or-imm ] emit-fixnum-op iterate-next ] }
112 { \ math.private:fixnum-bitxor [ [ ^^xor ] [ ^^xor-imm ] emit-fixnum-op iterate-next ] }
113 { \ math.private:fixnum-shift-fast [ emit-fixnum-shift-fast iterate-next ] }
114 { \ math.private:fixnum-bitnot [ drop emit-fixnum-bitnot iterate-next ] }
115 { \ math.integers.private:fixnum-log2 [ drop emit-fixnum-log2 iterate-next ] }
116 { \ math.private:fixnum*fast [ emit-fixnum*fast iterate-next ] }
117 { \ math.private:fixnum< [ cc< emit-fixnum-comparison iterate-next ] }
118 { \ math.private:fixnum<= [ cc<= emit-fixnum-comparison iterate-next ] }
119 { \ math.private:fixnum>= [ cc>= emit-fixnum-comparison iterate-next ] }
120 { \ math.private:fixnum> [ cc> emit-fixnum-comparison iterate-next ] }
121 { \ kernel:eq? [ cc= emit-fixnum-comparison iterate-next ] }
122 { \ math.private:bignum>fixnum [ drop emit-bignum>fixnum iterate-next ] }
123 { \ math.private:fixnum>bignum [ drop emit-fixnum>bignum iterate-next ] }
124 { \ math.private:float+ [ drop [ ^^add-float ] emit-float-op iterate-next ] }
125 { \ math.private:float- [ drop [ ^^sub-float ] emit-float-op iterate-next ] }
126 { \ math.private:float* [ drop [ ^^mul-float ] emit-float-op iterate-next ] }
127 { \ math.private:float/f [ drop [ ^^div-float ] emit-float-op iterate-next ] }
128 { \ math.private:float< [ drop cc< emit-float-comparison iterate-next ] }
129 { \ math.private:float<= [ drop cc<= emit-float-comparison iterate-next ] }
130 { \ math.private:float>= [ drop cc>= emit-float-comparison iterate-next ] }
131 { \ math.private:float> [ drop cc> emit-float-comparison iterate-next ] }
132 { \ math.private:float= [ drop cc= emit-float-comparison iterate-next ] }
133 { \ math.private:float>fixnum [ drop emit-float>fixnum iterate-next ] }
134 { \ math.private:fixnum>float [ drop emit-fixnum>float iterate-next ] }
135 { \ slots.private:slot [ emit-slot iterate-next ] }
136 { \ slots.private:set-slot [ emit-set-slot iterate-next ] }
137 { \ strings.private:string-nth [ drop emit-string-nth iterate-next ] }
138 { \ strings.private:set-string-nth-fast [ drop emit-set-string-nth-fast iterate-next ] }
139 { \ classes.tuple.private:<tuple-boa> [ emit-<tuple-boa> iterate-next ] }
140 { \ arrays:<array> [ emit-<array> iterate-next ] }
141 { \ byte-arrays:<byte-array> [ emit-<byte-array> iterate-next ] }
142 { \ byte-arrays:(byte-array) [ emit-(byte-array) iterate-next ] }
143 { \ math.private:<complex> [ emit-simple-allot iterate-next ] }
144 { \ math.private:<ratio> [ emit-simple-allot iterate-next ] }
145 { \ kernel:<wrapper> [ emit-simple-allot iterate-next ] }
146 { \ alien.accessors:alien-unsigned-1 [ 1 emit-alien-unsigned-getter iterate-next ] }
147 { \ alien.accessors:set-alien-unsigned-1 [ 1 emit-alien-integer-setter iterate-next ] }
148 { \ alien.accessors:alien-signed-1 [ 1 emit-alien-signed-getter iterate-next ] }
149 { \ alien.accessors:set-alien-signed-1 [ 1 emit-alien-integer-setter iterate-next ] }
150 { \ alien.accessors:alien-unsigned-2 [ 2 emit-alien-unsigned-getter iterate-next ] }
151 { \ alien.accessors:set-alien-unsigned-2 [ 2 emit-alien-integer-setter iterate-next ] }
152 { \ alien.accessors:alien-signed-2 [ 2 emit-alien-signed-getter iterate-next ] }
153 { \ alien.accessors:set-alien-signed-2 [ 2 emit-alien-integer-setter iterate-next ] }
154 { \ alien.accessors:alien-unsigned-4 [ 4 emit-alien-unsigned-getter iterate-next ] }
155 { \ alien.accessors:set-alien-unsigned-4 [ 4 emit-alien-integer-setter iterate-next ] }
156 { \ alien.accessors:alien-signed-4 [ 4 emit-alien-signed-getter iterate-next ] }
157 { \ alien.accessors:set-alien-signed-4 [ 4 emit-alien-integer-setter iterate-next ] }
158 { \ alien.accessors:alien-cell [ emit-alien-cell-getter iterate-next ] }
159 { \ alien.accessors:set-alien-cell [ emit-alien-cell-setter iterate-next ] }
160 { \ alien.accessors:alien-float [ single-float-regs emit-alien-float-getter iterate-next ] }
161 { \ alien.accessors:set-alien-float [ single-float-regs emit-alien-float-setter iterate-next ] }
162 { \ alien.accessors:alien-double [ double-float-regs emit-alien-float-getter iterate-next ] }
163 { \ alien.accessors:set-alien-double [ double-float-regs emit-alien-float-setter iterate-next ] }