- change some primitives into sub-primitives: fixnum+ fixnum- fixnum* inline-cache-miss inline-cache-miss-tail
- rename some relocation types for clarity
- some other minor re-organizations and cleanups
! Copyright (C) 2004, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: alien arrays byte-arrays generic hashtables
+USING: alien alien.strings arrays byte-arrays generic hashtables
hashtables.private io io.binary io.files io.encodings.binary
io.pathnames kernel kernel.private math namespaces make parser
prettyprint sequences strings sbufs vectors words quotations
quotations.private combinators combinators.short-circuit
math.order math.private accessors slots.private
generic.single.private compiler.units compiler.constants fry
-bootstrap.image.syntax ;
+locals bootstrap.image.syntax generalizations ;
IN: bootstrap.image
: arch ( os cpu -- arch )
SYMBOL: jit-relocations
+SYMBOL: jit-offset
+
: compute-offset ( rc -- offset )
- [ building get length ] dip rc-absolute-cell = bootstrap-cell 4 ? - ;
+ [ building get length jit-offset get + ] dip
+ rc-absolute-cell = bootstrap-cell 4 ? - ;
: jit-rel ( rc rt -- )
over compute-offset 3array jit-relocations get push-all ;
: jit-literal ( literal -- )
jit-literals get push ;
-: make-jit ( quot -- jit-parameters jit-literals jit-data )
+: jit-vm ( offset rc -- )
+ [ jit-parameter ] dip rt-vm jit-rel ;
+
+: jit-dlsym ( name library rc -- )
+ rt-dlsym jit-rel [ string>symbol jit-parameter ] bi@ ;
+
+:: jit-conditional ( test-quot false-quot -- )
+ [ 0 test-quot call ] B{ } make length :> len
+ building get length jit-offset get + len +
+ [ jit-offset set false-quot call ] B{ } make
+ [ length test-quot call ] [ % ] bi ; inline
+
+: make-jit ( quot -- jit-parameters jit-literals jit-code )
[
+ 0 jit-offset set
V{ } clone jit-parameters set
V{ } clone jit-literals set
V{ } clone jit-relocations set
: define-sub-primitive ( quot word -- )
[ make-jit 3array ] dip sub-primitives get set-at ;
+: define-sub-primitive* ( quot non-tail-quot tail-quot word -- )
+ [
+ [ make-jit ]
+ [ make-jit 2nip ]
+ [ make-jit 2nip ]
+ tri* 5 narray
+ ] dip
+ sub-primitives get set-at ;
+
! The image being constructed; a vector of word-size integers
SYMBOL: image
USERENV: jit-primitive 25
USERENV: jit-word-jump 26
USERENV: jit-word-call 27
-USERENV: jit-word-special 28
-USERENV: jit-if-word 29
-USERENV: jit-if 30
-USERENV: jit-epilog 31
-USERENV: jit-return 32
-USERENV: jit-profiling 33
-USERENV: jit-push-immediate 34
-USERENV: jit-dip-word 35
-USERENV: jit-dip 36
-USERENV: jit-2dip-word 37
-USERENV: jit-2dip 38
-USERENV: jit-3dip-word 39
-USERENV: jit-3dip 40
-USERENV: jit-execute-word 41
-USERENV: jit-execute-jump 42
-USERENV: jit-execute-call 43
-USERENV: jit-declare-word 44
-
-USERENV: callback-stub 45
+USERENV: jit-if-word 28
+USERENV: jit-if 29
+USERENV: jit-epilog 30
+USERENV: jit-return 31
+USERENV: jit-profiling 32
+USERENV: jit-push-immediate 33
+USERENV: jit-dip-word 34
+USERENV: jit-dip 35
+USERENV: jit-2dip-word 36
+USERENV: jit-2dip 37
+USERENV: jit-3dip-word 38
+USERENV: jit-3dip 39
+USERENV: jit-execute 40
+USERENV: jit-declare-word 41
+
+USERENV: callback-stub 48
! PIC stubs
-USERENV: pic-load 47
-USERENV: pic-tag 48
-USERENV: pic-tuple 49
-USERENV: pic-check-tag 50
-USERENV: pic-check-tuple 51
-USERENV: pic-hit 52
-USERENV: pic-miss-word 53
-USERENV: pic-miss-tail-word 54
+USERENV: pic-load 49
+USERENV: pic-tag 50
+USERENV: pic-tuple 51
+USERENV: pic-check-tag 52
+USERENV: pic-check-tuple 53
+USERENV: pic-hit 54
+USERENV: pic-miss-word 55
+USERENV: pic-miss-tail-word 56
! Megamorphic dispatch
USERENV: mega-lookup 57
\ dip jit-dip-word set
\ 2dip jit-2dip-word set
\ 3dip jit-3dip-word set
- \ (execute) jit-execute-word set
\ inline-cache-miss \ pic-miss-word set
\ inline-cache-miss-tail \ pic-miss-tail-word set
\ mega-cache-lookup \ mega-lookup-word set
M: stack-frame-insn compute-stack-frame*
stack-frame>> request-stack-frame ;
-M: ##call compute-stack-frame*
- word>> sub-primitive>> [ frame-required? on ] unless ;
+M: ##call compute-stack-frame* drop frame-required? on ;
M: ##gc compute-stack-frame*
frame-required? on
! Special cases
M: ##no-tco generate-insn drop ;
-M: ##call generate-insn
- word>> dup sub-primitive>>
- [ third first % ] [ [ add-call ] [ %call ] bi ] ?if ;
+M: ##call generate-insn word>> [ add-call ] [ %call ] bi ;
M: ##jump generate-insn word>> [ add-call ] [ %jump ] bi ;
[ def>> first add-parameter ] dip rt-primitive rel-fixup ;
: rel-immediate ( literal class -- )
- [ add-literal ] dip rt-immediate rel-fixup ;
+ [ add-literal ] dip rt-literal rel-fixup ;
: rel-this ( class -- )
rt-this rel-fixup ;
CONSTANT: rt-xt-pic-tail 5
CONSTANT: rt-here 6
CONSTANT: rt-this 7
-CONSTANT: rt-immediate 8
-CONSTANT: rt-stack-chain 9
+CONSTANT: rt-literal 8
+CONSTANT: rt-context 9
CONSTANT: rt-untagged 10
CONSTANT: rt-megamorphic-cache-hits 11
CONSTANT: rt-vm 12
-! Copyright (C) 2007, 2008 Slava Pestov.\r
+! Copyright (C) 2007, 2009 Slava Pestov.\r
! See http://factorcode.org/license.txt for BSD license.\r
USING: bootstrap.image.private kernel kernel.private namespaces\r
system cpu.ppc.assembler compiler.codegen.fixup compiler.units\r
-compiler.constants math math.private layouts words\r
-vocabs slots.private locals.backend ;\r
+compiler.constants math math.private layouts words vocabs\r
+slots.private locals locals.backend generic.single.private fry ;\r
FROM: cpu.ppc.assembler => B ;\r
IN: bootstrap.ppc\r
\r
: next-save ( -- n ) stack-frame bootstrap-cell - ;\r
: xt-save ( -- n ) stack-frame 2 bootstrap-cells - ;\r
\r
+: jit-conditional* ( test-quot true-quot -- )\r
+ [ '[ bootstrap-cell /i 1 + @ ] ] dip jit-conditional ; inline\r
+\r
+: jit-save-context ( -- )\r
+ 0 3 LOAD32 rc-absolute-ppc-2/2 rt-context jit-rel\r
+ 4 3 0 LWZ\r
+ 1 4 0 STW ;\r
+\r
[\r
- 0 3 LOAD32 rc-absolute-ppc-2/2 rt-immediate jit-rel\r
+ 0 3 LOAD32 rc-absolute-ppc-2/2 rt-literal jit-rel\r
11 3 profile-count-offset LWZ\r
11 11 1 tag-fixnum ADDI\r
11 3 profile-count-offset STW\r
] jit-prolog jit-define\r
\r
[\r
- 0 3 LOAD32 rc-absolute-ppc-2/2 rt-immediate jit-rel\r
+ 0 3 LOAD32 rc-absolute-ppc-2/2 rt-literal jit-rel\r
3 ds-reg 4 STWU\r
] jit-push-immediate jit-define\r
\r
[\r
- 0 3 LOAD32 rc-absolute-ppc-2/2 rt-stack-chain jit-rel\r
- 4 3 0 LWZ\r
- 1 4 0 STW\r
+ jit-save-context\r
4 0 swap LOAD32 rc-absolute-ppc-2/2 rt-vm jit-rel\r
0 5 LOAD32 rc-absolute-ppc-2/2 rt-primitive jit-rel\r
5 MTCTR\r
0 B rc-relative-ppc-3 rt-xt-pic-tail jit-rel\r
] jit-word-jump jit-define\r
\r
-[ 0 B rc-relative-ppc-3 rt-xt jit-rel ] jit-word-special jit-define\r
-\r
[\r
3 ds-reg 0 LWZ\r
ds-reg dup 4 SUBI\r
0 3 \ f type-number CMPI\r
- 2 BEQ\r
- 0 B rc-relative-ppc-3 rt-xt jit-rel\r
+ [ BEQ ] [ 0 B rc-relative-ppc-3 rt-xt jit-rel ] jit-conditional*\r
0 B rc-relative-ppc-3 rt-xt jit-rel\r
] jit-if jit-define\r
\r
jit-3r>\r
] jit-3dip jit-define\r
\r
-: prepare-(execute) ( -- operand )\r
- 3 ds-reg 0 LWZ\r
- ds-reg dup 4 SUBI\r
- 4 3 word-xt-offset LWZ\r
- 4 ;\r
-\r
-[ prepare-(execute) MTCTR BCTR ] jit-execute-jump jit-define\r
-\r
-[ prepare-(execute) MTLR BLRL ] jit-execute-call jit-define\r
-\r
[\r
0 1 lr-save stack-frame + LWZ\r
1 1 stack-frame ADDI\r
3 4 MR\r
load-tag\r
0 4 tuple type-number tag-fixnum CMPI\r
- 2 BNE\r
- 4 3 tuple type-number neg bootstrap-cell + LWZ\r
+ [ BNE ]\r
+ [ 4 3 tuple type-number neg bootstrap-cell + LWZ ]\r
+ jit-conditional*\r
] pic-tuple jit-define\r
\r
[\r
- 0 4 0 CMPI rc-absolute-ppc-2 rt-immediate jit-rel\r
+ 0 4 0 CMPI rc-absolute-ppc-2 rt-literal jit-rel\r
] pic-check-tag jit-define\r
\r
[\r
- 0 5 LOAD32 rc-absolute-ppc-2/2 rt-immediate jit-rel\r
+ 0 5 LOAD32 rc-absolute-ppc-2/2 rt-literal jit-rel\r
4 0 5 CMP\r
] pic-check-tuple jit-define\r
\r
-[ 2 BNE 0 B rc-relative-ppc-3 rt-xt jit-rel ] pic-hit jit-define\r
+[\r
+ [ BNE ] [ 0 B rc-relative-ppc-3 rt-xt jit-rel ] jit-conditional*\r
+] pic-hit jit-define\r
\r
! ! ! Megamorphic caches\r
\r
[\r
! cache = ...\r
- 0 3 LOAD32 rc-absolute-ppc-2/2 rt-immediate jit-rel\r
+ 0 3 LOAD32 rc-absolute-ppc-2/2 rt-literal jit-rel\r
! key = hashcode(class)\r
5 4 1 SRAWI\r
! key &= cache.length - 1\r
! if(get(cache) == class)\r
6 3 0 LWZ\r
6 0 4 CMP\r
- 10 BNE\r
- ! megamorphic_cache_hits++\r
- 0 4 LOAD32 rc-absolute-ppc-2/2 rt-megamorphic-cache-hits jit-rel\r
- 5 4 0 LWZ\r
- 5 5 1 ADDI\r
- 5 4 0 STW\r
- ! ... goto get(cache + bootstrap-cell)\r
- 3 3 4 LWZ\r
- 3 3 word-xt-offset LWZ\r
- 3 MTCTR\r
- BCTR\r
+ [ BNE ]\r
+ [\r
+ ! megamorphic_cache_hits++\r
+ 0 4 LOAD32 rc-absolute-ppc-2/2 rt-megamorphic-cache-hits jit-rel\r
+ 5 4 0 LWZ\r
+ 5 5 1 ADDI\r
+ 5 4 0 STW\r
+ ! ... goto get(cache + bootstrap-cell)\r
+ 3 3 4 LWZ\r
+ 3 3 word-xt-offset LWZ\r
+ 3 MTCTR\r
+ BCTR\r
+ ]\r
+ jit-conditional*\r
! fall-through on miss\r
] mega-lookup jit-define\r
\r
ds-reg dup 4 SUBI\r
4 0 swap LOAD32 0 jit-parameter rc-absolute-ppc-2/2 rt-vm jit-rel\r
5 3 quot-xt-offset LWZ\r
- 5 MTCTR\r
- BCTR\r
-] \ (call) define-sub-primitive\r
+]\r
+[ 5 MTLR BLRL ]\r
+[ 5 MTCTR BCTR ] \ (call) define-sub-primitive*\r
+\r
+[\r
+ 3 ds-reg 0 LWZ\r
+ ds-reg dup 4 SUBI\r
+ 4 3 word-xt-offset LWZ\r
+]\r
+[ 4 MTLR BLRL ]\r
+[ 4 MTCTR BCTR ] \ (execute) define-sub-primitive*\r
+\r
+[\r
+ 3 ds-reg 0 LWZ\r
+ ds-reg dup 4 SUBI\r
+ 4 3 word-xt-offset LWZ\r
+ 4 MTCTR BCTR\r
+] jit-execute jit-define\r
\r
! Objects\r
[\r
! Comparisons\r
: jit-compare ( insn -- )\r
t jit-literal\r
- 0 3 LOAD32 rc-absolute-ppc-2/2 rt-immediate jit-rel\r
+ 0 3 LOAD32 rc-absolute-ppc-2/2 rt-literal jit-rel\r
4 ds-reg 0 LWZ\r
5 ds-reg -4 LWZU\r
5 0 4 CMP\r
3 3 tag-mask get ANDI\r
\ f type-number 4 LI\r
0 3 0 CMPI\r
- 2 BNE\r
- 1 tag-fixnum 4 LI\r
+ [ BNE ] [ 1 tag-fixnum 4 LI ] jit-conditional*\r
4 ds-reg 0 STW\r
] \ both-fixnums? define-sub-primitive\r
\r
7 4 6 SRAW\r
7 7 0 0 31 tag-bits get - RLWINM\r
0 3 0 CMPI\r
- 2 BGT\r
- 5 7 MR\r
+ [ BGT ] [ 5 7 MR ] jit-conditional*\r
5 ds-reg 0 STW\r
] \ fixnum-shift-fast define-sub-primitive\r
\r
rs-reg 3 rs-reg SUBF\r
] \ drop-locals define-sub-primitive\r
\r
+! Inline cache miss entry points\r
+: jit-load-return-address ( -- ) 6 MFLR ;\r
+\r
+! These are always in tail position with an existing stack\r
+! frame, and the stack. The frame setup takes this into account.\r
+: jit-inline-cache-miss ( -- )\r
+ jit-save-context\r
+ 3 6 MR\r
+ 4 0 LOAD32 0 rc-absolute-ppc-2/2 jit-vm\r
+ 5 0 LOAD32 "inline_cache_miss" f rc-absolute-ppc-2/2 jit-dlsym ;\r
+\r
+[ jit-load-return-address jit-inline-cache-miss ]\r
+[ 5 MTLR BLRL ]\r
+[ 5 MTCTR BCTR ]\r
+\ inline-cache-miss define-sub-primitive*\r
+\r
+[ jit-inline-cache-miss ]\r
+[ 5 MTLR BLRL ]\r
+[ 5 MTCTR BCTR ]\r
+\ inline-cache-miss-tail define-sub-primitive*\r
+\r
+! Overflowing fixnum arithmetic\r
+:: jit-overflow ( insn func -- )\r
+ jit-save-context\r
+ 3 ds-reg 0 LWZ\r
+ 4 ds-reg -4 LWZ\r
+ ds-reg ds-reg 4 SUBI\r
+ 0 0 LI\r
+ 0 MTXER\r
+ 6 3 4 insn call( d a s -- )\r
+ 6 ds-reg 0 STW\r
+ [ BNO ]\r
+ [\r
+ 0 5 LOAD32 0 rc-absolute-ppc-2/2 jit-vm\r
+ 0 6 LOAD32 func f rc-absolute-ppc-2/2 jit-dlsym\r
+ ]\r
+ jit-conditional ;\r
+\r
+[ [ ADDO. ] "overflow_fixnum_add" jit-overflow ] \ fixnum+ define-sub-primitive\r
+\r
+[ [ SUBFO. ] "overflow_fixnum_subtract" jit-overflow ] \ fixnum- define-sub-primitive\r
+\r
+[\r
+ jit-save-context\r
+ 3 ds-reg 0 LWZ\r
+ 3 3 tag-bits get SRAWI\r
+ 4 ds-reg -4 LWZ\r
+ ds-reg ds-reg 4 SUBI\r
+ 0 0 LI\r
+ 0 MTXER\r
+ 6 3 4 MULLWO.\r
+ 6 ds-reg 0 STW\r
+ [ BNO ]\r
+ [\r
+ 4 4 tag-bits get SRAWI\r
+ 0 5 LOAD32 0 rc-absolute-ppc-2/2 jit-vm\r
+ 0 6 LOAD32 "overflow_fixnum_multiply" f rc-absolute-ppc-2/2 jit-dlsym\r
+ 6 MTLR\r
+ BLRL\r
+ ]\r
+ jit-conditional\r
+] \ fixnum* define-sub-primitive\r
+\r
[ "bootstrap.ppc" forget-vocab ] with-compilation-unit\r
! See http://factorcode.org/license.txt for BSD license.
USING: bootstrap.image.private kernel namespaces system
cpu.x86.assembler cpu.x86.assembler.operands layouts
-vocabs parser compiler.constants sequences ;
+vocabs parser compiler.constants sequences math math.private
+generic.single.private ;
IN: bootstrap.x86
4 \ cell set
-: stack-frame-size ( -- n ) 4 bootstrap-cells ;
+: stack-frame-size ( -- n ) 8 bootstrap-cells ;
: shift-arg ( -- reg ) ECX ;
: div-arg ( -- reg ) EAX ;
: mod-arg ( -- reg ) EDX ;
: rex-length ( -- n ) 0 ;
[
- ! load stack_chain
- temp0 0 [] MOV rc-absolute-cell rt-stack-chain jit-rel
+ ! save stack frame size
+ stack-frame-size PUSH
+ ! push XT
+ 0 PUSH rc-absolute-cell rt-this jit-rel
+ ! alignment
+ ESP stack-frame-size 3 bootstrap-cells - SUB
+] jit-prolog jit-define
+
+: jit-save-context ( -- )
+ EAX 0 [] MOV rc-absolute-cell rt-context jit-rel
! save stack pointer
- temp0 [] stack-reg MOV
+ ECX ESP -4 [+] LEA
+ EAX [] ECX MOV ;
+
+[
+ jit-save-context
! pass vm ptr to primitive
- arg1 0 MOV rc-absolute-cell rt-vm jit-rel
+ EAX 0 MOV rc-absolute-cell rt-vm jit-rel
! call the primitive
- 0 JMP rc-relative rt-primitive jit-rel
+ 0 CALL rc-relative rt-primitive jit-rel
] jit-primitive jit-define
+! Inline cache miss entry points
+: jit-load-return-address ( -- )
+ EBX ESP stack-frame-size bootstrap-cell - [+] MOV ;
+
+! These are always in tail position with an existing stack
+! frame, and the stack. The frame setup takes this into account.
+: jit-inline-cache-miss ( -- )
+ jit-save-context
+ ESP 4 [+] 0 MOV 0 rc-absolute-cell jit-vm
+ ESP [] EBX MOV
+ 0 CALL "inline_cache_miss" f rc-relative jit-dlsym ;
+
+[ jit-load-return-address jit-inline-cache-miss ]
+[ EAX CALL ]
+[ EAX JMP ]
+\ inline-cache-miss define-sub-primitive*
+
+[ jit-inline-cache-miss ]
+[ EAX CALL ]
+[ EAX JMP ]
+\ inline-cache-miss-tail define-sub-primitive*
+
+! Overflowing fixnum arithmetic
+: jit-overflow ( insn func -- )
+ jit-save-context
+ EAX ds-reg -4 [+] MOV
+ EDX ds-reg [] MOV
+ ds-reg 4 SUB
+ ECX EAX MOV
+ [ [ ECX EDX ] dip call( dst src -- ) ] dip
+ ds-reg [] ECX MOV
+ [ JNO ]
+ [
+ ECX 0 MOV 0 rc-absolute-cell jit-vm
+ [ 0 CALL ] dip f rc-relative jit-dlsym
+ ]
+ jit-conditional ;
+
+[ [ ADD ] "overflow_fixnum_add" jit-overflow ] \ fixnum+ define-sub-primitive
+
+[ [ SUB ] "overflow_fixnum_subtract" jit-overflow ] \ fixnum- define-sub-primitive
+
+[
+ jit-save-context
+ ECX ds-reg -4 [+] MOV
+ EBX ds-reg [] MOV
+ EBX tag-bits get SAR
+ ds-reg 4 SUB
+ EAX ECX MOV
+ EBX IMUL
+ ds-reg [] EAX MOV
+ [ JNO ]
+ [
+ EAX ECX MOV
+ EAX tag-bits get SAR
+ EDX EBX MOV
+ ECX 0 MOV 0 rc-absolute-cell jit-vm
+ 0 CALL "overflow_fixnum_multiply" f rc-relative jit-dlsym
+ ]
+ jit-conditional
+] \ fixnum* define-sub-primitive
+
<< "vocab:cpu/x86/bootstrap.factor" parse-file suffix! >>
call
! Copyright (C) 2007, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: bootstrap.image.private kernel namespaces system
-layouts vocabs parser compiler.constants math
-cpu.x86.assembler cpu.x86.assembler.operands sequences ;
+layouts vocabs parser compiler.constants math math.private
+cpu.x86.assembler cpu.x86.assembler.operands sequences
+generic.single.private ;
IN: bootstrap.x86
8 \ cell set
: rex-length ( -- n ) 1 ;
[
- ! load stack_chain
- temp0 0 MOV rc-absolute-cell rt-stack-chain jit-rel
+ ! load XT
+ RDI 0 MOV rc-absolute-cell rt-this jit-rel
+ ! save stack frame size
+ stack-frame-size PUSH
+ ! push XT
+ RDI PUSH
+ ! alignment
+ RSP stack-frame-size 3 bootstrap-cells - SUB
+] jit-prolog jit-define
+
+: jit-save-context ( -- )
+ temp0 0 MOV rc-absolute-cell rt-context jit-rel
temp0 temp0 [] MOV
! save stack pointer
- temp0 [] stack-reg MOV
+ temp1 stack-reg bootstrap-cell neg [+] LEA
+ temp0 [] temp1 MOV ;
+
+[
+ jit-save-context
! load vm ptr
arg1 0 MOV rc-absolute-cell rt-vm jit-rel
! load XT
temp1 0 MOV rc-absolute-cell rt-primitive jit-rel
! go
- temp1 JMP
+ temp1 CALL
] jit-primitive jit-define
+! Inline cache miss entry points
+: jit-load-return-address ( -- )
+ RBX RSP stack-frame-size bootstrap-cell - [+] MOV ;
+
+! These are always in tail position with an existing stack
+! frame, and the stack. The frame setup takes this into account.
+: jit-inline-cache-miss ( -- )
+ jit-save-context
+ arg1 RBX MOV
+ arg2 0 MOV 0 rc-absolute-cell jit-vm
+ 0 CALL "inline_cache_miss" f rc-relative jit-dlsym ;
+
+[ jit-load-return-address jit-inline-cache-miss ]
+[ RAX CALL ]
+[ RAX JMP ]
+\ inline-cache-miss define-sub-primitive*
+
+[ jit-inline-cache-miss ]
+[ RAX CALL ]
+[ RAX JMP ]
+\ inline-cache-miss-tail define-sub-primitive*
+
+! Overflowing fixnum arithmetic
+: jit-overflow ( insn func -- )
+ jit-save-context
+ arg1 ds-reg bootstrap-cell neg [+] MOV
+ arg2 ds-reg [] MOV
+ ds-reg bootstrap-cell SUB
+ arg3 arg1 MOV
+ [ [ arg3 arg2 ] dip call ] dip
+ ds-reg [] arg3 MOV
+ [ JNO ]
+ [
+ arg3 0 MOV 0 rc-absolute-cell jit-vm
+ [ 0 CALL ] dip f rc-relative jit-dlsym
+ ]
+ jit-conditional ; inline
+
+[ [ ADD ] "overflow_fixnum_add" jit-overflow ] \ fixnum+ define-sub-primitive
+
+[ [ SUB ] "overflow_fixnum_subtract" jit-overflow ] \ fixnum- define-sub-primitive
+
+[
+ jit-save-context
+ RCX ds-reg bootstrap-cell neg [+] MOV
+ RBX ds-reg [] MOV
+ RBX tag-bits get SAR
+ ds-reg bootstrap-cell SUB
+ RAX RCX MOV
+ RBX IMUL
+ ds-reg [] RAX MOV
+ [ JNO ]
+ [
+ arg1 RCX MOV
+ arg1 tag-bits get SAR
+ arg2 RBX MOV
+ arg3 0 MOV 0 rc-absolute-cell jit-vm
+ 0 CALL "overflow_fixnum_multiply" f rc-relative jit-dlsym
+ ]
+ jit-conditional
+] \ fixnum* define-sub-primitive
+
<< "vocab:cpu/x86/bootstrap.factor" parse-file suffix! >>
call
: stack-frame-size ( -- n ) 4 bootstrap-cells ;
: arg1 ( -- reg ) RDI ;
: arg2 ( -- reg ) RSI ;
+: arg3 ( -- reg ) RDX ;
<< "vocab:cpu/x86/64/bootstrap.factor" parse-file suffix! >>
call
: stack-frame-size ( -- n ) 8 bootstrap-cells ;
: arg1 ( -- reg ) RCX ;
: arg2 ( -- reg ) RDX ;
+: arg3 ( -- reg ) R8 ;
<< "vocab:cpu/x86/64/bootstrap.factor" parse-file suffix! >>
call
[
! Load word
- temp0 0 MOV rc-absolute-cell rt-immediate jit-rel
+ temp0 0 MOV rc-absolute-cell rt-literal jit-rel
! Bump profiling counter
temp0 profile-count-offset [+] 1 tag-fixnum ADD
! Load word->code
temp0 JMP
] jit-profiling jit-define
-[
- ! load XT
- 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
-] jit-prolog jit-define
-
[
! load literal
- temp0 0 MOV rc-absolute-cell rt-immediate jit-rel
+ temp0 0 MOV rc-absolute-cell rt-literal jit-rel
! increment datastack pointer
ds-reg bootstrap-cell ADD
! store literal on datastack
0 CALL rc-relative rt-xt-pic jit-rel
] jit-word-call jit-define
-[
- 0 JMP rc-relative rt-xt jit-rel
-] jit-word-special jit-define
-
[
! load boolean
temp0 ds-reg [] MOV
jit-3r>
] jit-3dip jit-define
-: prepare-(execute) ( -- operand )
+[
! load from stack
- temp0 ds-reg [] MOV
+ arg1 ds-reg [] MOV
! pop stack
ds-reg bootstrap-cell SUB
- ! execute word
- temp0 word-xt-offset [+] ;
+ ! pass vm pointer
+ arg2 0 MOV 0 rc-absolute-cell jit-vm
+]
+[ arg1 quot-xt-offset [+] CALL ]
+[ arg1 quot-xt-offset [+] JMP ]
+\ (call) define-sub-primitive*
-[ prepare-(execute) JMP ] jit-execute-jump jit-define
+[
+ ! load from stack
+ arg1 ds-reg [] MOV
+ ! pop stack
+ ds-reg bootstrap-cell SUB
+]
+[ arg1 word-xt-offset [+] CALL ]
+[ arg1 word-xt-offset [+] JMP ]
+\ (execute) define-sub-primitive*
-[ prepare-(execute) CALL ] jit-execute-call jit-define
+[
+ arg1 ds-reg [] MOV
+ ds-reg bootstrap-cell SUB
+ arg1 word-xt-offset [+] JMP
+] jit-execute jit-define
[
- ! unwind stack frame
stack-reg stack-frame-size bootstrap-cell - ADD
] jit-epilog jit-define
temp0 temp1 MOV
load-tag
temp1 tuple type-number tag-fixnum CMP
- [ temp1 temp0 tuple type-number neg bootstrap-cell + [+] MOV ] { } make
- [ length JNE ] [ % ] bi
+ [ JNE ]
+ [ temp1 temp0 tuple type-number neg bootstrap-cell + [+] MOV ]
+ jit-conditional
] pic-tuple jit-define
[
- temp1 HEX: ffffffff CMP rc-absolute rt-immediate jit-rel
+ temp1 HEX: ffffffff CMP rc-absolute rt-literal jit-rel
] pic-check-tag jit-define
[
- temp2 HEX: ffffffff MOV rc-absolute-cell rt-immediate jit-rel
+ temp2 HEX: ffffffff MOV rc-absolute-cell rt-literal jit-rel
temp1 temp2 CMP
] pic-check-tuple jit-define
[
! cache = ...
- temp0 0 MOV rc-absolute-cell rt-immediate jit-rel
+ temp0 0 MOV rc-absolute-cell rt-literal jit-rel
! key = hashcode(class)
temp2 temp1 MOV
bootstrap-cell 4 = [ temp2 1 SHR ] when
! ! ! Sub-primitives
-! Quotations and words
-[
- ! load from stack
- arg1 ds-reg [] MOV
- ! pop stack
- ds-reg bootstrap-cell SUB
- ! pass vm pointer
- arg2 0 MOV 0 jit-parameter rc-absolute-cell rt-vm jit-rel
- ! call quotation
- arg1 quot-xt-offset [+] JMP
-] \ (call) define-sub-primitive
-
! Objects
[
! load from stack
: jit-compare ( insn -- )
! load t
t jit-literal
- temp3 0 MOV rc-absolute-cell rt-immediate jit-rel
+ temp3 0 MOV rc-absolute-cell rt-literal jit-rel
! load f
temp1 \ f type-number MOV
! load first value
{ "fixnum-shift-fast" "math.private" (( x y -- z )) }
{ "fixnum/i-fast" "math.private" (( x y -- z )) }
{ "fixnum/mod-fast" "math.private" (( x y -- z w )) }
+ { "fixnum+" "math.private" (( x y -- z )) }
+ { "fixnum-" "math.private" (( x y -- z )) }
+ { "fixnum*" "math.private" (( x y -- z )) }
{ "fixnum<" "math.private" (( x y -- ? )) }
{ "fixnum<=" "math.private" (( x y -- z )) }
{ "fixnum>" "math.private" (( x y -- ? )) }
{ "load-local" "locals.backend" (( obj -- )) }
{ "drop-locals" "locals.backend" (( n -- )) }
{ "mega-cache-lookup" "generic.single.private" (( methods index cache -- )) }
+ { "inline-cache-miss" "generic.single.private" (( generic methods index cache -- )) }
+ { "inline-cache-miss-tail" "generic.single.private" (( generic methods index cache -- )) }
} [ first3 make-sub-primitive ] each
! Primitive words
{ "double>bits" "math" (( x -- n )) }
{ "bits>float" "math" (( n -- x )) }
{ "bits>double" "math" (( n -- x )) }
- { "fixnum+" "math.private" (( x y -- z )) }
- { "fixnum-" "math.private" (( x y -- z )) }
- { "fixnum*" "math.private" (( x y -- z )) }
{ "fixnum/i" "math.private" (( x y -- z )) }
{ "fixnum/mod" "math.private" (( x y -- z w )) }
{ "fixnum-shift" "math.private" (( x y -- z )) }
{ "jit-compile" "quotations" (( quot -- )) }
{ "load-locals" "locals.backend" (( ... n -- )) }
{ "check-datastack" "kernel.private" (( array in# out# -- ? )) }
- { "inline-cache-miss" "generic.single.private" (( generic methods index cache -- )) }
- { "inline-cache-miss-tail" "generic.single.private" (( generic methods index cache -- )) }
{ "mega-cache-miss" "generic.single.private" (( methods index cache -- method )) }
{ "lookup-method" "generic.single.private" (( object methods -- method )) }
{ "reset-dispatch-stats" "tools.dispatch.private" (( -- )) }
! Incremented each time stack effects potentially changed, used
! by compiler.tree.propagation.call-effect for call( and execute(
! inline caching
-: effect-counter ( -- n ) 46 getenv ; inline
+: effect-counter ( -- n ) 47 getenv ; inline
GENERIC: bump-effect-counter* ( defspec -- ? )
or ;
: bump-effect-counter ( -- )
- bump-effect-counter? [ 46 getenv 0 or 1 + 46 setenv ] when ;
+ bump-effect-counter? [ 47 getenv 0 or 1 + 47 setenv ] when ;
: notify-observers ( -- )
updated-definitions dup assoc-empty?
return frame + 1;
}
-/* We ignore the topmost frame, the one calling 'callstack',
+/* We ignore the two topmost frames, the 'callstack' primitive
+frame itself, and the frame calling the 'callstack' primitive,
so that set-callstack doesn't get stuck in an infinite loop.
This means that if 'callstack' is called in tail position, we
will have popped a necessary frame... however this word is only
called by continuation implementation, and user code shouldn't
be calling it at all, so we leave it as it is for now. */
-stack_frame *factor_vm::capture_start()
+stack_frame *factor_vm::second_from_top_stack_frame()
{
stack_frame *frame = ctx->callstack_bottom - 1;
- while(frame >= ctx->callstack_top && frame_successor(frame) >= ctx->callstack_top)
+ while(frame >= ctx->callstack_top
+ && frame_successor(frame) >= ctx->callstack_top
+ && frame_successor(frame_successor(frame)) >= ctx->callstack_top)
+ {
frame = frame_successor(frame);
+ }
return frame + 1;
}
void factor_vm::primitive_callstack()
{
- stack_frame *top = capture_start();
+ stack_frame *top = second_from_top_stack_frame();
stack_frame *bottom = ctx->callstack_bottom;
- fixnum size = (cell)bottom - (cell)top;
- if(size < 0)
- size = 0;
+ fixnum size = std::max((fixnum)0,(fixnum)bottom - (fixnum)top);
callstack *stack = allot_callstack(size);
memcpy(stack->top(),top,size);
return sizeof(callstack) + size;
}
-VM_ASM_API void save_callstack_bottom(stack_frame *callstack_bottom, factor_vm *vm);
+VM_ASM_API void save_callstack_bottom(stack_frame *callstack_bottom, factor_vm *parent);
/* This is a little tricky. The iterator may allocate memory, so we
keep the callstack in a GC root and use relative offsets */
template<typename Iterator> void factor_vm::iterate_callstack(context *ctx, Iterator &iterator)
{
- cell top = (cell)ctx->callstack_top;
- cell bottom = (cell)ctx->callstack_bottom;
+ stack_frame *frame = ctx->callstack_bottom - 1;
- stack_frame *frame = (stack_frame *)bottom - 1;
-
- while((cell)frame >= top)
+ while(frame >= ctx->callstack_top)
{
iterator(frame);
frame = frame_successor(frame);
{
switch(op.rel_type())
{
- case RT_IMMEDIATE:
+ case RT_LITERAL:
op.store_value(next_literal());
break;
case RT_XT:
switch(op.rel_type())
{
- case RT_IMMEDIATE:
+ case RT_LITERAL:
op.store_value(slot_forwarder.visit_pointer(op.load_value(old_offset)));
break;
case RT_XT:
#define DS_REG r13
-DEF(void,primitive_fixnum_add,(void *vm)):
- mr r5,r3 /* save vm ptr for overflow */
- lwz r3,0(DS_REG)
- lwz r4,-4(DS_REG)
- subi DS_REG,DS_REG,4
- li r0,0
- mtxer r0
- addo. r6,r3,r4
- bso add_overflow
- stw r6,0(DS_REG)
- blr
-add_overflow:
- b MANGLE(overflow_fixnum_add)
-
-DEF(void,primitive_fixnum_subtract,(void *vm)):
- mr r5,r3 /* save vm ptr for overflow */
- lwz r3,-4(DS_REG)
- lwz r4,0(DS_REG)
- subi DS_REG,DS_REG,4
- li r0,0
- mtxer r0
- subfo. r6,r4,r3
- bso sub_overflow
- stw r6,0(DS_REG)
- blr
-sub_overflow:
- b MANGLE(overflow_fixnum_subtract)
-
-DEF(void,primitive_fixnum_multiply,(void *vm)):
- mr r5,r3 /* save vm ptr for overflow */
- lwz r3,0(DS_REG)
- lwz r4,-4(DS_REG)
- subi DS_REG,DS_REG,4
- srawi r3,r3,4
- mullwo. r6,r3,r4
- bso multiply_overflow
- stw r6,0(DS_REG)
- blr
-multiply_overflow:
- srawi r4,r4,4
- b MANGLE(overflow_fixnum_multiply)
-
-/* Note that the XT is passed to the quotation in r11 */
#define CALL_OR_JUMP_QUOT \
lwz r11,12(r3) /* load quotation-xt slot */ XX \
SAVE_FP(f30,52)
SAVE_FP(f31,54)
- SAVE_V(v20,56)
- SAVE_V(v21,60)
- SAVE_V(v22,64)
- SAVE_V(v23,68)
- SAVE_V(v24,72)
- SAVE_V(v25,76)
- SAVE_V(v26,80)
- SAVE_V(v27,84)
- SAVE_V(v28,88)
- SAVE_V(v29,92)
- SAVE_V(v30,96)
- SAVE_V(v31,100)
+ SAVE_V(v20,56)
+ SAVE_V(v21,60)
+ SAVE_V(v22,64)
+ SAVE_V(v23,68)
+ SAVE_V(v24,72)
+ SAVE_V(v25,76)
+ SAVE_V(v26,80)
+ SAVE_V(v27,84)
+ SAVE_V(v28,88)
+ SAVE_V(v29,92)
+ SAVE_V(v30,96)
+ SAVE_V(v31,100)
/* r4 vm ptr preserved */
- mfvscr v0
- li r2,SAVE_AT(104)
- stvxl v0,r2,r1
- addi r2,r2,0xc
- lwzx r5,r2,r1
- lis r6,0x1
- andc r5,r5,r6
- stwx r5,r2,r1
- subi r2,r2,0xc
- lvxl v0,r2,r1
- mtvscr v0
-
- /* save args in non-volatile regs */
- mr r15,r3
- mr r16,r4
+ mfvscr v0
+ li r2,SAVE_AT(104)
+ stvxl v0,r2,r1
+ addi r2,r2,0xc
+ lwzx r5,r2,r1
+ lis r6,0x1
+ andc r5,r5,r6
+ stwx r5,r2,r1
+ subi r2,r2,0xc
+ lvxl v0,r2,r1
+ mtvscr v0
+
+ /* save args in non-volatile regs */
+ mr r15,r3
+ mr r16,r4
/* pass call stack pointer as an argument */
mr r3,r1
mr r4,r16
CALL_QUOT
- RESTORE_V(v0,104)
- mtvscr v0
-
- RESTORE_V(v31,100)
- RESTORE_V(v30,96)
- RESTORE_V(v29,92)
- RESTORE_V(v28,88)
- RESTORE_V(v27,84)
- RESTORE_V(v26,80)
- RESTORE_V(v25,76)
- RESTORE_V(v24,72)
- RESTORE_V(v23,68)
- RESTORE_V(v22,64)
- RESTORE_V(v21,60)
- RESTORE_V(v20,56)
-
- /* Restore FPRs */
+ RESTORE_V(v0,104)
+ mtvscr v0
+
+ RESTORE_V(v31,100)
+ RESTORE_V(v30,96)
+ RESTORE_V(v29,92)
+ RESTORE_V(v28,88)
+ RESTORE_V(v27,84)
+ RESTORE_V(v26,80)
+ RESTORE_V(v25,76)
+ RESTORE_V(v24,72)
+ RESTORE_V(v23,68)
+ RESTORE_V(v22,64)
+ RESTORE_V(v21,60)
+ RESTORE_V(v20,56)
+
+ /* Restore FPRs */
RESTORE_FP(f31,54)
RESTORE_FP(f30,52)
RESTORE_FP(f29,50)
isync
blr
-DEF(void,primitive_inline_cache_miss,(void *vm)):
- mflr r6
-DEF(void,primitive_inline_cache_miss_tail,(void *vm)):
- PROLOGUE
- mr r4,r3 /* vm ptr in 2nd arg */
- mr r3,r6
- bl MANGLE(inline_cache_miss)
- EPILOGUE
- mtctr r3
- bctr
-
DEF(void,get_ppc_fpu_env,(void*)):
mffs f0
stfd f0,0(r3)
lvxl v0,0,r4
mtvscr v0
blr
-
#define NV0 %ebx
#define NV1 %ebp
-#define ARITH_TEMP_1 %ebp
-#define ARITH_TEMP_2 %ebx
-#define DIV_RESULT %eax
-
#define CELL_SIZE 4
#define STACK_PADDING 12
add $12,%esp /* pop args from the stack */
ret /* return _with new stack_ */
+DEF(F_FASTCALL void,throw_impl,(CELL quot, F_STACK_FRAME *rewind_to, void *vm)):
+ mov ARG2,NV0 /* remember vm ptr in case quot_xt = lazy_jit_compile */
+ /* clear x87 stack, but preserve rounding mode and exception flags */
+ sub $2,STACK_REG
+ fnstcw (STACK_REG)
+ fninit
+ fldcw (STACK_REG)
+ /* rewind_to */
+ mov ARG1,STACK_REG
+ mov NV0,ARG1
+ jmp *QUOT_XT_OFFSET(ARG0)
+
+DEF(F_FASTCALL void,lazy_jit_compile,(CELL quot, void *vm)):
+ mov ARG1,ARG2
+ mov STACK_REG,ARG1 /* Save stack pointer */
+ sub $STACK_PADDING,STACK_REG
+ call MANGLE(lazy_jit_compile_impl)
+ mov RETURN_REG,ARG0 /* No-op on 32-bit */
+ add $STACK_PADDING,STACK_REG
+ jmp *QUOT_XT_OFFSET(ARG0) /* Call the quotation */
+
+
DEF(long long,read_timestamp_counter,(void)):
rdtsc
ret
-DEF(void,primitive_inline_cache_miss,(void *vm)):
- mov (%esp),%ebx
-DEF(void,primitive_inline_cache_miss_tail,(void *vm)):
- sub $4,%esp
- push ARG0 /* push vm ptr */
- push %ebx
- call MANGLE(inline_cache_miss)
- add $12,%esp
- jmp *%eax
-
DEF(void,get_sse_env,(void*)):
movl 4(%esp), %eax
stmxcsr (%eax)
fldcw 2(%eax)
ret
-DEF(F_FASTCALL void,throw_impl,(CELL quot, F_STACK_FRAME *rewind_to, void *vm)):
- mov ARG2,NV0 /* remember vm ptr in case quot_xt = lazy_jit_compile */
- /* clear x87 stack, but preserve rounding mode and exception flags */
- sub $2,STACK_REG
- fnstcw (STACK_REG)
- fninit
- fldcw (STACK_REG)
- /* rewind_to */
- mov ARG1,STACK_REG
- mov NV0,ARG1
- jmp *QUOT_XT_OFFSET(ARG0)
-
-DEF(F_FASTCALL void,lazy_jit_compile,(CELL quot, void *vm)):
- mov ARG1,ARG2
- mov STACK_REG,ARG1 /* Save stack pointer */
- sub $STACK_PADDING,STACK_REG
- call MANGLE(lazy_jit_compile_impl)
- mov RETURN_REG,ARG0 /* No-op on 32-bit */
- add $STACK_PADDING,STACK_REG
- jmp *QUOT_XT_OFFSET(ARG0) /* Call the quotation */
-
-
#include "cpu-x86.S"
#ifdef WINDOWS
#define NV0 %rbp
#define NV1 %r12
-#define ARITH_TEMP_1 %r8
-#define ARITH_TEMP_2 %r9
-#define DIV_RESULT %rax
-
#ifdef WINDOWS
#define ARG0 %rcx
call *ARG3 /* call memcpy */
ret /* return _with new stack_ */
+DEF(F_FASTCALL void,throw_impl,(CELL quot, F_STACK_FRAME *rewind_to, void *vm)):
+ /* clear x87 stack, but preserve rounding mode and exception flags */
+ sub $2,STACK_REG
+ fnstcw (STACK_REG)
+ fninit
+ fldcw (STACK_REG)
+ /* rewind_to */
+ mov ARG1,STACK_REG
+ mov ARG2,ARG1 /* make vm ptr 2nd arg in case quot_xt = lazy_jit_compile */
+ jmp *QUOT_XT_OFFSET(ARG0)
+
+DEF(F_FASTCALL void,lazy_jit_compile,(CELL quot, void *vm)):
+ mov ARG1,ARG2 /* vm is 3rd arg */
+ mov STACK_REG,ARG1 /* Save stack pointer */
+ sub $STACK_PADDING,STACK_REG
+ call MANGLE(lazy_jit_compile_impl)
+ mov RETURN_REG,ARG0 /* No-op on 32-bit */
+ add $STACK_PADDING,STACK_REG
+ jmp *QUOT_XT_OFFSET(ARG0) /* Call the quotation */
+
DEF(long long,read_timestamp_counter,(void)):
mov $0,%rax
rdtsc
or %rdx,%rax
ret
-DEF(void,primitive_inline_cache_miss,(void *vm)):
- mov (%rsp),%rbx
-DEF(void,primitive_inline_cache_miss_tail,(void *vm)):
- sub $STACK_PADDING,%rsp
- mov ARG0,ARG1
- mov %rbx,ARG0
- call MANGLE(inline_cache_miss)
- add $STACK_PADDING,%rsp
- jmp *%rax
-
DEF(void,get_sse_env,(void*)):
stmxcsr (%rdi)
ret
fnclex
fldcw 2(%rdi)
ret
-
-DEF(F_FASTCALL void,throw_impl,(CELL quot, F_STACK_FRAME *rewind_to, void *vm)):
- /* clear x87 stack, but preserve rounding mode and exception flags */
- sub $2,STACK_REG
- fnstcw (STACK_REG)
- fninit
- fldcw (STACK_REG)
- /* rewind_to */
- mov ARG1,STACK_REG
- mov ARG2,ARG1 /* make vm ptr 2nd arg in case quot_xt = lazy_jit_compile */
- jmp *QUOT_XT_OFFSET(ARG0)
-
-DEF(F_FASTCALL void,lazy_jit_compile,(CELL quot, void *vm)):
- mov ARG1,ARG2 /* vm is 3rd arg */
- mov STACK_REG,ARG1 /* Save stack pointer */
- sub $STACK_PADDING,STACK_REG
- call MANGLE(lazy_jit_compile_impl)
- mov RETURN_REG,ARG0 /* No-op on 32-bit */
- add $STACK_PADDING,STACK_REG
- jmp *QUOT_XT_OFFSET(ARG0) /* Call the quotation */
-
#include "cpu-x86.S"
-DEF(void,primitive_fixnum_add,(void *myvm)):
- mov ARG0, ARG2 /* save vm ptr for overflow */
- mov (DS_REG),ARG0
- mov -CELL_SIZE(DS_REG),ARG1
- sub $CELL_SIZE,DS_REG
- mov ARG1,ARITH_TEMP_1
- add ARG0,ARITH_TEMP_1
- jo MANGLE(overflow_fixnum_add)
- mov ARITH_TEMP_1,(DS_REG)
- ret
-
-DEF(void,primitive_fixnum_subtract,(void *myvm)):
- mov ARG0, ARG2 /* save vm ptr for overflow */
- mov (DS_REG),ARG1
- mov -CELL_SIZE(DS_REG),ARG0
- sub $CELL_SIZE,DS_REG
- mov ARG0,ARITH_TEMP_1
- sub ARG1,ARITH_TEMP_1
- jo MANGLE(overflow_fixnum_subtract)
- mov ARITH_TEMP_1,(DS_REG)
- ret
-
-DEF(void,primitive_fixnum_multiply,(void *myvm)):
- push ARG0 /* save vm ptr for overflow */
- mov (DS_REG),ARITH_TEMP_1
- mov ARITH_TEMP_1,DIV_RESULT
- mov -CELL_SIZE(DS_REG),ARITH_TEMP_2
- sar $4,ARITH_TEMP_2
- sub $CELL_SIZE,DS_REG
- imul ARITH_TEMP_2
- jo multiply_overflow
- mov DIV_RESULT,(DS_REG)
- pop ARG2
- ret
-multiply_overflow:
- sar $4,ARITH_TEMP_1
- mov ARITH_TEMP_1,ARG0
- mov ARITH_TEMP_2,ARG1
- pop ARG2
- jmp MANGLE(overflow_fixnum_multiply)
-
DEF(F_FASTCALL void,c_to_factor,(CELL quot, void *vm)):
PUSH_NONVOLATILE
mov ARG0,NV0
inline static bool tail_call_site_p(cell return_address)
{
- return call_site_opcode(return_address) == jmp_opcode;
+ switch(call_site_opcode(return_address))
+ {
+ case jmp_opcode: return true;
+ case call_opcode: return false;
+ default: abort(); return false;
+ }
}
inline static unsigned int fpu_status(unsigned int status)
VM_ASM_API void lazy_jit_compile(cell quot, void *vm);
VM_C_API void set_callstack(stack_frame *to,
- stack_frame *from,
- cell length,
- void *(*memcpy)(void*,const void*, size_t));
+ stack_frame *from,
+ cell length,
+ void *(*memcpy)(void*,const void*, size_t));
}
dpush(instances(TYPE_COUNT));
}
-cell factor_vm::find_all_words()
-{
- return instances(WORD_TYPE);
-}
-
}
return out;
}
-void factor_vm::print_word(word* word, cell nesting)
+void factor_vm::print_word(word *word, cell nesting)
{
if(tagged<object>(word->vocabulary).type_p(STRING_TYPE))
std::cout << untag<string>(word->vocabulary) << ":";
std::cout << '"' << str << '"';
}
-void factor_vm::print_array(array* array, cell nesting)
+void factor_vm::print_array(array *array, cell nesting)
{
cell length = array_capacity(array);
cell i;
explicit stack_frame_printer(factor_vm *parent_) : parent(parent_) {}
void operator()(stack_frame *frame)
{
+ std::cout << "frame: " << std::hex << (cell)frame << std::dec << std::endl;
+ std::cout << "executing: ";
parent->print_obj(parent->frame_executing(frame));
std::cout << std::endl;
+ std::cout << "scan: ";
parent->print_obj(parent->frame_scan(frame));
std::cout << std::endl;
std::cout << "word/quot addr: ";
/* Now the new method has been stored into the cache, and its on
the stack. */
emit(parent->special_objects[JIT_EPILOG]);
- emit(parent->special_objects[JIT_EXECUTE_JUMP]);
+ emit(parent->special_objects[JIT_EXECUTE]);
}
}
/* Offset of return address within 16-byte allocation line */
cell offset = root->value - (cell)block;
- if(root->valid && state->marked_p((code_block *)root->value))
+ if(root->valid && state->marked_p(block))
{
block = state->forward_block(block);
root->value = (cell)block + offset;
switch(op.rel_type())
{
- case RT_IMMEDIATE:
+ case RT_LITERAL:
op.store_value(data_visitor.visit_pointer(op.load_value(old_offset)));
break;
case RT_XT:
emit_with_literal(parent->special_objects[PIC_HIT],method);
}
- /* Generate machine code to handle a cache miss, which ultimately results in
- this function being called again.
+ /* If none of the above conditionals tested true, then execution "falls
+ through" to here. */
- The inline-cache-miss primitive call receives enough information to
- reconstruct the PIC. */
+ /* A stack frame is set up, since the inline-cache-miss sub-primitive
+ makes a subroutine call to the VM. */
+ emit(parent->special_objects[JIT_PROLOG]);
+
+ /* The inline-cache-miss sub-primitive call receives enough information to
+ reconstruct the PIC with the new entry. */
push(generic_word.value());
push(methods.value());
push(tag_fixnum(index));
push(cache_entries.value());
- word_special(parent->special_objects[tail_call_p ? PIC_MISS_TAIL_WORD : PIC_MISS_WORD]);
+
+ emit_subprimitive(
+ parent->special_objects[tail_call_p ? PIC_MISS_TAIL_WORD : PIC_MISS_WORD],
+ true, /* tail_call_p */
+ true); /* stack_frame_p */
}
code_block *factor_vm::compile_inline_cache(fixnum index,
void *factor_vm::inline_cache_miss(cell return_address_)
{
code_root return_address(return_address_,this);
-
check_code_pointer(return_address.value);
+ bool tail_call_site = tail_call_site_p(return_address.value);
+
+#ifdef PIC_DEBUG
+ std::cout << "Inline cache miss at "
+ << (tail_call_site ? "tail" : "non-tail")
+ << " call site 0x" << std::hex << return_address.value << std::dec
+ << std::endl;
+#endif
data_root<array> cache_entries(dpop(),this);
fixnum index = untag_fixnum(dpop());
cell method = lookup_method(object.value(),methods.value());
data_root<array> new_cache_entries(add_inline_cache_entry(
- cache_entries.value(),
- klass,
- method),this);
+ cache_entries.value(),
+ klass,
+ method),this);
+
xt = compile_inline_cache(index,
- generic_word.value(),
- methods.value(),
- new_cache_entries.value(),
- tail_call_site_p(return_address.value))->xt();
+ generic_word.value(),
+ methods.value(),
+ new_cache_entries.value(),
+ tail_call_site)->xt();
}
/* Install the new stub. */
#ifdef PIC_DEBUG
std::cout << "Updated "
- << (tail_call_site_p(return_address.value) ? "tail" : "non-tail")
+ << (tail_call_site ? "tail" : "non-tail")
<< " call site 0x" << std::hex << return_address.value << std::dec
- << " with " << std::hex << (cell)xt << std::dec << "\n";
+ << " with 0x" << std::hex << (cell)xt << std::dec << std::endl;
#endif
}
RT_HERE,
/* current code block */
RT_THIS,
- /* immediate literal */
- RT_IMMEDIATE,
+ /* data heap literal */
+ RT_LITERAL,
/* address of ctx var */
RT_CONTEXT,
/* untagged fixnum literal */
case RT_XT:
case RT_XT_PIC:
case RT_XT_PIC_TAIL:
- case RT_IMMEDIATE:
+ case RT_LITERAL:
case RT_HERE:
case RT_UNTAGGED:
case RT_THIS:
emit(code_template.value());
}
+bool jit::emit_subprimitive(cell word_, bool tail_call_p, bool stack_frame_p)
+{
+ data_root<word> word(word_,parent);
+ data_root<array> code_template(word->subprimitive,parent);
+ parameters.append(untag<array>(array_nth(code_template.untagged(),0)));
+ literals.append(untag<array>(array_nth(code_template.untagged(),1)));
+ emit(array_nth(code_template.untagged(),2));
+ if(array_capacity(code_template.untagged()) == 5)
+ {
+ if(tail_call_p)
+ {
+ if(stack_frame_p) emit(parent->special_objects[JIT_EPILOG]);
+ emit(array_nth(code_template.untagged(),4));
+ return true;
+ }
+ else
+ emit(array_nth(code_template.untagged(),3));
+ }
+ return false;
+}
+
void jit::emit_class_lookup(fixnum index, cell type)
{
emit_with_literal(parent->special_objects[PIC_LOAD],tag_fixnum(-index * sizeof(cell)));
emit_with_literal(parent->special_objects[JIT_WORD_CALL],word);
}
- void word_special(cell word)
- {
- emit_with_literal(parent->special_objects[JIT_WORD_SPECIAL],word);
- }
-
- void emit_subprimitive(cell word_)
- {
- data_root<word> word(word_,parent);
- data_root<array> code_triple(word->subprimitive,parent);
- parameters.append(untag<array>(array_nth(code_triple.untagged(),0)));
- literals.append(untag<array>(array_nth(code_triple.untagged(),1)));
- emit(array_nth(code_triple.untagged(),2));
- }
+ bool emit_subprimitive(cell word_, bool tail_call_p, bool stack_frame_p);
void emit_class_lookup(fixnum index, cell type);
JIT_PRIMITIVE,
JIT_WORD_JUMP,
JIT_WORD_CALL,
- JIT_WORD_SPECIAL,
JIT_IF_WORD,
JIT_IF,
JIT_EPILOG,
JIT_2DIP,
JIT_3DIP_WORD,
JIT_3DIP,
- JIT_EXECUTE_WORD,
- JIT_EXECUTE_JUMP,
- JIT_EXECUTE_CALL,
+ JIT_EXECUTE,
JIT_DECLARE_WORD,
- /* Callback stub generation in callbacks.c */
- CALLBACK_STUB = 45,
-
/* Incremented on every modify-code-heap call; invalidates call( inline
caching */
- REDEFINITION_COUNTER = 46,
+ REDEFINITION_COUNTER = 47,
+ /* Callback stub generation in callbacks.c */
+ CALLBACK_STUB = 48,
+
/* Polymorphic inline cache generation in inline_cache.c */
- PIC_LOAD = 47,
+ PIC_LOAD = 49,
PIC_TAG,
PIC_TUPLE,
PIC_CHECK_TAG,
primitive_double_bits,
primitive_bits_float,
primitive_bits_double,
- primitive_fixnum_add,
- primitive_fixnum_subtract,
- primitive_fixnum_multiply,
primitive_fixnum_divint,
primitive_fixnum_divmod,
primitive_fixnum_shift,
primitive_jit_compile,
primitive_load_locals,
primitive_check_datastack,
- primitive_inline_cache_miss,
- primitive_inline_cache_miss_tail,
primitive_mega_cache_miss,
primitive_lookup_method,
primitive_reset_dispatch_stats,
&& array_nth(elements.untagged(),i + 1) == parent->special_objects[JIT_DECLARE_WORD];
}
+bool quotation_jit::word_stack_frame_p(cell obj)
+{
+ return to_boolean(untag<word>(obj)->subprimitive)
+ || obj == parent->special_objects[JIT_PRIMITIVE_WORD];
+}
+
bool quotation_jit::stack_frame_p()
{
fixnum length = array_capacity(elements.untagged());
- fixnum i;
- for(i = 0; i < length - 1; i++)
+ for(fixnum i = 0; i < length; i++)
{
cell obj = array_nth(elements.untagged(),i);
switch(tagged<object>(obj).type())
{
case WORD_TYPE:
- if(!to_boolean(untag<word>(obj)->subprimitive))
+ if(i != length - 1 || word_stack_frame_p(obj))
return true;
break;
case QUOTATION_TYPE:
switch(obj.type())
{
case WORD_TYPE:
- /* Intrinsics */
+ /* Sub-primitives */
if(to_boolean(obj.as<word>()->subprimitive))
- emit_subprimitive(obj.value());
- /* The (execute) primitive is special-cased */
- else if(obj.value() == parent->special_objects[JIT_EXECUTE_WORD])
{
- if(i == length - 1)
- {
- if(stack_frame) emit(parent->special_objects[JIT_EPILOG]);
- tail_call = true;
- emit(parent->special_objects[JIT_EXECUTE_JUMP]);
- }
- else
- emit(parent->special_objects[JIT_EXECUTE_CALL]);
+ tail_call = emit_subprimitive(obj.value(), /* word */
+ i == length - 1, /* tail_call_p */
+ stack_frame); /* stack_frame_p */
}
/* Everything else */
- else
+ else if(i == length - 1)
{
- if(i == length - 1)
- {
- if(stack_frame) emit(parent->special_objects[JIT_EPILOG]);
- tail_call = true;
- /* Inline cache misses are special-cased.
- The calling convention for tail
- calls stores the address of the next
- instruction in a register. However,
- PIC miss stubs themselves tail-call
- the inline cache miss primitive, and
- we don't want to clobber the saved
- address. */
- if(obj.value() == parent->special_objects[PIC_MISS_WORD]
- || obj.value() == parent->special_objects[PIC_MISS_TAIL_WORD])
- {
- word_special(obj.value());
- }
- else
- {
- word_jump(obj.value());
- }
- }
- else
- word_call(obj.value());
+ if(stack_frame) emit(parent->special_objects[JIT_EPILOG]);
+ tail_call = true;
+ word_jump(obj.value());
}
+ else
+ word_call(obj.value());
break;
case WRAPPER_TYPE:
push(obj.as<wrapper>()->object);
emit(parent->special_objects[JIT_PRIMITIVE]);
i++;
-
- tail_call = true;
}
else
push(obj.value());
/* Method dispatch */
if(mega_lookup_p(i,length))
{
+ if(stack_frame) emit(parent->special_objects[JIT_EPILOG]);
+ tail_call = true;
emit_mega_cache_lookup(
array_nth(elements.untagged(),i),
untag_fixnum(array_nth(elements.untagged(),i + 1)),
array_nth(elements.untagged(),i + 2));
i += 3;
- tail_call = true;
}
/* Non-optimizing compiler ignores declarations */
else if(declare_p(i,length))
{
set_position(length);
- if(stack_frame)
- emit(parent->special_objects[JIT_EPILOG]);
+ if(stack_frame) emit(parent->special_objects[JIT_EPILOG]);
emit(parent->special_objects[JIT_RETURN]);
}
}
drepl(allot_cell((cell)quot->xt));
}
-/* Compile a word definition with the non-optimizing compiler. Allocates memory */
-void factor_vm::jit_compile_word(cell word_, cell def_, bool relocating)
-{
- data_root<word> word(word_,this);
- data_root<quotation> def(def_,this);
-
- code_block *compiled = jit_compile_quot(word.value(),def.value(),relocating);
- word->code = compiled;
-
- if(to_boolean(word->pic_def)) jit_compile_quot(word->pic_def,relocating);
- if(to_boolean(word->pic_tail_def)) jit_compile_quot(word->pic_tail_def,relocating);
-}
-
-void factor_vm::compile_all_words()
-{
- data_root<array> words(find_all_words(),this);
-
- cell i;
- cell length = array_capacity(words.untagged());
- for(i = 0; i < length; i++)
- {
- data_root<word> word(array_nth(words.untagged(),i),this);
-
- if(!word->code || !word->code->optimized_p())
- jit_compile_word(word.value(),word->def,false);
-
- update_word_xt(word.untagged());
-
- }
-}
-
/* Allocates memory */
fixnum factor_vm::quot_code_offset_to_scan(cell quot_, cell offset)
{
bool fast_3dip_p(cell i, cell length);
bool mega_lookup_p(cell i, cell length);
bool declare_p(cell i, cell length);
+ bool word_stack_frame_p(cell obj);
bool stack_frame_p();
void iterate_quotation();
};
void operator()(instruction_operand op)
{
- if(op.rel_type() == RT_IMMEDIATE)
+ if(op.rel_type() == RT_LITERAL)
op.store_value(visitor->visit_pointer(op.load_value()));
}
};
void end_scan();
cell instances(cell type);
void primitive_all_instances();
- cell find_all_words();
template<typename Generation, typename Iterator>
inline void each_object(Generation *gen, Iterator &iterator)
void update_word_xt(word *w_);
void primitive_optimized_p();
void primitive_wrapper();
+ void jit_compile_word(cell word_, cell def_, bool relocating);
+ cell find_all_words();
+ void compile_all_words();
//math
void primitive_bignum_to_fixnum();
void check_frame(stack_frame *frame);
callstack *allot_callstack(cell size);
stack_frame *fix_callstack_top(stack_frame *top, stack_frame *bottom);
- stack_frame *capture_start();
+ stack_frame *second_from_top_stack_frame();
void primitive_callstack();
void primitive_set_callstack();
code_block *frame_code(stack_frame *frame);
void set_quot_xt(quotation *quot, code_block *code);
code_block *jit_compile_quot(cell owner_, cell quot_, bool relocating);
void jit_compile_quot(cell quot_, bool relocating);
- void jit_compile_word(cell word_, cell def_, bool relocating);
- void compile_all_words();
fixnum quot_code_offset_to_scan(cell quot_, cell offset);
cell lazy_jit_compile_impl(cell quot_, stack_frame *stack);
void primitive_quot_compiled_p();
namespace factor
{
+/* Compile a word definition with the non-optimizing compiler. Allocates memory */
+void factor_vm::jit_compile_word(cell word_, cell def_, bool relocating)
+{
+ data_root<word> word(word_,this);
+ data_root<quotation> def(def_,this);
+
+ code_block *compiled = jit_compile_quot(word.value(),def.value(),relocating);
+ word->code = compiled;
+
+ if(to_boolean(word->pic_def)) jit_compile_quot(word->pic_def,relocating);
+ if(to_boolean(word->pic_tail_def)) jit_compile_quot(word->pic_tail_def,relocating);
+}
+
+cell factor_vm::find_all_words()
+{
+ return instances(WORD_TYPE);
+}
+
+void factor_vm::compile_all_words()
+{
+ data_root<array> words(find_all_words(),this);
+
+ cell length = array_capacity(words.untagged());
+ for(cell i = 0; i < length; i++)
+ {
+ data_root<word> word(array_nth(words.untagged(),i),this);
+
+ if(!word->code || !word->code->optimized_p())
+ jit_compile_word(word.value(),word->def,false);
+
+ update_word_xt(word.untagged());
+
+ }
+}
+
word *factor_vm::allot_word(cell name_, cell vocab_, cell hashcode_)
{
data_root<object> vocab(vocab_,this);
projects / factor.git / commitdiff