1 ! Copyright (C) 2007, 2008 Slava Pestov.
\r
2 ! See http://factorcode.org/license.txt for BSD license.
\r
3 USING: bootstrap.image.private kernel kernel.private namespaces
\r
4 system cpu.ppc.assembler compiler.codegen.fixup compiler.units
\r
5 compiler.constants math math.private layouts words words.private
\r
6 vocabs slots.private locals.backend ;
\r
12 4 jit-code-format set
\r
17 : factor-area-size ( -- n ) 4 bootstrap-cells ;
\r
19 : stack-frame ( -- n )
\r
20 factor-area-size c-area-size + 4 bootstrap-cells align ;
\r
22 : next-save ( -- n ) stack-frame bootstrap-cell - ;
\r
23 : xt-save ( -- n ) stack-frame 2 bootstrap-cells - ;
\r
27 11 6 profile-count-offset LWZ
\r
28 11 11 1 tag-fixnum ADDI
\r
29 11 6 profile-count-offset STW
\r
30 11 6 word-code-offset LWZ
\r
31 11 11 compiled-header-size ADDI
\r
34 ] rc-absolute-ppc-2/2 rt-immediate 1 jit-profiling jit-define
\r
39 1 1 stack-frame SUBI
\r
43 0 1 lr-save stack-frame + STW
\r
44 ] rc-absolute-ppc-2/2 rt-label 1 jit-prolog jit-define
\r
49 ] rc-absolute-ppc-2/2 rt-immediate 1 jit-push-immediate jit-define
\r
55 ] rc-absolute-ppc-2/2 rt-stack-chain 1 jit-save-stack jit-define
\r
61 ] rc-absolute-ppc-2/2 rt-primitive 1 jit-primitive jit-define
\r
63 [ 0 BL ] rc-relative-ppc-3 rt-xt 0 jit-word-call jit-define
\r
65 [ 0 B ] rc-relative-ppc-3 rt-xt 0 jit-word-jump jit-define
\r
70 0 3 \ f tag-number CMPI
\r
73 ] rc-relative-ppc-3 rt-xt 4 jit-if-1 jit-define
\r
77 ] rc-relative-ppc-3 rt-xt 0 jit-if-2 jit-define
\r
79 : jit-jump-quot ( -- )
\r
80 4 3 quot-xt-offset LWZ
\r
89 3 3 array-start-offset LWZ
\r
92 ] rc-absolute-ppc-2/2 rt-immediate 1 jit-dispatch jit-define
\r
144 ] rc-relative-ppc-3 rt-xt 3 jit-dip jit-define
\r
150 ] rc-relative-ppc-3 rt-xt 6 jit-2dip jit-define
\r
156 ] rc-relative-ppc-3 rt-xt 8 jit-3dip jit-define
\r
159 0 1 lr-save stack-frame + LWZ
\r
160 1 1 stack-frame ADDI
\r
162 ] f f f jit-epilog jit-define
\r
164 [ BLR ] f f f jit-return jit-define
\r
168 ! Quotations and words
\r
173 ] f f f \ (call) define-sub-primitive
\r
178 4 3 word-xt-offset LWZ
\r
181 ] f f f \ (execute) define-sub-primitive
\r
186 3 3 tag-mask get ANDI
\r
187 3 3 tag-bits get SLWI
\r
189 ] f f f \ tag define-sub-primitive
\r
195 4 4 0 0 31 tag-bits get - RLWINM
\r
198 ] f f f \ slot define-sub-primitive
\r
203 ] f f f \ drop define-sub-primitive
\r
207 ] f f f \ 2drop define-sub-primitive
\r
211 ] f f f \ 3drop define-sub-primitive
\r
216 ] f f f \ dup define-sub-primitive
\r
224 ] f f f \ 2dup define-sub-primitive
\r
234 ] f f f \ 3dup define-sub-primitive
\r
240 ] f f f \ nip define-sub-primitive
\r
246 ] f f f \ 2nip define-sub-primitive
\r
251 ] f f f \ over define-sub-primitive
\r
256 ] f f f \ pick define-sub-primitive
\r
263 ] f f f \ dupd define-sub-primitive
\r
271 ] f f f \ tuck define-sub-primitive
\r
278 ] f f f \ swap define-sub-primitive
\r
285 ] f f f \ swapd define-sub-primitive
\r
294 ] f f f \ rot define-sub-primitive
\r
303 ] f f f \ -rot define-sub-primitive
\r
305 [ jit->r ] f f f \ load-local define-sub-primitive
\r
308 : jit-compare ( insn -- )
\r
313 2 swap execute ! magic number
\r
314 \ f tag-number 3 LI
\r
317 : define-jit-compare ( insn word -- )
\r
318 [ [ jit-compare ] curry rc-absolute-ppc-2/2 rt-immediate 1 ] dip
\r
319 define-sub-primitive ;
\r
321 \ BEQ \ eq? define-jit-compare
\r
322 \ BGE \ fixnum>= define-jit-compare
\r
323 \ BLE \ fixnum<= define-jit-compare
\r
324 \ BGT \ fixnum> define-jit-compare
\r
325 \ BLT \ fixnum< define-jit-compare
\r
330 ds-reg ds-reg 4 SUBI
\r
333 3 3 tag-mask get ANDI
\r
334 \ f tag-number 4 LI
\r
339 ] f f f \ both-fixnums? define-sub-primitive
\r
341 : jit-math ( insn -- )
\r
344 [ 5 3 4 ] dip execute
\r
347 [ \ ADD jit-math ] f f f \ fixnum+fast define-sub-primitive
\r
349 [ \ SUBF jit-math ] f f f \ fixnum-fast define-sub-primitive
\r
354 4 4 tag-bits get SRAWI
\r
357 ] f f f \ fixnum*fast define-sub-primitive
\r
359 [ \ AND jit-math ] f f f \ fixnum-bitand define-sub-primitive
\r
361 [ \ OR jit-math ] f f f \ fixnum-bitor define-sub-primitive
\r
363 [ \ XOR jit-math ] f f f \ fixnum-bitxor define-sub-primitive
\r
368 3 3 tag-mask get XORI
\r
370 ] f f f \ fixnum-bitnot define-sub-primitive
\r
374 3 3 tag-bits get SRAWI
\r
375 ds-reg ds-reg 4 SUBI
\r
380 7 7 0 0 31 tag-bits get - RLWINM
\r
385 ] f f f \ fixnum-shift-fast define-sub-primitive
\r
389 ds-reg ds-reg 4 SUBI
\r
395 ] f f f \ fixnum-mod define-sub-primitive
\r
399 ds-reg ds-reg 4 SUBI
\r
402 5 5 tag-bits get SLWI
\r
404 ] f f f \ fixnum/i-fast define-sub-primitive
\r
412 5 5 tag-bits get SLWI
\r
415 ] f f f \ fixnum/mod-fast define-sub-primitive
\r
422 ] f f f \ get-local define-sub-primitive
\r
426 ds-reg ds-reg 4 SUBI
\r
428 rs-reg 3 rs-reg SUBF
\r
429 ] f f f \ drop-locals define-sub-primitive
\r
431 [ "bootstrap.ppc" forget-vocab ] with-compilation-unit
\r