1 ! Copyright (C) 2007, 2008 Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: bootstrap.image.private kernel kernel.private namespaces
4 system cpu.x86.assembler layouts compiler.units math
5 math.private compiler.generator.fixup compiler.constants vocabs
6 slots.private words words.private ;
13 : stack-frame-size ( -- n ) 4 bootstrap-cells ;
19 ! Bump profiling counter
20 temp-reg profile-count-offset [+] 1 tag-fixnum ADD
22 temp-reg temp-reg word-code-offset [+] MOV
24 temp-reg compiled-header-size ADD
27 ] rc-absolute-cell rt-literal 1 rex-length + jit-profiling jit-define
30 temp-reg 0 MOV ! load XT
31 stack-frame-size PUSH ! save stack frame size
32 temp-reg PUSH ! push XT
34 ] rc-absolute-cell rt-label 1 rex-length + jit-prolog jit-define
37 arg0 0 MOV ! load literal
39 ds-reg bootstrap-cell ADD ! increment datastack pointer
40 ds-reg [] arg0 MOV ! store literal on datastack
41 ] rc-absolute-cell rt-literal 1 rex-length + jit-push-literal jit-define
44 arg0 0 MOV ! load literal
45 ds-reg bootstrap-cell ADD ! increment datastack pointer
46 ds-reg [] arg0 MOV ! store literal on datastack
47 ] rc-absolute-cell rt-immediate 1 rex-length + jit-push-immediate jit-define
51 arg1 stack-reg MOV ! pass callstack pointer as arg 2
53 ] rc-absolute-cell rt-primitive 1 rex-length + jit-primitive jit-define
57 ] rc-relative rt-xt 1 jit-word-jump jit-define
61 ] rc-relative rt-xt 1 jit-word-call jit-define
64 arg1 0 MOV ! load addr of true quotation
65 arg0 ds-reg [] MOV ! load boolean
66 ds-reg bootstrap-cell SUB ! pop boolean
67 arg0 \ f tag-number CMP ! compare it with f
68 arg0 arg1 [] CMOVNE ! load true branch if not equal
69 arg0 arg1 bootstrap-cell [+] CMOVE ! load false branch if equal
70 arg0 quot-xt-offset [+] JMP ! jump to quotation-xt
71 ] rc-absolute-cell rt-literal 1 rex-length + jit-if-jump jit-define
74 arg1 0 MOV ! load dispatch table
76 arg0 ds-reg [] MOV ! load index
77 fixnum>slot@ ! turn it into an array offset
78 ds-reg bootstrap-cell SUB ! pop index
79 arg0 arg1 ADD ! compute quotation location
80 arg0 arg0 array-start-offset [+] MOV ! load quotation
81 arg0 quot-xt-offset [+] JMP ! execute branch
82 ] rc-absolute-cell rt-literal 1 rex-length + jit-dispatch jit-define
85 stack-reg stack-frame-size bootstrap-cell - ADD ! unwind stack frame
86 ] f f f jit-epilog jit-define
88 [ 0 RET ] f f f jit-return jit-define
92 ! Quotations and words
94 arg0 ds-reg [] MOV ! load from stack
95 ds-reg bootstrap-cell SUB ! pop stack
96 arg0 quot-xt-offset [+] JMP ! call quotation
97 ] f f f \ (call) define-sub-primitive
100 arg0 ds-reg [] MOV ! load from stack
101 ds-reg bootstrap-cell SUB ! pop stack
102 arg0 word-xt-offset [+] JMP ! execute word
103 ] f f f \ (execute) define-sub-primitive
107 arg1 ds-reg [] MOV ! load from stack
108 arg1 tag-mask get AND ! compute tag
109 arg1 tag-bits get SHL ! tag the tag
110 ds-reg [] arg1 MOV ! push to stack
111 ] f f f \ tag define-sub-primitive
114 arg0 ds-reg [] MOV ! load slot number
115 ds-reg bootstrap-cell SUB ! adjust stack pointer
116 arg1 ds-reg [] MOV ! load object
117 fixnum>slot@ ! turn slot number into offset
118 arg1 tag-bits get SHR ! mask off tag
119 arg1 tag-bits get SHL
120 arg0 arg1 arg0 [+] MOV ! load slot value
121 ds-reg [] arg0 MOV ! push to stack
122 ] f f f \ slot define-sub-primitive
126 ds-reg bootstrap-cell SUB
127 ] f f f \ drop define-sub-primitive
130 ds-reg 2 bootstrap-cells SUB
131 ] f f f \ 2drop define-sub-primitive
134 ds-reg 3 bootstrap-cells SUB
135 ] f f f \ 3drop define-sub-primitive
139 ds-reg bootstrap-cell ADD
141 ] f f f \ dup define-sub-primitive
145 arg1 ds-reg bootstrap-cell neg [+] MOV
146 ds-reg 2 bootstrap-cells ADD
148 ds-reg bootstrap-cell neg [+] arg1 MOV
149 ] f f f \ 2dup define-sub-primitive
153 arg1 ds-reg -1 bootstrap-cells [+] MOV
154 temp-reg ds-reg -2 bootstrap-cells [+] MOV
155 ds-reg 3 bootstrap-cells ADD
157 ds-reg -1 bootstrap-cells [+] arg1 MOV
158 ds-reg -2 bootstrap-cells [+] temp-reg MOV
159 ] f f f \ 3dup define-sub-primitive
163 ds-reg bootstrap-cell SUB
165 ] f f f \ nip define-sub-primitive
169 ds-reg 2 bootstrap-cells SUB
171 ] f f f \ 2nip define-sub-primitive
174 arg0 ds-reg -1 bootstrap-cells [+] MOV
175 ds-reg bootstrap-cell ADD
177 ] f f f \ over define-sub-primitive
180 arg0 ds-reg -2 bootstrap-cells [+] MOV
181 ds-reg bootstrap-cell ADD
183 ] f f f \ pick define-sub-primitive
187 arg1 ds-reg -1 bootstrap-cells [+] MOV
189 ds-reg bootstrap-cell ADD
191 ] f f f \ dupd define-sub-primitive
195 arg1 ds-reg -1 bootstrap-cells [+] MOV
196 ds-reg bootstrap-cell ADD
198 ds-reg -1 bootstrap-cells [+] arg1 MOV
199 ds-reg -2 bootstrap-cells [+] arg0 MOV
200 ] f f f \ tuck define-sub-primitive
204 arg1 ds-reg bootstrap-cell neg [+] MOV
205 ds-reg bootstrap-cell neg [+] arg0 MOV
207 ] f f f \ swap define-sub-primitive
210 arg0 ds-reg -1 bootstrap-cells [+] MOV
211 arg1 ds-reg -2 bootstrap-cells [+] MOV
212 ds-reg -2 bootstrap-cells [+] arg0 MOV
213 ds-reg -1 bootstrap-cells [+] arg1 MOV
214 ] f f f \ swapd define-sub-primitive
218 arg1 ds-reg -1 bootstrap-cells [+] MOV
219 temp-reg ds-reg -2 bootstrap-cells [+] MOV
220 ds-reg -2 bootstrap-cells [+] arg1 MOV
221 ds-reg -1 bootstrap-cells [+] arg0 MOV
222 ds-reg [] temp-reg MOV
223 ] f f f \ rot define-sub-primitive
227 arg1 ds-reg -1 bootstrap-cells [+] MOV
228 temp-reg ds-reg -2 bootstrap-cells [+] MOV
229 ds-reg -2 bootstrap-cells [+] arg0 MOV
230 ds-reg -1 bootstrap-cells [+] temp-reg MOV
232 ] f f f \ -rot define-sub-primitive
235 rs-reg bootstrap-cell ADD
237 ds-reg bootstrap-cell SUB
239 ] f f f \ >r define-sub-primitive
242 ds-reg bootstrap-cell ADD
244 rs-reg bootstrap-cell SUB
246 ] f f f \ r> define-sub-primitive
249 : jit-compare ( insn -- )
252 temp-reg \ f tag-number MOV ! load f
253 arg0 ds-reg [] MOV ! load first value
254 ds-reg bootstrap-cell SUB ! adjust stack pointer
255 ds-reg [] arg0 CMP ! compare with second value
256 [ arg1 temp-reg ] dip execute ! move t if true
257 ds-reg [] arg1 MOV ! store
260 : define-jit-compare ( insn word -- )
261 [ [ jit-compare ] curry rc-absolute-cell rt-literal 1 rex-length + ] dip
262 define-sub-primitive ;
264 \ CMOVNE \ eq? define-jit-compare
265 \ CMOVL \ fixnum>= define-jit-compare
266 \ CMOVG \ fixnum<= define-jit-compare
267 \ CMOVLE \ fixnum> define-jit-compare
268 \ CMOVGE \ fixnum< define-jit-compare
271 : jit-math ( insn -- )
272 arg0 ds-reg [] MOV ! load second input
273 ds-reg bootstrap-cell SUB ! pop stack
274 arg1 ds-reg [] MOV ! load first input
275 [ arg1 arg0 ] dip execute ! compute result
276 ds-reg [] arg1 MOV ! push result
279 [ \ ADD jit-math ] f f f \ fixnum+fast define-sub-primitive
281 [ \ SUB jit-math ] f f f \ fixnum-fast define-sub-primitive
284 arg0 ds-reg [] MOV ! load second input
285 ds-reg bootstrap-cell SUB ! pop stack
286 arg1 ds-reg [] MOV ! load first input
287 arg0 tag-bits get SAR ! untag second input
288 arg0 arg1 IMUL2 ! multiply
289 ds-reg [] arg1 MOV ! push result
290 ] f f f \ fixnum*fast define-sub-primitive
292 [ \ AND jit-math ] f f f \ fixnum-bitand define-sub-primitive
294 [ \ OR jit-math ] f f f \ fixnum-bitor define-sub-primitive
296 [ \ XOR jit-math ] f f f \ fixnum-bitxor define-sub-primitive
299 arg0 ds-reg [] MOV ! load input input
300 arg0 NOT ! complement
301 arg0 tag-mask get XOR ! clear tag bits
302 ds-reg [] arg0 MOV ! save
303 ] f f f \ fixnum-bitnot define-sub-primitive
305 [ "bootstrap.x86" forget-vocab ] with-compilation-unit