extra/compiler/cfg/gvn/gvn.factor

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