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
\r
6 vocabs slots.private locals.backend ;
\r
7 FROM: cpu.ppc.assembler => B ;
\r
16 : factor-area-size ( -- n ) 4 bootstrap-cells ;
\r
18 : stack-frame ( -- n )
\r
19 factor-area-size c-area-size + 4 bootstrap-cells align ;
\r
21 : next-save ( -- n ) stack-frame bootstrap-cell - ;
\r
22 : xt-save ( -- n ) stack-frame 2 bootstrap-cells - ;
\r
25 0 3 LOAD32 rc-absolute-ppc-2/2 rt-immediate jit-rel
\r
26 11 3 profile-count-offset LWZ
\r
27 11 11 1 tag-fixnum ADDI
\r
28 11 3 profile-count-offset STW
\r
29 11 3 word-code-offset LWZ
\r
30 11 11 compiled-header-size ADDI
\r
33 ] jit-profiling jit-define
\r
36 0 3 LOAD32 rc-absolute-ppc-2/2 rt-this jit-rel
\r
38 1 1 stack-frame SUBI
\r
42 0 1 lr-save stack-frame + STW
\r
43 ] jit-prolog jit-define
\r
46 0 3 LOAD32 rc-absolute-ppc-2/2 rt-immediate jit-rel
\r
48 ] jit-push-immediate jit-define
\r
51 0 3 LOAD32 rc-absolute-ppc-2/2 rt-stack-chain jit-rel
\r
54 0 3 LOAD32 rc-absolute-ppc-2/2 rt-primitive jit-rel
\r
57 ] jit-primitive jit-define
\r
59 [ 0 BL rc-relative-ppc-3 rt-xt-pic jit-rel ] jit-word-call jit-define
\r
62 0 6 LOAD32 rc-absolute-ppc-2/2 rt-here jit-rel
\r
63 0 B rc-relative-ppc-3 rt-xt-pic-tail jit-rel
\r
64 ] jit-word-jump jit-define
\r
66 [ 0 B rc-relative-ppc-3 rt-xt jit-rel ] jit-word-special jit-define
\r
71 0 3 \ f tag-number CMPI
\r
73 0 B rc-relative-ppc-3 rt-xt jit-rel
\r
74 0 B rc-relative-ppc-3 rt-xt jit-rel
\r
125 0 BL rc-relative-ppc-3 rt-xt jit-rel
\r
127 ] jit-dip jit-define
\r
131 0 BL rc-relative-ppc-3 rt-xt jit-rel
\r
133 ] jit-2dip jit-define
\r
137 0 BL rc-relative-ppc-3 rt-xt jit-rel
\r
139 ] jit-3dip jit-define
\r
141 : prepare-(execute) ( -- operand )
\r
144 4 3 word-xt-offset LWZ
\r
147 [ prepare-(execute) MTCTR BCTR ] jit-execute-jump jit-define
\r
149 [ prepare-(execute) MTLR BLRL ] jit-execute-call jit-define
\r
152 0 1 lr-save stack-frame + LWZ
\r
153 1 1 stack-frame ADDI
\r
155 ] jit-epilog jit-define
\r
157 [ BLR ] jit-return jit-define
\r
159 ! ! ! Polymorphic inline caches
\r
161 ! Don't touch r6 here; it's used to pass the tail call site
\r
162 ! address for tail PICs
\r
164 ! Load a value from a stack position
\r
166 4 ds-reg 0 LWZ rc-absolute-ppc-2 rt-untagged jit-rel
\r
167 ] pic-load jit-define
\r
171 4 4 tag-mask get ANDI
\r
172 4 4 tag-bits get SLWI ;
\r
174 [ load-tag ] pic-tag jit-define
\r
180 0 4 object tag-number tag-fixnum CMPI
\r
182 4 3 object tag-number neg LWZ
\r
183 ] pic-hi-tag jit-define
\r
189 0 4 tuple tag-number tag-fixnum CMPI
\r
191 4 3 tuple tag-number neg bootstrap-cell + LWZ
\r
192 ] pic-tuple jit-define
\r
198 ! If bits 2 and 3 are set, the tag is either 6 (object) or 7 (tuple)
\r
199 0 4 BIN: 110 tag-fixnum CMPI
\r
202 3 3 0 0 31 tag-bits get - RLWINM
\r
203 ! Set r4 to 0 for objects, and bootstrap-cell for tuples
\r
204 4 4 1 tag-fixnum ANDI
\r
206 ! Load header cell or tuple layout cell
\r
208 ] pic-hi-tag-tuple jit-define
\r
211 0 4 0 CMPI rc-absolute-ppc-2 rt-immediate jit-rel
\r
212 ] pic-check-tag jit-define
\r
215 0 5 LOAD32 rc-absolute-ppc-2/2 rt-immediate jit-rel
\r
217 ] pic-check jit-define
\r
219 [ 2 BNE 0 B rc-relative-ppc-3 rt-xt jit-rel ] pic-hit jit-define
\r
221 ! ! ! Megamorphic caches
\r
225 0 3 LOAD32 rc-absolute-ppc-2/2 rt-immediate jit-rel
\r
228 ! key &= cache.length - 1
\r
229 5 5 mega-cache-size get 1- bootstrap-cell * ANDI
\r
230 ! cache += array-start-offset
\r
231 3 3 array-start-offset ADDI
\r
234 ! if(get(cache) == class)
\r
238 ! megamorphic_cache_hits++
\r
239 0 4 LOAD32 rc-absolute-ppc-2/2 rt-megamorphic-cache-hits jit-rel
\r
243 ! ... goto get(cache + bootstrap-cell)
\r
245 3 3 word-xt-offset LWZ
\r
248 ! fall-through on miss
\r
249 ] mega-lookup jit-define
\r
251 ! ! ! Sub-primitives
\r
253 ! Quotations and words
\r
257 4 3 quot-xt-offset LWZ
\r
260 ] \ (call) define-sub-primitive
\r
265 3 3 tag-mask get ANDI
\r
266 3 3 tag-bits get SLWI
\r
268 ] \ tag define-sub-primitive
\r
274 4 4 0 0 31 tag-bits get - RLWINM
\r
277 ] \ slot define-sub-primitive
\r
282 ] \ drop define-sub-primitive
\r
286 ] \ 2drop define-sub-primitive
\r
290 ] \ 3drop define-sub-primitive
\r
295 ] \ dup define-sub-primitive
\r
303 ] \ 2dup define-sub-primitive
\r
313 ] \ 3dup define-sub-primitive
\r
319 ] \ nip define-sub-primitive
\r
325 ] \ 2nip define-sub-primitive
\r
330 ] \ over define-sub-primitive
\r
335 ] \ pick define-sub-primitive
\r
342 ] \ dupd define-sub-primitive
\r
350 ] \ tuck define-sub-primitive
\r
357 ] \ swap define-sub-primitive
\r
364 ] \ swapd define-sub-primitive
\r
373 ] \ rot define-sub-primitive
\r
382 ] \ -rot define-sub-primitive
\r
384 [ jit->r ] \ load-local define-sub-primitive
\r
387 : jit-compare ( insn -- )
\r
388 0 3 LOAD32 rc-absolute-ppc-2/2 rt-immediate jit-rel
\r
392 2 swap execute( offset -- ) ! magic number
\r
393 \ f tag-number 3 LI
\r
396 : define-jit-compare ( insn word -- )
\r
397 [ [ jit-compare ] curry ] dip define-sub-primitive ;
\r
399 \ BEQ \ eq? define-jit-compare
\r
400 \ BGE \ fixnum>= define-jit-compare
\r
401 \ BLE \ fixnum<= define-jit-compare
\r
402 \ BGT \ fixnum> define-jit-compare
\r
403 \ BLT \ fixnum< define-jit-compare
\r
408 ds-reg ds-reg 4 SUBI
\r
411 3 3 tag-mask get ANDI
\r
412 \ f tag-number 4 LI
\r
417 ] \ both-fixnums? define-sub-primitive
\r
419 : jit-math ( insn -- )
\r
422 [ 5 3 4 ] dip execute( dst src1 src2 -- )
\r
425 [ \ ADD jit-math ] \ fixnum+fast define-sub-primitive
\r
427 [ \ SUBF jit-math ] \ fixnum-fast define-sub-primitive
\r
432 4 4 tag-bits get SRAWI
\r
435 ] \ fixnum*fast define-sub-primitive
\r
437 [ \ AND jit-math ] \ fixnum-bitand define-sub-primitive
\r
439 [ \ OR jit-math ] \ fixnum-bitor define-sub-primitive
\r
441 [ \ XOR jit-math ] \ fixnum-bitxor define-sub-primitive
\r
446 3 3 tag-mask get XORI
\r
448 ] \ fixnum-bitnot define-sub-primitive
\r
452 3 3 tag-bits get SRAWI
\r
453 ds-reg ds-reg 4 SUBI
\r
458 7 7 0 0 31 tag-bits get - RLWINM
\r
463 ] \ fixnum-shift-fast define-sub-primitive
\r
467 ds-reg ds-reg 4 SUBI
\r
473 ] \ fixnum-mod define-sub-primitive
\r
477 ds-reg ds-reg 4 SUBI
\r
480 5 5 tag-bits get SLWI
\r
482 ] \ fixnum/i-fast define-sub-primitive
\r
490 5 5 tag-bits get SLWI
\r
493 ] \ fixnum/mod-fast define-sub-primitive
\r
500 ] \ get-local define-sub-primitive
\r
504 ds-reg ds-reg 4 SUBI
\r
506 rs-reg 3 rs-reg SUBF
\r
507 ] \ drop-locals define-sub-primitive
\r
509 [ "bootstrap.ppc" forget-vocab ] with-compilation-unit
\r