--- /dev/null
+! Copyright (C) 2011 Alex Vondrak.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors assocs compiler.cfg
+compiler.cfg.dataflow-analysis compiler.cfg.def-use hashtables
+kernel namespaces sequences ;
+IN: compiler.cfg.gvn.avail
+
+! assoc mapping basic blocks to the set of value numbers that
+! are defined in the block
+SYMBOL: bbs>defns
+
+! : defined ( bb -- vns ) bbs>defns get at ;
+
+: defined ( bb -- vregs )
+ instructions>> [ defs-vregs ] map concat [ dup ] H{ } map>assoc ;
+
+FORWARD-ANALYSIS: avail
+
+M: avail-analysis transfer-set drop defined assoc-union ;
+
+: available? ( vn -- ? )
+ basic-block get avail-ins get at key? ;
+
+: make-available ( insn -- insn )
+ dup dst>>
+ basic-block get avail-ins get [ dupd ?set-at ] change-at ;
! Copyright (C) 2008, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors kernel math namespaces assocs ;
+USING: accessors compiler.cfg.gvn.avail kernel math namespaces
+assocs ;
IN: compiler.cfg.gvn.graph
SYMBOL: input-expr-counter
! assoc mapping value numbers to instructions
SYMBOL: vns>insns
-! assoc mapping basic blocks to the set of value numbers that
-! are defined in the block
-SYMBOL: bbs>defns
-
! boolean to track whether vregs>vns changes
SYMBOL: changed?
+! boolean to track when it's safe to alter the CFG in a rewrite
+! method (i.e., after vregs>vns stops changing)
+SYMBOL: final-iteration?
+
: vn>insn ( vn -- insn ) vns>insns get at ;
-: vreg>vn ( vreg -- vn ) vregs>vns get at ;
+: vreg>canon-vn ( vreg -- vn )
+ vregs>vns get at ;
+
+: vreg>avail-vn ( vreg -- vn )
+ dup vreg>canon-vn dup available? [ nip ] [ drop ] if ;
+
+: vreg>vn ( vreg -- vn )
+ final-iteration? get [ vreg>avail-vn ] [ vreg>canon-vn ] if ;
: set-vn ( vn vreg -- )
vregs>vns get maybe-set-at [ changed? on ] when ;
: vreg>insn ( vreg -- insn ) vreg>vn vn>insn ;
-: defined ( bb -- vns ) bbs>defns get at ;
-
: clear-exprs ( -- )
exprs>vns get clear-assoc
vns>insns get clear-assoc
compiler.cfg.def-use
compiler.cfg.utilities
compiler.cfg.instructions
+compiler.cfg.predecessors
compiler.cfg.gvn.alien
+compiler.cfg.gvn.avail
compiler.cfg.gvn.comparisons
compiler.cfg.gvn.graph
compiler.cfg.gvn.math
compiler.cfg.gvn.rewrite
compiler.cfg.gvn.slots
compiler.cfg.gvn.misc
-compiler.cfg.gvn.expressions ;
+compiler.cfg.gvn.expressions
+compiler.cfg.gvn.redundancy-elimination ;
IN: compiler.cfg.gvn
GENERIC: process-instruction ( insn -- insn' )
changed? get
] loop ;
-! FIXME can't just do a pass through the cfg to rewrite---not
-! all canonical leaders are necessarily available in a
-! particular rewrite
-
-: eliminate-redundancies ( cfg -- )
- final-iteration? on
- clear-exprs
- [ value-numbering-step ] simple-optimization ;
-
: value-numbering ( cfg -- cfg )
+ needs-predecessors
+
dup identify-redundancies
- ! dup eliminate-redundancies
+ dup eliminate-redundancies
+
cfg-changed predecessors-changed ;
! Copyright (C) 2011 Alex Vondrak.
! See http://factorcode.org/license.txt for BSD license.
-USING: ;
+USING: accessors arrays assocs combinators.short-circuit
+compiler.cfg.def-use compiler.cfg.gvn.avail
+compiler.cfg.gvn.expressions compiler.cfg.gvn.graph
+compiler.cfg.gvn.rewrite compiler.cfg.instructions
+compiler.cfg.registers compiler.cfg.renaming.functor
+compiler.cfg.rpo compiler.cfg.utilities kernel namespaces
+sequences sequences.deep ;
IN: compiler.cfg.gvn.redundancy-elimination
-! ! ! Available expressions analysis
+RENAMING: copy-prop [ vreg>vn ] [ vreg>vn ] [ drop next-vreg ]
-FORWARD-ANALYSIS: avail
+: copy-prop ( insn -- insn' )
+ dup vreg-insn? [ dup copy-prop-insn-uses ] when ;
-M: avail-analysis transfer-set drop defined assoc-union ;
+GENERIC: update-insn ( insn -- insn/f )
-: available? ( vn -- ? )
- basic-block get avail-ins get at key? ;
-
-! ! ! Copy propagation
-
-RENAMING: propagate [ vreg>avail-vn ] [ vreg>avail-vn ] [ drop next-vreg ]
-
-! ! ! Redundancy elimination
-
-! Returns f if insn should be removed
-GENERIC: process-instruction ( insn -- insn'/f )
-
-: redundant-instruction ( insn vn -- f ) 2drop f ; inline
-
-: make-available ( vn -- )
- dup basic-block get avail-ins get [ ?set-at ] change-at ;
-
-:: useful-instruction ( insn expr -- insn' )
- insn dst>> :> vn
- vn make-available
- insn propagate-insn-uses ! I think that's right?
- insn ;
-
-: check-redundancy ( insn -- insn'/f )
- dup >expr dup exrs>vns get at
- [ redundant-instruction ] [ useful-instruction ] ?if ;
+: canonical-leader? ( vreg -- ? ) dup vreg>vn = ;
: check-redundancy? ( insn -- ? )
defs-vregs {
[ length 1 = ]
- [ first dup vreg>vn = not ] ! avoid ##copy x x
+ ! [ first canonical-leader? not ]
} 1&& ;
-M: insn process-instruction
- dup rewrite
- [ process-instruction ]
- [ dup check-redundancy? [ check-redundancy ] when ] ?if ;
+: redundant? ( insn -- ? )
+ ! [ dst>> ] [ >expr exprs>vns get at ] bi = not ;
+ >expr exprs>vns get key? ;
+
+: check-redundancy ( insn -- insn/f )
+ dup check-redundancy? [
+ dup redundant?
+ [ [ dst>> ] [ >expr exprs>vns get at ] bi <copy> ]
+ [ make-available ] if
+ ] when ;
+
+M: insn update-insn
+ dup rewrite [ update-insn ] [ check-redundancy ] ?if ;
+
+M: ##copy update-insn ;
-M: ##copy process-instruction drop f ;
+M: array update-insn [ update-insn ] map ;
-M: array process-instruction [ process-instruction ] map ;
+: (eliminate-redundancies) ( insns -- insns' )
+ [ update-insn ] map flatten sift ;
-: redundancy-elimination-step ( insns -- insns' )
- [ process-instruction ] map flatten sift ;
+! USING: accessors io prettyprint compiler.cfg compiler.cfg.graphviz
+! graphviz.render ;
-: eliminate-redunancies ( cfg -- )
- final-iteration? on ! if vreg>vn uses this to obey avail-ins
+: eliminate-redundancies ( cfg -- )
+ final-iteration? on
dup compute-avail-sets
- [ redundancy-elimination-step ] simple-optimization ;
+ [
+ ! "Before:" print
+ ! avail-ins get [ [ number>> ] [ keys ] bi* ] assoc-map .
+ (eliminate-redundancies)
+ ! "After:" print
+ ! avail-ins get [ [ number>> ] [ keys ] bi* ] assoc-map .
+ ! cfg get cfgviz preview
+ ] simple-optimization ;
projects / factor.git / commitdiff