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