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 kernel accessors fry grouping
   4 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.gvn.alien
  13 compiler.cfg.gvn.comparisons
  14 compiler.cfg.gvn.graph
  15 compiler.cfg.gvn.math
  16 compiler.cfg.gvn.rewrite
  17 compiler.cfg.gvn.slots
  18 compiler.cfg.gvn.misc
  19 compiler.cfg.gvn.expressions ;
  20 IN: compiler.cfg.gvn
  21
  22 GENERIC: process-instruction ( insn -- insn' )
  23
  24 : redundant-instruction ( insn vn -- insn' )
  25     [ dst>> ] dip [ swap set-vn ] [ <copy> ] 2bi ;
  26
  27 :: useful-instruction ( insn expr -- insn' )
  28     insn dst>> :> vn
  29     vn vn set-vn
  30     vn expr exprs>vns get set-at
  31     insn vn vns>insns get set-at
  32     insn ;
  33
  34 : check-redundancy ( insn -- insn' )
  35     dup >expr dup exprs>vns get at
  36     [ redundant-instruction ] [ useful-instruction ] ?if ;
  37
  38 M: insn process-instruction
  39     dup rewrite
  40     [ process-instruction ]
  41     [ dup defs-vregs length 1 = [ check-redundancy ] when ] ?if ;
  42
  43 M: ##copy process-instruction
  44     dup [ src>> vreg>vn ] [ dst>> ] bi set-vn ;
  45
  46 M: array process-instruction
  47     [ process-instruction ] map ;
  48
  49 : value-numbering-step ( insns -- insns' )
  50     [ process-instruction ] map flatten ;
  51
  52 ! FIXME there's going to be trouble with certain rewrites that
  53 ! modify the cfg / instructions destructively; namely those in
  54 ! alien.factor and slots.factor
  55
  56 : value-numbering-iteration ( cfg -- )
  57     clear-exprs
  58     [ value-numbering-step drop ] simple-analysis ;
  59
  60 : identify-redundancies ( cfg -- )
  61     final-iteration? off
  62     init-value-graph
  63     '[
  64         changed? off
  65         _ value-numbering-iteration
  66         changed? get
  67     ] loop ;
  68
  69 : eliminate-redundancies ( cfg -- )
  70     final-iteration? on
  71     clear-exprs
  72     [ value-numbering-step ] simple-optimization ;
  73
  74 : value-numbering ( cfg -- cfg )
  75     dup identify-redundancies
  76     dup eliminate-redundancies
  77     cfg-changed predecessors-changed ;