PowerPC support work in progress
Slava Pestov
parent
0142d96238
commit
ac5f758bce
|
|
@ -1,4 +1,4 @@
|
|||
! Copyright (C) 2007 Slava Pestov.
|
||||
! 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 ;
|
||||
|
|
@ -10,12 +10,8 @@ big-endian on
|
|||
4 jit-code-format set
|
||||
|
||||
: ds-reg 14 ;
|
||||
|
||||
: word-reg 3 ;
|
||||
: quot-reg 3 ;
|
||||
: scan-reg 5 ;
|
||||
: temp-reg 6 ;
|
||||
: xt-reg 11 ;
|
||||
: aux-reg 7 ;
|
||||
|
||||
: factor-area-size 4 bootstrap-cells ;
|
||||
|
||||
|
|
@ -24,98 +20,73 @@ big-endian on
|
|||
|
||||
: next-save stack-frame bootstrap-cell - ;
|
||||
: xt-save stack-frame 2 bootstrap-cells - ;
|
||||
: array-save stack-frame 3 bootstrap-cells - ;
|
||||
: scan-save stack-frame 4 bootstrap-cells - ;
|
||||
|
||||
! jit-profiling
|
||||
|
||||
[
|
||||
temp-reg quot-reg quot-array@ LWZ ! load array
|
||||
scan-reg temp-reg scan@ ADDI ! initialize scan pointer
|
||||
] { } make jit-setup set
|
||||
|
||||
[
|
||||
0 MFLR
|
||||
1 1 stack-frame neg ADDI
|
||||
xt-reg 1 xt-save STW ! save XT
|
||||
stack-frame xt-reg LI
|
||||
xt-reg 1 next-save STW ! save frame size
|
||||
temp-reg 1 array-save STW ! save array
|
||||
0 temp-reg LOAD32 ! load XT
|
||||
0 MFLR ! load return address
|
||||
1 1 stack-frame neg ADDI ! create stack frame
|
||||
temp-reg 1 xt-save STW ! save XT
|
||||
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
|
||||
] { } make jit-prolog set
|
||||
] rc-absolute-ppc-2/2 rt-label 0 jit-prolog jit-define
|
||||
|
||||
[
|
||||
temp-reg scan-reg 4 LWZU ! load literal and advance
|
||||
0 temp-reg LOAD32 ! load literal
|
||||
temp-reg dup 0 LWZ ! indirection
|
||||
temp-reg ds-reg 4 STWU ! push literal
|
||||
] { } make jit-push-literal set
|
||||
|
||||
[
|
||||
temp-reg scan-reg 4 LWZU ! load wrapper and advance
|
||||
temp-reg dup wrapper@ LWZ ! load wrapped object
|
||||
temp-reg ds-reg 4 STWU ! push wrapped object
|
||||
] { } make jit-push-wrapper set
|
||||
] rc-absolute-ppc-2/2 rt-literal 0 jit-push-literal jit-define
|
||||
|
||||
[
|
||||
4 1 MR ! pass stack pointer to primitive
|
||||
] { } make jit-word-primitive-jump set
|
||||
0 temp-reg LOAD32 ! load primitive address
|
||||
temp-reg MTCTR ! jump to primitive
|
||||
BCTR
|
||||
] rc-absolute-ppc-2/2 rt-primitive 1 jit-word-primitive jit-define
|
||||
|
||||
[
|
||||
4 1 MR ! pass stack pointer to primitive
|
||||
] { } make jit-word-primitive-call set
|
||||
0 BL
|
||||
] rc-relative-ppc-3 rt-xt 0 jit-word-call jit-define
|
||||
|
||||
: load-xt ( -- )
|
||||
word-reg scan-reg 4 LWZU ! load word and advance
|
||||
xt-reg word-reg word-xt@ LWZ ;
|
||||
[
|
||||
0 B
|
||||
] rc-relative-ppc-3 rt-xt 0 jit-word-jump jit-define
|
||||
|
||||
: jit-call
|
||||
scan-reg 1 scan-save STW ! save scan pointer
|
||||
xt-reg MTLR ! pass XT to callee
|
||||
BLRL ! call
|
||||
scan-reg 1 scan-save LWZ ! restore scan pointer
|
||||
;
|
||||
: jit-call-quot ( -- )
|
||||
temp-reg temp-reg quot-xt@ LWZ ! load quotation-xt
|
||||
temp-reg MTCTR ! jump to quotation-xt
|
||||
BCTR ;
|
||||
|
||||
: jit-jump
|
||||
xt-reg MTCTR BCTR ;
|
||||
|
||||
[ load-xt jit-call ] { } make jit-word-call set
|
||||
|
||||
[ load-xt jit-jump ] { } make jit-word-jump set
|
||||
|
||||
: load-branch
|
||||
temp-reg ds-reg 0 LWZ ! load boolean
|
||||
0 temp-reg \ f tag-number CMPI ! compare it with f
|
||||
quot-reg scan-reg MR ! point quot-reg at false branch
|
||||
[
|
||||
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
|
||||
2 BNE ! skip next insn if its not f
|
||||
quot-reg dup 4 ADDI ! point quot-reg at true branch
|
||||
quot-reg dup 4 LWZ ! load the branch
|
||||
temp-reg dup 4 ADDI ! point quot-reg at true branch
|
||||
temp-reg dup 0 LWZ ! load the branch
|
||||
ds-reg dup 4 SUBI ! pop boolean
|
||||
scan-reg dup 12 ADDI ! advance scan pointer
|
||||
xt-reg quot-reg quot-xt@ LWZ ! load quotation-xt
|
||||
;
|
||||
jit-call-quot
|
||||
] rc-absolute-ppc-2/2 rt-literal 0 jit-if-jump jit-define
|
||||
|
||||
[
|
||||
load-branch jit-jump
|
||||
] { } make jit-if-jump set
|
||||
|
||||
[
|
||||
load-branch jit-call
|
||||
] { } make jit-if-call set
|
||||
|
||||
[
|
||||
temp-reg ds-reg 0 LWZ ! load index
|
||||
temp-reg dup 1 SRAWI ! turn it into an array offset
|
||||
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
|
||||
ds-reg dup 4 SUBI ! pop index
|
||||
scan-reg dup 4 LWZ ! load array
|
||||
temp-reg dup scan-reg ADD ! compute quotation location
|
||||
quot-reg temp-reg array-start LWZ ! load quotation
|
||||
xt-reg quot-reg quot-xt@ LWZ ! load quotation-xt
|
||||
jit-jump ! execute quotation
|
||||
] { } make jit-dispatch set
|
||||
jit-call-quot
|
||||
] rc-absolute-ppc-2/2 rt-literal 0 jit-dispatch jit-define
|
||||
|
||||
[
|
||||
0 1 lr-save stack-frame + LWZ ! load return address
|
||||
1 1 stack-frame ADDI ! pop stack frame
|
||||
0 MTLR ! get ready to return
|
||||
] { } make jit-epilog set
|
||||
] f f f jit-epilog jit-define
|
||||
|
||||
[ BLR ] { } make jit-return set
|
||||
[ BLR ] f f f jit-return jit-define
|
||||
|
||||
"bootstrap.ppc" forget-vocab
|
||||
|
|
|
|||
27
vm/cpu-ppc.S
27
vm/cpu-ppc.S
|
|
@ -103,31 +103,6 @@ DEF(void,c_to_factor,(CELL quot)):
|
|||
EPILOGUE
|
||||
blr
|
||||
|
||||
/* The JIT compiles an 'mr r4,r1' in front of every primitive call, since a
|
||||
word which was defined as a primitive will not change its definition for the
|
||||
lifetime of the image -- adding new primitives requires a bootstrap. However,
|
||||
an undefined word can certainly become defined,
|
||||
|
||||
DEFER: foo
|
||||
...
|
||||
: foo ... ;
|
||||
|
||||
And calls to non-primitives do not have this one-instruction prologue, so we
|
||||
set the XT of undefined words to this symbol. */
|
||||
DEF(void,undefined,(CELL word)):
|
||||
mr r4,r1
|
||||
b MANGLE(undefined_error)
|
||||
|
||||
/* Here we have two entry points. The first one is taken when profiling is
|
||||
enabled */
|
||||
DEF(void,docol_profiling,(CELL word)):
|
||||
lwz r4,25(r3) /* load profile-count slot */
|
||||
addi r4,r4,8 /* increment count */
|
||||
stw r4,25(r3) /* store profile-count slot */
|
||||
DEF(void,docol,(CELL word)):
|
||||
lwz r3,13(r3) /* load word-def slot */
|
||||
JUMP_QUOT
|
||||
|
||||
/* We must pass the XT to the quotation in r11. */
|
||||
DEF(void,primitive_call,(void)):
|
||||
lwz r3,0(r14) /* load quotation from data stack */
|
||||
|
|
@ -138,7 +113,7 @@ DEF(void,primitive_call,(void)):
|
|||
DEF(void,primitive_execute,(void)):
|
||||
lwz r3,0(r14) /* load word from data stack */
|
||||
lwz r11,29(r3) /* load word-xt slot */
|
||||
mtctr r11 /* prepare to call XT with word in r3 */
|
||||
mtctr r11 /* prepare to call XT */
|
||||
subi r14,r14,4 /* pop word from data stack */
|
||||
bctr /* go */
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue