diff --git a/core/cpu/ppc/bootstrap.factor b/core/cpu/ppc/bootstrap.factor index dfca6f2849..efd5b10251 100755 --- a/core/cpu/ppc/bootstrap.factor +++ b/core/cpu/ppc/bootstrap.factor @@ -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 diff --git a/vm/cpu-ppc.S b/vm/cpu-ppc.S index 25b0ff0bd2..55c4f01df0 100755 --- a/vm/cpu-ppc.S +++ b/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 */