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

Clean up JIT backend a little

db4
Slava Pestov 2008-12-09 17:14:17 -06:00
parent a90118da5d
commit 4b927f732f
5 changed files with 274 additions and 195 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -10,19 +10,19 @@ IN: bootstrap.x86
: shift-arg ( -- reg ) ECX ; : shift-arg ( -- reg ) ECX ;
: div-arg ( -- reg ) EAX ; : div-arg ( -- reg ) EAX ;
: mod-arg ( -- reg ) EDX ; : mod-arg ( -- reg ) EDX ;
: arg0 ( -- reg ) EAX ; : temp0 ( -- reg ) EAX ;
: arg1 ( -- reg ) EDX ; : temp1 ( -- reg ) EDX ;
: arg2 ( -- reg ) ECX ; : temp2 ( -- reg ) ECX ;
: temp-reg ( -- reg ) EBX ; : temp3 ( -- reg ) EBX ;
: stack-reg ( -- reg ) ESP ; : stack-reg ( -- reg ) ESP ;
: ds-reg ( -- reg ) ESI ; : ds-reg ( -- reg ) ESI ;
: rs-reg ( -- reg ) EDI ; : rs-reg ( -- reg ) EDI ;
: fixnum>slot@ ( -- ) arg0 1 SAR ; : fixnum>slot@ ( -- ) temp0 1 SAR ;
: rex-length ( -- n ) 0 ; : rex-length ( -- n ) 0 ;
[ [
arg0 0 [] MOV ! load stack_chain temp0 0 [] MOV ! load stack_chain
arg0 [] stack-reg MOV ! save stack pointer temp0 [] stack-reg MOV ! save stack pointer
] rc-absolute-cell rt-stack-chain 2 jit-save-stack jit-define ] rc-absolute-cell rt-stack-chain 2 jit-save-stack jit-define
[ [

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

@ -9,7 +9,10 @@ IN: bootstrap.x86
: shift-arg ( -- reg ) RCX ; : shift-arg ( -- reg ) RCX ;
: div-arg ( -- reg ) RAX ; : div-arg ( -- reg ) RAX ;
: mod-arg ( -- reg ) RDX ; : mod-arg ( -- reg ) RDX ;
: temp-reg ( -- reg ) RBX ; : temp0 ( -- reg ) RDI ;
: temp1 ( -- reg ) RSI ;
: temp2 ( -- reg ) RDX ;
: temp3 ( -- reg ) RBX ;
: stack-reg ( -- reg ) RSP ; : stack-reg ( -- reg ) RSP ;
: ds-reg ( -- reg ) R14 ; : ds-reg ( -- reg ) R14 ;
: rs-reg ( -- reg ) R15 ; : rs-reg ( -- reg ) R15 ;
@ -17,14 +20,14 @@ IN: bootstrap.x86
: rex-length ( -- n ) 1 ; : rex-length ( -- n ) 1 ;
[ [
arg0 0 MOV ! load stack_chain temp0 0 MOV ! load stack_chain
arg0 arg0 [] MOV temp0 temp0 [] MOV
arg0 [] stack-reg MOV ! save stack pointer temp0 [] stack-reg MOV ! save stack pointer
] rc-absolute-cell rt-stack-chain 1 rex-length + jit-save-stack jit-define ] rc-absolute-cell rt-stack-chain 1 rex-length + jit-save-stack jit-define
[ [
arg1 0 MOV ! load XT temp1 0 MOV ! load XT
arg1 JMP ! go temp1 JMP ! go
] rc-absolute-cell rt-primitive 1 rex-length + jit-primitive jit-define ] rc-absolute-cell rt-primitive 1 rex-length + jit-primitive jit-define
<< "resource:basis/cpu/x86/bootstrap.factor" parse-file parsed >> << "resource:basis/cpu/x86/bootstrap.factor" parse-file parsed >>

3
basis/cpu/x86/64/unix/bootstrap.factor
View File

@ -5,9 +5,6 @@ cpu.x86.assembler layouts vocabs parser ;
IN: bootstrap.x86 IN: bootstrap.x86
: stack-frame-size ( -- n ) 4 bootstrap-cells ; : stack-frame-size ( -- n ) 4 bootstrap-cells ;
: arg0 ( -- reg ) RDI ;
: arg1 ( -- reg ) RSI ;
: arg2 ( -- reg ) RDX ;
<< "resource:basis/cpu/x86/64/bootstrap.factor" parse-file parsed >> << "resource:basis/cpu/x86/64/bootstrap.factor" parse-file parsed >>
call call

3
basis/cpu/x86/64/winnt/bootstrap.factor
View File

@ -5,9 +5,6 @@ cpu.x86.assembler layouts vocabs parser ;
IN: bootstrap.x86 IN: bootstrap.x86
: stack-frame-size ( -- n ) 8 bootstrap-cells ; : stack-frame-size ( -- n ) 8 bootstrap-cells ;
: arg0 ( -- reg ) RCX ;
: arg1 ( -- reg ) RDX ;
: arg2 ( -- reg ) R8 ;
<< "resource:basis/cpu/x86/64/bootstrap.factor" parse-file parsed >> << "resource:basis/cpu/x86/64/bootstrap.factor" parse-file parsed >>
call call

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

@ -12,28 +12,35 @@ big-endian off
[ [
! Load word ! Load word
temp-reg 0 MOV temp0 0 MOV
! Bump profiling counter ! Bump profiling counter
temp-reg profile-count-offset [+] 1 tag-fixnum ADD temp0 profile-count-offset [+] 1 tag-fixnum ADD
! Load word->code ! Load word->code
temp-reg temp-reg word-code-offset [+] MOV temp0 temp0 word-code-offset [+] MOV
! Compute word XT ! Compute word XT
temp-reg compiled-header-size ADD temp0 compiled-header-size ADD
! Jump to XT ! Jump to XT
temp-reg JMP temp0 JMP
] rc-absolute-cell rt-immediate 1 rex-length + jit-profiling jit-define ] rc-absolute-cell rt-immediate 1 rex-length + jit-profiling jit-define
[ [
temp-reg 0 MOV ! load XT ! load XT
stack-frame-size PUSH ! save stack frame size temp0 0 MOV
temp-reg PUSH ! push XT ! save stack frame size
stack-reg stack-frame-size 3 bootstrap-cells - SUB ! alignment stack-frame-size PUSH
! push XT
temp0 PUSH
! alignment
stack-reg stack-frame-size 3 bootstrap-cells - SUB
] rc-absolute-cell rt-label 1 rex-length + jit-prolog jit-define ] rc-absolute-cell rt-label 1 rex-length + jit-prolog jit-define
[ [
arg0 0 MOV ! load literal ! load literal
ds-reg bootstrap-cell ADD ! increment datastack pointer temp0 0 MOV
ds-reg [] arg0 MOV ! store literal on datastack ! 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 ] rc-absolute-cell rt-immediate 1 rex-length + jit-push-immediate jit-define
[ [
@ -45,73 +52,85 @@ big-endian off
] rc-relative rt-xt 1 jit-word-call jit-define ] rc-relative rt-xt 1 jit-word-call jit-define
[ [
arg0 ds-reg [] MOV ! load boolean ! load boolean
ds-reg bootstrap-cell SUB ! pop boolean temp0 ds-reg [] MOV
arg0 \ f tag-number CMP ! compare boolean with f ! pop boolean
f JNE ! jump to true branch if not equal ds-reg bootstrap-cell SUB
! 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 ] rc-relative rt-xt 10 rex-length 3 * + jit-if-1 jit-define
[ [
f JMP ! jump to false branch if equal ! jump to false branch if equal
f JMP
] rc-relative rt-xt 1 jit-if-2 jit-define ] rc-relative rt-xt 1 jit-if-2 jit-define
[ [
arg1 0 MOV ! load dispatch table ! load dispatch table
arg0 ds-reg [] MOV ! load index temp1 0 MOV
fixnum>slot@ ! turn it into an array offset ! load index
ds-reg bootstrap-cell SUB ! pop index temp0 ds-reg [] MOV
arg0 arg1 ADD ! compute quotation location ! turn it into an array offset
arg0 arg0 array-start-offset [+] MOV ! load quotation fixnum>slot@
arg0 quot-xt-offset [+] JMP ! execute branch ! pop index
ds-reg bootstrap-cell SUB
! compute quotation location
temp0 temp1 ADD
! load quotation
temp0 temp0 array-start-offset [+] MOV
! execute branch
temp0 quot-xt-offset [+] JMP
] rc-absolute-cell rt-immediate 1 rex-length + jit-dispatch jit-define ] rc-absolute-cell rt-immediate 1 rex-length + jit-dispatch jit-define
: jit->r ( -- ) : jit->r ( -- )
rs-reg bootstrap-cell ADD rs-reg bootstrap-cell ADD
arg0 ds-reg [] MOV temp0 ds-reg [] MOV
ds-reg bootstrap-cell SUB ds-reg bootstrap-cell SUB
rs-reg [] arg0 MOV ; rs-reg [] temp0 MOV ;
: jit-2>r ( -- ) : jit-2>r ( -- )
rs-reg 2 bootstrap-cells ADD rs-reg 2 bootstrap-cells ADD
arg0 ds-reg [] MOV temp0 ds-reg [] MOV
arg1 ds-reg -1 bootstrap-cells [+] MOV temp1 ds-reg -1 bootstrap-cells [+] MOV
ds-reg 2 bootstrap-cells SUB ds-reg 2 bootstrap-cells SUB
rs-reg [] arg0 MOV rs-reg [] temp0 MOV
rs-reg -1 bootstrap-cells [+] arg1 MOV ; rs-reg -1 bootstrap-cells [+] temp1 MOV ;
: jit-3>r ( -- ) : jit-3>r ( -- )
rs-reg 3 bootstrap-cells ADD rs-reg 3 bootstrap-cells ADD
arg0 ds-reg [] MOV temp0 ds-reg [] MOV
arg1 ds-reg -1 bootstrap-cells [+] MOV temp1 ds-reg -1 bootstrap-cells [+] MOV
arg2 ds-reg -2 bootstrap-cells [+] MOV temp2 ds-reg -2 bootstrap-cells [+] MOV
ds-reg 3 bootstrap-cells SUB ds-reg 3 bootstrap-cells SUB
rs-reg [] arg0 MOV rs-reg [] temp0 MOV
rs-reg -1 bootstrap-cells [+] arg1 MOV rs-reg -1 bootstrap-cells [+] temp1 MOV
rs-reg -2 bootstrap-cells [+] arg2 MOV ; rs-reg -2 bootstrap-cells [+] temp2 MOV ;
: jit-r> ( -- ) : jit-r> ( -- )
ds-reg bootstrap-cell ADD ds-reg bootstrap-cell ADD
arg0 rs-reg [] MOV temp0 rs-reg [] MOV
rs-reg bootstrap-cell SUB rs-reg bootstrap-cell SUB
ds-reg [] arg0 MOV ; ds-reg [] temp0 MOV ;
: jit-2r> ( -- ) : jit-2r> ( -- )
ds-reg 2 bootstrap-cells ADD ds-reg 2 bootstrap-cells ADD
arg0 rs-reg [] MOV temp0 rs-reg [] MOV
arg1 rs-reg -1 bootstrap-cells [+] MOV temp1 rs-reg -1 bootstrap-cells [+] MOV
rs-reg 2 bootstrap-cells SUB rs-reg 2 bootstrap-cells SUB
ds-reg [] arg0 MOV ds-reg [] temp0 MOV
ds-reg -1 bootstrap-cells [+] arg1 MOV ; ds-reg -1 bootstrap-cells [+] temp1 MOV ;
: jit-3r> ( -- ) : jit-3r> ( -- )
ds-reg 3 bootstrap-cells ADD ds-reg 3 bootstrap-cells ADD
arg0 rs-reg [] MOV temp0 rs-reg [] MOV
arg1 rs-reg -1 bootstrap-cells [+] MOV temp1 rs-reg -1 bootstrap-cells [+] MOV
arg2 rs-reg -2 bootstrap-cells [+] MOV temp2 rs-reg -2 bootstrap-cells [+] MOV
rs-reg 3 bootstrap-cells SUB rs-reg 3 bootstrap-cells SUB
ds-reg [] arg0 MOV ds-reg [] temp0 MOV
ds-reg -1 bootstrap-cells [+] arg1 MOV ds-reg -1 bootstrap-cells [+] temp1 MOV
ds-reg -2 bootstrap-cells [+] arg2 MOV ; ds-reg -2 bootstrap-cells [+] temp2 MOV ;
[ [
jit->r jit->r
@ -126,13 +145,14 @@ big-endian off
] rc-relative rt-xt 17 rex-length 6 * + jit-2dip jit-define ] rc-relative rt-xt 17 rex-length 6 * + jit-2dip jit-define
[ [
jit-3>r jit-3>r
f CALL f CALL
jit-3r> jit-3r>
] rc-relative rt-xt 23 rex-length 8 * + jit-3dip jit-define ] rc-relative rt-xt 23 rex-length 8 * + jit-3dip jit-define
[ [
stack-reg stack-frame-size bootstrap-cell - ADD ! unwind stack frame ! unwind stack frame
stack-reg stack-frame-size bootstrap-cell - ADD
] f f f jit-epilog jit-define ] f f f jit-epilog jit-define
[ 0 RET ] f f f jit-return jit-define [ 0 RET ] f f f jit-return jit-define
@ -141,34 +161,51 @@ big-endian off
! Quotations and words ! Quotations and words
[ [
arg0 ds-reg [] MOV ! load from stack ! load from stack
ds-reg bootstrap-cell SUB ! pop stack temp0 ds-reg [] MOV
arg0 quot-xt-offset [+] JMP ! call quotation ! pop stack
ds-reg bootstrap-cell SUB
! call quotation
temp0 quot-xt-offset [+] JMP
] f f f \ (call) define-sub-primitive ] f f f \ (call) define-sub-primitive
[ [
arg0 ds-reg [] MOV ! load from stack ! load from stack
ds-reg bootstrap-cell SUB ! pop stack temp0 ds-reg [] MOV
arg0 word-xt-offset [+] JMP ! execute word ! pop stack
ds-reg bootstrap-cell SUB
! execute word
temp0 word-xt-offset [+] JMP
] f f f \ (execute) define-sub-primitive ] f f f \ (execute) define-sub-primitive
! Objects ! Objects
[ [
arg1 ds-reg [] MOV ! load from stack ! load from stack
arg1 tag-mask get AND ! compute tag temp0 ds-reg [] MOV
arg1 tag-bits get SHL ! tag the tag ! compute tag
ds-reg [] arg1 MOV ! push to stack temp0 tag-mask get AND
! tag the tag
temp0 tag-bits get SHL
! push to stack
ds-reg [] temp0 MOV
] f f f \ tag define-sub-primitive ] f f f \ tag define-sub-primitive
[ [
arg0 ds-reg [] MOV ! load slot number ! load slot number
ds-reg bootstrap-cell SUB ! adjust stack pointer temp0 ds-reg [] MOV
arg1 ds-reg [] MOV ! load object ! adjust stack pointer
fixnum>slot@ ! turn slot number into offset ds-reg bootstrap-cell SUB
arg1 tag-bits get SHR ! mask off tag ! load object
arg1 tag-bits get SHL temp1 ds-reg [] MOV
arg0 arg1 arg0 [+] MOV ! load slot value ! turn slot number into offset
ds-reg [] arg0 MOV ! push to stack fixnum>slot@
! mask off tag
temp1 tag-bits get SHR
temp1 tag-bits get SHL
! load slot value
temp0 temp1 temp0 [+] MOV
! push to stack
ds-reg [] temp0 MOV
] f f f \ slot define-sub-primitive ] f f f \ slot define-sub-primitive
! Shufflers ! Shufflers
@ -185,100 +222,100 @@ big-endian off
] f f f \ 3drop define-sub-primitive ] f f f \ 3drop define-sub-primitive
[ [
arg0 ds-reg [] MOV temp0 ds-reg [] MOV
ds-reg bootstrap-cell ADD ds-reg bootstrap-cell ADD
ds-reg [] arg0 MOV ds-reg [] temp0 MOV
] f f f \ dup define-sub-primitive ] f f f \ dup define-sub-primitive
[ [
arg0 ds-reg [] MOV temp0 ds-reg [] MOV
arg1 ds-reg bootstrap-cell neg [+] MOV temp1 ds-reg bootstrap-cell neg [+] MOV
ds-reg 2 bootstrap-cells ADD ds-reg 2 bootstrap-cells ADD
ds-reg [] arg0 MOV ds-reg [] temp0 MOV
ds-reg bootstrap-cell neg [+] arg1 MOV ds-reg bootstrap-cell neg [+] temp1 MOV
] f f f \ 2dup define-sub-primitive ] f f f \ 2dup define-sub-primitive
[ [
arg0 ds-reg [] MOV temp0 ds-reg [] MOV
arg1 ds-reg -1 bootstrap-cells [+] MOV temp1 ds-reg -1 bootstrap-cells [+] MOV
temp-reg ds-reg -2 bootstrap-cells [+] MOV temp3 ds-reg -2 bootstrap-cells [+] MOV
ds-reg 3 bootstrap-cells ADD ds-reg 3 bootstrap-cells ADD
ds-reg [] arg0 MOV ds-reg [] temp0 MOV
ds-reg -1 bootstrap-cells [+] arg1 MOV ds-reg -1 bootstrap-cells [+] temp1 MOV
ds-reg -2 bootstrap-cells [+] temp-reg MOV ds-reg -2 bootstrap-cells [+] temp3 MOV
] f f f \ 3dup define-sub-primitive ] f f f \ 3dup define-sub-primitive
[ [
arg0 ds-reg [] MOV temp0 ds-reg [] MOV
ds-reg bootstrap-cell SUB ds-reg bootstrap-cell SUB
ds-reg [] arg0 MOV ds-reg [] temp0 MOV
] f f f \ nip define-sub-primitive ] f f f \ nip define-sub-primitive
[ [
arg0 ds-reg [] MOV temp0 ds-reg [] MOV
ds-reg 2 bootstrap-cells SUB ds-reg 2 bootstrap-cells SUB
ds-reg [] arg0 MOV ds-reg [] temp0 MOV
] f f f \ 2nip define-sub-primitive ] f f f \ 2nip define-sub-primitive
[ [
arg0 ds-reg -1 bootstrap-cells [+] MOV temp0 ds-reg -1 bootstrap-cells [+] MOV
ds-reg bootstrap-cell ADD ds-reg bootstrap-cell ADD
ds-reg [] arg0 MOV ds-reg [] temp0 MOV
] f f f \ over define-sub-primitive ] f f f \ over define-sub-primitive
[ [
arg0 ds-reg -2 bootstrap-cells [+] MOV temp0 ds-reg -2 bootstrap-cells [+] MOV
ds-reg bootstrap-cell ADD ds-reg bootstrap-cell ADD
ds-reg [] arg0 MOV ds-reg [] temp0 MOV
] f f f \ pick define-sub-primitive ] f f f \ pick define-sub-primitive
[ [
arg0 ds-reg [] MOV temp0 ds-reg [] MOV
arg1 ds-reg -1 bootstrap-cells [+] MOV temp1 ds-reg -1 bootstrap-cells [+] MOV
ds-reg [] arg1 MOV ds-reg [] temp1 MOV
ds-reg bootstrap-cell ADD ds-reg bootstrap-cell ADD
ds-reg [] arg0 MOV ds-reg [] temp0 MOV
] f f f \ dupd define-sub-primitive ] f f f \ dupd define-sub-primitive
[ [
arg0 ds-reg [] MOV temp0 ds-reg [] MOV
arg1 ds-reg -1 bootstrap-cells [+] MOV temp1 ds-reg -1 bootstrap-cells [+] MOV
ds-reg bootstrap-cell ADD ds-reg bootstrap-cell ADD
ds-reg [] arg0 MOV ds-reg [] temp0 MOV
ds-reg -1 bootstrap-cells [+] arg1 MOV ds-reg -1 bootstrap-cells [+] temp1 MOV
ds-reg -2 bootstrap-cells [+] arg0 MOV ds-reg -2 bootstrap-cells [+] temp0 MOV
] f f f \ tuck define-sub-primitive ] f f f \ tuck define-sub-primitive
[ [
arg0 ds-reg [] MOV temp0 ds-reg [] MOV
arg1 ds-reg bootstrap-cell neg [+] MOV temp1 ds-reg bootstrap-cell neg [+] MOV
ds-reg bootstrap-cell neg [+] arg0 MOV ds-reg bootstrap-cell neg [+] temp0 MOV
ds-reg [] arg1 MOV ds-reg [] temp1 MOV
] f f f \ swap define-sub-primitive ] f f f \ swap define-sub-primitive
[ [
arg0 ds-reg -1 bootstrap-cells [+] MOV temp0 ds-reg -1 bootstrap-cells [+] MOV
arg1 ds-reg -2 bootstrap-cells [+] MOV temp1 ds-reg -2 bootstrap-cells [+] MOV
ds-reg -2 bootstrap-cells [+] arg0 MOV ds-reg -2 bootstrap-cells [+] temp0 MOV
ds-reg -1 bootstrap-cells [+] arg1 MOV ds-reg -1 bootstrap-cells [+] temp1 MOV
] f f f \ swapd define-sub-primitive ] f f f \ swapd define-sub-primitive
[ [
arg0 ds-reg [] MOV temp0 ds-reg [] MOV
arg1 ds-reg -1 bootstrap-cells [+] MOV temp1 ds-reg -1 bootstrap-cells [+] MOV
temp-reg ds-reg -2 bootstrap-cells [+] MOV temp3 ds-reg -2 bootstrap-cells [+] MOV
ds-reg -2 bootstrap-cells [+] arg1 MOV ds-reg -2 bootstrap-cells [+] temp1 MOV
ds-reg -1 bootstrap-cells [+] arg0 MOV ds-reg -1 bootstrap-cells [+] temp0 MOV
ds-reg [] temp-reg MOV ds-reg [] temp3 MOV
] f f f \ rot define-sub-primitive ] f f f \ rot define-sub-primitive
[ [
arg0 ds-reg [] MOV temp0 ds-reg [] MOV
arg1 ds-reg -1 bootstrap-cells [+] MOV temp1 ds-reg -1 bootstrap-cells [+] MOV
temp-reg ds-reg -2 bootstrap-cells [+] MOV temp3 ds-reg -2 bootstrap-cells [+] MOV
ds-reg -2 bootstrap-cells [+] arg0 MOV ds-reg -2 bootstrap-cells [+] temp0 MOV
ds-reg -1 bootstrap-cells [+] temp-reg MOV ds-reg -1 bootstrap-cells [+] temp3 MOV
ds-reg [] arg1 MOV ds-reg [] temp1 MOV
] f f f \ -rot define-sub-primitive ] f f f \ -rot define-sub-primitive
[ jit->r ] f f f \ >r define-sub-primitive [ jit->r ] f f f \ >r define-sub-primitive
@ -287,14 +324,20 @@ big-endian off
! Comparisons ! Comparisons
: jit-compare ( insn -- ) : jit-compare ( insn -- )
temp-reg 0 MOV ! load t ! load t
arg1 \ f tag-number MOV ! load f temp3 0 MOV
arg0 ds-reg [] MOV ! load first value ! load f
ds-reg bootstrap-cell SUB ! adjust stack pointer temp1 \ f tag-number MOV
ds-reg [] arg0 CMP ! compare with second value ! load first value
[ arg1 temp-reg ] dip execute ! move t if true temp0 ds-reg [] MOV
ds-reg [] arg1 MOV ! store ! adjust stack pointer
; ds-reg bootstrap-cell SUB
! compare with second value
ds-reg [] temp0 CMP
! move t if true
[ temp1 temp3 ] dip execute
! store
ds-reg [] temp1 MOV ;
: define-jit-compare ( insn word -- ) : define-jit-compare ( insn word -- )
[ [ jit-compare ] curry rc-absolute-cell rt-immediate 1 rex-length + ] dip [ [ jit-compare ] curry rc-absolute-cell rt-immediate 1 rex-length + ] dip
@ -308,22 +351,30 @@ big-endian off
! Math ! Math
: jit-math ( insn -- ) : jit-math ( insn -- )
arg0 ds-reg [] MOV ! load second input ! load second input
ds-reg bootstrap-cell SUB ! pop stack temp0 ds-reg [] MOV
[ ds-reg [] arg0 ] dip execute ! compute result ! pop stack
; ds-reg bootstrap-cell SUB
! compute result
[ ds-reg [] temp0 ] dip execute ;
[ \ ADD jit-math ] f f f \ fixnum+fast define-sub-primitive [ \ ADD jit-math ] f f f \ fixnum+fast define-sub-primitive
[ \ SUB jit-math ] f f f \ fixnum-fast define-sub-primitive [ \ SUB jit-math ] f f f \ fixnum-fast define-sub-primitive
[ [
arg0 ds-reg [] MOV ! load second input ! load second input
ds-reg bootstrap-cell SUB ! pop stack temp0 ds-reg [] MOV
arg1 ds-reg [] MOV ! load first input ! pop stack
arg0 tag-bits get SAR ! untag second input ds-reg bootstrap-cell SUB
arg0 arg1 IMUL2 ! multiply ! load first input
ds-reg [] arg1 MOV ! push result temp1 ds-reg [] MOV
! untag second input
temp0 tag-bits get SAR
! multiply
temp0 temp1 IMUL2
! push result
ds-reg [] temp1 MOV
] f f f \ fixnum*fast define-sub-primitive ] f f f \ fixnum*fast define-sub-primitive
[ \ AND jit-math ] f f f \ fixnum-bitand define-sub-primitive [ \ AND jit-math ] f f f \ fixnum-bitand define-sub-primitive
@ -333,75 +384,106 @@ big-endian off
[ \ XOR jit-math ] f f f \ fixnum-bitxor define-sub-primitive [ \ XOR jit-math ] f f f \ fixnum-bitxor define-sub-primitive
[ [
ds-reg [] NOT ! complement ! complement
ds-reg [] tag-mask get XOR ! clear tag bits ds-reg [] NOT
! clear tag bits
ds-reg [] tag-mask get XOR
] f f f \ fixnum-bitnot define-sub-primitive ] f f f \ fixnum-bitnot define-sub-primitive
[ [
shift-arg ds-reg [] MOV ! load shift count ! load shift count
shift-arg tag-bits get SAR ! untag shift count shift-arg ds-reg [] MOV
ds-reg bootstrap-cell SUB ! adjust stack pointer ! untag shift count
temp-reg ds-reg [] MOV ! load value shift-arg tag-bits get SAR
arg1 temp-reg MOV ! make a copy ! adjust stack pointer
arg1 CL SHL ! compute positive shift value in arg1 ds-reg bootstrap-cell SUB
shift-arg NEG ! compute negative shift value in arg0 ! load value
temp-reg CL SAR temp3 ds-reg [] MOV
temp-reg tag-mask get bitnot AND ! make a copy
shift-arg 0 CMP ! if shift count was negative, move arg0 to arg1 temp1 temp3 MOV
arg1 temp-reg CMOVGE ! compute positive shift value in temp1
ds-reg [] arg1 MOV ! push to stack temp1 CL SHL
shift-arg NEG
! compute negative shift value in temp3
temp3 CL SAR
temp3 tag-mask get bitnot AND
shift-arg 0 CMP
! if shift count was negative, move temp0 to temp1
temp1 temp3 CMOVGE
! push to stack
ds-reg [] temp1 MOV
] f f f \ fixnum-shift-fast define-sub-primitive ] f f f \ fixnum-shift-fast define-sub-primitive
: jit-fixnum-/mod ( -- ) : jit-fixnum-/mod ( -- )
temp-reg ds-reg [] MOV ! load second parameter ! load second parameter
div-arg ds-reg bootstrap-cell neg [+] MOV ! load first parameter temp3 ds-reg [] MOV
mod-arg div-arg MOV ! make a copy ! load first parameter
mod-arg bootstrap-cell-bits 1- SAR ! sign-extend div-arg ds-reg bootstrap-cell neg [+] MOV
temp-reg IDIV ; ! divide ! make a copy
mod-arg div-arg MOV
! sign-extend
mod-arg bootstrap-cell-bits 1- SAR
! divide
temp3 IDIV ;
[ [
jit-fixnum-/mod jit-fixnum-/mod
ds-reg bootstrap-cell SUB ! adjust stack pointer ! adjust stack pointer
ds-reg [] mod-arg MOV ! push to stack ds-reg bootstrap-cell SUB
! push to stack
ds-reg [] mod-arg MOV
] f f f \ fixnum-mod define-sub-primitive ] f f f \ fixnum-mod define-sub-primitive
[ [
jit-fixnum-/mod jit-fixnum-/mod
ds-reg bootstrap-cell SUB ! adjust stack pointer ! adjust stack pointer
div-arg tag-bits get SHL ! tag it ds-reg bootstrap-cell SUB
ds-reg [] div-arg MOV ! push to stack ! tag it
div-arg tag-bits get SHL
! push to stack
ds-reg [] div-arg MOV
] f f f \ fixnum/i-fast define-sub-primitive ] f f f \ fixnum/i-fast define-sub-primitive
[ [
jit-fixnum-/mod jit-fixnum-/mod
div-arg tag-bits get SHL ! tag it ! tag it
ds-reg [] mod-arg MOV ! push to stack div-arg tag-bits get SHL
! push to stack
ds-reg [] mod-arg MOV
ds-reg bootstrap-cell neg [+] div-arg MOV ds-reg bootstrap-cell neg [+] div-arg MOV
] f f f \ fixnum/mod-fast define-sub-primitive ] f f f \ fixnum/mod-fast define-sub-primitive
[ [
arg0 ds-reg [] MOV temp0 ds-reg [] MOV
ds-reg bootstrap-cell SUB ds-reg bootstrap-cell SUB
arg0 ds-reg [] OR temp0 ds-reg [] OR
arg0 tag-mask get AND temp0 tag-mask get AND
arg0 \ f tag-number MOV temp0 \ f tag-number MOV
arg1 1 tag-fixnum MOV temp1 1 tag-fixnum MOV
arg0 arg1 CMOVE temp0 temp1 CMOVE
ds-reg [] arg0 MOV ds-reg [] temp0 MOV
] f f f \ both-fixnums? define-sub-primitive ] f f f \ both-fixnums? define-sub-primitive
[ [
arg0 ds-reg [] MOV ! load local number ! load local number
fixnum>slot@ ! turn local number into offset temp0 ds-reg [] MOV
arg0 rs-reg arg0 [+] MOV ! load local value ! turn local number into offset
ds-reg [] arg0 MOV ! push to stack fixnum>slot@
! load local value
temp0 rs-reg temp0 [+] MOV
! push to stack
ds-reg [] temp0 MOV
] f f f \ get-local define-sub-primitive ] f f f \ get-local define-sub-primitive
[ [
arg0 ds-reg [] MOV ! load local count ! load local count
ds-reg bootstrap-cell SUB ! adjust stack pointer temp0 ds-reg [] MOV
fixnum>slot@ ! turn local number into offset ! adjust stack pointer
rs-reg arg0 SUB ! decrement retain stack pointer ds-reg bootstrap-cell SUB
! turn local number into offset
fixnum>slot@
! decrement retain stack pointer
rs-reg temp0 SUB
] f f f \ drop-locals define-sub-primitive ] f f f \ drop-locals define-sub-primitive
[ "bootstrap.x86" forget-vocab ] with-compilation-unit [ "bootstrap.x86" forget-vocab ] with-compilation-unit