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

vm: big overhaul of non-optimizing compiler 

- 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
db4
Slava Pestov 2009-12-15 07:20:09 -05:00
parent 4cea294cfd
commit 0068bce934
38 changed files with 629 additions and 517 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1,6 +1,6 @@
! 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
@ -10,7 +10,7 @@ vocabs.loader source-files definitions debugger
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 )
@ -107,8 +107,11 @@ SYMBOL: sub-primitives
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 ;
@ -123,8 +126,21 @@ SYMBOL: jit-literals
: 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
@ -140,6 +156,15 @@ SYMBOL: jit-literals
: 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
@ -163,35 +188,32 @@ USERENV: jit-primitive-word 24
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: 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 45
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
@ -513,7 +535,6 @@ M: quotation '
\ 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

3
basis/compiler/cfg/build-stack-frame/build-stack-frame.factor
View File

@ -22,8 +22,7 @@ UNION: stack-frame-insn
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

4
basis/compiler/codegen/codegen.factor
View File

@ -61,9 +61,7 @@ SYMBOL: labels
! 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 ;

2
basis/compiler/codegen/fixup/fixup.factor
View File

@ -74,7 +74,7 @@ SYMBOL: relocation-table
[ 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 ;

4
basis/compiler/constants/constants.factor
View File

@ -47,8 +47,8 @@ CONSTANT: rt-xt-pic 4
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

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

@ -1,9 +1,9 @@
! Copyright (C) 2007, 2008 Slava Pestov.
! Copyright (C) 2007, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: bootstrap.image.private kernel kernel.private namespaces
system cpu.ppc.assembler compiler.codegen.fixup compiler.units
compiler.constants math math.private layouts words
vocabs slots.private locals.backend ;
compiler.constants math math.private layouts words vocabs
slots.private locals locals.backend generic.single.private fry ;
FROM: cpu.ppc.assembler => B ;
IN: bootstrap.ppc
@ -21,8 +21,16 @@ CONSTANT: rs-reg 14
: next-save ( -- n ) stack-frame bootstrap-cell - ;
: xt-save ( -- n ) stack-frame 2 bootstrap-cells - ;
: jit-conditional* ( test-quot true-quot -- )
[ '[ bootstrap-cell /i 1 + @ ] ] dip jit-conditional ; inline
: jit-save-context ( -- )
0 3 LOAD32 rc-absolute-ppc-2/2 rt-context jit-rel
4 3 0 LWZ
1 4 0 STW ;
[
0 3 LOAD32 rc-absolute-ppc-2/2 rt-immediate jit-rel
0 3 LOAD32 rc-absolute-ppc-2/2 rt-literal jit-rel
11 3 profile-count-offset LWZ
11 11 1 tag-fixnum ADDI
11 3 profile-count-offset STW
@ -43,14 +51,12 @@ CONSTANT: rs-reg 14
] jit-prolog jit-define
[
0 3 LOAD32 rc-absolute-ppc-2/2 rt-immediate jit-rel
0 3 LOAD32 rc-absolute-ppc-2/2 rt-literal jit-rel
3 ds-reg 4 STWU
] jit-push-immediate jit-define
[
0 3 LOAD32 rc-absolute-ppc-2/2 rt-stack-chain jit-rel
4 3 0 LWZ
1 4 0 STW
jit-save-context
4 0 swap LOAD32 rc-absolute-ppc-2/2 rt-vm jit-rel
0 5 LOAD32 rc-absolute-ppc-2/2 rt-primitive jit-rel
5 MTCTR
@ -64,14 +70,11 @@ CONSTANT: rs-reg 14
0 B rc-relative-ppc-3 rt-xt-pic-tail jit-rel
] jit-word-jump jit-define
[ 0 B rc-relative-ppc-3 rt-xt jit-rel ] jit-word-special jit-define
[
3 ds-reg 0 LWZ
ds-reg dup 4 SUBI
0 3 \ f type-number CMPI
2 BEQ
0 B rc-relative-ppc-3 rt-xt jit-rel
[ BEQ ] [ 0 B rc-relative-ppc-3 rt-xt jit-rel ] jit-conditional*
0 B rc-relative-ppc-3 rt-xt jit-rel
] jit-if jit-define
@ -139,16 +142,6 @@ CONSTANT: rs-reg 14
jit-3r>
] jit-3dip jit-define
: prepare-(execute) ( -- operand )
3 ds-reg 0 LWZ
ds-reg dup 4 SUBI
4 3 word-xt-offset LWZ
4 ;
[ prepare-(execute) MTCTR BCTR ] jit-execute-jump jit-define
[ prepare-(execute) MTLR BLRL ] jit-execute-call jit-define
[
0 1 lr-save stack-frame + LWZ
1 1 stack-frame ADDI
@ -179,26 +172,29 @@ CONSTANT: rs-reg 14
3 4 MR
load-tag
0 4 tuple type-number tag-fixnum CMPI
2 BNE
4 3 tuple type-number neg bootstrap-cell + LWZ
[ BNE ]
[ 4 3 tuple type-number neg bootstrap-cell + LWZ ]
jit-conditional*
] pic-tuple jit-define
[
0 4 0 CMPI rc-absolute-ppc-2 rt-immediate jit-rel
0 4 0 CMPI rc-absolute-ppc-2 rt-literal jit-rel
] pic-check-tag jit-define
[
0 5 LOAD32 rc-absolute-ppc-2/2 rt-immediate jit-rel
0 5 LOAD32 rc-absolute-ppc-2/2 rt-literal jit-rel
4 0 5 CMP
] pic-check-tuple jit-define
[ 2 BNE 0 B rc-relative-ppc-3 rt-xt jit-rel ] pic-hit jit-define
[
[ BNE ] [ 0 B rc-relative-ppc-3 rt-xt jit-rel ] jit-conditional*
] pic-hit jit-define
! ! ! Megamorphic caches
[
! cache = ...
0 3 LOAD32 rc-absolute-ppc-2/2 rt-immediate jit-rel
0 3 LOAD32 rc-absolute-ppc-2/2 rt-literal jit-rel
! key = hashcode(class)
5 4 1 SRAWI
! key &= cache.length - 1
@ -210,17 +206,20 @@ CONSTANT: rs-reg 14
! if(get(cache) == class)
6 3 0 LWZ
6 0 4 CMP
10 BNE
! megamorphic_cache_hits++
0 4 LOAD32 rc-absolute-ppc-2/2 rt-megamorphic-cache-hits jit-rel
5 4 0 LWZ
5 5 1 ADDI
5 4 0 STW
! ... goto get(cache + bootstrap-cell)
3 3 4 LWZ
3 3 word-xt-offset LWZ
3 MTCTR
BCTR
[ BNE ]
[
! megamorphic_cache_hits++
0 4 LOAD32 rc-absolute-ppc-2/2 rt-megamorphic-cache-hits jit-rel
5 4 0 LWZ
5 5 1 ADDI
5 4 0 STW
! ... goto get(cache + bootstrap-cell)
3 3 4 LWZ
3 3 word-xt-offset LWZ
3 MTCTR
BCTR
]
jit-conditional*
! fall-through on miss
] mega-lookup jit-define
@ -238,9 +237,24 @@ CONSTANT: rs-reg 14
ds-reg dup 4 SUBI
4 0 swap LOAD32 0 jit-parameter rc-absolute-ppc-2/2 rt-vm jit-rel
5 3 quot-xt-offset LWZ
5 MTCTR
BCTR
] \ (call) define-sub-primitive
]
[ 5 MTLR BLRL ]
[ 5 MTCTR BCTR ] \ (call) define-sub-primitive*
[
3 ds-reg 0 LWZ
ds-reg dup 4 SUBI
4 3 word-xt-offset LWZ
]
[ 4 MTLR BLRL ]
[ 4 MTCTR BCTR ] \ (execute) define-sub-primitive*
[
3 ds-reg 0 LWZ
ds-reg dup 4 SUBI
4 3 word-xt-offset LWZ
4 MTCTR BCTR
] jit-execute jit-define
! Objects
[
@ -361,7 +375,7 @@ CONSTANT: rs-reg 14
! Comparisons
: jit-compare ( insn -- )
t jit-literal
0 3 LOAD32 rc-absolute-ppc-2/2 rt-immediate jit-rel
0 3 LOAD32 rc-absolute-ppc-2/2 rt-literal jit-rel
4 ds-reg 0 LWZ
5 ds-reg -4 LWZU
5 0 4 CMP
@ -387,8 +401,7 @@ CONSTANT: rs-reg 14
3 3 tag-mask get ANDI
\ f type-number 4 LI
0 3 0 CMPI
2 BNE
1 tag-fixnum 4 LI
[ BNE ] [ 1 tag-fixnum 4 LI ] jit-conditional*
4 ds-reg 0 STW
] \ both-fixnums? define-sub-primitive
@ -433,8 +446,7 @@ CONSTANT: rs-reg 14
7 4 6 SRAW
7 7 0 0 31 tag-bits get - RLWINM
0 3 0 CMPI
2 BGT
5 7 MR
[ BGT ] [ 5 7 MR ] jit-conditional*
5 ds-reg 0 STW
] \ fixnum-shift-fast define-sub-primitive
@ -482,4 +494,67 @@ CONSTANT: rs-reg 14
rs-reg 3 rs-reg SUBF
] \ drop-locals define-sub-primitive
! Inline cache miss entry points
: jit-load-return-address ( -- ) 6 MFLR ;
! 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
3 6 MR
4 0 LOAD32 0 rc-absolute-ppc-2/2 jit-vm
5 0 LOAD32 "inline_cache_miss" f rc-absolute-ppc-2/2 jit-dlsym ;
[ jit-load-return-address jit-inline-cache-miss ]
[ 5 MTLR BLRL ]
[ 5 MTCTR BCTR ]
\ inline-cache-miss define-sub-primitive*
[ jit-inline-cache-miss ]
[ 5 MTLR BLRL ]
[ 5 MTCTR BCTR ]
\ inline-cache-miss-tail define-sub-primitive*
! Overflowing fixnum arithmetic
:: jit-overflow ( insn func -- )
jit-save-context
3 ds-reg 0 LWZ
4 ds-reg -4 LWZ
ds-reg ds-reg 4 SUBI
0 0 LI
0 MTXER
6 3 4 insn call( d a s -- )
6 ds-reg 0 STW
[ BNO ]
[
0 5 LOAD32 0 rc-absolute-ppc-2/2 jit-vm
0 6 LOAD32 func f rc-absolute-ppc-2/2 jit-dlsym
]
jit-conditional ;
[ [ ADDO. ] "overflow_fixnum_add" jit-overflow ] \ fixnum+ define-sub-primitive
[ [ SUBFO. ] "overflow_fixnum_subtract" jit-overflow ] \ fixnum- define-sub-primitive
[
jit-save-context
3 ds-reg 0 LWZ
3 3 tag-bits get SRAWI
4 ds-reg -4 LWZ
ds-reg ds-reg 4 SUBI
0 0 LI
0 MTXER
6 3 4 MULLWO.
6 ds-reg 0 STW
[ BNO ]
[
4 4 tag-bits get SRAWI
0 5 LOAD32 0 rc-absolute-ppc-2/2 jit-vm
0 6 LOAD32 "overflow_fixnum_multiply" f rc-absolute-ppc-2/2 jit-dlsym
6 MTLR
BLRL
]
jit-conditional
] \ fixnum* define-sub-primitive
[ "bootstrap.ppc" forget-vocab ] with-compilation-unit

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

