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 GENERIC: value-number ( insn -- )
  31
  32 M: alien-call-insn value-number drop ;
  33 M: ##callback-inputs value-number drop ;
  34 M: ##copy value-number [ src>> vreg>vn ] [ dst>> ] bi set-vn ;
  35
  36 : redundant-instruction ( insn vn -- )
  37     swap dst>> set-vn ;
  38
  39 :: useful-instruction ( insn expr -- )
  40     insn dst>> :> vn
  41     vn vn set-vn
  42     vn expr exprs>vns get set-at
  43     insn vn vns>insns get set-at ;
  44
  45 M: insn value-number
  46     dup defs-vregs length 1 = [
  47         dup >expr dup exprs>vns get at
  48         [ redundant-instruction ] [ useful-instruction ] ?if
  49     ] [ drop ] if ;
  50
  51 : value-numbering-step ( insns -- )
  52     [ simplify ] map flatten [ value-number ] each ;
  53
  54 : value-numbering-iteration ( cfg -- )
  55     clear-exprs [ value-numbering-step ] simple-analysis ;
  56
  57 : determine-value-numbers ( cfg -- )
  58     final-iteration? off
  59     init-value-graph
  60     '[
  61         changed? off
  62         _ value-numbering-iteration
  63         changed? get
  64     ] loop ;
  65
  66 : value-numbering ( cfg -- cfg )
  67     needs-predecessors
  68     dup determine-value-numbers
  69
  70     cfg-changed predecessors-changed ;