Working on PowerPC port
Slava Pestov
parent
c23815fe52
commit
3cea135fae
|
|
@ -1,8 +1,9 @@
|
|||
! 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 generator.fixup compiler.units
|
||||
compiler.constants math layouts words vocabs ;
|
||||
USING: bootstrap.image.private kernel kernel.private namespaces
|
||||
system cpu.ppc.assembler generator.fixup compiler.units
|
||||
compiler.constants math math.private layouts words words.private
|
||||
vocabs slots.private ;
|
||||
IN: bootstrap.ppc
|
||||
|
||||
4 \ cell set
|
||||
|
|
@ -11,9 +12,7 @@ big-endian on
|
|||
4 jit-code-format set
|
||||
|
||||
: ds-reg 14 ;
|
||||
: quot-reg 3 ;
|
||||
: temp-reg 6 ;
|
||||
: aux-reg 11 ;
|
||||
: rs-reg 15 ;
|
||||
|
||||
: factor-area-size 4 bootstrap-cells ;
|
||||
|
||||
|
|
@ -24,86 +23,281 @@ big-endian on
|
|||
: xt-save stack-frame 2 bootstrap-cells - ;
|
||||
|
||||
[
|
||||
! 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 ADDI
|
||||
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
|
||||
0 6 LOAD32
|
||||
6 dup 0 LWZ
|
||||
11 6 profile-count-offset LWZ
|
||||
11 11 1 tag-fixnum ADDI
|
||||
11 6 profile-count-offset STW
|
||||
11 6 word-code-offset LWZ
|
||||
11 11 compiled-header-size ADDI
|
||||
11 MTCTR
|
||||
BCTR
|
||||
] rc-absolute-ppc-2/2 rt-literal 1 jit-profiling jit-define
|
||||
|
||||
[
|
||||
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
|
||||
0 6 LOAD32
|
||||
0 MFLR
|
||||
1 1 stack-frame SUBI
|
||||
6 1 xt-save STW
|
||||
stack-frame 6 LI
|
||||
6 1 next-save STW
|
||||
0 1 lr-save stack-frame + STW
|
||||
] 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
|
||||
0 6 LOAD32
|
||||
6 dup 0 LWZ
|
||||
6 ds-reg 4 STWU
|
||||
] rc-absolute-ppc-2/2 rt-literal 1 jit-push-literal jit-define
|
||||
|
||||
[
|
||||
0 temp-reg LOAD32 ! load primitive address
|
||||
4 1 MR ! pass stack pointer to primitive
|
||||
temp-reg MTCTR ! jump to primitive
|
||||
0 6 LOAD32
|
||||
6 ds-reg 4 STWU
|
||||
] rc-absolute-ppc-2/2 rt-immediate 1 jit-push-immediate jit-define
|
||||
|
||||
[
|
||||
0 6 LOAD32
|
||||
4 1 MR
|
||||
6 MTCTR
|
||||
BCTR
|
||||
] rc-absolute-ppc-2/2 rt-primitive 1 jit-primitive jit-define
|
||||
|
||||
[
|
||||
0 BL
|
||||
] rc-relative-ppc-3 rt-xt 0 jit-word-call jit-define
|
||||
[ 0 BL ] rc-relative-ppc-3 rt-xt 0 jit-word-call jit-define
|
||||
|
||||
[
|
||||
0 B
|
||||
] rc-relative-ppc-3 rt-xt 0 jit-word-jump jit-define
|
||||
[ 0 B ] rc-relative-ppc-3 rt-xt 0 jit-word-jump jit-define
|
||||
|
||||
: jit-call-quot ( -- )
|
||||
temp-reg quot-reg quot-xt-offset LWZ ! load quotation-xt
|
||||
temp-reg MTCTR ! jump to quotation-xt
|
||||
4 3 quot-xt-offset LWZ
|
||||
4 MTCTR
|
||||
BCTR ;
|
||||
|
||||
[
|
||||
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
|
||||
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
|
||||
0 3 LOAD32
|
||||
6 ds-reg 0 LWZ
|
||||
0 6 \ f tag-number CMPI
|
||||
2 BNE
|
||||
3 3 4 ADDI
|
||||
3 3 0 LWZ
|
||||
ds-reg dup 4 SUBI
|
||||
jit-call-quot
|
||||
] rc-absolute-ppc-2/2 rt-literal 1 jit-if-jump jit-define
|
||||
|
||||
[
|
||||
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-offset LWZ ! load quotation
|
||||
ds-reg dup 4 SUBI ! pop index
|
||||
0 3 LOAD32
|
||||
3 3 0 LWZ
|
||||
6 ds-reg 0 LWZ
|
||||
6 6 1 SRAWI
|
||||
3 3 6 ADD
|
||||
3 3 array-start-offset LWZ
|
||||
ds-reg dup 4 SUBI
|
||||
jit-call-quot
|
||||
] rc-absolute-ppc-2/2 rt-literal 1 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
|
||||
0 1 lr-save stack-frame + LWZ
|
||||
1 1 stack-frame ADDI
|
||||
0 MTLR
|
||||
] f f f jit-epilog jit-define
|
||||
|
||||
[ BLR ] f f f jit-return jit-define
|
||||
|
||||
! Sub-primitives
|
||||
|
||||
! Quotations and words
|
||||
[
|
||||
3 ds-reg 0 LWZ
|
||||
ds-reg dup 4 SUBI
|
||||
jit-call-quot
|
||||
] f f f \ (call) define-sub-primitive
|
||||
|
||||
[
|
||||
3 ds-reg 0 LWZ
|
||||
ds-reg dup 4 SUBI
|
||||
4 3 word-xt-offset LWZ
|
||||
4 MTCTR
|
||||
BCTR
|
||||
] f f f \ (execute) define-sub-primitive
|
||||
|
||||
! Objects
|
||||
[
|
||||
3 ds-reg 0 LWZ
|
||||
3 3 tag-mask get ANDI
|
||||
3 3 tag-bits get SLWI
|
||||
3 ds-reg 0 STW
|
||||
] f f f \ tag define-sub-primitive
|
||||
|
||||
[
|
||||
3 ds-reg 0 LWZ
|
||||
4 ds-reg -4 LWZU
|
||||
3 3 1 SRAWI
|
||||
4 4 0 0 31 tag-bits get - RLWINM
|
||||
4 3 3 LWZX
|
||||
3 ds-reg 0 STW
|
||||
] f f f \ slot define-sub-primitive
|
||||
|
||||
|
||||
! Shufflers
|
||||
[
|
||||
ds-reg dup 4 SUBI
|
||||
] f f f \ drop define-sub-primitive
|
||||
|
||||
[
|
||||
ds-reg dup 8 SUBI
|
||||
] f f f \ 2drop define-sub-primitive
|
||||
|
||||
[
|
||||
ds-reg dup 12 SUBI
|
||||
] f f f \ 3drop define-sub-primitive
|
||||
|
||||
[
|
||||
3 ds-reg 0 LWZ
|
||||
3 ds-reg 4 STWU
|
||||
] f f f \ dup define-sub-primitive
|
||||
|
||||
[
|
||||
3 ds-reg 0 LWZ
|
||||
4 ds-reg -4 LWZ
|
||||
ds-reg dup 8 ADDI
|
||||
3 ds-reg 0 STW
|
||||
4 ds-reg -4 STW
|
||||
] f f f \ 2dup define-sub-primitive
|
||||
|
||||
[
|
||||
3 ds-reg 0 LWZ
|
||||
4 ds-reg -4 LWZ
|
||||
5 ds-reg -8 LWZ
|
||||
ds-reg dup 12 ADDI
|
||||
3 ds-reg 0 STW
|
||||
4 ds-reg -4 STW
|
||||
5 ds-reg -8 STW
|
||||
] f f f \ 3dup define-sub-primitive
|
||||
|
||||
[
|
||||
3 ds-reg 0 LWZ
|
||||
ds-reg dup 4 SUBI
|
||||
3 ds-reg 0 STW
|
||||
] f f f \ nip define-sub-primitive
|
||||
|
||||
[
|
||||
3 ds-reg 0 LWZ
|
||||
ds-reg dup 8 SUBI
|
||||
3 ds-reg 0 STW
|
||||
] f f f \ 2nip define-sub-primitive
|
||||
|
||||
[
|
||||
3 ds-reg -4 LWZ
|
||||
3 ds-reg 4 STWU
|
||||
] f f f \ over define-sub-primitive
|
||||
|
||||
[
|
||||
3 ds-reg -8 LWZ
|
||||
3 ds-reg 4 STWU
|
||||
] f f f \ pick define-sub-primitive
|
||||
|
||||
[
|
||||
3 ds-reg 0 LWZ
|
||||
4 ds-reg -4 LWZ
|
||||
4 ds-reg 0 STW
|
||||
3 ds-reg 4 STWU
|
||||
] f f f \ dupd define-sub-primitive
|
||||
|
||||
[
|
||||
3 ds-reg 0 LWZ
|
||||
4 ds-reg -4 LWZ
|
||||
3 ds-reg 4 STWU
|
||||
4 ds-reg -4 STW
|
||||
3 ds-reg -8 STW
|
||||
] f f f \ tuck define-sub-primitive
|
||||
|
||||
[
|
||||
3 ds-reg 0 LWZ
|
||||
4 ds-reg -4 LWZ
|
||||
3 ds-reg -4 STW
|
||||
4 ds-reg 0 STW
|
||||
] f f f \ swap define-sub-primitive
|
||||
|
||||
[
|
||||
3 ds-reg -4 LWZ
|
||||
4 ds-reg -8 LWZ
|
||||
3 ds-reg -8 STW
|
||||
4 ds-reg -4 STW
|
||||
] f f f \ swapd define-sub-primitive
|
||||
|
||||
[
|
||||
3 ds-reg 0 LWZ
|
||||
4 ds-reg -4 LWZ
|
||||
5 ds-reg -8 LWZ
|
||||
4 ds-reg -8 STW
|
||||
3 ds-reg -4 STW
|
||||
5 ds-reg 0 STW
|
||||
] f f f \ rot define-sub-primitive
|
||||
|
||||
[
|
||||
3 ds-reg 0 LWZ
|
||||
4 ds-reg -4 LWZ
|
||||
5 ds-reg -8 LWZ
|
||||
3 ds-reg -8 STW
|
||||
5 ds-reg -4 STW
|
||||
4 ds-reg 0 STW
|
||||
] f f f \ -rot define-sub-primitive
|
||||
|
||||
[
|
||||
3 ds-reg 0 LWZ
|
||||
ds-reg dup 4 SUBI
|
||||
3 rs-reg 4 STWU
|
||||
] f f f \ >r define-sub-primitive
|
||||
|
||||
[
|
||||
3 rs-reg 0 STW
|
||||
rs-reg dup 4 SUBI
|
||||
3 ds-reg 4 STWU
|
||||
] f f f \ r> define-sub-primitive
|
||||
|
||||
! Comparisons
|
||||
: jit-compare ( insn -- )
|
||||
0 3 LOAD32
|
||||
3 3 0 LWZ
|
||||
4 ds-reg 0 LWZ
|
||||
5 ds-reg -4 LWZU
|
||||
5 0 4 CMP
|
||||
2 swap execute ! magic number
|
||||
3 \ f tag-number LI
|
||||
3 ds-reg 0 STW ;
|
||||
|
||||
: define-jit-compare ( insn word -- )
|
||||
[ [ jit-compare ] curry rc-absolute-ppc-2/2 rt-literal 0 ] dip
|
||||
define-sub-primitive ;
|
||||
|
||||
\ BEQ \ eq? define-jit-compare
|
||||
\ BGE \ fixnum>= define-jit-compare
|
||||
\ BLE \ fixnum<= define-jit-compare
|
||||
\ BGT \ fixnum> define-jit-compare
|
||||
\ BLT \ fixnum< define-jit-compare
|
||||
|
||||
! Math
|
||||
: jit-math ( insn -- )
|
||||
3 ds-reg 0 LWZ
|
||||
4 ds-reg -4 LWZU
|
||||
[ 5 3 4 ] dip execute
|
||||
5 ds-reg 0 STW ;
|
||||
|
||||
[ \ ADD jit-math ] f f f \ fixnum+fast define-sub-primitive
|
||||
|
||||
[ \ SUBF jit-math ] f f f \ fixnum-fast define-sub-primitive
|
||||
|
||||
[ \ MULLW jit-math ] f f f \ fixnum*fast define-sub-primitive
|
||||
|
||||
[ \ AND jit-math ] f f f \ fixnum-bitand define-sub-primitive
|
||||
|
||||
[ \ OR jit-math ] f f f \ fixnum-bitor define-sub-primitive
|
||||
|
||||
[ \ XOR jit-math ] f f f \ fixnum-bitxor define-sub-primitive
|
||||
|
||||
[
|
||||
3 ds-reg 0 LWZ
|
||||
3 3 NOT
|
||||
3 3 tag-mask get XORI
|
||||
3 ds-reg 0 STW
|
||||
] f f f \ fixnum-bitnot define-sub-primitive
|
||||
|
||||
[ "bootstrap.ppc" forget-vocab ] with-compilation-unit
|
||||
|
|
|
|||
14
vm/cpu-ppc.S
14
vm/cpu-ppc.S
|
|
@ -103,20 +103,6 @@ DEF(void,c_to_factor,(CELL quot)):
|
|||
EPILOGUE
|
||||
blr
|
||||
|
||||
/* We must pass the XT to the quotation in r11. */
|
||||
DEF(void,primitive_call,(void)):
|
||||
lwz r3,0(r14) /* load quotation from data stack */
|
||||
subi r14,r14,4 /* pop quotation from data stack */
|
||||
JUMP_QUOT
|
||||
|
||||
/* We must preserve r4 here in case we're calling a primitive */
|
||||
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 */
|
||||
subi r14,r14,4 /* pop word from data stack */
|
||||
bctr /* go */
|
||||
|
||||
/* We pass a function pointer to memcpy in r6 to work around a Mac OS X ABI
|
||||
limitation which would otherwise require us to do a bizzaro PC-relative
|
||||
trampoline to retrieve the function address */
|
||||
|
|
|
|||
Loading…
Reference in New Issue