Fix PowerPC JIT

db4
Slava Pestov 2008-01-09 00:18:03 -04:00
parent ac5f758bce
commit 85c9f78790
1 changed files with 38 additions and 21 deletions

View File

@ -1,7 +1,8 @@
! Copyright (C) 2007, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: bootstrap.image.private kernel namespaces system
cpu.ppc.assembler math layouts words vocabs ;
cpu.ppc.assembler generator.fixup compiler.constants math
layouts words vocabs ;
IN: bootstrap.ppc
4 \ cell set
@ -10,8 +11,9 @@ big-endian on
4 jit-code-format set
: ds-reg 14 ;
: quot-reg 3 ;
: temp-reg 6 ;
: aux-reg 7 ;
: aux-reg 11 ;
: factor-area-size 4 bootstrap-cells ;
@ -21,7 +23,22 @@ big-endian on
: next-save stack-frame bootstrap-cell - ;
: xt-save stack-frame 2 bootstrap-cells - ;
! jit-profiling
[
! Load word
0 temp-reg LOAD32
temp-reg dup 0 LWZ
! Bump profiling counter
aux-reg temp-reg profile-count-offset LWZ
aux-reg dup 1 tag-fixnum ADD
aux-reg temp-reg profile-count-offset STW
! Load word->code
aux-reg temp-reg word-code-offset LWZ
! Compute word XT
aux-reg dup compiled-header-size ADDI
! Jump to XT
aux-reg MTCTR
BCTR
] rc-absolute-ppc-2/2 rt-literal 1 jit-profiling jit-define
[
0 temp-reg LOAD32 ! load XT
@ -31,20 +48,20 @@ big-endian on
stack-frame temp-reg LI ! load frame size
temp-reg 1 next-save STW ! save frame size
0 1 lr-save stack-frame + STW ! save return address
] rc-absolute-ppc-2/2 rt-label 0 jit-prolog jit-define
] rc-absolute-ppc-2/2 rt-label 1 jit-prolog jit-define
[
0 temp-reg LOAD32 ! load literal
temp-reg dup 0 LWZ ! indirection
temp-reg ds-reg 4 STWU ! push literal
] rc-absolute-ppc-2/2 rt-literal 0 jit-push-literal jit-define
] rc-absolute-ppc-2/2 rt-literal 1 jit-push-literal jit-define
[
4 1 MR ! pass stack pointer to primitive
0 temp-reg LOAD32 ! load primitive address
4 1 MR ! pass stack pointer to primitive
temp-reg MTCTR ! jump to primitive
BCTR
] rc-absolute-ppc-2/2 rt-primitive 1 jit-word-primitive jit-define
] rc-absolute-ppc-2/2 rt-primitive 1 jit-primitive jit-define
[
0 BL
@ -55,31 +72,31 @@ big-endian on
] rc-relative-ppc-3 rt-xt 0 jit-word-jump jit-define
: jit-call-quot ( -- )
temp-reg temp-reg quot-xt@ LWZ ! load quotation-xt
temp-reg quot-reg quot-xt@ LWZ ! load quotation-xt
temp-reg MTCTR ! jump to quotation-xt
BCTR ;
[
0 temp-reg LOAD32 ! point quot-reg at false branch
aux-reg ds-reg 0 LWZ ! load boolean
0 aux-reg \ f tag-number CMPI ! compare it with f
0 quot-reg LOAD32 ! point quot-reg at false branch
temp-reg ds-reg 0 LWZ ! load boolean
0 temp-reg \ f tag-number CMPI ! compare it with f
2 BNE ! skip next insn if its not f
temp-reg dup 4 ADDI ! point quot-reg at true branch
temp-reg dup 0 LWZ ! load the branch
quot-reg dup 4 ADDI ! point quot-reg at true branch
quot-reg dup 0 LWZ ! load the branch
ds-reg dup 4 SUBI ! pop boolean
jit-call-quot
] rc-absolute-ppc-2/2 rt-literal 0 jit-if-jump jit-define
] rc-absolute-ppc-2/2 rt-literal 1 jit-if-jump jit-define
[
0 temp-reg LOAD32 ! load dispatch array
temp-reg dup 0 LWZ ! indirection
aux-reg ds-reg 0 LWZ ! load index
aux-reg dup 1 SRAWI ! turn it into an array offset
temp-reg dup aux-reg ADD ! compute quotation location
temp-reg dup array-start LWZ ! load quotation
0 quot-reg LOAD32 ! load dispatch array
quot-reg dup 0 LWZ ! indirection
temp-reg ds-reg 0 LWZ ! load index
temp-reg dup 1 SRAWI ! turn it into an array offset
quot-reg dup temp-reg ADD ! compute quotation location
quot-reg dup array-start LWZ ! load quotation
ds-reg dup 4 SUBI ! pop index
jit-call-quot
] rc-absolute-ppc-2/2 rt-literal 0 jit-dispatch jit-define
] rc-absolute-ppc-2/2 rt-literal 1 jit-dispatch jit-define
[
0 1 lr-save stack-frame + LWZ ! load return address