Refactoring low-level optimizer to support stack analysis pass
Slava Pestov
parent
eda44f28a6
commit
1db81da264
|
|
@ -1,56 +1 @@
|
|||
USING: compiler.cfg.instructions compiler.cfg.registers
|
||||
compiler.cfg.alias-analysis compiler.cfg.debugger
|
||||
cpu.architecture tools.test kernel ;
|
||||
IN: compiler.cfg.alias-analysis.tests
|
||||
|
||||
[ ] [
|
||||
{
|
||||
T{ ##peek f V int-regs 2 D 1 f }
|
||||
T{ ##box-alien f V int-regs 1 V int-regs 2 }
|
||||
T{ ##slot-imm f V int-regs 3 V int-regs 1 0 3 }
|
||||
} alias-analysis drop
|
||||
] unit-test
|
||||
|
||||
[ ] [
|
||||
{
|
||||
T{ ##load-reference f V int-regs 1 "hello" }
|
||||
T{ ##slot-imm f V int-regs 0 V int-regs 1 0 3 }
|
||||
} alias-analysis drop
|
||||
] unit-test
|
||||
|
||||
[
|
||||
{
|
||||
T{ ##peek f V int-regs 1 D 1 f }
|
||||
T{ ##peek f V int-regs 2 D 2 f }
|
||||
T{ ##replace f V int-regs 1 D 0 f }
|
||||
}
|
||||
] [
|
||||
{
|
||||
T{ ##peek f V int-regs 1 D 1 f }
|
||||
T{ ##peek f V int-regs 2 D 2 f }
|
||||
T{ ##replace f V int-regs 2 D 0 f }
|
||||
T{ ##replace f V int-regs 1 D 0 f }
|
||||
} alias-analysis
|
||||
] unit-test
|
||||
|
||||
[
|
||||
{
|
||||
T{ ##peek f V int-regs 1 D 1 f }
|
||||
T{ ##peek f V int-regs 2 D 0 f }
|
||||
T{ ##copy f V int-regs 3 V int-regs 2 f }
|
||||
T{ ##copy f V int-regs 4 V int-regs 1 f }
|
||||
T{ ##replace f V int-regs 3 D 0 f }
|
||||
T{ ##replace f V int-regs 4 D 1 f }
|
||||
}
|
||||
] [
|
||||
{
|
||||
T{ ##peek f V int-regs 1 D 1 f }
|
||||
T{ ##peek f V int-regs 2 D 0 f }
|
||||
T{ ##replace f V int-regs 1 D 0 f }
|
||||
T{ ##replace f V int-regs 2 D 1 f }
|
||||
T{ ##peek f V int-regs 3 D 1 f }
|
||||
T{ ##peek f V int-regs 4 D 0 f }
|
||||
T{ ##replace f V int-regs 3 D 0 f }
|
||||
T{ ##replace f V int-regs 4 D 1 f }
|
||||
} alias-analysis
|
||||
] unit-test
|
||||
|
|
|
|||
|
|
@ -1,15 +1,13 @@
|
|||
! Copyright (C) 2008 Slava Pestov.
|
||||
! Copyright (C) 2008, 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel math namespaces assocs hashtables sequences arrays
|
||||
accessors vectors combinators sets classes compiler.cfg
|
||||
compiler.cfg.registers compiler.cfg.instructions
|
||||
compiler.cfg.copy-prop ;
|
||||
compiler.cfg.copy-prop compiler.cfg.rpo
|
||||
compiler.cfg.liveness ;
|
||||
IN: compiler.cfg.alias-analysis
|
||||
|
||||
! Alias analysis -- assumes compiler.cfg.height has already run.
|
||||
!
|
||||
! We try to eliminate redundant slot and stack
|
||||
! traffic using some simple heuristics.
|
||||
! We try to eliminate redundant slot operations using some simple heuristics.
|
||||
!
|
||||
! All heap-allocated objects which are loaded from the stack, or
|
||||
! other object slots are pessimistically assumed to belong to
|
||||
|
|
@ -17,9 +15,6 @@ IN: compiler.cfg.alias-analysis
|
|||
!
|
||||
! Freshly-allocated objects get their own alias class.
|
||||
!
|
||||
! The data and retain stack pointer registers are treated
|
||||
! uniformly, and each one gets its own alias class.
|
||||
!
|
||||
! Simple pseudo-C example showing load elimination:
|
||||
!
|
||||
! int *x, *y, z: inputs
|
||||
|
|
@ -189,23 +184,19 @@ SYMBOL: constants
|
|||
GENERIC: insn-slot# ( insn -- slot#/f )
|
||||
GENERIC: insn-object ( insn -- vreg )
|
||||
|
||||
M: ##peek insn-slot# loc>> n>> ;
|
||||
M: ##replace insn-slot# loc>> n>> ;
|
||||
M: ##slot insn-slot# slot>> constant ;
|
||||
M: ##slot-imm insn-slot# slot>> ;
|
||||
M: ##set-slot insn-slot# slot>> constant ;
|
||||
M: ##set-slot-imm insn-slot# slot>> ;
|
||||
M: ##alien-global insn-slot# [ library>> ] [ symbol>> ] bi 2array ;
|
||||
|
||||
M: ##peek insn-object loc>> class ;
|
||||
M: ##replace insn-object loc>> class ;
|
||||
M: ##slot insn-object obj>> resolve ;
|
||||
M: ##slot-imm insn-object obj>> resolve ;
|
||||
M: ##set-slot insn-object obj>> resolve ;
|
||||
M: ##set-slot-imm insn-object obj>> resolve ;
|
||||
M: ##alien-global insn-object drop \ ##alien-global ;
|
||||
|
||||
: init-alias-analysis ( -- )
|
||||
: init-alias-analysis ( basic-block -- )
|
||||
H{ } clone histories set
|
||||
H{ } clone vregs>acs set
|
||||
H{ } clone acs>vregs set
|
||||
|
|
@ -213,11 +204,10 @@ M: ##alien-global insn-object drop \ ##alien-global ;
|
|||
H{ } clone constants set
|
||||
H{ } clone copies set
|
||||
|
||||
live-in keys [ set-heap-ac ] each
|
||||
|
||||
0 ac-counter set
|
||||
next-ac heap-ac set
|
||||
|
||||
ds-loc next-ac set-ac
|
||||
rs-loc next-ac set-ac ;
|
||||
next-ac heap-ac set ;
|
||||
|
||||
GENERIC: analyze-aliases* ( insn -- insn' )
|
||||
|
||||
|
|
@ -292,15 +282,6 @@ GENERIC: eliminate-dead-stores* ( insn -- insn' )
|
|||
] unless
|
||||
] when ;
|
||||
|
||||
M: ##replace eliminate-dead-stores*
|
||||
#! Writes to above the top of the stack can be pruned also.
|
||||
#! This is sound since any such writes are not observable
|
||||
#! after the basic block, and any reads of those locations
|
||||
#! will have been converted to copies by analyze-slot,
|
||||
#! and the final stack height of the basic block is set at
|
||||
#! the beginning by compiler.cfg.stack.
|
||||
dup loc>> n>> 0 < [ drop f ] [ (eliminate-dead-stores) ] if ;
|
||||
|
||||
M: ##set-slot eliminate-dead-stores* (eliminate-dead-stores) ;
|
||||
|
||||
M: ##set-slot-imm eliminate-dead-stores* (eliminate-dead-stores) ;
|
||||
|
|
@ -310,8 +291,13 @@ M: insn eliminate-dead-stores* ;
|
|||
: eliminate-dead-stores ( insns -- insns' )
|
||||
[ insn# set eliminate-dead-stores* ] map-index sift ;
|
||||
|
||||
: alias-analysis ( insns -- insns' )
|
||||
init-alias-analysis
|
||||
analyze-aliases
|
||||
compute-live-stores
|
||||
eliminate-dead-stores ;
|
||||
: alias-analysis-step ( basic-block -- )
|
||||
dup init-alias-analysis
|
||||
[
|
||||
analyze-aliases
|
||||
compute-live-stores
|
||||
eliminate-dead-stores
|
||||
] change-instructions drop ;
|
||||
|
||||
: alias-analysis ( rpo -- )
|
||||
[ alias-analysis-step ] each ;
|
||||
|
|
@ -22,4 +22,4 @@ ERROR: last-insn-not-a-jump insn ;
|
|||
[ instructions>> check-basic-block ] each ;
|
||||
|
||||
: check-cfg ( cfg -- )
|
||||
entry>> reverse-post-order check-rpo ;
|
||||
reverse-post-order check-rpo ;
|
||||
|
|
@ -14,9 +14,9 @@ SYMBOL: live-vregs
|
|||
H{ } clone liveness-graph set
|
||||
H{ } clone live-vregs set ;
|
||||
|
||||
GENERIC: compute-liveness ( insn -- )
|
||||
GENERIC: update-liveness-graph ( insn -- )
|
||||
|
||||
M: ##flushable compute-liveness
|
||||
M: ##flushable update-liveness-graph
|
||||
[ uses-vregs ] [ dst>> ] bi liveness-graph get set-at ;
|
||||
|
||||
: record-live ( vregs -- )
|
||||
|
|
@ -28,7 +28,7 @@ M: ##flushable compute-liveness
|
|||
] if
|
||||
] each ;
|
||||
|
||||
M: insn compute-liveness uses-vregs record-live ;
|
||||
M: insn update-liveness-graph uses-vregs record-live ;
|
||||
|
||||
GENERIC: live-insn? ( insn -- ? )
|
||||
|
||||
|
|
@ -36,9 +36,8 @@ M: ##flushable live-insn? dst>> live-vregs get key? ;
|
|||
|
||||
M: insn live-insn? drop t ;
|
||||
|
||||
: eliminate-dead-code ( rpo -- rpo )
|
||||
: eliminate-dead-code ( rpo -- )
|
||||
init-dead-code
|
||||
[ [ instructions>> [ compute-liveness ] each ] each ]
|
||||
[ [ instructions>> [ update-liveness-graph ] each ] each ]
|
||||
[ [ [ [ live-insn? ] filter ] change-instructions drop ] each ]
|
||||
[ ]
|
||||
tri ;
|
||||
bi ;
|
||||
|
|
@ -37,5 +37,5 @@ PRIVATE>
|
|||
|
||||
: compute-dominance ( cfg -- cfg )
|
||||
H{ } clone idoms set
|
||||
dup entry>> reverse-post-order
|
||||
dup reverse-post-order
|
||||
unclip dup set-idom drop '[ _ iterate ] loop ;
|
||||
|
|
@ -1,7 +1,8 @@
|
|||
! Copyright (C) 2008 Slava Pestov.
|
||||
! Copyright (C) 2008, 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors math namespaces sequences kernel fry
|
||||
compiler.cfg compiler.cfg.registers compiler.cfg.instructions ;
|
||||
compiler.cfg compiler.cfg.registers compiler.cfg.instructions
|
||||
compiler.cfg.rpo ;
|
||||
IN: compiler.cfg.height
|
||||
|
||||
! Combine multiple stack height changes into one at the
|
||||
|
|
@ -42,10 +43,15 @@ M: ##replace normalize-height* normalize-peek/replace ;
|
|||
|
||||
M: insn normalize-height* ;
|
||||
|
||||
: normalize-height ( insns -- insns' )
|
||||
: height-step ( insns -- insns' )
|
||||
0 ds-height set
|
||||
0 rs-height set
|
||||
[ [ compute-heights ] each ]
|
||||
[ [ [ normalize-height* ] map sift ] with-scope ] bi
|
||||
ds-height get dup zero? [ drop ] [ f \ ##inc-d boa prefix ] if
|
||||
rs-height get dup zero? [ drop ] [ f \ ##inc-r boa prefix ] if ;
|
||||
[
|
||||
[ [ compute-heights ] each ]
|
||||
[ [ [ normalize-height* ] map sift ] with-scope ] bi
|
||||
ds-height get dup zero? [ drop ] [ f \ ##inc-d boa prefix ] if
|
||||
rs-height get dup zero? [ drop ] [ f \ ##inc-r boa prefix ] if
|
||||
] change-instructions drop ;
|
||||
|
||||
: normalize-height ( rpo -- )
|
||||
[ height-step ] each ;
|
||||
|
|
|
|||
|
|
@ -44,8 +44,8 @@ M: fixnum ##load-literal tag-fixnum ##load-immediate ;
|
|||
M: f ##load-literal drop \ f tag-number ##load-immediate ;
|
||||
M: object ##load-literal ##load-reference ;
|
||||
|
||||
INSN: ##peek < ##read { loc loc } ;
|
||||
INSN: ##replace < ##write { loc loc } ;
|
||||
INSN: ##peek < ##flushable { loc loc } ;
|
||||
INSN: ##replace < ##effect { loc loc } ;
|
||||
INSN: ##inc-d { n integer } ;
|
||||
INSN: ##inc-r { n integer } ;
|
||||
|
||||
|
|
|
|||
|
|
@ -75,6 +75,6 @@ M: ##compare-float-branch linearize-insn
|
|||
[ [ linearize-basic-block ] each ] { } make ;
|
||||
|
||||
: build-mr ( cfg -- mr )
|
||||
[ entry>> reverse-post-order linearize-basic-blocks ]
|
||||
[ reverse-post-order linearize-basic-blocks ]
|
||||
[ word>> ] [ label>> ]
|
||||
tri <mr> ;
|
||||
|
|
|
|||
|
|
@ -0,0 +1 @@
|
|||
Slava Pestov
|
||||
|
|
@ -0,0 +1,55 @@
|
|||
! Copyright (C) 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel namespaces deques accessors sets sequences assocs fry dlists
|
||||
compiler.cfg.def-use compiler.cfg.rpo ;
|
||||
IN: compiler.cfg.liveness
|
||||
|
||||
! This is a backward dataflow analysis. See http://en.wikipedia.org/wiki/Liveness_analysis
|
||||
|
||||
! Assoc mapping basic blocks to sets of vregs
|
||||
SYMBOL: live-ins
|
||||
|
||||
: live-in ( basic-block -- set ) live-ins get at ;
|
||||
|
||||
! Assoc mapping basic blocks to sets of vregs
|
||||
SYMBOL: live-outs
|
||||
|
||||
: live-out ( basic-block -- set ) live-outs get at ;
|
||||
|
||||
SYMBOL: work-list
|
||||
|
||||
: add-to-work-list ( basic-blocks -- )
|
||||
work-list get '[ _ push-front ] each ;
|
||||
|
||||
: map-unique ( seq quot -- assoc )
|
||||
map concat unique ; inline
|
||||
|
||||
: gen-set ( basic-block -- seq )
|
||||
instructions>> [ uses-vregs ] map-unique ;
|
||||
|
||||
: kill-set ( basic-block -- seq )
|
||||
instructions>> [ defs-vregs ] map-unique ;
|
||||
|
||||
: update-live-in ( basic-block -- changed? )
|
||||
[
|
||||
[ [ gen-set ] [ live-out ] bi assoc-union ]
|
||||
[ kill-set ]
|
||||
bi assoc-diff
|
||||
] keep live-ins get maybe-set-at ;
|
||||
|
||||
: update-live-out ( basic-block -- changed? )
|
||||
[ successors>> [ live-in ] map assoc-combine ] keep
|
||||
live-outs get maybe-set-at ;
|
||||
|
||||
: liveness-step ( basic-block -- )
|
||||
dup update-live-out [
|
||||
dup update-live-in
|
||||
[ predecessors>> add-to-work-list ] [ drop ] if
|
||||
] [ drop ] if ;
|
||||
|
||||
: compute-liveness ( rpo -- )
|
||||
<hashed-dlist> work-list set
|
||||
H{ } clone live-ins set
|
||||
H{ } clone live-outs set
|
||||
<reversed> add-to-work-list
|
||||
work-list get [ liveness-step ] slurp-deque ;
|
||||
|
|
@ -1,29 +1,32 @@
|
|||
! Copyright (C) 2008 Slava Pestov.
|
||||
! Copyright (C) 2008, 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel sequences compiler.cfg.rpo
|
||||
compiler.cfg.instructions
|
||||
USING: kernel sequences accessors combinators
|
||||
compiler.cfg.predecessors
|
||||
compiler.cfg.useless-blocks
|
||||
compiler.cfg.height
|
||||
compiler.cfg.stack-analysis
|
||||
compiler.cfg.alias-analysis
|
||||
compiler.cfg.value-numbering
|
||||
compiler.cfg.dead-code
|
||||
compiler.cfg.write-barrier ;
|
||||
compiler.cfg.dce
|
||||
compiler.cfg.write-barrier
|
||||
compiler.cfg.liveness
|
||||
compiler.cfg.rpo ;
|
||||
IN: compiler.cfg.optimizer
|
||||
|
||||
: trivial? ( insns -- ? )
|
||||
dup length 2 = [ first ##call? ] [ drop f ] if ;
|
||||
|
||||
: optimize-cfg ( cfg -- cfg' )
|
||||
compute-predecessors
|
||||
delete-useless-blocks
|
||||
delete-useless-conditionals
|
||||
: optimize-cfg ( cfg -- cfg )
|
||||
[
|
||||
dup trivial? [
|
||||
normalize-height
|
||||
alias-analysis
|
||||
value-numbering
|
||||
eliminate-dead-code
|
||||
eliminate-write-barriers
|
||||
] unless
|
||||
] change-basic-blocks ;
|
||||
[ compute-predecessors ]
|
||||
[ delete-useless-blocks ]
|
||||
[ delete-useless-conditionals ] tri
|
||||
] [
|
||||
reverse-post-order
|
||||
{
|
||||
[ compute-liveness ]
|
||||
[ normalize-height ]
|
||||
[ stack-analysis ]
|
||||
[ alias-analysis ]
|
||||
[ value-numbering ]
|
||||
[ eliminate-dead-code ]
|
||||
[ eliminate-write-barriers ]
|
||||
} cleave
|
||||
] [ ] tri ;
|
||||
|
|
|
|||
|
|
@ -1,10 +1,10 @@
|
|||
! Copyright (C) 2008 Slava Pestov.
|
||||
! Copyright (C) 2008, 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel accessors sequences compiler.cfg.rpo ;
|
||||
IN: compiler.cfg.predecessors
|
||||
|
||||
: (compute-predecessors) ( bb -- )
|
||||
: predecessors-step ( bb -- )
|
||||
dup successors>> [ predecessors>> push ] with each ;
|
||||
|
||||
: compute-predecessors ( cfg -- cfg' )
|
||||
dup [ (compute-predecessors) ] each-basic-block ;
|
||||
: compute-predecessors ( cfg -- )
|
||||
[ predecessors-step ] each-basic-block ;
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
! Copyright (C) 2008 Slava Pestov.
|
||||
! Copyright (C) 2008, 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel accessors namespaces make math sequences sets
|
||||
assocs fry compiler.cfg compiler.cfg.instructions ;
|
||||
|
|
@ -7,29 +7,24 @@ IN: compiler.cfg.rpo
|
|||
SYMBOL: visited
|
||||
|
||||
: post-order-traversal ( bb -- )
|
||||
dup id>> visited get key? [ drop ] [
|
||||
dup id>> visited get conjoin
|
||||
dup visited get key? [ drop ] [
|
||||
dup visited get conjoin
|
||||
[
|
||||
successors>> <reversed>
|
||||
[ post-order-traversal ] each
|
||||
] [ , ] bi
|
||||
] if ;
|
||||
|
||||
: post-order ( bb -- blocks )
|
||||
[ post-order-traversal ] { } make ;
|
||||
: post-order ( cfg -- blocks )
|
||||
[ entry>> post-order-traversal ] { } make ;
|
||||
|
||||
: number-blocks ( blocks -- )
|
||||
[ >>number drop ] each-index ;
|
||||
|
||||
: reverse-post-order ( bb -- blocks )
|
||||
: reverse-post-order ( cfg -- blocks )
|
||||
H{ } clone visited [
|
||||
post-order <reversed> dup number-blocks
|
||||
] with-variable ; inline
|
||||
|
||||
: each-basic-block ( cfg quot -- )
|
||||
[ entry>> reverse-post-order ] dip each ; inline
|
||||
|
||||
: change-basic-blocks ( cfg quot -- cfg' )
|
||||
[ '[ _ change-instructions drop ] each-basic-block ]
|
||||
[ drop ]
|
||||
2bi ; inline
|
||||
[ reverse-post-order ] dip each ; inline
|
||||
|
|
|
|||
|
|
@ -6,10 +6,6 @@ compiler.cfg.checker compiler.cfg.height compiler.cfg.rpo
|
|||
compiler.cfg.dce compiler.cfg.registers sets ;
|
||||
IN: compiler.cfg.stack-analysis.tests
|
||||
|
||||
[ f ] [ 1 2 H{ { 2 1 } } maybe-set-at ] unit-test
|
||||
[ t ] [ 1 3 H{ { 2 1 } } clone maybe-set-at ] unit-test
|
||||
[ t ] [ 3 2 H{ { 2 1 } } clone maybe-set-at ] unit-test
|
||||
|
||||
! Fundamental invariant: a basic block should not load or store a value more than once
|
||||
: check-for-redundant-ops ( rpo -- )
|
||||
[
|
||||
|
|
@ -25,11 +21,12 @@ IN: compiler.cfg.stack-analysis.tests
|
|||
|
||||
: test-stack-analysis ( quot -- mr )
|
||||
dup cfg? [ test-cfg first ] unless
|
||||
compute-predecessors
|
||||
entry>> reverse-post-order
|
||||
optimize-stack
|
||||
dup [ [ normalize-height ] change-instructions drop ] each
|
||||
dup check-rpo dup check-for-redundant-ops ;
|
||||
dup compute-predecessors
|
||||
reverse-post-order
|
||||
dup stack-analysis
|
||||
dup normalize-height
|
||||
dup check-rpo
|
||||
dup check-for-redundant-ops ;
|
||||
|
||||
[ ] [ [ ] test-stack-analysis drop ] unit-test
|
||||
|
||||
|
|
@ -81,13 +78,13 @@ IN: compiler.cfg.stack-analysis.tests
|
|||
|
||||
! Make sure the replace stores a value with the right height
|
||||
[ ] [
|
||||
[ [ . ] [ 2drop 1 ] if ] test-stack-analysis eliminate-dead-code linearize-basic-blocks
|
||||
[ [ . ] [ 2drop 1 ] if ] test-stack-analysis dup eliminate-dead-code linearize-basic-blocks
|
||||
[ ##replace? ] filter [ length 1 assert= ] [ first loc>> D 0 assert= ] bi
|
||||
] unit-test
|
||||
|
||||
! translate-loc was the wrong way round
|
||||
[ ] [
|
||||
[ 1 2 rot ] test-stack-analysis eliminate-dead-code linearize-basic-blocks
|
||||
[ 1 2 rot ] test-stack-analysis dup eliminate-dead-code linearize-basic-blocks
|
||||
[ [ ##load-immediate? ] count 2 assert= ]
|
||||
[ [ ##peek? ] count 1 assert= ]
|
||||
[ [ ##replace? ] count 3 assert= ]
|
||||
|
|
@ -95,7 +92,7 @@ IN: compiler.cfg.stack-analysis.tests
|
|||
] unit-test
|
||||
|
||||
[ ] [
|
||||
[ 1 2 ? ] test-stack-analysis eliminate-dead-code linearize-basic-blocks
|
||||
[ 1 2 ? ] test-stack-analysis dup eliminate-dead-code linearize-basic-blocks
|
||||
[ [ ##load-immediate? ] count 2 assert= ]
|
||||
[ [ ##peek? ] count 1 assert= ]
|
||||
[ [ ##replace? ] count 1 assert= ]
|
||||
|
|
@ -104,6 +101,6 @@ IN: compiler.cfg.stack-analysis.tests
|
|||
|
||||
! Sync before a back-edge, not after
|
||||
[ 1 ] [
|
||||
[ 1000 [ ] times ] test-stack-analysis eliminate-dead-code linearize-basic-blocks
|
||||
[ 1000 [ ] times ] test-stack-analysis dup eliminate-dead-code linearize-basic-blocks
|
||||
[ ##add-imm? ] count
|
||||
] unit-test
|
||||
|
|
@ -10,15 +10,15 @@ IN: compiler.cfg.stack-analysis
|
|||
|
||||
! If 'poisoned' is set, disregard height information. This is set if we don't have
|
||||
! height change information for an instruction.
|
||||
TUPLE: state locs>vregs actual-locs>vregs changed-locs d-height r-height poisoned? ;
|
||||
TUPLE: state locs>vregs actual-locs>vregs changed-locs ds-height rs-height poisoned? ;
|
||||
|
||||
: <state> ( -- state )
|
||||
state new
|
||||
H{ } clone >>locs>vregs
|
||||
H{ } clone >>actual-locs>vregs
|
||||
H{ } clone >>changed-locs
|
||||
0 >>d-height
|
||||
0 >>r-height ;
|
||||
0 >>ds-height
|
||||
0 >>rs-height ;
|
||||
|
||||
M: state clone
|
||||
call-next-method
|
||||
|
|
@ -39,8 +39,8 @@ M: state clone
|
|||
|
||||
GENERIC: height-for ( loc -- n )
|
||||
|
||||
M: ds-loc height-for drop state get d-height>> ;
|
||||
M: rs-loc height-for drop state get r-height>> ;
|
||||
M: ds-loc height-for drop state get ds-height>> ;
|
||||
M: rs-loc height-for drop state get rs-height>> ;
|
||||
|
||||
: (translate-loc) ( loc -- n height ) [ n>> ] [ height-for ] bi ; inline
|
||||
|
||||
|
|
@ -105,11 +105,11 @@ M: sync-if-back-edge visit
|
|||
[ sync-state ] when
|
||||
, ;
|
||||
|
||||
: adjust-d ( n -- ) state get [ + ] change-d-height drop ;
|
||||
: adjust-d ( n -- ) state get [ + ] change-ds-height drop ;
|
||||
|
||||
M: ##inc-d visit [ , ] [ n>> adjust-d ] bi ;
|
||||
|
||||
: adjust-r ( n -- ) state get [ + ] change-r-height drop ;
|
||||
: adjust-r ( n -- ) state get [ + ] change-rs-height drop ;
|
||||
|
||||
M: ##inc-r visit [ , ] [ n>> adjust-r ] bi ;
|
||||
|
||||
|
|
@ -198,8 +198,8 @@ ERROR: must-equal-failed seq ;
|
|||
|
||||
: merge-heights ( state predecessors states -- state )
|
||||
nip
|
||||
[ [ d-height>> ] map must-equal >>d-height ]
|
||||
[ [ r-height>> ] map must-equal >>r-height ] bi ;
|
||||
[ [ ds-height>> ] map must-equal >>ds-height ]
|
||||
[ [ rs-height>> ] map must-equal >>rs-height ] bi ;
|
||||
|
||||
: insert-peek ( predecessor loc -- vreg )
|
||||
! XXX critical edges
|
||||
|
|
@ -300,10 +300,10 @@ ERROR: cannot-merge-poisoned states ;
|
|||
] 2bi
|
||||
] V{ } make >>instructions drop ;
|
||||
|
||||
: optimize-stack ( rpo -- rpo )
|
||||
: stack-analysis ( rpo -- )
|
||||
[
|
||||
H{ } clone copies set
|
||||
H{ } clone state-in set
|
||||
H{ } clone state-out set
|
||||
dup [ visit-block ] each
|
||||
[ visit-block ] each
|
||||
] with-scope ;
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
! Copyright (C) 2008 Slava Pestov.
|
||||
! Copyright (C) 2008, 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel accessors sequences combinators classes vectors
|
||||
compiler.cfg compiler.cfg.rpo compiler.cfg.instructions ;
|
||||
compiler.cfg compiler.cfg.instructions compiler.cfg.rpo ;
|
||||
IN: compiler.cfg.useless-blocks
|
||||
|
||||
: update-predecessor-for-delete ( bb -- )
|
||||
|
|
@ -30,8 +30,8 @@ IN: compiler.cfg.useless-blocks
|
|||
[ t ]
|
||||
} cond nip ;
|
||||
|
||||
: delete-useless-blocks ( cfg -- cfg' )
|
||||
dup [
|
||||
: delete-useless-blocks ( cfg -- )
|
||||
[
|
||||
dup delete-basic-block? [ delete-basic-block ] [ drop ] if
|
||||
] each-basic-block ;
|
||||
|
||||
|
|
@ -49,7 +49,7 @@ IN: compiler.cfg.useless-blocks
|
|||
[ but-last f \ ##branch boa suffix ] change-instructions
|
||||
drop ;
|
||||
|
||||
: delete-useless-conditionals ( cfg -- cfg' )
|
||||
dup [
|
||||
: delete-useless-conditionals ( cfg -- )
|
||||
[
|
||||
dup delete-conditional? [ delete-conditional ] [ drop ] if
|
||||
] each-basic-block ;
|
||||
|
|
|
|||
|
|
@ -22,17 +22,17 @@ M: constant-expr equal?
|
|||
and
|
||||
] [ 2drop f ] if ;
|
||||
|
||||
SYMBOL: input-expr-counter
|
||||
|
||||
: next-input-expr ( -- n )
|
||||
input-expr-counter [ dup 1 + ] change ;
|
||||
|
||||
! Expressions whose values are inputs to the basic block. We
|
||||
! can eliminate a second computation having the same 'n' as
|
||||
! the first one; we can also eliminate input-exprs whose
|
||||
! result is not used.
|
||||
TUPLE: input-expr < expr n ;
|
||||
|
||||
SYMBOL: input-expr-counter
|
||||
|
||||
: next-input-expr ( class -- expr )
|
||||
input-expr-counter [ dup 1 + ] change input-expr boa ;
|
||||
|
||||
: constant>vn ( constant -- vn ) <constant> expr>vn ; inline
|
||||
|
||||
GENERIC: >expr ( insn -- expr )
|
||||
|
|
@ -80,7 +80,7 @@ M: ##compare-imm >expr compare-imm>expr ;
|
|||
|
||||
M: ##compare-float >expr compare>expr ;
|
||||
|
||||
M: ##flushable >expr class next-input-expr input-expr boa ;
|
||||
M: ##flushable >expr class next-input-expr ;
|
||||
|
||||
: init-expressions ( -- )
|
||||
0 input-expr-counter set ;
|
||||
|
|
|
|||
|
|
@ -2,7 +2,7 @@ IN: compiler.cfg.value-numbering.tests
|
|||
USING: compiler.cfg.value-numbering compiler.cfg.instructions
|
||||
compiler.cfg.registers compiler.cfg.debugger cpu.architecture
|
||||
tools.test kernel math combinators.short-circuit accessors
|
||||
sequences ;
|
||||
sequences compiler.cfg vectors arrays ;
|
||||
|
||||
: trim-temps ( insns -- insns )
|
||||
[
|
||||
|
|
@ -13,6 +13,10 @@ sequences ;
|
|||
} 1|| [ f >>temp ] when
|
||||
] map ;
|
||||
|
||||
: test-value-numbering ( insns -- insns )
|
||||
basic-block new swap >vector >>instructions
|
||||
dup value-numbering-step instructions>> >array ;
|
||||
|
||||
[
|
||||
{
|
||||
T{ ##peek f V int-regs 45 D 1 }
|
||||
|
|
@ -24,7 +28,7 @@ sequences ;
|
|||
T{ ##peek f V int-regs 45 D 1 }
|
||||
T{ ##copy f V int-regs 48 V int-regs 45 }
|
||||
T{ ##compare-imm-branch f V int-regs 48 7 cc/= }
|
||||
} value-numbering
|
||||
} test-value-numbering
|
||||
] unit-test
|
||||
|
||||
[
|
||||
|
|
@ -40,14 +44,14 @@ sequences ;
|
|||
T{ ##peek f V int-regs 3 D 0 }
|
||||
T{ ##slot-imm f V int-regs 4 V int-regs 3 1 3 }
|
||||
T{ ##replace f V int-regs 4 D 0 }
|
||||
} value-numbering
|
||||
} test-value-numbering
|
||||
] unit-test
|
||||
|
||||
[ t ] [
|
||||
{
|
||||
T{ ##peek f V int-regs 1 D 0 }
|
||||
T{ ##dispatch f V int-regs 1 V int-regs 2 0 }
|
||||
} dup value-numbering =
|
||||
} dup test-value-numbering =
|
||||
] unit-test
|
||||
|
||||
[ t ] [
|
||||
|
|
@ -60,7 +64,7 @@ sequences ;
|
|||
T{ ##alien-unsigned-1 f V int-regs 22 V int-regs 21 }
|
||||
T{ ##shl-imm f V int-regs 23 V int-regs 22 3 }
|
||||
T{ ##replace f V int-regs 23 D 0 }
|
||||
} dup value-numbering =
|
||||
} dup test-value-numbering =
|
||||
] unit-test
|
||||
|
||||
[
|
||||
|
|
@ -76,7 +80,7 @@ sequences ;
|
|||
T{ ##mul-imm f V int-regs 2 V int-regs 1 8 }
|
||||
T{ ##shr-imm f V int-regs 3 V int-regs 2 3 }
|
||||
T{ ##replace f V int-regs 3 D 0 }
|
||||
} value-numbering
|
||||
} test-value-numbering
|
||||
] unit-test
|
||||
|
||||
[
|
||||
|
|
@ -94,7 +98,7 @@ sequences ;
|
|||
T{ ##compare f V int-regs 4 V int-regs 2 V int-regs 1 cc> }
|
||||
T{ ##compare-imm f V int-regs 6 V int-regs 4 5 cc/= }
|
||||
T{ ##replace f V int-regs 6 D 0 }
|
||||
} value-numbering trim-temps
|
||||
} test-value-numbering trim-temps
|
||||
] unit-test
|
||||
|
||||
[
|
||||
|
|
@ -112,7 +116,7 @@ sequences ;
|
|||
T{ ##compare f V int-regs 4 V int-regs 2 V int-regs 1 cc<= }
|
||||
T{ ##compare-imm f V int-regs 6 V int-regs 4 5 cc= }
|
||||
T{ ##replace f V int-regs 6 D 0 }
|
||||
} value-numbering trim-temps
|
||||
} test-value-numbering trim-temps
|
||||
] unit-test
|
||||
|
||||
[
|
||||
|
|
@ -134,7 +138,7 @@ sequences ;
|
|||
T{ ##compare-float f V int-regs 12 V double-float-regs 10 V double-float-regs 11 cc< }
|
||||
T{ ##compare-imm f V int-regs 14 V int-regs 12 5 cc= }
|
||||
T{ ##replace f V int-regs 14 D 0 }
|
||||
} value-numbering trim-temps
|
||||
} test-value-numbering trim-temps
|
||||
] unit-test
|
||||
|
||||
[
|
||||
|
|
@ -150,5 +154,5 @@ sequences ;
|
|||
T{ ##peek f V int-regs 30 D -2 }
|
||||
T{ ##compare f V int-regs 33 V int-regs 29 V int-regs 30 cc<= }
|
||||
T{ ##compare-imm-branch f V int-regs 33 5 cc/= }
|
||||
} value-numbering trim-temps
|
||||
} test-value-numbering trim-temps
|
||||
] unit-test
|
||||
|
|
|
|||
|
|
@ -2,6 +2,7 @@
|
|||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: namespaces assocs biassocs classes kernel math accessors
|
||||
sorting sets sequences
|
||||
compiler.cfg.liveness
|
||||
compiler.cfg.value-numbering.graph
|
||||
compiler.cfg.value-numbering.expressions
|
||||
compiler.cfg.value-numbering.propagate
|
||||
|
|
@ -9,7 +10,14 @@ compiler.cfg.value-numbering.simplify
|
|||
compiler.cfg.value-numbering.rewrite ;
|
||||
IN: compiler.cfg.value-numbering
|
||||
|
||||
: value-numbering ( insns -- insns' )
|
||||
: number-input-values ( basic-block -- )
|
||||
live-in keys [ [ next-input-expr ] dip set-vn ] each ;
|
||||
|
||||
: value-numbering-step ( basic-block -- )
|
||||
init-value-graph
|
||||
init-expressions
|
||||
[ [ number-values ] [ rewrite propagate ] bi ] map ;
|
||||
dup number-input-values
|
||||
[ [ [ number-values ] [ rewrite propagate ] bi ] map ] change-instructions drop ;
|
||||
|
||||
: value-numbering ( rpo -- )
|
||||
[ value-numbering-step ] each ;
|
||||
|
|
|
|||
|
|
@ -1,8 +1,12 @@
|
|||
USING: compiler.cfg.write-barrier compiler.cfg.instructions
|
||||
compiler.cfg.registers compiler.cfg.debugger cpu.architecture
|
||||
arrays tools.test ;
|
||||
arrays tools.test vectors compiler.cfg kernel accessors ;
|
||||
IN: compiler.cfg.write-barrier.tests
|
||||
|
||||
: test-write-barrier ( insns -- insns )
|
||||
basic-block new swap >vector >>instructions
|
||||
dup write-barriers-step instructions>> >array ;
|
||||
|
||||
[
|
||||
{
|
||||
T{ ##peek f V int-regs 4 D 0 f }
|
||||
|
|
@ -24,7 +28,7 @@ IN: compiler.cfg.write-barrier.tests
|
|||
T{ ##set-slot-imm f V int-regs 6 V int-regs 7 2 3 }
|
||||
T{ ##write-barrier f V int-regs 7 V int-regs 12 V int-regs 13 }
|
||||
T{ ##replace f V int-regs 7 D 0 }
|
||||
} eliminate-write-barriers
|
||||
} test-write-barrier
|
||||
] unit-test
|
||||
|
||||
[
|
||||
|
|
@ -42,7 +46,7 @@ IN: compiler.cfg.write-barrier.tests
|
|||
T{ ##peek f V int-regs 6 D -2 }
|
||||
T{ ##set-slot-imm f V int-regs 5 V int-regs 6 3 2 }
|
||||
T{ ##write-barrier f V int-regs 6 V int-regs 7 V int-regs 8 }
|
||||
} eliminate-write-barriers
|
||||
} test-write-barrier
|
||||
] unit-test
|
||||
|
||||
[
|
||||
|
|
@ -69,5 +73,5 @@ IN: compiler.cfg.write-barrier.tests
|
|||
T{ ##copy f V int-regs 29 V int-regs 19 }
|
||||
T{ ##set-slot-imm f V int-regs 28 V int-regs 29 4 2 }
|
||||
T{ ##write-barrier f V int-regs 29 V int-regs 30 V int-regs 3 }
|
||||
} eliminate-write-barriers
|
||||
} test-write-barrier
|
||||
] unit-test
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
! Copyright (C) 2008 Slava Pestov.
|
||||
! Copyright (C) 2008, 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel accessors namespaces assocs sets sequences locals
|
||||
compiler.cfg compiler.cfg.instructions compiler.cfg.copy-prop ;
|
||||
|
|
@ -35,8 +35,11 @@ M: ##set-slot-imm eliminate-write-barrier
|
|||
|
||||
M: insn eliminate-write-barrier ;
|
||||
|
||||
: eliminate-write-barriers ( insns -- insns' )
|
||||
: write-barriers-step ( basic-block -- )
|
||||
H{ } clone safe set
|
||||
H{ } clone mutated set
|
||||
H{ } clone copies set
|
||||
[ eliminate-write-barrier ] map sift ;
|
||||
[ [ eliminate-write-barrier ] map sift ] change-instructions drop ;
|
||||
|
||||
: eliminate-write-barriers ( rpo -- )
|
||||
[ write-barriers-step ] each ;
|
||||
|
|
|
|||
Loading…
Reference in New Issue