@ -2,12 +2,13 @@
! 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 ;
@ -25,15 +26,89 @@ IN: bootstrap.x86
: 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

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

@ -1,8 +1,9 @@
! 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
@ -22,18 +23,94 @@ IN: bootstrap.x86
: 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

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

@ -8,6 +8,7 @@ IN: bootstrap.x86
: 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

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

@ -8,6 +8,7 @@ IN: bootstrap.x86
: 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

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

@ -10,7 +10,7 @@ big-endian off
[
! 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
@ -21,20 +21,9 @@ big-endian off
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
@ -50,10 +39,6 @@ big-endian off
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
@ -133,20 +118,35 @@ big-endian off
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 [+] ;
[ prepare-(execute) JMP ] jit-execute-jump jit-define
[ prepare-(execute) CALL ] jit-execute-call jit-define
! 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*
[
! 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*
[
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
@ -176,16 +176,17 @@ big-endian off
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
@ -195,7 +196,7 @@ big-endian off
[
! 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
@ -224,18 +225,6 @@ big-endian off
! ! ! 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
@ -373,7 +362,7 @@ big-endian off
: 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

10
core/bootstrap/primitives.factor
View File

@ -326,6 +326,9 @@ tuple
{ "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 -- ? )) }
@ -352,6 +355,8 @@ tuple
{ "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
@ -374,9 +379,6 @@ tuple
{ "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 )) }
@ -508,8 +510,6 @@ tuple
{ "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" (( -- )) }

4
core/compiler/units/units.factor
View File

@ -100,7 +100,7 @@ GENERIC: definitions-changed ( assoc obj -- )
! 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 -- ? )
@ -132,7 +132,7 @@ M: object bump-effect-counter* drop f ;
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?

17
vm/callstack.cpp
View File

@ -28,29 +28,32 @@ stack_frame *factor_vm::fix_callstack_top(stack_frame *top, stack_frame *bottom)
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);

9
vm/callstack.hpp
View File

@ -6,7 +6,7 @@ inline static cell callstack_size(cell 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 */
@ -25,12 +25,9 @@ template<typename Iterator> void factor_vm::iterate_callstack_object(callstack *
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);

2
vm/code_blocks.cpp
View File

@ -264,7 +264,7 @@ struct initial_code_block_visitor {
{
switch(op.rel_type())
{
case RT_IMMEDIATE:
case RT_LITERAL:
op.store_value(next_literal());
break;
case RT_XT:

2
vm/compaction.cpp
View File

@ -108,7 +108,7 @@ struct code_block_compaction_relocation_visitor {
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:

137
vm/cpu-ppc.S
View File

@ -4,49 +4,6 @@ in the public domain. */
#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 \
@ -150,35 +107,35 @@ DEF(void,c_to_factor,(cell quot, void *vm)):
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
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
/* save args in non-volatile regs */
mr r15,r3
mr r16,r4
/* pass call stack pointer as an argument */
mr r3,r1
@ -189,23 +146,23 @@ DEF(void,c_to_factor,(cell quot, void *vm)):
mr r4,r16
CALL_QUOT
RESTORE_V(v0,104)
mtvscr v0
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_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 FPRs */
RESTORE_FP(f31,54)
RESTORE_FP(f30,52)
RESTORE_FP(f29,50)
@ -299,17 +256,6 @@ DEF(void,flush_icache,(void *start, int len)):
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)
@ -341,4 +287,3 @@ DEF(void,set_ppc_vmx_env,(const void*)):
lvxl v0,0,r4
mtvscr v0
blr

58
vm/cpu-x86.32.S
View File

@ -10,10 +10,6 @@
#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
@ -44,20 +40,32 @@ DEF(void,set_callstack,(F_STACK_FRAME *to, F_STACK_FRAME *from, CELL length, voi
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)
@ -80,28 +88,6 @@ DEF(void,set_x87_env,(const void*)):
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

63
vm/cpu-x86.64.S
View File

@ -10,10 +10,6 @@
#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
@ -69,41 +65,6 @@ DEF(void,set_callstack,(F_STACK_FRAME *to, F_STACK_FRAME *from, CELL length, voi
call *ARG3 /* call memcpy */
ret /* return _with new stack_ */
DEF(long long,read_timestamp_counter,(void)):
mov $0,%rax
rdtsc
shl $32,%rdx
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
DEF(void,set_sse_env,(const void*)):
ldmxcsr (%rdi)
ret
DEF(void,get_x87_env,(void*)):
fnstsw (%rdi)
fnstcw 2(%rdi)
ret
DEF(void,set_x87_env,(const void*)):
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
@ -124,5 +85,29 @@ DEF(F_FASTCALL void,lazy_jit_compile,(CELL quot, void *vm)):
add $STACK_PADDING,STACK_REG
jmp *QUOT_XT_OFFSET(ARG0) /* Call the quotation */
DEF(long long,read_timestamp_counter,(void)):
mov $0,%rax
rdtsc
shl $32,%rdx
or %rdx,%rax
ret
DEF(void,get_sse_env,(void*)):
stmxcsr (%rdi)
ret
DEF(void,set_sse_env,(const void*)):
ldmxcsr (%rdi)
ret
DEF(void,get_x87_env,(void*)):
fnstsw (%rdi)
fnstcw 2(%rdi)
ret
DEF(void,set_x87_env,(const void*)):
fnclex
fldcw 2(%rdi)
ret
#include "cpu-x86.S"

41
vm/cpu-x86.S
View File

@ -1,44 +1,3 @@
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

13
vm/cpu-x86.hpp
View File

@ -47,7 +47,12 @@ inline static void set_call_target(cell return_address, void *target)
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)
@ -74,8 +79,8 @@ VM_ASM_API void throw_impl(cell quot, stack_frame *rewind_to, void *vm);
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));
}

5
vm/data_heap.cpp
View File

@ -268,9 +268,4 @@ void factor_vm::primitive_all_instances()
dpush(instances(TYPE_COUNT));
}
cell factor_vm::find_all_words()
{
return instances(WORD_TYPE);
}
}

7
vm/debug.cpp
View File

@ -10,7 +10,7 @@ std::ostream &operator<<(std::ostream &out, const string *str)
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) << ":";
@ -30,7 +30,7 @@ void factor_vm::print_factor_string(string *str)
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;
@ -160,8 +160,11 @@ struct stack_frame_printer {
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: ";

2
vm/dispatch.cpp
View File

@ -166,7 +166,7 @@ void quotation_jit::emit_mega_cache_lookup(cell methods_, fixnum index, cell cac
/* 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]);
}
}

2
vm/full_collector.cpp
View File

@ -75,7 +75,7 @@ void factor_vm::update_code_roots_for_compaction()
/* 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;

2
vm/image.cpp
View File

@ -182,7 +182,7 @@ struct code_block_fixup_relocation_visitor {
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:

46
vm/inline_cache.cpp
View File

@ -104,16 +104,24 @@ void inline_cache_jit::compile_inline_cache(fixnum index,
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,
@ -180,8 +188,15 @@ to take care of the details. */
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());
@ -203,14 +218,15 @@ void *factor_vm::inline_cache_miss(cell return_address_)
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. */
@ -224,9 +240,9 @@ void *factor_vm::inline_cache_miss(cell return_address_)
#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
}

6
vm/instruction_operands.hpp
View File

@ -18,8 +18,8 @@ enum relocation_type {
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 */
@ -103,7 +103,7 @@ struct relocation_entry {
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:

21
vm/jit.cpp
View File

@ -82,6 +82,27 @@ void jit::emit_with_parameter(cell code_template_, cell argument_) {
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)));

14
vm/jit.hpp
View File

@ -43,19 +43,7 @@ struct jit {
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);

15
vm/objects.hpp
View File

@ -42,7 +42,6 @@ enum special_object {
JIT_PRIMITIVE,
JIT_WORD_JUMP,
JIT_WORD_CALL,
JIT_WORD_SPECIAL,
JIT_IF_WORD,
JIT_IF,
JIT_EPILOG,
@ -55,20 +54,18 @@ enum special_object {
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,

5
vm/primitives.cpp
View File

@ -143,9 +143,6 @@ const primitive_type primitives[] = {
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,
@ -279,8 +276,6 @@ const primitive_type primitives[] = {
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,

97
vm/quotations.cpp
View File

@ -82,18 +82,23 @@ bool quotation_jit::declare_p(cell i, cell length)
&& 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:
@ -153,49 +158,22 @@ void quotation_jit::iterate_quotation()
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);
@ -209,8 +187,6 @@ void quotation_jit::iterate_quotation()
emit(parent->special_objects[JIT_PRIMITIVE]);
i++;
tail_call = true;
}
else
push(obj.value());
@ -257,12 +233,13 @@ void quotation_jit::iterate_quotation()
/* 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))
@ -280,8 +257,7 @@ void quotation_jit::iterate_quotation()
{
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]);
}
}
@ -342,37 +318,6 @@ void factor_vm::primitive_quotation_xt()
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)
{

1
vm/quotations.hpp
View File

@ -22,6 +22,7 @@ struct quotation_jit : public jit {
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();
};

2
vm/slot_visitor.hpp
View File

@ -191,7 +191,7 @@ struct literal_references_visitor {
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()));
}
};

8
vm/vm.hpp
View File

@ -232,7 +232,6 @@ struct factor_vm
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)
@ -398,6 +397,9 @@ struct factor_vm
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();
@ -562,7 +564,7 @@ struct factor_vm
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);
@ -605,8 +607,6 @@ struct factor_vm
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();

35
vm/words.cpp
View File

@ -3,6 +3,41 @@
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);