bootstrap.image: clean up jit-define and define-sub-primitive so that
parent
356537593e
commit
76281235e7
|
@ -3,14 +3,13 @@
|
|||
USING: alien arrays byte-arrays generic assocs hashtables assocs
|
||||
hashtables.private io io.binary io.files io.encodings.binary
|
||||
io.pathnames kernel kernel.private math namespaces make parser
|
||||
prettyprint sequences sequences.private strings sbufs
|
||||
vectors words quotations assocs system layouts splitting
|
||||
grouping growable classes classes.builtin classes.tuple
|
||||
classes.tuple.private words.private vocabs
|
||||
vocabs.loader source-files definitions debugger
|
||||
quotations.private sequences.private combinators
|
||||
math.order math.private accessors
|
||||
slots.private compiler.units fry ;
|
||||
prettyprint sequences sequences.private strings sbufs vectors words
|
||||
quotations assocs system layouts splitting grouping growable classes
|
||||
classes.builtin classes.tuple classes.tuple.private words.private
|
||||
vocabs vocabs.loader source-files definitions debugger
|
||||
quotations.private sequences.private combinators math.order
|
||||
math.private accessors slots.private compiler.units compiler.constants
|
||||
fry ;
|
||||
IN: bootstrap.image
|
||||
|
||||
: arch ( os cpu -- arch )
|
||||
|
@ -94,13 +93,30 @@ CONSTANT: -1-offset 9
|
|||
|
||||
SYMBOL: sub-primitives
|
||||
|
||||
: make-jit ( quot rc rt offset -- quad )
|
||||
[ [ call( -- ) ] { } make ] 3dip 4array ;
|
||||
SYMBOL: jit-define-rc
|
||||
SYMBOL: jit-define-rt
|
||||
SYMBOL: jit-define-offset
|
||||
|
||||
: jit-define ( quot rc rt offset name -- )
|
||||
: compute-offset ( -- offset )
|
||||
building get length jit-define-rc get rc-absolute-cell = cell 4 ? - ;
|
||||
|
||||
: jit-rel ( rc rt -- )
|
||||
jit-define-rt set
|
||||
jit-define-rc set
|
||||
compute-offset jit-define-offset set ;
|
||||
|
||||
: make-jit ( quot -- quad )
|
||||
[
|
||||
call( -- )
|
||||
jit-define-rc get
|
||||
jit-define-rt get
|
||||
jit-define-offset get 3array
|
||||
] { } make prefix ;
|
||||
|
||||
: jit-define ( quot name -- )
|
||||
[ make-jit ] dip set ;
|
||||
|
||||
: define-sub-primitive ( quot rc rt offset word -- )
|
||||
: define-sub-primitive ( quot word -- )
|
||||
[ make-jit ] dip sub-primitives get set-at ;
|
||||
|
||||
! The image being constructed; a vector of word-size integers
|
||||
|
|
|
@ -23,7 +23,7 @@ CONSTANT: rs-reg 30
|
|||
: xt-save ( -- n ) stack-frame 2 bootstrap-cells - ;
|
||||
|
||||
[
|
||||
0 6 LOAD32
|
||||
0 6 LOAD32 rc-absolute-ppc-2/2 rt-immediate jit-rel
|
||||
11 6 profile-count-offset LWZ
|
||||
11 11 1 tag-fixnum ADDI
|
||||
11 6 profile-count-offset STW
|
||||
|
@ -31,50 +31,50 @@ CONSTANT: rs-reg 30
|
|||
11 11 compiled-header-size ADDI
|
||||
11 MTCTR
|
||||
BCTR
|
||||
] rc-absolute-ppc-2/2 rt-immediate 1 jit-profiling jit-define
|
||||
] jit-profiling jit-define
|
||||
|
||||
[
|
||||
0 6 LOAD32
|
||||
0 6 LOAD32 rc-absolute-ppc-2/2 rt-this jit-rel
|
||||
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-this 1 jit-prolog jit-define
|
||||
] jit-prolog jit-define
|
||||
|
||||
[
|
||||
0 6 LOAD32
|
||||
0 6 LOAD32 rc-absolute-ppc-2/2 rt-immediate jit-rel
|
||||
6 ds-reg 4 STWU
|
||||
] rc-absolute-ppc-2/2 rt-immediate 1 jit-push-immediate jit-define
|
||||
] jit-push-immediate jit-define
|
||||
|
||||
[
|
||||
0 6 LOAD32
|
||||
0 6 LOAD32 rc-absolute-ppc-2/2 rt-stack-chain jit-rel
|
||||
7 6 0 LWZ
|
||||
1 7 0 STW
|
||||
] rc-absolute-ppc-2/2 rt-stack-chain 1 jit-save-stack jit-define
|
||||
] jit-save-stack jit-define
|
||||
|
||||
[
|
||||
0 6 LOAD32
|
||||
0 6 LOAD32 rc-absolute-ppc-2/2 rt-primitive jit-rel
|
||||
6 MTCTR
|
||||
BCTR
|
||||
] rc-absolute-ppc-2/2 rt-primitive 1 jit-primitive jit-define
|
||||
] 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 jit-rel ] 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 ] jit-word-jump jit-define
|
||||
|
||||
[
|
||||
3 ds-reg 0 LWZ
|
||||
ds-reg dup 4 SUBI
|
||||
0 3 \ f tag-number CMPI
|
||||
2 BEQ
|
||||
0 B
|
||||
] rc-relative-ppc-3 rt-xt 4 jit-if-1 jit-define
|
||||
0 B rc-relative-ppc-3 rt-xt jit-rel
|
||||
] jit-if-1 jit-define
|
||||
|
||||
[
|
||||
0 B
|
||||
] rc-relative-ppc-3 rt-xt 0 jit-if-2 jit-define
|
||||
0 B rc-relative-ppc-3 rt-xt jit-rel
|
||||
] jit-if-2 jit-define
|
||||
|
||||
: jit-jump-quot ( -- )
|
||||
4 3 quot-xt-offset LWZ
|
||||
|
@ -82,14 +82,14 @@ CONSTANT: rs-reg 30
|
|||
BCTR ;
|
||||
|
||||
[
|
||||
0 3 LOAD32
|
||||
0 3 LOAD32 rc-absolute-ppc-2/2 rt-immediate jit-rel
|
||||
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-jump-quot
|
||||
] rc-absolute-ppc-2/2 rt-immediate 1 jit-dispatch jit-define
|
||||
] jit-dispatch jit-define
|
||||
|
||||
: jit->r ( -- )
|
||||
4 ds-reg 0 LWZ
|
||||
|
@ -139,29 +139,29 @@ CONSTANT: rs-reg 30
|
|||
|
||||
[
|
||||
jit->r
|
||||
0 BL
|
||||
0 BL rc-relative-ppc-3 rt-xt
|
||||
jit-r>
|
||||
] rc-relative-ppc-3 rt-xt 3 jit-dip jit-define
|
||||
] jit-dip jit-define
|
||||
|
||||
[
|
||||
jit-2>r
|
||||
0 BL
|
||||
0 BL rc-relative-ppc-3 rt-xt
|
||||
jit-2r>
|
||||
] rc-relative-ppc-3 rt-xt 6 jit-2dip jit-define
|
||||
] jit-2dip jit-define
|
||||
|
||||
[
|
||||
jit-3>r
|
||||
0 BL
|
||||
0 BL rc-relative-ppc-3 rt-xt
|
||||
jit-3r>
|
||||
] rc-relative-ppc-3 rt-xt 8 jit-3dip jit-define
|
||||
] jit-3dip jit-define
|
||||
|
||||
[
|
||||
0 1 lr-save stack-frame + LWZ
|
||||
1 1 stack-frame ADDI
|
||||
0 MTLR
|
||||
] f f f jit-epilog jit-define
|
||||
] jit-epilog jit-define
|
||||
|
||||
[ BLR ] f f f jit-return jit-define
|
||||
[ BLR ] jit-return jit-define
|
||||
|
||||
! Sub-primitives
|
||||
|
||||
|
@ -170,7 +170,7 @@ CONSTANT: rs-reg 30
|
|||
3 ds-reg 0 LWZ
|
||||
ds-reg dup 4 SUBI
|
||||
jit-jump-quot
|
||||
] f f f \ (call) define-sub-primitive
|
||||
] \ (call) define-sub-primitive
|
||||
|
||||
[
|
||||
3 ds-reg 0 LWZ
|
||||
|
@ -178,7 +178,7 @@ CONSTANT: rs-reg 30
|
|||
4 3 word-xt-offset LWZ
|
||||
4 MTCTR
|
||||
BCTR
|
||||
] f f f \ (execute) define-sub-primitive
|
||||
] \ (execute) define-sub-primitive
|
||||
|
||||
! Objects
|
||||
[
|
||||
|
@ -186,7 +186,7 @@ CONSTANT: rs-reg 30
|
|||
3 3 tag-mask get ANDI
|
||||
3 3 tag-bits get SLWI
|
||||
3 ds-reg 0 STW
|
||||
] f f f \ tag define-sub-primitive
|
||||
] \ tag define-sub-primitive
|
||||
|
||||
[
|
||||
3 ds-reg 0 LWZ
|
||||
|
@ -195,25 +195,25 @@ CONSTANT: rs-reg 30
|
|||
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
|
||||
] \ slot define-sub-primitive
|
||||
|
||||
! Shufflers
|
||||
[
|
||||
ds-reg dup 4 SUBI
|
||||
] f f f \ drop define-sub-primitive
|
||||
] \ drop define-sub-primitive
|
||||
|
||||
[
|
||||
ds-reg dup 8 SUBI
|
||||
] f f f \ 2drop define-sub-primitive
|
||||
] \ 2drop define-sub-primitive
|
||||
|
||||
[
|
||||
ds-reg dup 12 SUBI
|
||||
] f f f \ 3drop define-sub-primitive
|
||||
] \ 3drop define-sub-primitive
|
||||
|
||||
[
|
||||
3 ds-reg 0 LWZ
|
||||
3 ds-reg 4 STWU
|
||||
] f f f \ dup define-sub-primitive
|
||||
] \ dup define-sub-primitive
|
||||
|
||||
[
|
||||
3 ds-reg 0 LWZ
|
||||
|
@ -221,7 +221,7 @@ CONSTANT: rs-reg 30
|
|||
ds-reg dup 8 ADDI
|
||||
3 ds-reg 0 STW
|
||||
4 ds-reg -4 STW
|
||||
] f f f \ 2dup define-sub-primitive
|
||||
] \ 2dup define-sub-primitive
|
||||
|
||||
[
|
||||
3 ds-reg 0 LWZ
|
||||
|
@ -231,36 +231,36 @@ CONSTANT: rs-reg 30
|
|||
3 ds-reg 0 STW
|
||||
4 ds-reg -4 STW
|
||||
5 ds-reg -8 STW
|
||||
] f f f \ 3dup define-sub-primitive
|
||||
] \ 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
|
||||
] \ 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
|
||||
] \ 2nip define-sub-primitive
|
||||
|
||||
[
|
||||
3 ds-reg -4 LWZ
|
||||
3 ds-reg 4 STWU
|
||||
] f f f \ over define-sub-primitive
|
||||
] \ over define-sub-primitive
|
||||
|
||||
[
|
||||
3 ds-reg -8 LWZ
|
||||
3 ds-reg 4 STWU
|
||||
] f f f \ pick define-sub-primitive
|
||||
] \ 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
|
||||
] \ dupd define-sub-primitive
|
||||
|
||||
[
|
||||
3 ds-reg 0 LWZ
|
||||
|
@ -268,21 +268,21 @@ CONSTANT: rs-reg 30
|
|||
3 ds-reg 4 STWU
|
||||
4 ds-reg -4 STW
|
||||
3 ds-reg -8 STW
|
||||
] f f f \ tuck define-sub-primitive
|
||||
] \ 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
|
||||
] \ 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
|
||||
] \ swapd define-sub-primitive
|
||||
|
||||
[
|
||||
3 ds-reg 0 LWZ
|
||||
|
@ -291,7 +291,7 @@ CONSTANT: rs-reg 30
|
|||
4 ds-reg -8 STW
|
||||
3 ds-reg -4 STW
|
||||
5 ds-reg 0 STW
|
||||
] f f f \ rot define-sub-primitive
|
||||
] \ rot define-sub-primitive
|
||||
|
||||
[
|
||||
3 ds-reg 0 LWZ
|
||||
|
@ -300,9 +300,9 @@ CONSTANT: rs-reg 30
|
|||
3 ds-reg -8 STW
|
||||
5 ds-reg -4 STW
|
||||
4 ds-reg 0 STW
|
||||
] f f f \ -rot define-sub-primitive
|
||||
] \ -rot define-sub-primitive
|
||||
|
||||
[ jit->r ] f f f \ load-local define-sub-primitive
|
||||
[ jit->r ] \ load-local define-sub-primitive
|
||||
|
||||
! Comparisons
|
||||
: jit-compare ( insn -- )
|
||||
|
@ -336,7 +336,7 @@ CONSTANT: rs-reg 30
|
|||
2 BNE
|
||||
1 tag-fixnum 4 LI
|
||||
4 ds-reg 0 STW
|
||||
] f f f \ both-fixnums? define-sub-primitive
|
||||
] \ both-fixnums? define-sub-primitive
|
||||
|
||||
: jit-math ( insn -- )
|
||||
3 ds-reg 0 LWZ
|
||||
|
@ -344,9 +344,9 @@ CONSTANT: rs-reg 30
|
|||
[ 5 3 4 ] dip execute( dst src1 src2 -- )
|
||||
5 ds-reg 0 STW ;
|
||||
|
||||
[ \ ADD jit-math ] f f f \ fixnum+fast define-sub-primitive
|
||||
[ \ ADD jit-math ] \ fixnum+fast define-sub-primitive
|
||||
|
||||
[ \ SUBF jit-math ] f f f \ fixnum-fast define-sub-primitive
|
||||
[ \ SUBF jit-math ] \ fixnum-fast define-sub-primitive
|
||||
|
||||
[
|
||||
3 ds-reg 0 LWZ
|
||||
|
@ -354,20 +354,20 @@ CONSTANT: rs-reg 30
|
|||
4 4 tag-bits get SRAWI
|
||||
5 3 4 MULLW
|
||||
5 ds-reg 0 STW
|
||||
] f f f \ fixnum*fast define-sub-primitive
|
||||
] \ fixnum*fast define-sub-primitive
|
||||
|
||||
[ \ AND jit-math ] f f f \ fixnum-bitand define-sub-primitive
|
||||
[ \ AND jit-math ] \ fixnum-bitand define-sub-primitive
|
||||
|
||||
[ \ OR jit-math ] f f f \ fixnum-bitor define-sub-primitive
|
||||
[ \ OR jit-math ] \ fixnum-bitor define-sub-primitive
|
||||
|
||||
[ \ XOR jit-math ] f f f \ fixnum-bitxor define-sub-primitive
|
||||
[ \ XOR jit-math ] \ 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
|
||||
] \ fixnum-bitnot define-sub-primitive
|
||||
|
||||
[
|
||||
3 ds-reg 0 LWZ
|
||||
|
@ -382,7 +382,7 @@ CONSTANT: rs-reg 30
|
|||
2 BGT
|
||||
5 7 MR
|
||||
5 ds-reg 0 STW
|
||||
] f f f \ fixnum-shift-fast define-sub-primitive
|
||||
] \ fixnum-shift-fast define-sub-primitive
|
||||
|
||||
[
|
||||
3 ds-reg 0 LWZ
|
||||
|
@ -392,7 +392,7 @@ CONSTANT: rs-reg 30
|
|||
6 5 3 MULLW
|
||||
7 6 4 SUBF
|
||||
7 ds-reg 0 STW
|
||||
] f f f \ fixnum-mod define-sub-primitive
|
||||
] \ fixnum-mod define-sub-primitive
|
||||
|
||||
[
|
||||
3 ds-reg 0 LWZ
|
||||
|
@ -401,7 +401,7 @@ CONSTANT: rs-reg 30
|
|||
5 4 3 DIVW
|
||||
5 5 tag-bits get SLWI
|
||||
5 ds-reg 0 STW
|
||||
] f f f \ fixnum/i-fast define-sub-primitive
|
||||
] \ fixnum/i-fast define-sub-primitive
|
||||
|
||||
[
|
||||
3 ds-reg 0 LWZ
|
||||
|
@ -412,20 +412,20 @@ CONSTANT: rs-reg 30
|
|||
5 5 tag-bits get SLWI
|
||||
5 ds-reg -4 STW
|
||||
7 ds-reg 0 STW
|
||||
] f f f \ fixnum/mod-fast define-sub-primitive
|
||||
] \ fixnum/mod-fast define-sub-primitive
|
||||
|
||||
[
|
||||
3 ds-reg 0 LWZ
|
||||
3 3 1 SRAWI
|
||||
rs-reg 3 3 LWZX
|
||||
3 ds-reg 0 STW
|
||||
] f f f \ get-local define-sub-primitive
|
||||
] \ get-local define-sub-primitive
|
||||
|
||||
[
|
||||
3 ds-reg 0 LWZ
|
||||
ds-reg ds-reg 4 SUBI
|
||||
3 3 1 SRAWI
|
||||
rs-reg 3 rs-reg SUBF
|
||||
] f f f \ drop-locals define-sub-primitive
|
||||
] \ drop-locals define-sub-primitive
|
||||
|
||||
[ "bootstrap.ppc" forget-vocab ] with-compilation-unit
|
||||
|
|
|
@ -22,13 +22,15 @@ IN: bootstrap.x86
|
|||
: rex-length ( -- n ) 0 ;
|
||||
|
||||
[
|
||||
temp0 0 [] MOV ! load stack_chain
|
||||
temp0 [] stack-reg MOV ! save stack pointer
|
||||
] rc-absolute-cell rt-stack-chain 2 jit-save-stack jit-define
|
||||
! load stack_chain
|
||||
temp0 0 [] MOV rc-absolute-cell rt-stack-chain jit-rel
|
||||
! save stack pointer
|
||||
temp0 [] stack-reg MOV
|
||||
] jit-save-stack jit-define
|
||||
|
||||
[
|
||||
(JMP) drop
|
||||
] rc-relative rt-primitive 1 jit-primitive jit-define
|
||||
(JMP) drop rc-relative rt-primitive jit-rel
|
||||
] jit-primitive jit-define
|
||||
|
||||
<< "vocab:cpu/x86/bootstrap.factor" parse-file parsed >>
|
||||
call
|
||||
|
|
|
@ -20,15 +20,19 @@ IN: bootstrap.x86
|
|||
: rex-length ( -- n ) 1 ;
|
||||
|
||||
[
|
||||
temp0 0 MOV ! load stack_chain
|
||||
! load stack_chain
|
||||
temp0 0 MOV rc-absolute-cell rt-stack-chain jit-rel
|
||||
temp0 temp0 [] MOV
|
||||
temp0 [] stack-reg MOV ! save stack pointer
|
||||
] rc-absolute-cell rt-stack-chain 1 rex-length + jit-save-stack jit-define
|
||||
! save stack pointer
|
||||
temp0 [] stack-reg MOV
|
||||
] jit-save-stack jit-define
|
||||
|
||||
[
|
||||
temp1 0 MOV ! load XT
|
||||
temp1 JMP ! go
|
||||
] rc-absolute-cell rt-primitive 1 rex-length + jit-primitive jit-define
|
||||
! load XT
|
||||
temp1 0 MOV rc-absolute-cell rt-primitive jit-rel
|
||||
! go
|
||||
temp1 JMP
|
||||
] jit-primitive jit-define
|
||||
|
||||
<< "vocab:cpu/x86/bootstrap.factor" parse-file parsed >>
|
||||
call
|
||||
|
|
|
@ -12,7 +12,7 @@ big-endian off
|
|||
|
||||
[
|
||||
! Load word
|
||||
temp0 0 MOV
|
||||
temp0 0 MOV rc-absolute-cell rt-immediate jit-rel
|
||||
! Bump profiling counter
|
||||
temp0 profile-count-offset [+] 1 tag-fixnum ADD
|
||||
! Load word->code
|
||||
|
@ -21,35 +21,35 @@ big-endian off
|
|||
temp0 compiled-header-size ADD
|
||||
! Jump to XT
|
||||
temp0 JMP
|
||||
] rc-absolute-cell rt-immediate 1 rex-length + jit-profiling jit-define
|
||||
] jit-profiling jit-define
|
||||
|
||||
[
|
||||
! load XT
|
||||
temp0 0 MOV
|
||||
temp0 0 MOV rc-absolute-cell rt-this jit-rel
|
||||
! save stack frame size
|
||||
stack-frame-size PUSH
|
||||
! push XT
|
||||
temp0 PUSH
|
||||
! alignment
|
||||
stack-reg stack-frame-size 3 bootstrap-cells - SUB
|
||||
] rc-absolute-cell rt-this 1 rex-length + jit-prolog jit-define
|
||||
] jit-prolog jit-define
|
||||
|
||||
[
|
||||
! load literal
|
||||
temp0 0 MOV
|
||||
temp0 0 MOV rc-absolute-cell rt-immediate jit-rel
|
||||
! increment datastack pointer
|
||||
ds-reg bootstrap-cell ADD
|
||||
! store literal on datastack
|
||||
ds-reg [] temp0 MOV
|
||||
] rc-absolute-cell rt-immediate 1 rex-length + jit-push-immediate jit-define
|
||||
] jit-push-immediate jit-define
|
||||
|
||||
[
|
||||
f JMP
|
||||
] rc-relative rt-xt 1 jit-word-jump jit-define
|
||||
f JMP rc-relative rt-xt jit-rel
|
||||
] jit-word-jump jit-define
|
||||
|
||||
[
|
||||
f CALL
|
||||
] rc-relative rt-xt 1 jit-word-call jit-define
|
||||
f CALL rc-relative rt-xt jit-rel
|
||||
] jit-word-call jit-define
|
||||
|
||||
[
|
||||
! load boolean
|
||||
|
@ -59,17 +59,17 @@ big-endian off
|
|||
! compare boolean with f
|
||||
temp0 \ f tag-number CMP
|
||||
! jump to true branch if not equal
|
||||
f JNE
|
||||
] rc-relative rt-xt 10 rex-length 3 * + jit-if-1 jit-define
|
||||
f JNE rc-relative rt-xt jit-rel
|
||||
] jit-if-1 jit-define
|
||||
|
||||
[
|
||||
! jump to false branch if equal
|
||||
f JMP
|
||||
] rc-relative rt-xt 1 jit-if-2 jit-define
|
||||
f JMP rc-relative rt-xt jit-rel
|
||||
] jit-if-2 jit-define
|
||||
|
||||
[
|
||||
! load dispatch table
|
||||
temp1 0 MOV
|
||||
temp1 0 MOV rc-absolute-cell rt-immediate jit-rel
|
||||
! load index
|
||||
temp0 ds-reg [] MOV
|
||||
! turn it into an array offset
|
||||
|
@ -83,7 +83,7 @@ big-endian off
|
|||
! execute branch. the quot must be in arg, since it might
|
||||
! not be compiled yet
|
||||
arg quot-xt-offset [+] JMP
|
||||
] rc-absolute-cell rt-immediate 1 rex-length + jit-dispatch jit-define
|
||||
] jit-dispatch jit-define
|
||||
|
||||
: jit->r ( -- )
|
||||
rs-reg bootstrap-cell ADD
|
||||
|
@ -135,21 +135,21 @@ big-endian off
|
|||
|
||||
[
|
||||
jit->r
|
||||
f CALL
|
||||
f CALL rc-relative rt-xt jit-rel
|
||||
jit-r>
|
||||
] rc-relative rt-xt 11 rex-length 4 * + jit-dip jit-define
|
||||
] jit-dip jit-define
|
||||
|
||||
[
|
||||
jit-2>r
|
||||
f CALL
|
||||
f CALL rc-relative rt-xt jit-rel
|
||||
jit-2r>
|
||||
] rc-relative rt-xt 17 rex-length 6 * + jit-2dip jit-define
|
||||
] jit-2dip jit-define
|
||||
|
||||
[
|
||||
jit-3>r
|
||||
f CALL
|
||||
f CALL rc-relative rt-xt jit-rel
|
||||
jit-3r>
|
||||
] rc-relative rt-xt 23 rex-length 8 * + jit-3dip jit-define
|
||||
] jit-3dip jit-define
|
||||
|
||||
: prepare-(execute) ( -- operand )
|
||||
! load from stack
|
||||
|
@ -159,16 +159,16 @@ big-endian off
|
|||
! execute word
|
||||
temp0 word-xt-offset [+] ;
|
||||
|
||||
[ prepare-(execute) JMP ] f f f jit-execute-jump jit-define
|
||||
[ prepare-(execute) JMP ] jit-execute-jump jit-define
|
||||
|
||||
[ prepare-(execute) CALL ] f f f jit-execute-call jit-define
|
||||
[ prepare-(execute) CALL ] jit-execute-call jit-define
|
||||
|
||||
[
|
||||
! unwind stack frame
|
||||
stack-reg stack-frame-size bootstrap-cell - ADD
|
||||
] f f f jit-epilog jit-define
|
||||
] jit-epilog jit-define
|
||||
|
||||
[ 0 RET ] f f f jit-return jit-define
|
||||
[ 0 RET ] jit-return jit-define
|
||||
|
||||
! Sub-primitives
|
||||
|
||||
|
@ -180,7 +180,7 @@ big-endian off
|
|||
ds-reg bootstrap-cell SUB
|
||||
! call quotation
|
||||
arg quot-xt-offset [+] JMP
|
||||
] f f f \ (call) define-sub-primitive
|
||||
] \ (call) define-sub-primitive
|
||||
|
||||
! Objects
|
||||
[
|
||||
|
@ -192,7 +192,7 @@ big-endian off
|
|||
temp0 tag-bits get SHL
|
||||
! push to stack
|
||||
ds-reg [] temp0 MOV
|
||||
] f f f \ tag define-sub-primitive
|
||||
] \ tag define-sub-primitive
|
||||
|
||||
[
|
||||
! load slot number
|
||||
|
@ -210,26 +210,26 @@ big-endian off
|
|||
temp0 temp1 temp0 [+] MOV
|
||||
! push to stack
|
||||
ds-reg [] temp0 MOV
|
||||
] f f f \ slot define-sub-primitive
|
||||
] \ slot define-sub-primitive
|
||||
|
||||
! Shufflers
|
||||
[
|
||||
ds-reg bootstrap-cell SUB
|
||||
] f f f \ drop define-sub-primitive
|
||||
] \ drop define-sub-primitive
|
||||
|
||||
[
|
||||
ds-reg 2 bootstrap-cells SUB
|
||||
] f f f \ 2drop define-sub-primitive
|
||||
] \ 2drop define-sub-primitive
|
||||
|
||||
[
|
||||
ds-reg 3 bootstrap-cells SUB
|
||||
] f f f \ 3drop define-sub-primitive
|
||||
] \ 3drop define-sub-primitive
|
||||
|
||||
[
|
||||
temp0 ds-reg [] MOV
|
||||
ds-reg bootstrap-cell ADD
|
||||
ds-reg [] temp0 MOV
|
||||
] f f f \ dup define-sub-primitive
|
||||
] \ dup define-sub-primitive
|
||||
|
||||
[
|
||||
temp0 ds-reg [] MOV
|
||||
|
@ -237,7 +237,7 @@ big-endian off
|
|||
ds-reg 2 bootstrap-cells ADD
|
||||
ds-reg [] temp0 MOV
|
||||
ds-reg bootstrap-cell neg [+] temp1 MOV
|
||||
] f f f \ 2dup define-sub-primitive
|
||||
] \ 2dup define-sub-primitive
|
||||
|
||||
[
|
||||
temp0 ds-reg [] MOV
|
||||
|
@ -247,31 +247,31 @@ big-endian off
|
|||
ds-reg [] temp0 MOV
|
||||
ds-reg -1 bootstrap-cells [+] temp1 MOV
|
||||
ds-reg -2 bootstrap-cells [+] temp3 MOV
|
||||
] f f f \ 3dup define-sub-primitive
|
||||
] \ 3dup define-sub-primitive
|
||||
|
||||
[
|
||||
temp0 ds-reg [] MOV
|
||||
ds-reg bootstrap-cell SUB
|
||||
ds-reg [] temp0 MOV
|
||||
] f f f \ nip define-sub-primitive
|
||||
] \ nip define-sub-primitive
|
||||
|
||||
[
|
||||
temp0 ds-reg [] MOV
|
||||
ds-reg 2 bootstrap-cells SUB
|
||||
ds-reg [] temp0 MOV
|
||||
] f f f \ 2nip define-sub-primitive
|
||||
] \ 2nip define-sub-primitive
|
||||
|
||||
[
|
||||
temp0 ds-reg -1 bootstrap-cells [+] MOV
|
||||
ds-reg bootstrap-cell ADD
|
||||
ds-reg [] temp0 MOV
|
||||
] f f f \ over define-sub-primitive
|
||||
] \ over define-sub-primitive
|
||||
|
||||
[
|
||||
temp0 ds-reg -2 bootstrap-cells [+] MOV
|
||||
ds-reg bootstrap-cell ADD
|
||||
ds-reg [] temp0 MOV
|
||||
] f f f \ pick define-sub-primitive
|
||||
] \ pick define-sub-primitive
|
||||
|
||||
[
|
||||
temp0 ds-reg [] MOV
|
||||
|
@ -279,7 +279,7 @@ big-endian off
|
|||
ds-reg [] temp1 MOV
|
||||
ds-reg bootstrap-cell ADD
|
||||
ds-reg [] temp0 MOV
|
||||
] f f f \ dupd define-sub-primitive
|
||||
] \ dupd define-sub-primitive
|
||||
|
||||
[
|
||||
temp0 ds-reg [] MOV
|
||||
|
@ -288,21 +288,21 @@ big-endian off
|
|||
ds-reg [] temp0 MOV
|
||||
ds-reg -1 bootstrap-cells [+] temp1 MOV
|
||||
ds-reg -2 bootstrap-cells [+] temp0 MOV
|
||||
] f f f \ tuck define-sub-primitive
|
||||
] \ tuck define-sub-primitive
|
||||
|
||||
[
|
||||
temp0 ds-reg [] MOV
|
||||
temp1 ds-reg bootstrap-cell neg [+] MOV
|
||||
ds-reg bootstrap-cell neg [+] temp0 MOV
|
||||
ds-reg [] temp1 MOV
|
||||
] f f f \ swap define-sub-primitive
|
||||
] \ swap define-sub-primitive
|
||||
|
||||
[
|
||||
temp0 ds-reg -1 bootstrap-cells [+] MOV
|
||||
temp1 ds-reg -2 bootstrap-cells [+] MOV
|
||||
ds-reg -2 bootstrap-cells [+] temp0 MOV
|
||||
ds-reg -1 bootstrap-cells [+] temp1 MOV
|
||||
] f f f \ swapd define-sub-primitive
|
||||
] \ swapd define-sub-primitive
|
||||
|
||||
[
|
||||
temp0 ds-reg [] MOV
|
||||
|
@ -311,7 +311,7 @@ big-endian off
|
|||
ds-reg -2 bootstrap-cells [+] temp1 MOV
|
||||
ds-reg -1 bootstrap-cells [+] temp0 MOV
|
||||
ds-reg [] temp3 MOV
|
||||
] f f f \ rot define-sub-primitive
|
||||
] \ rot define-sub-primitive
|
||||
|
||||
[
|
||||
temp0 ds-reg [] MOV
|
||||
|
@ -320,14 +320,14 @@ big-endian off
|
|||
ds-reg -2 bootstrap-cells [+] temp0 MOV
|
||||
ds-reg -1 bootstrap-cells [+] temp3 MOV
|
||||
ds-reg [] temp1 MOV
|
||||
] f f f \ -rot define-sub-primitive
|
||||
] \ -rot define-sub-primitive
|
||||
|
||||
[ jit->r ] f f f \ load-local define-sub-primitive
|
||||
[ jit->r ] \ load-local define-sub-primitive
|
||||
|
||||
! Comparisons
|
||||
: jit-compare ( insn -- )
|
||||
! load t
|
||||
temp3 0 MOV
|
||||
temp3 0 MOV rc-absolute-cell rt-immediate jit-rel
|
||||
! load f
|
||||
temp1 \ f tag-number MOV
|
||||
! load first value
|
||||
|
@ -342,8 +342,7 @@ big-endian off
|
|||
ds-reg [] temp1 MOV ;
|
||||
|
||||
: define-jit-compare ( insn word -- )
|
||||
[ [ jit-compare ] curry rc-absolute-cell rt-immediate 1 rex-length + ] dip
|
||||
define-sub-primitive ;
|
||||
[ [ jit-compare ] curry ] dip define-sub-primitive ;
|
||||
|
||||
\ CMOVE \ eq? define-jit-compare
|
||||
\ CMOVGE \ fixnum>= define-jit-compare
|
||||
|
@ -360,9 +359,9 @@ big-endian off
|
|||
! compute result
|
||||
[ ds-reg [] temp0 ] dip execute( dst src -- ) ;
|
||||
|
||||
[ \ ADD jit-math ] f f f \ fixnum+fast define-sub-primitive
|
||||
[ \ ADD jit-math ] \ fixnum+fast define-sub-primitive
|
||||
|
||||
[ \ SUB jit-math ] f f f \ fixnum-fast define-sub-primitive
|
||||
[ \ SUB jit-math ] \ fixnum-fast define-sub-primitive
|
||||
|
||||
[
|
||||
! load second input
|
||||
|
@ -377,20 +376,20 @@ big-endian off
|
|||
temp0 temp1 IMUL2
|
||||
! push result
|
||||
ds-reg [] temp1 MOV
|
||||
] f f f \ fixnum*fast define-sub-primitive
|
||||
] \ fixnum*fast define-sub-primitive
|
||||
|
||||
[ \ AND jit-math ] f f f \ fixnum-bitand define-sub-primitive
|
||||
[ \ AND jit-math ] \ fixnum-bitand define-sub-primitive
|
||||
|
||||
[ \ OR jit-math ] f f f \ fixnum-bitor define-sub-primitive
|
||||
[ \ OR jit-math ] \ fixnum-bitor define-sub-primitive
|
||||
|
||||
[ \ XOR jit-math ] f f f \ fixnum-bitxor define-sub-primitive
|
||||
[ \ XOR jit-math ] \ fixnum-bitxor define-sub-primitive
|
||||
|
||||
[
|
||||
! complement
|
||||
ds-reg [] NOT
|
||||
! clear tag bits
|
||||
ds-reg [] tag-mask get XOR
|
||||
] f f f \ fixnum-bitnot define-sub-primitive
|
||||
] \ fixnum-bitnot define-sub-primitive
|
||||
|
||||
[
|
||||
! load shift count
|
||||
|
@ -414,7 +413,7 @@ big-endian off
|
|||
temp1 temp3 CMOVGE
|
||||
! push to stack
|
||||
ds-reg [] temp1 MOV
|
||||
] f f f \ fixnum-shift-fast define-sub-primitive
|
||||
] \ fixnum-shift-fast define-sub-primitive
|
||||
|
||||
: jit-fixnum-/mod ( -- )
|
||||
! load second parameter
|
||||
|
@ -434,7 +433,7 @@ big-endian off
|
|||
ds-reg bootstrap-cell SUB
|
||||
! push to stack
|
||||
ds-reg [] mod-arg MOV
|
||||
] f f f \ fixnum-mod define-sub-primitive
|
||||
] \ fixnum-mod define-sub-primitive
|
||||
|
||||
[
|
||||
jit-fixnum-/mod
|
||||
|
@ -444,7 +443,7 @@ big-endian off
|
|||
div-arg tag-bits get SHL
|
||||
! push to stack
|
||||
ds-reg [] div-arg MOV
|
||||
] f f f \ fixnum/i-fast define-sub-primitive
|
||||
] \ fixnum/i-fast define-sub-primitive
|
||||
|
||||
[
|
||||
jit-fixnum-/mod
|
||||
|
@ -453,7 +452,7 @@ big-endian off
|
|||
! push to stack
|
||||
ds-reg [] mod-arg MOV
|
||||
ds-reg bootstrap-cell neg [+] div-arg MOV
|
||||
] f f f \ fixnum/mod-fast define-sub-primitive
|
||||
] \ fixnum/mod-fast define-sub-primitive
|
||||
|
||||
[
|
||||
temp0 ds-reg [] MOV
|
||||
|
@ -464,7 +463,7 @@ big-endian off
|
|||
temp1 1 tag-fixnum MOV
|
||||
temp0 temp1 CMOVE
|
||||
ds-reg [] temp0 MOV
|
||||
] f f f \ both-fixnums? define-sub-primitive
|
||||
] \ both-fixnums? define-sub-primitive
|
||||
|
||||
[
|
||||
! load local number
|
||||
|
@ -475,7 +474,7 @@ big-endian off
|
|||
temp0 rs-reg temp0 [+] MOV
|
||||
! push to stack
|
||||
ds-reg [] temp0 MOV
|
||||
] f f f \ get-local define-sub-primitive
|
||||
] \ get-local define-sub-primitive
|
||||
|
||||
[
|
||||
! load local count
|
||||
|
@ -486,6 +485,6 @@ big-endian off
|
|||
fixnum>slot@
|
||||
! decrement retain stack pointer
|
||||
rs-reg temp0 SUB
|
||||
] f f f \ drop-locals define-sub-primitive
|
||||
] \ drop-locals define-sub-primitive
|
||||
|
||||
[ "bootstrap.x86" forget-vocab ] with-compilation-unit
|
||||
|
|
Loading…
Reference in New Issue