Inline caching for call(
parent
e1a358a30c
commit
e981090045
|
@ -0,0 +1 @@
|
|||
Slava Pestov
|
|
@ -0,0 +1,91 @@
|
|||
! Copyright (C) 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors combinators combinators.private effects fry
|
||||
kernel kernel.private make sequences continuations
|
||||
stack-checker stack-checker.transforms ;
|
||||
IN: stack-checker.call-effect
|
||||
|
||||
! call( and execute( have complex expansions.
|
||||
|
||||
! call( uses the following strategy:
|
||||
! - Inline caching. If the quotation is the same as last time, just call it unsafely
|
||||
! - Effect inference. Infer quotation's effect, caching it in the cached-effect slot,
|
||||
! and compare it with declaration. If matches, call it unsafely.
|
||||
! - Fallback. If the above doesn't work, call it and compare the datastack before
|
||||
! and after to make sure it didn't mess anything up.
|
||||
|
||||
! execute( uses a similar strategy.
|
||||
|
||||
TUPLE: inline-cache value ;
|
||||
|
||||
: cache-hit? ( word/quot ic -- ? ) value>> eq? ; inline
|
||||
|
||||
SYMBOL: +failed+
|
||||
|
||||
: cached-effect ( quot -- effect )
|
||||
dup cached-effect>>
|
||||
[ ] [
|
||||
[ [ infer ] [ 2drop +failed+ ] recover dup ] keep
|
||||
(>>cached-effect)
|
||||
] ?if ;
|
||||
|
||||
: call-effect-unsafe? ( quot effect -- ? )
|
||||
[ cached-effect ] dip
|
||||
over +failed+ eq?
|
||||
[ 2drop f ] [ effect<= ] if ; inline
|
||||
|
||||
: (call-effect-slow>quot) ( in out effect -- quot )
|
||||
[
|
||||
[ [ datastack ] dip dip ] %
|
||||
[ [ , ] bi@ \ check-datastack , ] dip
|
||||
'[ _ wrong-values ] , \ unless ,
|
||||
] [ ] make ;
|
||||
|
||||
: call-effect-slow>quot ( effect -- quot )
|
||||
[ in>> length ] [ out>> length ] [ ] tri
|
||||
[ (call-effect-slow>quot) ] keep add-effect-input
|
||||
[ call-effect-unsafe ] 2curry ;
|
||||
|
||||
: call-effect-slow ( quot effect -- ) drop call ;
|
||||
|
||||
\ call-effect-slow [ call-effect-slow>quot ] 1 define-transform
|
||||
|
||||
: call-effect-fast ( quot effect inline-cache -- )
|
||||
2over call-effect-unsafe?
|
||||
[ [ nip (>>value) ] [ drop call-effect-unsafe ] 3bi ]
|
||||
[ drop call-effect-slow ]
|
||||
if ; inline
|
||||
|
||||
\ call-effect [
|
||||
inline-cache new '[
|
||||
_
|
||||
3dup nip cache-hit? [
|
||||
drop call-effect-unsafe
|
||||
] [
|
||||
call-effect-fast
|
||||
] if
|
||||
]
|
||||
] 0 define-transform
|
||||
|
||||
: execute-effect-slow ( word effect -- )
|
||||
[ '[ _ execute ] ] dip call-effect-slow ; inline
|
||||
|
||||
: execute-effect-unsafe? ( word effect -- ? )
|
||||
over optimized>> [ [ stack-effect ] dip effect<= ] [ 2drop f ] if ; inline
|
||||
|
||||
: execute-effect-fast ( word effect inline-cache -- )
|
||||
2over execute-effect-unsafe?
|
||||
[ [ nip (>>value) ] [ drop execute-effect-unsafe ] 3bi ]
|
||||
[ drop execute-effect-slow ]
|
||||
if ; inline
|
||||
|
||||
: execute-effect-ic ( word effect inline-cache -- )
|
||||
3dup nip cache-hit?
|
||||
[ drop execute-effect-unsafe ]
|
||||
[ execute-effect-fast ]
|
||||
if ; inline
|
||||
|
||||
: execute-effect>quot ( effect -- quot )
|
||||
inline-cache new '[ _ _ execute-effect-ic ] ;
|
||||
|
||||
\ execute-effect [ execute-effect>quot ] 1 define-transform
|
|
@ -1,7 +1,7 @@
|
|||
! Copyright (C) 2004, 2008 Slava Pestov.
|
||||
! Copyright (C) 2004, 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel io effects namespaces sequences quotations vocabs
|
||||
generic words stack-checker.backend stack-checker.state
|
||||
vocabs.loader generic words stack-checker.backend stack-checker.state
|
||||
stack-checker.known-words stack-checker.transforms
|
||||
stack-checker.errors stack-checker.inlining
|
||||
stack-checker.visitor.dummy ;
|
||||
|
@ -28,3 +28,5 @@ M: callable infer ( quot -- effect )
|
|||
dup subwords [ f "inferred-effect" set-word-prop ] each
|
||||
f "inferred-effect" set-word-prop
|
||||
] each ;
|
||||
|
||||
"stack-checker.call-effect" require
|
|
@ -51,47 +51,6 @@ IN: stack-checker.transforms
|
|||
[ nip "transform-n" set-word-prop ]
|
||||
3bi ;
|
||||
|
||||
! call( and execute(
|
||||
: (call-effect>quot) ( in out effect -- quot )
|
||||
[
|
||||
[ [ datastack ] dip dip ] %
|
||||
[ [ , ] bi@ \ check-datastack , ] dip
|
||||
'[ _ wrong-values ] , \ unless ,
|
||||
] [ ] make ;
|
||||
|
||||
: call-effect>quot ( effect -- quot )
|
||||
[ in>> length ] [ out>> length ] [ ] tri
|
||||
[ (call-effect>quot) ] keep add-effect-input
|
||||
[ call-effect-unsafe ] 2curry ;
|
||||
|
||||
\ call-effect [ call-effect>quot ] 1 define-transform
|
||||
|
||||
: execute-effect-slow ( word effect -- )
|
||||
[ '[ _ execute ] ] dip call-effect ; inline
|
||||
|
||||
TUPLE: inline-cache value ;
|
||||
|
||||
: cache-hit? ( word ic -- ? ) value>> eq? ; inline
|
||||
|
||||
: cache-hit ( word effect ic -- ) drop execute-effect-unsafe ; inline
|
||||
|
||||
: execute-effect-unsafe? ( word effect -- ? )
|
||||
over optimized>> [ [ stack-effect ] dip effect<= ] [ 2drop f ] if ; inline
|
||||
|
||||
: cache-miss ( word effect ic -- )
|
||||
2over execute-effect-unsafe?
|
||||
[ [ nip (>>value) ] [ drop execute-effect-unsafe ] 3bi ]
|
||||
[ drop execute-effect-slow ] if ; inline
|
||||
|
||||
: execute-effect-ic ( word effect ic -- )
|
||||
#! ic is a mutable cell { effect }
|
||||
3dup nip cache-hit? [ cache-hit ] [ cache-miss ] if ; inline
|
||||
|
||||
: execute-effect>quot ( effect -- quot )
|
||||
inline-cache new '[ _ _ execute-effect-ic ] ;
|
||||
|
||||
\ execute-effect [ execute-effect>quot ] 1 define-transform
|
||||
|
||||
! Combinators
|
||||
\ cond [ cond>quot ] 1 define-transform
|
||||
|
||||
|
|
Loading…
Reference in New Issue