steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

PowerPC support work in progress

db4
Slava Pestov 2008-01-08 17:04:45 -04:00
parent 0142d96238
commit ac5f758bce
2 changed files with 46 additions and 100 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

119
core/cpu/ppc/bootstrap.factor
View File

@ -1,4 +1,4 @@
! Copyright (C) 2007 Slava Pestov. ! Copyright (C) 2007, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: bootstrap.image.private kernel namespaces system USING: bootstrap.image.private kernel namespaces system
cpu.ppc.assembler math layouts words vocabs ; cpu.ppc.assembler math layouts words vocabs ;
@ -10,12 +10,8 @@ big-endian on
4 jit-code-format set 4 jit-code-format set
: ds-reg 14 ; : ds-reg 14 ;
: word-reg 3 ;
: quot-reg 3 ;
: scan-reg 5 ;
: temp-reg 6 ; : temp-reg 6 ;
: xt-reg 11 ; : aux-reg 7 ;
: factor-area-size 4 bootstrap-cells ; : factor-area-size 4 bootstrap-cells ;
@ -24,98 +20,73 @@ big-endian on
: next-save stack-frame bootstrap-cell - ; : next-save stack-frame bootstrap-cell - ;
: xt-save stack-frame 2 bootstrap-cells - ; : 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 0 temp-reg LOAD32 ! load XT
scan-reg temp-reg scan@ ADDI ! initialize scan pointer 0 MFLR ! load return address
] { } make jit-setup set 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
0 MFLR temp-reg 1 next-save STW ! save frame size
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 1 lr-save stack-frame + STW ! save return address 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 temp-reg ds-reg 4 STWU ! push literal
] { } make jit-push-literal set ] rc-absolute-ppc-2/2 rt-literal 0 jit-push-literal jit-define
[
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
[ [
4 1 MR ! pass stack pointer to primitive 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 0 BL
] { } make jit-word-primitive-call set ] rc-relative-ppc-3 rt-xt 0 jit-word-call jit-define
: load-xt ( -- ) [
word-reg scan-reg 4 LWZU ! load word and advance 0 B
xt-reg word-reg word-xt@ LWZ ; ] rc-relative-ppc-3 rt-xt 0 jit-word-jump jit-define
: jit-call : jit-call-quot ( -- )
scan-reg 1 scan-save STW ! save scan pointer temp-reg temp-reg quot-xt@ LWZ ! load quotation-xt
xt-reg MTLR ! pass XT to callee temp-reg MTCTR ! jump to quotation-xt
BLRL ! call BCTR ;
scan-reg 1 scan-save LWZ ! restore scan pointer
;
: jit-jump [
xt-reg MTCTR BCTR ; 0 temp-reg LOAD32 ! point quot-reg at false branch
aux-reg ds-reg 0 LWZ ! load boolean
[ load-xt jit-call ] { } make jit-word-call set 0 aux-reg \ f tag-number CMPI ! compare it with f
[ 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
2 BNE ! skip next insn if its not f 2 BNE ! skip next insn if its not f
quot-reg dup 4 ADDI ! point quot-reg at true branch temp-reg dup 4 ADDI ! point quot-reg at true branch
quot-reg dup 4 LWZ ! load the branch temp-reg dup 0 LWZ ! load the branch
ds-reg dup 4 SUBI ! pop boolean ds-reg dup 4 SUBI ! pop boolean
scan-reg dup 12 ADDI ! advance scan pointer jit-call-quot
xt-reg quot-reg quot-xt@ LWZ ! load quotation-xt ] rc-absolute-ppc-2/2 rt-literal 0 jit-if-jump jit-define
;
[ [
load-branch jit-jump 0 temp-reg LOAD32 ! load dispatch array
] { } make jit-if-jump set 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
load-branch jit-call temp-reg dup aux-reg ADD ! compute quotation location
] { } make jit-if-call set temp-reg dup array-start LWZ ! load quotation
[
temp-reg ds-reg 0 LWZ ! load index
temp-reg dup 1 SRAWI ! turn it into an array offset
ds-reg dup 4 SUBI ! pop index ds-reg dup 4 SUBI ! pop index
scan-reg dup 4 LWZ ! load array jit-call-quot
temp-reg dup scan-reg ADD ! compute quotation location ] rc-absolute-ppc-2/2 rt-literal 0 jit-dispatch jit-define
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
[ [
0 1 lr-save stack-frame + LWZ ! load return address 0 1 lr-save stack-frame + LWZ ! load return address
1 1 stack-frame ADDI ! pop stack frame 1 1 stack-frame ADDI ! pop stack frame
0 MTLR ! get ready to return 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 "bootstrap.ppc" forget-vocab

27
vm/cpu-ppc.S
View File

@ -103,31 +103,6 @@ DEF(void,c_to_factor,(CELL quot)):
EPILOGUE EPILOGUE
blr 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. */ /* We must pass the XT to the quotation in r11. */
DEF(void,primitive_call,(void)): DEF(void,primitive_call,(void)):
lwz r3,0(r14) /* load quotation from data stack */ lwz r3,0(r14) /* load quotation from data stack */
@ -138,7 +113,7 @@ DEF(void,primitive_call,(void)):
DEF(void,primitive_execute,(void)): DEF(void,primitive_execute,(void)):
lwz r3,0(r14) /* load word from data stack */ lwz r3,0(r14) /* load word from data stack */
lwz r11,29(r3) /* load word-xt slot */ 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 */ subi r14,r14,4 /* pop word from data stack */
bctr /* go */ bctr /* go */