extra/compiler/cfg/gvn/gvn.factor

   1 ! Copyright (C) 2008, 2010 Slava Pestov, 2011 Alex Vondrak
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors arrays assocs compiler.cfg compiler.cfg.def-use
   4 compiler.cfg.gvn.avail compiler.cfg.gvn.expressions
   5 compiler.cfg.gvn.graph compiler.cfg.gvn.rewrite
   6 compiler.cfg.instructions compiler.cfg.predecessors
   7 compiler.cfg.rpo compiler.cfg.utilities grouping kernel
   8 namespaces sequences sequences.deep ;
   9 IN: compiler.cfg.gvn
  10
  11 GENERIC: simplify ( insn -- insn' )
  12
  13 M: insn simplify dup rewrite [ simplify ] [ dup >avail-insn-uses ] ?if ;
  14 M: array simplify [ simplify ] map ;
  15 M: ##copy simplify ;
  16
  17 ! ! ! Global value numbering
  18
  19 GENERIC: value-number ( insn -- )
  20
  21 M: array value-number [ value-number ] each ;
  22
  23 : record-defs ( insn -- ) defs-vregs [ dup set-vn ] each ;
  24
  25 M: alien-call-insn value-number record-defs ;
  26 M: ##callback-inputs value-number record-defs ;
  27
  28 M: ##copy value-number [ src>> vreg>vn ] [ dst>> ] bi set-vn ;
  29
  30 : redundant-instruction ( insn vn -- )
  31     swap dst>> set-vn ;
  32
  33 :: useful-instruction ( insn expr -- )
  34     insn dst>> :> vn
  35     vn vn set-vn
  36     vn expr exprs>vns get set-at
  37     insn vn vns>insns get set-at ;
  38
  39 : check-redundancy ( insn -- )
  40     dup >expr dup exprs>vns get at
  41     [ redundant-instruction ] [ useful-instruction ] ?if ;
  42
  43 M: ##phi value-number
  44     dup inputs>> values [ vreg>vn ] map sift
  45     dup all-equal? [
  46         [ drop ] [ first redundant-instruction ] if-empty
  47     ] [ drop check-redundancy ] if ;
  48
  49 M: insn value-number
  50     dup defs-vregs length 1 = [ check-redundancy ] [ drop ] if ;
  51
  52 : value-numbering-step ( insns -- )
  53     [ simplify value-number ] each ;
  54
  55 : value-numbering-iteration ( cfg -- )
  56     clear-exprs [ value-numbering-step ] simple-analysis ;
  57
  58 : determine-value-numbers ( cfg -- )
  59     final-iteration? off
  60     init-value-graph
  61     '[
  62         changed? off
  63         _ value-numbering-iteration
  64         changed? get
  65     ] loop ;
  66
  67 ! ! ! Global common subexpression elimination
  68
  69 GENERIC: gcse ( insn -- insn' )
  70
  71 M: array gcse [ gcse ] map ;
  72
  73 : defs-available ( insn -- insn )
  74     dup defs-vregs [ make-available ] each ;
  75
  76 M: alien-call-insn gcse defs-available ;
  77 M: ##callback-inputs gcse defs-available ;
  78 M: ##copy gcse defs-available ;
  79
  80 : ?eliminate ( insn vn -- insn' )
  81     dup available? [
  82         [ dst>> dup make-available ] dip <copy>
  83     ] [ drop defs-available ] if ;
  84
  85 : eliminate-redundancy ( insn -- insn' )
  86     dup >expr exprs>vns get at >avail-vreg
  87     [ ?eliminate ] [ defs-available ] if* ;
  88
  89 M: ##phi gcse
  90     dup inputs>> values [ vreg>vn ] map sift
  91     dup all-equal? [
  92         [ first ?eliminate ] unless-empty
  93     ] [ drop eliminate-redundancy ] if ;
  94
  95 M: insn gcse
  96     dup defs-vregs length 1 = [ eliminate-redundancy ] when ;
  97
  98 : gcse-step ( insns -- insns' )
  99     [ simplify gcse ] map flatten ;
 100
 101 : eliminate-common-subexpressions ( cfg -- )
 102     final-iteration? on
 103     compute-congruence-classes
 104     dup compute-avail-sets
 105     [ gcse-step ] simple-optimization ;
 106
 107 : value-numbering ( cfg -- )
 108     {
 109         needs-predecessors
 110         determine-value-numbers
 111         eliminate-common-subexpressions
 112         cfg-changed
 113         predecessors-changed
 114     } apply-passes ;