-! Copyright (C) 2008, 2010 Slava Pestov.
+! Copyright (C) 2008, 2010 Slava Pestov, 2011 Alex Vondrak
! See http://factorcode.org/license.txt for BSD license.
-USING: namespaces arrays assocs hashtables kernel accessors fry
-grouping sorting sets sequences locals
-cpu.architecture
-sequences.deep
-compiler.cfg
-compiler.cfg.rpo
-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 ;
+USING: accessors arrays assocs compiler.cfg 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.predecessors
+compiler.cfg.rpo compiler.cfg.utilities grouping kernel
+namespaces sequences sequences.deep ;
IN: compiler.cfg.gvn
GENERIC: simplify ( insn -- insn' )
-M: insn simplify dup rewrite [ simplify ] [ ] ?if ;
+M: insn simplify dup rewrite [ simplify ] [ dup >avail-insn-uses ] ?if ;
M: array simplify [ simplify ] map ;
M: ##copy simplify ;
M: array value-number [ value-number ] each ;
-M: alien-call-insn value-number drop ;
-M: ##callback-inputs value-number drop ;
+: record-defs ( insn -- ) defs-vregs [ dup set-vn ] each ;
+
+M: alien-call-insn value-number record-defs ;
+M: ##callback-inputs value-number record-defs ;
M: ##copy value-number [ src>> vreg>vn ] [ dst>> ] bi set-vn ;
dup >expr dup exprs>vns get at
[ redundant-instruction ] [ useful-instruction ] ?if ;
-! M: ##phi value-number
-! dup inputs>> values [ vreg>vn ] map sift
-! dup all-equal? [
-! [ drop ] [ first redundant-instruction ] if-empty
-! ] [ drop check-redundancy ] if ;
+M: ##phi value-number
+ dup inputs>> values [ vreg>vn ] map sift
+ dup all-equal? [
+ [ drop ] [ first redundant-instruction ] if-empty
+ ] [ drop check-redundancy ] if ;
M: insn value-number
dup defs-vregs length 1 = [ check-redundancy ] [ drop ] if ;
M: array gcse [ gcse ] map ;
-M: alien-call-insn gcse ;
-M: ##callback-inputs gcse ;
-M: ##copy gcse ;
+: defs-available ( insn -- insn )
+ dup defs-vregs [ make-available ] each ;
+
+M: alien-call-insn gcse defs-available ;
+M: ##callback-inputs gcse defs-available ;
+M: ##copy gcse defs-available ;
: ?eliminate ( insn vn -- insn' )
dup available? [
- [ dst>> ] dip <copy>
- ] [ drop make-available ] if ;
+ [ dst>> dup make-available ] dip <copy>
+ ] [ drop defs-available ] if ;
: eliminate-redundancy ( insn -- insn' )
- dup >expr exprs>vns get at
- [ ?eliminate ] [ make-available ] if* ;
+ dup >expr exprs>vns get at >avail-vreg
+ [ ?eliminate ] [ defs-available ] if* ;
-! M: ##phi gcse
-! dup inputs>> values [ vreg>vn ] map sift
-! dup all-equal? [
-! [ first ?eliminate ] unless-empty
-! ] [ drop eliminate-redundancy ] if ;
+M: ##phi gcse
+ dup inputs>> values [ vreg>vn ] map sift
+ dup all-equal? [
+ [ first ?eliminate ] unless-empty
+ ] [ drop eliminate-redundancy ] if ;
M: insn gcse
dup defs-vregs length 1 = [ eliminate-redundancy ] when ;
: gcse-step ( insns -- insns' )
- ! [ simplify gcse ] map flatten ;
- [ gcse ] map flatten ;
+ [ simplify gcse ] map flatten ;
: eliminate-common-subexpressions ( cfg -- )
final-iteration? on
+ compute-congruence-classes
dup compute-avail-sets
[ gcse-step ] simple-optimization ;
-: value-numbering ( cfg -- cfg )
- needs-predecessors
- dup determine-value-numbers
- dup eliminate-common-subexpressions
-
- cfg-changed predecessors-changed ;
+: value-numbering ( cfg -- )
+ {
+ needs-predecessors
+ determine-value-numbers
+ eliminate-common-subexpressions
+ cfg-changed
+ predecessors-changed
+ } apply-passes ;