Merge branch 'master' of git://factorcode.org/git/factor
commit
42a86854a5
|
@ -9,7 +9,7 @@ classes.builtin classes.tuple classes.tuple.private vocabs
|
|||
vocabs.loader source-files definitions debugger quotations.private
|
||||
sequences.private combinators math.order math.private accessors
|
||||
slots.private generic.single.private compiler.units compiler.constants
|
||||
fry ;
|
||||
fry bootstrap.image.syntax ;
|
||||
IN: bootstrap.image
|
||||
|
||||
: arch ( os cpu -- arch )
|
||||
|
@ -93,24 +93,19 @@ CONSTANT: -1-offset 9
|
|||
|
||||
SYMBOL: sub-primitives
|
||||
|
||||
SYMBOL: jit-define-rc
|
||||
SYMBOL: jit-define-rt
|
||||
SYMBOL: jit-define-offset
|
||||
SYMBOL: jit-relocations
|
||||
|
||||
: compute-offset ( -- offset )
|
||||
building get length jit-define-rc get rc-absolute-cell = bootstrap-cell 4 ? - ;
|
||||
: compute-offset ( rc -- offset )
|
||||
[ building get length ] dip rc-absolute-cell = bootstrap-cell 4 ? - ;
|
||||
|
||||
: jit-rel ( rc rt -- )
|
||||
jit-define-rt set
|
||||
jit-define-rc set
|
||||
compute-offset jit-define-offset set ;
|
||||
over compute-offset 3array jit-relocations get push-all ;
|
||||
|
||||
: make-jit ( quot -- quad )
|
||||
: make-jit ( quot -- jit-data )
|
||||
[
|
||||
V{ } clone jit-relocations set
|
||||
call( -- )
|
||||
jit-define-rc get
|
||||
jit-define-rt get
|
||||
jit-define-offset get 3array
|
||||
jit-relocations get >array
|
||||
] B{ } make prefix ;
|
||||
|
||||
: jit-define ( quot name -- )
|
||||
|
@ -128,98 +123,59 @@ SYMBOL: big-endian
|
|||
! Bootstrap architecture name
|
||||
SYMBOL: architecture
|
||||
|
||||
! Bootstrap global namesapce
|
||||
SYMBOL: bootstrap-global
|
||||
RESET
|
||||
|
||||
! Boot quotation, set in stage1.factor
|
||||
SYMBOL: bootstrap-boot-quot
|
||||
USERENV: bootstrap-boot-quot 20
|
||||
|
||||
! Bootstrap global namesapce
|
||||
USERENV: bootstrap-global 21
|
||||
|
||||
! JIT parameters
|
||||
SYMBOL: jit-prolog
|
||||
SYMBOL: jit-primitive-word
|
||||
SYMBOL: jit-primitive
|
||||
SYMBOL: jit-word-jump
|
||||
SYMBOL: jit-word-call
|
||||
SYMBOL: jit-push-immediate
|
||||
SYMBOL: jit-if-word
|
||||
SYMBOL: jit-if-1
|
||||
SYMBOL: jit-if-2
|
||||
SYMBOL: jit-dip-word
|
||||
SYMBOL: jit-dip
|
||||
SYMBOL: jit-2dip-word
|
||||
SYMBOL: jit-2dip
|
||||
SYMBOL: jit-3dip-word
|
||||
SYMBOL: jit-3dip
|
||||
SYMBOL: jit-execute-word
|
||||
SYMBOL: jit-execute-jump
|
||||
SYMBOL: jit-execute-call
|
||||
SYMBOL: jit-epilog
|
||||
SYMBOL: jit-return
|
||||
SYMBOL: jit-profiling
|
||||
SYMBOL: jit-save-stack
|
||||
USERENV: jit-prolog 23
|
||||
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
|
||||
|
||||
! PIC stubs
|
||||
SYMBOL: pic-load
|
||||
SYMBOL: pic-tag
|
||||
SYMBOL: pic-hi-tag
|
||||
SYMBOL: pic-tuple
|
||||
SYMBOL: pic-hi-tag-tuple
|
||||
SYMBOL: pic-check-tag
|
||||
SYMBOL: pic-check
|
||||
SYMBOL: pic-hit
|
||||
SYMBOL: pic-miss-word
|
||||
USERENV: pic-load 47
|
||||
USERENV: pic-tag 48
|
||||
USERENV: pic-hi-tag 49
|
||||
USERENV: pic-tuple 50
|
||||
USERENV: pic-hi-tag-tuple 51
|
||||
USERENV: pic-check-tag 52
|
||||
USERENV: pic-check 53
|
||||
USERENV: pic-hit 54
|
||||
USERENV: pic-miss-word 55
|
||||
USERENV: pic-miss-tail-word 56
|
||||
|
||||
! Megamorphic dispatch
|
||||
SYMBOL: mega-lookup
|
||||
SYMBOL: mega-lookup-word
|
||||
SYMBOL: mega-miss-word
|
||||
USERENV: mega-lookup 57
|
||||
USERENV: mega-lookup-word 58
|
||||
USERENV: mega-miss-word 59
|
||||
|
||||
! Default definition for undefined words
|
||||
SYMBOL: undefined-quot
|
||||
|
||||
: userenvs ( -- assoc )
|
||||
H{
|
||||
{ bootstrap-boot-quot 20 }
|
||||
{ bootstrap-global 21 }
|
||||
{ jit-prolog 23 }
|
||||
{ jit-primitive-word 24 }
|
||||
{ jit-primitive 25 }
|
||||
{ jit-word-jump 26 }
|
||||
{ jit-word-call 27 }
|
||||
{ jit-if-word 28 }
|
||||
{ jit-if-1 29 }
|
||||
{ jit-if-2 30 }
|
||||
{ jit-epilog 33 }
|
||||
{ jit-return 34 }
|
||||
{ jit-profiling 35 }
|
||||
{ jit-push-immediate 36 }
|
||||
{ jit-save-stack 38 }
|
||||
{ jit-dip-word 39 }
|
||||
{ jit-dip 40 }
|
||||
{ jit-2dip-word 41 }
|
||||
{ jit-2dip 42 }
|
||||
{ jit-3dip-word 43 }
|
||||
{ jit-3dip 44 }
|
||||
{ jit-execute-word 45 }
|
||||
{ jit-execute-jump 46 }
|
||||
{ jit-execute-call 47 }
|
||||
{ pic-load 48 }
|
||||
{ pic-tag 49 }
|
||||
{ pic-hi-tag 50 }
|
||||
{ pic-tuple 51 }
|
||||
{ pic-hi-tag-tuple 52 }
|
||||
{ pic-check-tag 53 }
|
||||
{ pic-check 54 }
|
||||
{ pic-hit 55 }
|
||||
{ pic-miss-word 56 }
|
||||
{ mega-lookup 57 }
|
||||
{ mega-lookup-word 58 }
|
||||
{ mega-miss-word 59 }
|
||||
{ undefined-quot 60 }
|
||||
} ; inline
|
||||
USERENV: undefined-quot 60
|
||||
|
||||
: userenv-offset ( symbol -- n )
|
||||
userenvs at header-size + ;
|
||||
userenvs get at header-size + ;
|
||||
|
||||
: emit ( cell -- ) image get push ;
|
||||
|
||||
|
@ -351,7 +307,8 @@ M: f '
|
|||
[ vocabulary>> , ]
|
||||
[ def>> , ]
|
||||
[ props>> , ]
|
||||
[ direct-entry-def>> , ] ! direct-entry-def
|
||||
[ pic-def>> , ]
|
||||
[ pic-tail-def>> , ]
|
||||
[ drop 0 , ] ! count
|
||||
[ word-sub-primitive , ]
|
||||
[ drop 0 , ] ! xt
|
||||
|
@ -510,11 +467,7 @@ M: quotation '
|
|||
class<=-cache class-not-cache classes-intersect-cache
|
||||
class-and-cache class-or-cache next-method-quot-cache
|
||||
} [ H{ } clone ] H{ } map>assoc assoc-union
|
||||
bootstrap-global set
|
||||
bootstrap-global emit-userenv ;
|
||||
|
||||
: emit-boot-quot ( -- )
|
||||
bootstrap-boot-quot emit-userenv ;
|
||||
bootstrap-global set ;
|
||||
|
||||
: emit-jit-data ( -- )
|
||||
\ if jit-if-word set
|
||||
|
@ -524,46 +477,13 @@ M: quotation '
|
|||
\ 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
|
||||
\ mega-cache-miss \ mega-miss-word set
|
||||
[ undefined ] undefined-quot set
|
||||
{
|
||||
jit-prolog
|
||||
jit-primitive-word
|
||||
jit-primitive
|
||||
jit-word-jump
|
||||
jit-word-call
|
||||
jit-push-immediate
|
||||
jit-if-word
|
||||
jit-if-1
|
||||
jit-if-2
|
||||
jit-dip-word
|
||||
jit-dip
|
||||
jit-2dip-word
|
||||
jit-2dip
|
||||
jit-3dip-word
|
||||
jit-3dip
|
||||
jit-execute-word
|
||||
jit-execute-jump
|
||||
jit-execute-call
|
||||
jit-epilog
|
||||
jit-return
|
||||
jit-profiling
|
||||
jit-save-stack
|
||||
pic-load
|
||||
pic-tag
|
||||
pic-hi-tag
|
||||
pic-tuple
|
||||
pic-hi-tag-tuple
|
||||
pic-check-tag
|
||||
pic-check
|
||||
pic-hit
|
||||
pic-miss-word
|
||||
mega-lookup
|
||||
mega-lookup-word
|
||||
mega-miss-word
|
||||
undefined-quot
|
||||
} [ emit-userenv ] each ;
|
||||
[ undefined ] undefined-quot set ;
|
||||
|
||||
: emit-userenvs ( -- )
|
||||
userenvs get keys [ emit-userenv ] each ;
|
||||
|
||||
: fixup-header ( -- )
|
||||
heap-size data-heap-size-offset fixup ;
|
||||
|
@ -580,8 +500,8 @@ M: quotation '
|
|||
emit-jit-data
|
||||
"Serializing global namespace..." print flush
|
||||
emit-global
|
||||
"Serializing boot quotation..." print flush
|
||||
emit-boot-quot
|
||||
"Serializing user environment..." print flush
|
||||
emit-userenvs
|
||||
"Performing word fixups..." print flush
|
||||
fixup-words
|
||||
"Performing header fixups..." print flush
|
||||
|
|
|
@ -0,0 +1 @@
|
|||
Slava Pestov
|
|
@ -0,0 +1,14 @@
|
|||
! Copyright (C) 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: parser kernel namespaces assocs words.symbol ;
|
||||
IN: bootstrap.image.syntax
|
||||
|
||||
SYMBOL: userenvs
|
||||
|
||||
SYNTAX: RESET H{ } clone userenvs set-global ;
|
||||
|
||||
SYNTAX: USERENV:
|
||||
CREATE-WORD scan-word
|
||||
[ swap userenvs get set-at ]
|
||||
[ drop define-symbol ]
|
||||
2bi ;
|
|
@ -59,6 +59,9 @@ SYMBOL: literal-table
|
|||
: rel-word-pic ( word class -- )
|
||||
[ add-literal ] dip rt-xt-pic rel-fixup ;
|
||||
|
||||
: rel-word-pic-tail ( word class -- )
|
||||
[ add-literal ] dip rt-xt-pic-tail rel-fixup ;
|
||||
|
||||
: rel-primitive ( word class -- )
|
||||
[ def>> first add-literal ] dip rt-primitive rel-fixup ;
|
||||
|
||||
|
|
|
@ -1,7 +1,7 @@
|
|||
! Copyright (C) 2008, 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: math kernel layouts system strings words quotations byte-arrays
|
||||
alien arrays ;
|
||||
alien arrays literals sequences ;
|
||||
IN: compiler.constants
|
||||
|
||||
! These constants must match vm/memory.h
|
||||
|
@ -14,14 +14,14 @@ CONSTANT: deck-bits 18
|
|||
: float-offset ( -- n ) 8 float tag-number - ; inline
|
||||
: string-offset ( -- n ) 4 bootstrap-cells string tag-number - ; inline
|
||||
: string-aux-offset ( -- n ) 2 bootstrap-cells string tag-number - ; inline
|
||||
: profile-count-offset ( -- n ) 7 bootstrap-cells \ word tag-number - ; inline
|
||||
: profile-count-offset ( -- n ) 8 bootstrap-cells \ word tag-number - ; inline
|
||||
: byte-array-offset ( -- n ) 2 bootstrap-cells byte-array tag-number - ; inline
|
||||
: alien-offset ( -- n ) 3 bootstrap-cells alien tag-number - ; inline
|
||||
: underlying-alien-offset ( -- n ) bootstrap-cell alien tag-number - ; inline
|
||||
: tuple-class-offset ( -- n ) bootstrap-cell tuple tag-number - ; inline
|
||||
: word-xt-offset ( -- n ) 9 bootstrap-cells \ word tag-number - ; inline
|
||||
: word-xt-offset ( -- n ) 10 bootstrap-cells \ word tag-number - ; inline
|
||||
: quot-xt-offset ( -- n ) 5 bootstrap-cells quotation tag-number - ; inline
|
||||
: word-code-offset ( -- n ) 10 bootstrap-cells \ word tag-number - ; inline
|
||||
: word-code-offset ( -- n ) 11 bootstrap-cells \ word tag-number - ; inline
|
||||
: array-start-offset ( -- n ) 2 bootstrap-cells array tag-number - ; inline
|
||||
: compiled-header-size ( -- n ) 4 bootstrap-cells ; inline
|
||||
|
||||
|
@ -43,14 +43,12 @@ CONSTANT: rt-dlsym 1
|
|||
CONSTANT: rt-dispatch 2
|
||||
CONSTANT: rt-xt 3
|
||||
CONSTANT: rt-xt-pic 4
|
||||
CONSTANT: rt-here 5
|
||||
CONSTANT: rt-this 6
|
||||
CONSTANT: rt-immediate 7
|
||||
CONSTANT: rt-stack-chain 8
|
||||
CONSTANT: rt-untagged 9
|
||||
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-untagged 10
|
||||
|
||||
: rc-absolute? ( n -- ? )
|
||||
[ rc-absolute-ppc-2/2 = ]
|
||||
[ rc-absolute-cell = ]
|
||||
[ rc-absolute = ]
|
||||
tri or or ;
|
||||
${ rc-absolute-ppc-2/2 rc-absolute-cell rc-absolute } member? ;
|
||||
|
|
|
@ -50,9 +50,6 @@ CONSTANT: rs-reg 14
|
|||
0 6 LOAD32 rc-absolute-ppc-2/2 rt-stack-chain jit-rel
|
||||
7 6 0 LWZ
|
||||
1 7 0 STW
|
||||
] jit-save-stack jit-define
|
||||
|
||||
[
|
||||
0 6 LOAD32 rc-absolute-ppc-2/2 rt-primitive jit-rel
|
||||
6 MTCTR
|
||||
BCTR
|
||||
|
@ -68,11 +65,8 @@ CONSTANT: rs-reg 14
|
|||
0 3 \ f tag-number CMPI
|
||||
2 BEQ
|
||||
0 B rc-relative-ppc-3 rt-xt jit-rel
|
||||
] jit-if-1 jit-define
|
||||
|
||||
[
|
||||
0 B rc-relative-ppc-3 rt-xt jit-rel
|
||||
] jit-if-2 jit-define
|
||||
] jit-if jit-define
|
||||
|
||||
: jit->r ( -- )
|
||||
4 ds-reg 0 LWZ
|
||||
|
|
|
@ -114,7 +114,11 @@ M: ppc stack-frame-size ( stack-frame -- i )
|
|||
4 cells align ;
|
||||
|
||||
M: ppc %call ( word -- ) 0 BL rc-relative-ppc-3 rel-word-pic ;
|
||||
M: ppc %jump ( word -- ) 0 B rc-relative-ppc-3 rel-word ;
|
||||
|
||||
M: ppc %jump ( word -- )
|
||||
0 3 LOAD32 rc-absolute-ppc-2/2 rel-here
|
||||
0 B rc-relative-ppc-3 rel-word-pic-tail ;
|
||||
|
||||
M: ppc %jump-label ( label -- ) B ;
|
||||
M: ppc %return ( -- ) BLR ;
|
||||
|
||||
|
|
|
@ -42,6 +42,8 @@ M:: x86.32 %dispatch ( src temp offset -- )
|
|||
M: x86.32 param-reg-1 EAX ;
|
||||
M: x86.32 param-reg-2 EDX ;
|
||||
|
||||
M: x86.32 pic-tail-reg EBX ;
|
||||
|
||||
M: x86.32 reserved-area-size 0 ;
|
||||
|
||||
M: x86.32 %alien-invoke 0 CALL rc-relative rel-dlsym ;
|
||||
|
|
|
@ -1,4 +1,4 @@
|
|||
! Copyright (C) 2007 Slava Pestov.
|
||||
! Copyright (C) 2007, 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: bootstrap.image.private kernel namespaces system
|
||||
cpu.x86.assembler layouts vocabs parser compiler.constants ;
|
||||
|
@ -26,9 +26,7 @@ IN: bootstrap.x86
|
|||
temp0 0 [] MOV rc-absolute-cell rt-stack-chain jit-rel
|
||||
! save stack pointer
|
||||
temp0 [] stack-reg MOV
|
||||
] jit-save-stack jit-define
|
||||
|
||||
[
|
||||
! call the primitive
|
||||
0 JMP rc-relative rt-primitive jit-rel
|
||||
] jit-primitive jit-define
|
||||
|
||||
|
|
|
@ -39,6 +39,8 @@ M: x86.64 param-reg-1 int-regs param-regs first ;
|
|||
M: x86.64 param-reg-2 int-regs param-regs second ;
|
||||
: param-reg-3 ( -- reg ) int-regs param-regs third ; inline
|
||||
|
||||
M: x86.64 pic-tail-reg RBX ;
|
||||
|
||||
M: int-regs return-reg drop RAX ;
|
||||
M: float-regs return-reg drop XMM0 ;
|
||||
|
||||
|
|
|
@ -1,4 +1,4 @@
|
|||
! Copyright (C) 2007 Slava Pestov.
|
||||
! Copyright (C) 2007, 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: bootstrap.image.private kernel namespaces system
|
||||
cpu.x86.assembler layouts vocabs parser compiler.constants math ;
|
||||
|
@ -25,9 +25,6 @@ IN: bootstrap.x86
|
|||
temp0 temp0 [] MOV
|
||||
! save stack pointer
|
||||
temp0 [] stack-reg MOV
|
||||
] jit-save-stack jit-define
|
||||
|
||||
[
|
||||
! load XT
|
||||
temp1 0 MOV rc-absolute-cell rt-primitive jit-rel
|
||||
! go
|
||||
|
|
|
@ -42,13 +42,18 @@ big-endian off
|
|||
] jit-push-immediate jit-define
|
||||
|
||||
[
|
||||
0 JMP rc-relative rt-xt jit-rel
|
||||
temp3 0 MOV rc-absolute-cell rt-here jit-rel
|
||||
0 JMP rc-relative rt-xt-pic-tail jit-rel
|
||||
] jit-word-jump jit-define
|
||||
|
||||
[
|
||||
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
|
||||
|
@ -58,12 +63,9 @@ big-endian off
|
|||
temp0 \ f tag-number CMP
|
||||
! jump to true branch if not equal
|
||||
0 JNE rc-relative rt-xt jit-rel
|
||||
] jit-if-1 jit-define
|
||||
|
||||
[
|
||||
! jump to false branch if equal
|
||||
0 JMP rc-relative rt-xt jit-rel
|
||||
] jit-if-2 jit-define
|
||||
] jit-if jit-define
|
||||
|
||||
: jit->r ( -- )
|
||||
rs-reg bootstrap-cell ADD
|
||||
|
@ -152,6 +154,8 @@ big-endian off
|
|||
|
||||
! ! ! Polymorphic inline caches
|
||||
|
||||
! The PIC and megamorphic code stubs are not permitted to touch temp3.
|
||||
|
||||
! Load a value from a stack position
|
||||
[
|
||||
temp1 ds-reg HEX: ffffffff [+] MOV rc-absolute rt-untagged jit-rel
|
||||
|
|
|
@ -23,6 +23,8 @@ HOOK: temp-reg-2 cpu ( -- reg )
|
|||
HOOK: param-reg-1 cpu ( -- reg )
|
||||
HOOK: param-reg-2 cpu ( -- reg )
|
||||
|
||||
HOOK: pic-tail-reg cpu ( -- reg )
|
||||
|
||||
M: x86 %load-immediate MOV ;
|
||||
|
||||
M: x86 %load-reference swap 0 MOV rc-absolute-cell rel-immediate ;
|
||||
|
@ -58,8 +60,17 @@ M: x86 stack-frame-size ( stack-frame -- i )
|
|||
align-stack ;
|
||||
|
||||
M: x86 %call ( word -- ) 0 CALL rc-relative rel-word-pic ;
|
||||
M: x86 %jump ( word -- ) 0 JMP rc-relative rel-word ;
|
||||
|
||||
: xt-tail-pic-offset ( -- n )
|
||||
#! See the comment in vm/cpu-x86.hpp
|
||||
cell 4 + 1 + ; inline
|
||||
|
||||
M: x86 %jump ( word -- )
|
||||
pic-tail-reg 0 MOV xt-tail-pic-offset rc-absolute-cell rel-here
|
||||
0 JMP rc-relative rel-word-pic-tail ;
|
||||
|
||||
M: x86 %jump-label ( label -- ) 0 JMP rc-relative label-fixup ;
|
||||
|
||||
M: x86 %return ( -- ) 0 RET ;
|
||||
|
||||
: code-alignment ( align -- n )
|
||||
|
|
|
@ -1,4 +1,30 @@
|
|||
IN: tools.trace.tests
|
||||
USING: tools.trace tools.test sequences ;
|
||||
USING: tools.trace tools.test tools.continuations kernel math combinators
|
||||
sequences ;
|
||||
|
||||
[ { 3 2 1 } ] [ { 1 2 3 } [ reverse ] trace ] unit-test
|
||||
[ { 3 2 1 } ] [ { 1 2 3 } [ reverse ] trace ] unit-test
|
||||
|
||||
GENERIC: method-breakpoint-test ( x -- y )
|
||||
|
||||
TUPLE: method-breakpoint-tuple ;
|
||||
|
||||
M: method-breakpoint-tuple method-breakpoint-test break drop 1 2 + ;
|
||||
|
||||
\ method-breakpoint-test don't-step-into
|
||||
|
||||
[ 3 ]
|
||||
[ [ T{ method-breakpoint-tuple } method-breakpoint-test ] trace ] unit-test
|
||||
|
||||
: case-breakpoint-test ( -- x )
|
||||
5 { [ break 1 + ] } case ;
|
||||
|
||||
\ case-breakpoint-test don't-step-into
|
||||
|
||||
[ 6 ] [ [ case-breakpoint-test ] trace ] unit-test
|
||||
|
||||
: call(-breakpoint-test ( -- x )
|
||||
[ break 1 ] call( -- x ) 2 + ;
|
||||
|
||||
\ call(-breakpoint-test don't-step-into
|
||||
|
||||
[ 3 ] [ [ call(-breakpoint-test ] trace ] unit-test
|
||||
|
|
|
@ -4,19 +4,21 @@ USING: concurrency.promises models tools.continuations kernel
|
|||
sequences concurrency.messaging locals continuations threads
|
||||
namespaces namespaces.private make assocs accessors io strings
|
||||
prettyprint math math.parser words effects summary io.styles classes
|
||||
generic.math combinators.short-circuit ;
|
||||
generic.math combinators.short-circuit kernel.private quotations ;
|
||||
IN: tools.trace
|
||||
|
||||
: callstack-depth ( callstack -- n )
|
||||
callstack>array length 2/ ;
|
||||
|
||||
SYMBOL: end
|
||||
|
||||
SYMBOL: exclude-vocabs
|
||||
SYMBOL: include-vocabs
|
||||
|
||||
exclude-vocabs { "math" "accessors" } swap set-global
|
||||
|
||||
<PRIVATE
|
||||
|
||||
: callstack-depth ( callstack -- n )
|
||||
callstack>array length 2/ ;
|
||||
|
||||
SYMBOL: end
|
||||
|
||||
: include? ( vocab -- ? )
|
||||
include-vocabs get dup [ member? ] [ 2drop t ] if ;
|
||||
|
||||
|
@ -65,15 +67,20 @@ M: trace-step summary
|
|||
[ CHAR: \s <string> write ]
|
||||
[ number>string write ": " write ] bi ;
|
||||
|
||||
: trace-into? ( continuation -- ? )
|
||||
continuation-current into? ;
|
||||
|
||||
: trace-step ( continuation -- continuation' )
|
||||
dup continuation-current end eq? [
|
||||
[ print-depth ]
|
||||
[ print-step ]
|
||||
[
|
||||
dup continuation-current into?
|
||||
[ continuation-step-into ] [ continuation-step ] if
|
||||
] tri
|
||||
] unless ;
|
||||
dup call>> innermost-frame-executing quotation? [
|
||||
dup continuation-current end eq? [
|
||||
[ print-depth ]
|
||||
[ print-step ]
|
||||
[ dup trace-into? [ continuation-step-into ] [ continuation-step ] if ]
|
||||
tri
|
||||
] unless
|
||||
] when ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: trace ( quot -- data )
|
||||
[ [ trace-step ] break-hook ] dip
|
||||
|
|
|
@ -145,7 +145,9 @@ SYMBOL: ui-thread
|
|||
PRIVATE>
|
||||
|
||||
: find-window ( quot -- world )
|
||||
[ windows get values ] dip '[ gadget-child @ ] find-last nip ; inline
|
||||
[ windows get values ] dip
|
||||
'[ dup children>> [ ] [ nip first ] if-empty @ ]
|
||||
find-last nip ; inline
|
||||
|
||||
: ui-running? ( -- ? )
|
||||
\ ui-running get-global ;
|
||||
|
|
|
@ -231,7 +231,8 @@ bi
|
|||
"vocabulary"
|
||||
{ "def" { "quotation" "quotations" } initial: [ ] }
|
||||
"props"
|
||||
{ "direct-entry-def" }
|
||||
"pic-def"
|
||||
"pic-tail-def"
|
||||
{ "counter" { "fixnum" "math" } }
|
||||
{ "sub-primitive" read-only }
|
||||
} define-builtin
|
||||
|
@ -505,6 +506,7 @@ tuple
|
|||
{ "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" "generic.single" (( -- )) }
|
||||
|
|
|
@ -17,8 +17,6 @@ M: hook-combination picker
|
|||
|
||||
M: hook-combination dispatch# drop 0 ;
|
||||
|
||||
M: hook-combination inline-cache-quot 2drop f ;
|
||||
|
||||
M: hook-combination mega-cache-quot
|
||||
1quotation picker [ lookup-method (execute) ] surround ;
|
||||
|
||||
|
|
|
@ -273,5 +273,5 @@ M: growable call-next-hooker call-next-method "growable " prepend ;
|
|||
[ ] [ "IN: generic.single.tests GENERIC: xyz ( a -- b )" eval( -- ) ] unit-test
|
||||
[ ] [ "IN: generic.single.tests MATH: xyz ( a b -- c )" eval( -- ) ] unit-test
|
||||
|
||||
[ f ] [ "xyz" "generic.single.tests" lookup direct-entry-def>> ] unit-test
|
||||
[ f ] [ "xyz" "generic.single.tests" lookup pic-def>> ] unit-test
|
||||
[ f ] [ "xyz" "generic.single.tests" lookup "decision-tree" word-prop ] unit-test
|
|
@ -238,10 +238,14 @@ M: f compile-engine ;
|
|||
[ <engine> compile-engine ] bi
|
||||
] tri ;
|
||||
|
||||
HOOK: inline-cache-quot combination ( word methods -- quot/f )
|
||||
HOOK: inline-cache-quots combination ( word methods -- pic-quot/f pic-tail-quot/f )
|
||||
|
||||
M: single-combination inline-cache-quots 2drop f f ;
|
||||
|
||||
: define-inline-cache-quot ( word methods -- )
|
||||
[ drop ] [ inline-cache-quot ] 2bi >>direct-entry-def drop ;
|
||||
[ drop ] [ inline-cache-quots ] 2bi
|
||||
[ >>pic-def ] [ >>pic-tail-def ] bi*
|
||||
drop ;
|
||||
|
||||
HOOK: mega-cache-quot combination ( methods -- quot/f )
|
||||
|
||||
|
|
|
@ -3,7 +3,7 @@
|
|||
USING: accessors definitions generic generic.single kernel
|
||||
namespaces words math math.order combinators sequences
|
||||
generic.single.private quotations kernel.private
|
||||
assocs arrays layouts ;
|
||||
assocs arrays layouts make ;
|
||||
IN: generic.standard
|
||||
|
||||
TUPLE: standard-combination < single-combination # ;
|
||||
|
@ -38,17 +38,22 @@ M: standard-generic effective-method
|
|||
[ datastack ] dip [ "combination" word-prop #>> swap <reversed> nth ] keep
|
||||
(effective-method) ;
|
||||
|
||||
M: standard-combination inline-cache-quot ( word methods -- )
|
||||
: inline-cache-quot ( word methods miss-word -- quot )
|
||||
[ [ literalize , ] [ , ] [ combination get #>> , { } , , ] tri* ] [ ] make ;
|
||||
|
||||
M: standard-combination inline-cache-quots
|
||||
#! Direct calls to the generic word (not tail calls or indirect calls)
|
||||
#! will jump to the inline cache entry point instead of the megamorphic
|
||||
#! dispatch entry point.
|
||||
combination get #>> [ { } inline-cache-miss ] 3curry [ ] like ;
|
||||
[ \ inline-cache-miss inline-cache-quot ]
|
||||
[ \ inline-cache-miss-tail inline-cache-quot ]
|
||||
2bi ;
|
||||
|
||||
: make-empty-cache ( -- array )
|
||||
mega-cache-size get f <array> ;
|
||||
|
||||
M: standard-combination mega-cache-quot
|
||||
combination get #>> make-empty-cache [ mega-cache-lookup ] 3curry [ ] like ;
|
||||
combination get #>> make-empty-cache \ mega-cache-lookup [ ] 4sequence ;
|
||||
|
||||
M: standard-generic definer drop \ GENERIC# f ;
|
||||
|
||||
|
|
|
@ -155,7 +155,8 @@ M: word reset-word
|
|||
[ subwords forget-all ]
|
||||
[ reset-word ]
|
||||
[
|
||||
f >>direct-entry-def
|
||||
f >>pic-def
|
||||
f >>pic-tail-def
|
||||
{
|
||||
"methods"
|
||||
"combination"
|
||||
|
|
|
@ -27,7 +27,8 @@ void iterate_relocations(code_block *compiled, relocation_iterator iter)
|
|||
{
|
||||
case RT_PRIMITIVE:
|
||||
case RT_XT:
|
||||
case RT_XT_DIRECT:
|
||||
case RT_XT_PIC:
|
||||
case RT_XT_PIC_TAIL:
|
||||
case RT_IMMEDIATE:
|
||||
case RT_HERE:
|
||||
case RT_UNTAGGED:
|
||||
|
@ -171,9 +172,8 @@ void *object_xt(cell obj)
|
|||
}
|
||||
}
|
||||
|
||||
void *word_direct_xt(word *w)
|
||||
static void *xt_pic(word *w, cell tagged_quot)
|
||||
{
|
||||
cell tagged_quot = w->direct_entry_def;
|
||||
if(tagged_quot == F || max_pic_size == 0)
|
||||
return w->xt;
|
||||
else
|
||||
|
@ -186,20 +186,42 @@ void *word_direct_xt(word *w)
|
|||
}
|
||||
}
|
||||
|
||||
void *word_xt_pic(word *w)
|
||||
{
|
||||
return xt_pic(w,w->pic_def);
|
||||
}
|
||||
|
||||
void *word_xt_pic_tail(word *w)
|
||||
{
|
||||
return xt_pic(w,w->pic_tail_def);
|
||||
}
|
||||
|
||||
void update_word_references_step(relocation_entry rel, cell index, code_block *compiled)
|
||||
{
|
||||
relocation_type type = REL_TYPE(rel);
|
||||
if(type == RT_XT || type == RT_XT_DIRECT)
|
||||
if(type == RT_XT || type == RT_XT_PIC || type == RT_XT_PIC_TAIL)
|
||||
{
|
||||
cell offset = REL_OFFSET(rel) + (cell)(compiled + 1);
|
||||
array *literals = untag<array>(compiled->literals);
|
||||
cell obj = array_nth(literals,index);
|
||||
|
||||
void *xt;
|
||||
if(type == RT_XT)
|
||||
switch(type)
|
||||
{
|
||||
case RT_XT:
|
||||
xt = object_xt(obj);
|
||||
else
|
||||
xt = word_direct_xt(untag<word>(obj));
|
||||
break;
|
||||
case RT_XT_PIC:
|
||||
xt = word_xt_pic(untag<word>(obj));
|
||||
break;
|
||||
case RT_XT_PIC_TAIL:
|
||||
xt = word_xt_pic_tail(untag<word>(obj));
|
||||
break;
|
||||
default:
|
||||
critical_error("Oops",type);
|
||||
xt = NULL;
|
||||
break;
|
||||
}
|
||||
|
||||
store_address_in_code_block(REL_CLASS(rel),offset,(cell)xt);
|
||||
}
|
||||
|
@ -367,25 +389,30 @@ void relocate_code_block_step(relocation_entry rel, cell index, code_block *comp
|
|||
array *literals = untag<array>(compiled->literals);
|
||||
fixnum absolute_value;
|
||||
|
||||
#define ARG array_nth(literals,index)
|
||||
|
||||
switch(REL_TYPE(rel))
|
||||
{
|
||||
case RT_PRIMITIVE:
|
||||
absolute_value = (cell)primitives[untag_fixnum(array_nth(literals,index))];
|
||||
absolute_value = (cell)primitives[untag_fixnum(ARG)];
|
||||
break;
|
||||
case RT_DLSYM:
|
||||
absolute_value = (cell)get_rel_symbol(literals,index);
|
||||
break;
|
||||
case RT_IMMEDIATE:
|
||||
absolute_value = array_nth(literals,index);
|
||||
absolute_value = ARG;
|
||||
break;
|
||||
case RT_XT:
|
||||
absolute_value = (cell)object_xt(array_nth(literals,index));
|
||||
absolute_value = (cell)object_xt(ARG);
|
||||
break;
|
||||
case RT_XT_DIRECT:
|
||||
absolute_value = (cell)word_direct_xt(untag<word>(array_nth(literals,index)));
|
||||
case RT_XT_PIC:
|
||||
absolute_value = (cell)word_xt_pic(untag<word>(ARG));
|
||||
break;
|
||||
case RT_XT_PIC_TAIL:
|
||||
absolute_value = (cell)word_xt_pic_tail(untag<word>(ARG));
|
||||
break;
|
||||
case RT_HERE:
|
||||
absolute_value = offset + (short)untag_fixnum(array_nth(literals,index));
|
||||
absolute_value = offset + (short)untag_fixnum(ARG);
|
||||
break;
|
||||
case RT_THIS:
|
||||
absolute_value = (cell)(compiled + 1);
|
||||
|
@ -394,13 +421,15 @@ void relocate_code_block_step(relocation_entry rel, cell index, code_block *comp
|
|||
absolute_value = (cell)&stack_chain;
|
||||
break;
|
||||
case RT_UNTAGGED:
|
||||
absolute_value = untag_fixnum(array_nth(literals,index));
|
||||
absolute_value = untag_fixnum(ARG);
|
||||
break;
|
||||
default:
|
||||
critical_error("Bad rel type",rel);
|
||||
return; /* Can't happen */
|
||||
}
|
||||
|
||||
#undef ARG
|
||||
|
||||
store_address_in_code_block(REL_CLASS(rel),offset,absolute_value);
|
||||
}
|
||||
|
||||
|
|
|
@ -8,10 +8,12 @@ enum relocation_type {
|
|||
RT_DLSYM,
|
||||
/* a pointer to a compiled word reference */
|
||||
RT_DISPATCH,
|
||||
/* a word's general entry point XT */
|
||||
/* a word or quotation's general entry point */
|
||||
RT_XT,
|
||||
/* a word's direct entry point XT */
|
||||
RT_XT_DIRECT,
|
||||
/* a word's PIC entry point */
|
||||
RT_XT_PIC,
|
||||
/* a word's tail-call PIC entry point */
|
||||
RT_XT_PIC_TAIL,
|
||||
/* current offset */
|
||||
RT_HERE,
|
||||
/* current code block */
|
||||
|
|
|
@ -26,8 +26,8 @@ void jit_compile_word(cell word_, cell def_, bool relocate)
|
|||
|
||||
word->code = def->code;
|
||||
|
||||
if(word->direct_entry_def != F)
|
||||
jit_compile(word->direct_entry_def,relocate);
|
||||
if(word->pic_def != F) jit_compile(word->pic_def,relocate);
|
||||
if(word->pic_tail_def != F) jit_compile(word->pic_tail_def,relocate);
|
||||
}
|
||||
|
||||
/* Apply a function to every code block */
|
||||
|
|
|
@ -60,9 +60,10 @@ DEF(bool,check_sse2,(void)):
|
|||
ret
|
||||
|
||||
DEF(F_FASTCALL void,primitive_inline_cache_miss,(void)):
|
||||
mov (%esp),%eax
|
||||
mov (%esp),%ebx
|
||||
DEF(F_FASTCALL void,primitive_inline_cache_miss_tail,(void)):
|
||||
sub $8,%esp
|
||||
push %eax
|
||||
push %ebx
|
||||
call MANGLE(inline_cache_miss)
|
||||
add $12,%esp
|
||||
jmp *%eax
|
||||
|
|
|
@ -73,8 +73,10 @@ DEF(void,set_callstack,(F_STACK_FRAME *to, F_STACK_FRAME *from, CELL length, voi
|
|||
ret /* return _with new stack_ */
|
||||
|
||||
DEF(F_FASTCALL void,primitive_inline_cache_miss,(void)):
|
||||
mov (%rsp),ARG0
|
||||
mov (%rsp),%rbx
|
||||
DEF(F_FASTCALL void,primitive_inline_cache_miss_tail,(void)):
|
||||
sub $STACK_PADDING,%rsp
|
||||
mov %rbx,ARG0
|
||||
call MANGLE(inline_cache_miss)
|
||||
add $STACK_PADDING,%rsp
|
||||
jmp *%rax
|
||||
|
|
|
@ -7,15 +7,29 @@ namespace factor
|
|||
|
||||
inline static void flush_icache(cell start, cell len) {}
|
||||
|
||||
/* In the instruction sequence:
|
||||
|
||||
MOV EBX,...
|
||||
JMP blah
|
||||
|
||||
the offset from the immediate operand to MOV to the instruction after
|
||||
the jump is a cell for the immediate operand, 4 bytes for the JMP
|
||||
destination, and one byte for the JMP opcode. */
|
||||
static const fixnum xt_tail_pic_offset = sizeof(cell) + 4 + 1;
|
||||
|
||||
static const unsigned char call_opcode = 0xe8;
|
||||
static const unsigned char jmp_opcode = 0xe9;
|
||||
|
||||
inline static unsigned char call_site_opcode(cell return_address)
|
||||
{
|
||||
return *(unsigned char *)(return_address - 5);
|
||||
}
|
||||
|
||||
inline static void check_call_site(cell return_address)
|
||||
{
|
||||
/* An x86 CALL instruction looks like so:
|
||||
|e8|..|..|..|..|
|
||||
where the ... are a PC-relative jump address.
|
||||
The return_address points to right after the
|
||||
instruction. */
|
||||
#ifdef FACTOR_DEBUG
|
||||
assert(*(unsigned char *)(return_address - 5) == 0xe8);
|
||||
unsigned char opcode = call_site_opcode(return_address);
|
||||
assert(opcode == call_opcode || opcode == jmp_opcode);
|
||||
#endif
|
||||
}
|
||||
|
||||
|
@ -31,6 +45,11 @@ inline static void set_call_target(cell return_address, void *target)
|
|||
*(int *)(return_address - 4) = ((cell)target - return_address);
|
||||
}
|
||||
|
||||
inline static bool tail_call_site_p(cell return_address)
|
||||
{
|
||||
return call_site_opcode(return_address) == jmp_opcode;
|
||||
}
|
||||
|
||||
/* Defined in assembly */
|
||||
VM_ASM_API void c_to_factor(cell quot);
|
||||
VM_ASM_API void throw_impl(cell quot, stack_frame *rewind_to);
|
||||
|
|
|
@ -86,7 +86,11 @@ struct inline_cache_jit : public jit {
|
|||
inline_cache_jit(cell generic_word_) : jit(PIC_TYPE,generic_word_) {};
|
||||
|
||||
void emit_check(cell klass);
|
||||
void compile_inline_cache(fixnum index, cell generic_word_, cell methods_, cell cache_entries_);
|
||||
void compile_inline_cache(fixnum index,
|
||||
cell generic_word_,
|
||||
cell methods_,
|
||||
cell cache_entries_,
|
||||
bool tail_call_p);
|
||||
};
|
||||
|
||||
void inline_cache_jit::emit_check(cell klass)
|
||||
|
@ -102,7 +106,11 @@ void inline_cache_jit::emit_check(cell klass)
|
|||
|
||||
/* index: 0 = top of stack, 1 = item underneath, etc
|
||||
cache_entries: array of class/method pairs */
|
||||
void inline_cache_jit::compile_inline_cache(fixnum index, cell generic_word_, cell methods_, cell cache_entries_)
|
||||
void inline_cache_jit::compile_inline_cache(fixnum index,
|
||||
cell generic_word_,
|
||||
cell methods_,
|
||||
cell cache_entries_,
|
||||
bool tail_call_p)
|
||||
{
|
||||
gc_root<word> generic_word(generic_word_);
|
||||
gc_root<array> methods(methods_);
|
||||
|
@ -136,20 +144,25 @@ void inline_cache_jit::compile_inline_cache(fixnum index, cell generic_word_, ce
|
|||
push(methods.value());
|
||||
push(tag_fixnum(index));
|
||||
push(cache_entries.value());
|
||||
word_jump(userenv[PIC_MISS_WORD]);
|
||||
word_special(userenv[tail_call_p ? PIC_MISS_TAIL_WORD : PIC_MISS_WORD]);
|
||||
}
|
||||
|
||||
static code_block *compile_inline_cache(fixnum index,
|
||||
cell generic_word_,
|
||||
cell methods_,
|
||||
cell cache_entries_)
|
||||
cell generic_word_,
|
||||
cell methods_,
|
||||
cell cache_entries_,
|
||||
bool tail_call_p)
|
||||
{
|
||||
gc_root<word> generic_word(generic_word_);
|
||||
gc_root<array> methods(methods_);
|
||||
gc_root<array> cache_entries(cache_entries_);
|
||||
|
||||
inline_cache_jit jit(generic_word.value());
|
||||
jit.compile_inline_cache(index,generic_word.value(),methods.value(),cache_entries.value());
|
||||
jit.compile_inline_cache(index,
|
||||
generic_word.value(),
|
||||
methods.value(),
|
||||
cache_entries.value(),
|
||||
tail_call_p);
|
||||
code_block *code = jit.to_code_block();
|
||||
relocate_code_block(code);
|
||||
return code;
|
||||
|
@ -227,14 +240,18 @@ void *inline_cache_miss(cell return_address)
|
|||
xt = compile_inline_cache(index,
|
||||
generic_word.value(),
|
||||
methods.value(),
|
||||
new_cache_entries.value()) + 1;
|
||||
new_cache_entries.value(),
|
||||
tail_call_site_p(return_address))->xt();
|
||||
}
|
||||
|
||||
/* Install the new stub. */
|
||||
set_call_target(return_address,xt);
|
||||
|
||||
#ifdef PIC_DEBUG
|
||||
printf("Updated call site 0x%lx with 0x%lx\n",return_address,(cell)xt);
|
||||
printf("Updated %s call site 0x%lx with 0x%lx\n",
|
||||
tail_call_site_p(return_address) ? "tail" : "non-tail",
|
||||
return_address,
|
||||
(cell)xt);
|
||||
#endif
|
||||
|
||||
return xt;
|
||||
|
|
|
@ -8,7 +8,8 @@ void init_inline_caching(int max_size);
|
|||
PRIMITIVE(reset_inline_cache_stats);
|
||||
PRIMITIVE(inline_cache_stats);
|
||||
PRIMITIVE(inline_cache_miss);
|
||||
PRIMITIVE(inline_cache_miss_tail);
|
||||
|
||||
extern "C" void *inline_cache_miss(cell return_address);
|
||||
VM_C_API void *inline_cache_miss(cell return_address);
|
||||
|
||||
}
|
||||
|
|
29
vm/jit.cpp
29
vm/jit.cpp
|
@ -23,24 +23,21 @@ jit::jit(cell type_, cell owner_)
|
|||
if(stack_traces_p()) literal(owner.value());
|
||||
}
|
||||
|
||||
relocation_entry jit::rel_to_emit(cell code_template, bool *rel_p)
|
||||
void jit::emit_relocation(cell code_template_)
|
||||
{
|
||||
array *quadruple = untag<array>(code_template);
|
||||
cell rel_class = array_nth(quadruple,1);
|
||||
cell rel_type = array_nth(quadruple,2);
|
||||
cell offset = array_nth(quadruple,3);
|
||||
gc_root<array> code_template(code_template_);
|
||||
cell capacity = array_capacity(code_template.untagged());
|
||||
for(cell i = 1; i < capacity; i += 3)
|
||||
{
|
||||
cell rel_class = array_nth(code_template.untagged(),i);
|
||||
cell rel_type = array_nth(code_template.untagged(),i + 1);
|
||||
cell offset = array_nth(code_template.untagged(),i + 2);
|
||||
|
||||
if(rel_class == F)
|
||||
{
|
||||
*rel_p = false;
|
||||
return 0;
|
||||
}
|
||||
else
|
||||
{
|
||||
*rel_p = true;
|
||||
return (untag_fixnum(rel_type) << 28)
|
||||
relocation_entry new_entry
|
||||
= (untag_fixnum(rel_type) << 28)
|
||||
| (untag_fixnum(rel_class) << 24)
|
||||
| ((code.count + untag_fixnum(offset)));
|
||||
relocation.append_bytes(&new_entry,sizeof(relocation_entry));
|
||||
}
|
||||
}
|
||||
|
||||
|
@ -49,9 +46,7 @@ void jit::emit(cell code_template_)
|
|||
{
|
||||
gc_root<array> code_template(code_template_);
|
||||
|
||||
bool rel_p;
|
||||
relocation_entry rel = rel_to_emit(code_template.value(),&rel_p);
|
||||
if(rel_p) relocation.append_bytes(&rel,sizeof(relocation_entry));
|
||||
emit_relocation(code_template.value());
|
||||
|
||||
gc_root<byte_array> insns(array_nth(code_template.untagged(),0));
|
||||
|
||||
|
|
12
vm/jit.hpp
12
vm/jit.hpp
|
@ -14,7 +14,7 @@ struct jit {
|
|||
jit(cell jit_type, cell owner);
|
||||
void compute_position(cell offset);
|
||||
|
||||
relocation_entry rel_to_emit(cell code_template, bool *rel_p);
|
||||
void emit_relocation(cell code_template);
|
||||
void emit(cell code_template);
|
||||
|
||||
void literal(cell literal) { literals.add(literal); }
|
||||
|
@ -25,17 +25,23 @@ struct jit {
|
|||
}
|
||||
|
||||
void word_jump(cell word) {
|
||||
emit_with(userenv[JIT_WORD_JUMP],word);
|
||||
literal(tag_fixnum(xt_tail_pic_offset));
|
||||
literal(word);
|
||||
emit(userenv[JIT_WORD_JUMP]);
|
||||
}
|
||||
|
||||
void word_call(cell word) {
|
||||
emit_with(userenv[JIT_WORD_CALL],word);
|
||||
}
|
||||
|
||||
void word_special(cell word) {
|
||||
emit_with(userenv[JIT_WORD_SPECIAL],word);
|
||||
}
|
||||
|
||||
void emit_subprimitive(cell word_) {
|
||||
gc_root<word> word(word_);
|
||||
gc_root<array> code_template(word->subprimitive);
|
||||
if(array_nth(code_template.untagged(),1) != F) literal(T);
|
||||
if(array_capacity(code_template.untagged()) > 1) literal(T);
|
||||
emit(code_template.value());
|
||||
}
|
||||
|
||||
|
|
|
@ -229,7 +229,9 @@ struct word : public object {
|
|||
/* TAGGED property assoc for library code */
|
||||
cell props;
|
||||
/* TAGGED alternative entry point for direct non-tail calls. Used for inline caching */
|
||||
cell direct_entry_def;
|
||||
cell pic_def;
|
||||
/* TAGGED alternative entry point for direct tail calls. Used for inline caching */
|
||||
cell pic_tail_def;
|
||||
/* TAGGED call count for profiling */
|
||||
cell counter;
|
||||
/* TAGGED machine code for sub-primitive */
|
||||
|
|
|
@ -147,6 +147,7 @@ const primitive_type primitives[] = {
|
|||
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,
|
||||
|
|
|
@ -152,7 +152,23 @@ void quotation_jit::iterate_quotation()
|
|||
{
|
||||
if(stack_frame) emit(userenv[JIT_EPILOG]);
|
||||
tail_call = true;
|
||||
word_jump(obj.value());
|
||||
/* 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() == userenv[PIC_MISS_WORD]
|
||||
|| obj.value() == userenv[PIC_MISS_TAIL_WORD])
|
||||
{
|
||||
word_special(obj.value());
|
||||
}
|
||||
else
|
||||
{
|
||||
word_jump(obj.value());
|
||||
}
|
||||
}
|
||||
else
|
||||
word_call(obj.value());
|
||||
|
@ -165,7 +181,6 @@ void quotation_jit::iterate_quotation()
|
|||
/* Primitive calls */
|
||||
if(primitive_call_p(i))
|
||||
{
|
||||
emit(userenv[JIT_SAVE_STACK]);
|
||||
emit_with(userenv[JIT_PRIMITIVE],obj.value());
|
||||
|
||||
i++;
|
||||
|
@ -187,8 +202,9 @@ void quotation_jit::iterate_quotation()
|
|||
jit_compile(array_nth(elements.untagged(),i + 1),relocate);
|
||||
}
|
||||
|
||||
emit_with(userenv[JIT_IF_1],array_nth(elements.untagged(),i));
|
||||
emit_with(userenv[JIT_IF_2],array_nth(elements.untagged(),i + 1));
|
||||
literal(array_nth(elements.untagged(),i));
|
||||
literal(array_nth(elements.untagged(),i + 1));
|
||||
emit(userenv[JIT_IF]);
|
||||
|
||||
i += 2;
|
||||
|
||||
|
|
10
vm/run.hpp
10
vm/run.hpp
|
@ -41,14 +41,13 @@ enum special_object {
|
|||
JIT_PRIMITIVE,
|
||||
JIT_WORD_JUMP,
|
||||
JIT_WORD_CALL,
|
||||
JIT_WORD_SPECIAL,
|
||||
JIT_IF_WORD,
|
||||
JIT_IF_1,
|
||||
JIT_IF_2,
|
||||
JIT_EPILOG = 33,
|
||||
JIT_IF,
|
||||
JIT_EPILOG,
|
||||
JIT_RETURN,
|
||||
JIT_PROFILING,
|
||||
JIT_PUSH_IMMEDIATE,
|
||||
JIT_SAVE_STACK = 38,
|
||||
JIT_DIP_WORD,
|
||||
JIT_DIP,
|
||||
JIT_2DIP_WORD,
|
||||
|
@ -60,7 +59,7 @@ enum special_object {
|
|||
JIT_EXECUTE_CALL,
|
||||
|
||||
/* Polymorphic inline cache generation in inline_cache.c */
|
||||
PIC_LOAD = 48,
|
||||
PIC_LOAD = 47,
|
||||
PIC_TAG,
|
||||
PIC_HI_TAG,
|
||||
PIC_TUPLE,
|
||||
|
@ -69,6 +68,7 @@ enum special_object {
|
|||
PIC_CHECK,
|
||||
PIC_HIT,
|
||||
PIC_MISS_WORD,
|
||||
PIC_MISS_TAIL_WORD,
|
||||
|
||||
/* Megamorphic cache generation in dispatch.c */
|
||||
MEGA_LOOKUP = 57,
|
||||
|
|
|
@ -16,7 +16,8 @@ word *allot_word(cell vocab_, cell name_)
|
|||
new_word->def = userenv[UNDEFINED_ENV];
|
||||
new_word->props = F;
|
||||
new_word->counter = tag_fixnum(0);
|
||||
new_word->direct_entry_def = F;
|
||||
new_word->pic_def = F;
|
||||
new_word->pic_tail_def = F;
|
||||
new_word->subprimitive = F;
|
||||
new_word->profiling = NULL;
|
||||
new_word->code = NULL;
|
||||
|
|
Loading…
Reference in New Issue