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

bootstrap.image: clean up jit-define and define-sub-primitive so that

db4
Slava Pestov 2009-04-25 22:35:19 -05:00
parent 356537593e
commit 76281235e7
5 changed files with 168 additions and 147 deletions

40
basis/bootstrap/image/image.factor
View File

@ -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

122
basis/cpu/ppc/bootstrap.factor
View File

@ -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

12
basis/cpu/x86/32/bootstrap.factor
View File

@ -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

16
basis/cpu/x86/64/bootstrap.factor
View File

@ -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

125
basis/cpu/x86/bootstrap.factor
View File

@ -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